Что-то при интерпретации следующего скрипта у меня
вылезает сообщение:
Execution of redirect.pl aborted due to compilation errors.
Скрипт простой. По адресу электронной почты генерирует его же, только в виде набора картинок, которые сохранены в каталоге '../WWW/alphabet'. Скрипт копирует нужные буквы в каталог '.../WWW/cache' причем с новыми именами. Все каталоги имеют аттрибуты rwx-rwx-rwx. Причем под IIS все работает пучком, а на внешнем хосте - нет.
| Код | #!/usr/local/bin/perl -w
use strict 'refs';
use lib '..';
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use genpass;
$query=new CGI;
if ($query->param('mail') eq "yes")
{
my $imgname;
print "Content-type:text/html\n\n";
print $query->start_html(-title=>"E-mail address",
-style=>{'src'=>'../css/theme.css'});
print <<HTML;
Интересующий Вас адрес следующий<br><br>
<div align="center">
HTML
my @symb=("*",":","\\","/",".","<",">","|","\"",";","{","}");
my @names=("star","dblpoint","slash","backslash","point","leftarr","rightarr","strike","quote","semicolon","leftcurl","rightcurl" );
my @wr_params;
$wr_params[0]=$query->param('name');
$wr_params[1]=$query->param('domen');
chdir "../WWW/cache/";
opendir CACHE, ".";#"../WWW/cache/";
readdir(CACHE);
readdir(CACHE);#чтобы убрать '..' и '.'
my @files;
@files=readdir(CACHE);
unlink @files;
closedir CACHE;
my $filename;
for ($k=0;$k<=1;$k++)
{
@a=split(//,$wr_params[$k]);
for ($j=0;$j<=length($wr_params[$k])-1;$j++)
{
print "<IMG SRC=\"../cache/";
$let=$a[$j];
if (ord($let)>=ord('A') && ord($let)<=ord('Z'))
{
$filename="_".$let;
}
else
{
$found=0;
for ($i=0;$i<=@symb;$i++)
{
if ($let eq $symb[$i])
{
$filename=$names[$i];
$found=1;
last;
}
}
if ($found==0)
{
$filename=$let;
}
}
$filename.=".gif";
$newfilename=&genpass::genpass(18).".gif";
link "../alphabet/".$filename, $newfilename;
print $newfilename,"\">";
#$cnt++;
}
if ($k!=1)
{
print "<IMG SRC=\"../alphabet/@.gif\">";
}
}
#$dbh->disconnect;
print "\n</div><hr>","<div align=\"center\"><input type=\"Button\" onClick=\"self.close();\" value=\"Закрыть\"></div>",$query->end_html;
}
else
{
print $query->redirect(-uri=>$query->$query->param('domen'),
-nph=>1);
} |
|