我正在尝试分析用Perl编写的CGI文件。我知道在文件A中声明的使用/需要文件B的变量在文件B中可用，只要它是全局的。但请看一下这段代码：
sub makeoper {
%attr = (
PrintError => 0,
RaiseError => 0
);
$dbh=DBI->connect($configs{db_source},$configs{db_user},$configs{db_passw},\%attr) or die "Can not connect to database: $DBI::errstr!\n";
if ($fetched{submit} eq 'start' and !$fetched{savefr} )
{$fetched{savefr}=&get_time_fromdb;
$fetched{saveto}='';
system "mv pool/*.txt pool/arc/";
}
#some more else ifs
$dbh->disconnect or die "Database connection not made: $DBI::errstr";
}
此$fetched变量取自何处？例如，$configs avriable来自配置文件。我搜索了目录中的所有文件，其中没有$fetched。在获取数据时它是某种隐式变量吗？如果没有，那么我应该在哪里看？
以防万一，我发布了整个代码。
#!/usr/bin/perl -w
use DBI;
#$ENV { "ORACLE_HOME" } = "/d01/conf/oracle/product/924";
sub printPage(){
&parse_form || exit;
print "Content-type: text/html\n\n";
&makeoper;
#&makeoper;
print "<html><head></head>
<body>
<h3>$configs{servicename}</h3>
<form action='$ENV{REQUEST_URI}' method='post'>
<table align='center' width='96%' border='1'>
<tr>
<td width='50%' align='left' valign='top'>
Online-cutting <br><br>
<input type=hidden name='savefr' value='$fetched{savefr}'>$fetched{savefr}
-
<input type=hidden name='saveto' value='$fetched{saveto}'>$fetched{saveto}
<br>
<input type=submit name='submit' value='start'>
<input type=submit name='submit' value='cut'>
<input type=submit name='submit' value='stop'>
</td>
<td align='left' valign='top' bgcolor='\#eeeeee'>
Take history <br>
<small>
(times in format: YYYY-MM-DD HH:MI:SS<br>
or YYYY-MM-DD HH:MI<br>
or YYYY-MM-DD )<br>
example: 2004-08-22 17:13:04<br>
2004-08-22 17:13<br>
2004-08-22<br>
</small>
<input type=text size=20 name='histfr' value='$fetched{histfr}'>
-
<input type=text size=20 name='histto' value='$fetched{histto}'><br>
<input type=submit name='submit' value='history'>
</td>
</tr>
</table>
</form>
<br><br>
";
&print_filepool;
print "</body></html>";
exit;
}
sub makeoper {
# $error="pingvin";
%attr = (
PrintError => 0,
RaiseError => 0
);
$dbh=DBI->connect($configs{db_source},$configs{db_user},$configs{db_passw},\%attr) or die "Can not connect to database: $DBI::errstr!\n";
#print DBI->
#die "Cannot connect to DB!" if (!defined $dbh);
if ($fetched{submit} eq 'start' and !$fetched{savefr} )
{$fetched{savefr}=&get_time_fromdb;
$fetched{saveto}='';
system "mv pool/*.txt pool/arc/";
}
elsif ($fetched{submit} eq 'cut' and $fetched{savefr} )
{$fetched{saveto}=&get_time_fromdb;
&dumptofile($fetched{savefr},$fetched{saveto});
$fetched{savefr}=$fetched{saveto};
$fetched{saveto}='';
}
elsif ($fetched{submit} eq 'stop' and $fetched{savefr} )
{$fetched{saveto}=&get_time_fromdb;
&dumptofile($fetched{savefr},$fetched{saveto});
$fetched{savefr}='';
$fetched{saveto}='';
}
elsif ($fetched{submit} eq 'history')
{
system "mv pool/*.txt pool/arc/";
&normalize_times($fetched{histfr},$fetched{histto});
&humanize_times($fetched{histfr},$fetched{histto});
&dumptofile($fetched{histfr},$fetched{histto});
}
$dbh->disconnect or die "Database connection not made: $DBI::errstr";
}
sub get_time_fromdb {
$sth=$dbh->prepare("select to_char(sysdate,'YYYY-MM-DD HH24:MI:SS') from dual ");
$sth->execute();
$row=$sth->fetchrow_arrayref;
$sth->finish;
return $row->[0];
}
sub dumptofile { #pass savefr,saveto
my ($savefr,$saveto)=@_;
$sth=$dbh->prepare("SELECT * FROM $configs{dbtable}
WHERE (mess_dir='I' OR mess_dir='A' OR mess_dir='R') "
.($configs{nums_filter}
? " and b_num in $configs{nums_filter} "
: ''
)
." and in_date>to_date(?,'YYYY-MM-DD HH24:MI:SS')
and in_date<to_date(?,'YYYY-MM-DD HH24:MI:SS')
ORDER BY b_num, in_date
");
$sth->execute($savefr,$saveto);
$destnum = "";
if ($configs{nums_div})
{open OFI,">pool/$savefr - $saveto - mark.txt";
close OFI;
while ($row=$sth->fetchrow_arrayref)
{if ($row->[2] ne $destnum)
{$destnum=$row->[2];
open OFI,">pool/$savefr - $saveto - $destnum.txt";
}
$row->[3]=~s/[\r\n]/ /mg;
print OFI join("\t",@$row),"\n";
}
}
else
{open OFI,">pool/$savefr - $saveto.txt";
while ($row=$sth->fetchrow_arrayref)
{print OFI join("\t",@$row),"\n";}
}
close OFI;
$sth->finish;
}
sub print_filepool {
opendir IDI,'pool/';
foreach $afile (sort { $b cmp $a } readdir IDI)
{if ($afile=~/txt\Z/)
{print "<a target='_blank' href='$configs{pathtopool}/$afile'>";
print `wc -l \'pool/$afile\'`;
print "</a><br>\n";
};
};
closedir IDI;
print "<br><a target='_blank' href='list.cgi?arc'>ARC</a><br>\n";
}
sub parse_form { #sets %fetched=('name0'=>'content0',..)
if ($ENV{'CONTENT_LENGTH'}>$configs{'universal_maxinfosize_totake'}) {return 0;};
read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
if (length($buffer)<5) {$buffer=$ENV{QUERY_STRING};};
@pairs=split(/&/,$buffer);
foreach $pair (@pairs)
{local($name,$value)=split(/=/, $pair);
$name =~tr/+/ /;
$name =~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~tr/+/ /;
$value =~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~s/[<>\n\r|`]/ /mg;
if ($fetched{$name} eq '') {$fetched{$name}=$value;}
else {$fetched{$name}.="\a$value";};
}
return 1;
}
sub normalize_times { #pass fr_time, to_time
$_[0]=~s/\D+//sg;
$_[1]=~s/\D+//sg;
$_[0].='000000' if ($_[0]=~m/^\d{8}$/);
$_[1].='235959' if ($_[1]=~m/^\d{8}$/);
$_[0].='00' if ($_[0]=~m/^\d{12}$/);
$_[1].='59' if ($_[1]=~m/^\d{12}$/);
$_[1]='' if ($_[1]!~m/^\d{14}$/);
}
sub humanize_times { #pass fr_time, to_time
$_[0]=substr($_[0],0,4)."-".substr($_[0],4,2)."-".substr($_[0],6,2)
." ".substr($_[0],8,2).":".substr($_[0],10,2).":".substr($_[0],12,2);
$_[1]=substr($_[1],0,4)."-".substr($_[1],4,2)."-".substr($_[1],6,2)
." ".substr($_[1],8,2).":".substr($_[1],10,2).":".substr($_[1],12,2);
}
答案 0 :(得分：5)
Perl看到你正在使用一个名为%fetched的变量，所以它就会继续为你创建一个变量。这种行为是Perl早期的延续。
您应该在文件顶部use strict;，然后在顶部附近声明my %fetched;，因为它被用作全局变量。
比较
perl -e '$foo{bar}=42; print $foo{bar} . "\n";'
42
perl -e 'use strict; $foo{bar}=42; print $foo{bar} . "\n";'
Global symbol "%foo" requires explicit package name at -e line 1.
Execution of -e aborted due to compilation errors.
答案 1 :(得分：4)