Камрад
|
Khabarik
к сожалению на данный момент слабо, да и не вижу смысл из-за одного скрипта учить Perl.
У меня есть один подобный скрипт, но к сожалению он делает слишком громоздкую таблицу, т.е. все время вставляет тэги размера шрифта, урлы. Как мог я его подрезал, но больше ничего сделать не смог, буду очень благодарен, если кто-нибудь подскажет, как его исправить, текст привожу ниже:
----------------------------------------------------------
#!/usr/local/bin/perl -w
# CGI sсript to maintain a text database.
# Version 1.0 by Kjeld Borch Egevang <kbe@iname.com>
# See http://www.egevang.dk/dvd for latest version
# Simply change "field_names" to get more or different fields.
# Fix @com.pany as needed.
# Use as you please.
use strict;
use CGI ':standard';
use Fcntl ':flock'; # import LOCK_* constants
#######################################
# Variables
#######################################
my $q = new CGI;
my @parms = $q->param();
my @field_names = ("Artist", "Album", "Year", "Bitrate");
my %pu_values;
my %def_value;
my $database = "list_tab.txt";
my $myself = $q->self_url;
my $sort_key = $q->param('sort_key');
my $action = $q->param('action');
my $user_name = $q->cookie("user name");
$sort_key = "1" if !$sort_key;
$action = 'view' if !$action;
$myself =~ s/\?.*//;
$ENV{PATH}="";
my @sort_keys = split(/_/, $sort_key);
if (@sort_keys != @field_names) {
my $i = 1;
my $p;
@sort_keys = ();
foreach $p (@field_names) {
@sort_keys = (@sort_keys, $i++);
}
}
my @pu_type = ("PAL", "NTSC", "Audio");
my @pu_genre = ("Drama", "Action", "Comedy", "Non-fiction", "Music",
"DVD Audio", "DTS (Audio only)");
$pu_values{"Type"} = \@pu_type;
$pu_values{"Genre"} = \@pu_genre;
my ($sec, $min, $hour, $mday,
$mon, $year, $wday, $ydat, $isdst) = localtime();
$def_value{"Oprettet"} = sprintf("%4d.%02d.%02d", $year+1900, $mon+1, $mday);
#######################################
# Main
#######################################
if ($action eq 'view') {
&view_data;
}
################################################
# View data
################################################
sub view_data() {
my $url;
my $i;
my $p;
my $k;
my $line;
my @nkeys;
my @database;
my @rec;
my $fld;
my $cookie = $q->cookie(
-name=>"user name",
-value=>$user_name,
-expires=>"+2y");
open (RBASE,"<$database") or die "open failed: $!";
@database = <RBASE>;
close (RBASE);
@database = sort { &sort_func($a, $b) } @database;
print $q->header(-cookie=>$cookie);
print $q->start_html("DVD List")."\n";
print $q->style("a:link { color: #325d46; text-decoration: none }",
"a:visited { color: #000000; text-decoration: none }",
"a:active { color: #000000; text-decoration: none }",
"a:hover { color: #999999; text-decoration: underline }");
print $q->start_font({-face=>'Arial', -size=>'2'});
print $q->h1($q->i("DVD List"));
print "\n".$q->start_table({-border=>'1'})."\n";
print $q->start_Tr();
$i = 1;
foreach $p (@field_names) {
if ($i == $sort_keys[0]) {
@nkeys = -$sort_keys[0];
}
else {
@nkeys = $i;
}
foreach $k (@sort_keys) {
if (abs($k) == $i) {
next;
}
@nkeys = (@nkeys, $k)
}
$url = $myself."?action=view&sort_key=".join("_", @nkeys);
print $q->th({-bgcolor=>"#F2C973", -size=>'2'},
$q->a({-href=>$url}, $p));
$i++;
}
print $q->end_Tr()."\n";
foreach $line (@database) {
chomp($line);
@rec = split(/ /, $line);
if (@rec < 3) {
next;
}
$i = 0;
foreach $p (@field_names) {
if ($i >= @rec) {
$fld = "";
}
else {
$fld = $rec[$i];
}
if ($i == 0) {
print $q->td($q->font({-size=>'2'},
$q->a({-href=>$url}, $fld)));
}
elsif ($i == 2) {
my $mail;
$mail = "mailto:$rec[2]\@com.pany?subject=DVD: $rec[0]";
$mail .= "&body=Can I borrow your DVD: $rec[0]?";
print $q->td($q->font({-size=>'2'},
$q->a({-href=>$mail}, $fld)));
}
elsif ($i == 6) {
if (!$fld) {
$fld = "http://www.imdb.com/Find?".$q->escapeHTML($rec[0]);
if (lc($rec[0]) =~ /^the /) {
$fld =~ s/(...) (.*)/$2, $1/;
}
}
print $q->td($q->font({-size=>'2'},
$q->a({-href=>$fld}, "link")));
}
else {
print $q->td($q->font({-size=>'2'}, $fld));
}
$i++;
}
print $q->end_Tr()."\n";
}
print $q->end_table()."\n";
print $q->address($q->a({-align=>"right",
-href=>"mailto:maintainer\@com.pany"}, "maintainer"))."\n";
print $q->end_font()."\n";
print $q->end_html()."\n";
}
################################################
# Sort fields
################################################
sub sort_func {
my ($line1, $line2) = @_;
my (@rec1, @rec2);
my $retval;
my $p;
my $si;
@rec1 = split(/ /, $line1);
@rec2 = split(/ /, $line2);
for (my $i = 0; $i < @sort_keys; $i++) {
$si = $sort_keys[$i];
if (abs($si) > @rec1) {
return -$si/abs($si);
}
if (abs($si) > @rec2) {
return $si/abs($si);
}
if ($si > 0) {
$retval = $rec1[$si-1] cmp $rec2[$si-1];
}
else {
$retval = $rec2[-$si-1] cmp $rec1[-$si-1];
}
if ($retval) {
return $retval;
}
}
return 0;
}
|