Mikayil Abdullayev Mikayil Abdullayev - 2 months ago 13
Perl Question

Is $fetched some implicit variable in Perl

I'm trying to analyze a CGI file written in Perl. I know that a variable declared in file A that uses/requires file B is available in file B as long as it's global. But please take a look at this piece of code:

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";
}


Where is this
$fetched
variable taken from? The
$configs
avriable, for instance, comes from a config file. I've searched all the files in the directory there's no
$fetched
anywhere. Is it some kind of implicit variable when fetching data? If not, then where else should I look?

Just in case, I'm posting the whole code.

#!/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);
}

Answer

Perl is seeing that you are using a variable named %fetched so it just goes ahead and creates one for you. This is behavior that is a hold over from the early days of Perl.

You should use strict; at the top of your file, and then declare my %fetched; near the top, since it is being used as a global variable.

Compare:

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

Comments