$fetched 是 Perl 中的一些隐式变量吗

Question

我正在尝试分析用 Perl 编写的 CGI 文件。我知道在文件 A 中声明的变量 uses/requires 文件 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())/eg;
   $value =~tr/+/ /;
   $value =~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex())/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);
}

Answer 1

这就是您在程序中不使用 use strict; use warnings; 时面临的问题。

fetched 是一个散列，可能包含您的表单数据。

另见：Autovivification in Perl

Answer 2

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.

perldoc strict

$fetched 是 Perl 中的一些隐式变量吗

Is $fetched some implicit variable in Perl

perl

variables

dbi