Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Perl: разработка для Web > Забавный глюк


Автор: Acraft 1.12.2005, 21:17
наблюдается интересная вещь - скрипт выполняется только в том
случае, если находится в файле с имененем gd.pl
Если файл со скриптом переименовать (скажем в gd1.pl), то скрипт перестает
работать. Я не знаю с чем это связано. (Может быть с какими-то настройками
сервера). Потому что имя файла в коде скрипта никак не фигуриет.
smile

Автор: korob2001 1.12.2005, 23:40
Это скорее всего связано не с сервером а с провами доступа. Нужно установить 0755.
К тому же имя файла не обязательно должно быть явно указано. Например такой файл при запуске удаляет сам себя.
Код

#!/usr/bin/perl
unlink($0);

Можно того же результата добиться и таким образом, если это CGI
Код

#!/usr/bin/perl
unlink( $ENV{SCRIPT_NAME} );

Но опять же если эта переменная есть в окружении.

А вообще гадать очень сложно, ты бы код выложил. Тогда можно найти причину данного явления. Но для начала установи прова доступа.

Автор: Acraft 2.12.2005, 01:52
smile Права выставлены, не настолько я еще в маразме нахожусь smile

Вот код.

Код

#!/usr/bin/perl
use GD;
use gdconf;

&main;

sub do_convert {
    my ($inpath, $outpath, $filename, $neww , $newh) = @_;
    my $ImageOrg;

    $ImageOrg = newFromPng GD::Image($inpath.$filename, 1);
    if (!defined($ImageOrg)) {
        $ImageOrg = newFromJpeg GD::Image($inpath.$filename, 1);

    }

    if(defined($ImageOrg)) {
        my ($oldw, $oldh) = $ImageOrg->getBounds();

        #print "Content-type: image/jpeg\n\n";
        $im = new GD::Image($neww , $newh, 1);
        $im->copyResampled($ImageOrg, 0, 0, 0, 0, $neww, $newh, $oldw, $oldh);


        open(FILE, ">".$outpath.$filename);
        binmode (FILE);
        print FILE $im->jpeg;
        close(FILE);
    }
}

sub process {
    my ($inpath, $outpath, $neww , $newh) = @_;

    if (!($inpath =~ /\/$/)) {
        $inpath .= "/";
    }

    if (!($outpath =~ /\/$/)) {
        $outpath .= "/";
    }

    opendir(DIR, $inpath);
    @files = readdir(DIR);
    $total=$#files-1;
    close(DIR);
        $from=$FORM{from};
        $resized=$FORM{resized};

        $C=100;
    @files=@files[$from..$from+$C-1];
    $i=0;
    foreach (@files) {
        if (-f $inpath.$_) {
            #print $_."<br>";
            if (( -e  $outpath.$_ )) {
            unlink($outpath.$_);    
            }
                     do_convert($inpath, $outpath, $_, $neww, $newh);
                     $resized++;
        }

    }
$from+=$C;
$proc=int(($from/$total)*100);
if($proc>100){$proc=100;}
print "<font size=5><b>";
print $proc;
print "% Complete.</b></font><br>";
print $resized." photos resized.<br>";
if($from<$total)
  {
print<<a
<form name=form1 action="gd.pl" method=post>
a
;
print "<input type=hidden name=\"from\" value=\"".$from."\">";
print "<INPUT type=hidden name=inpath value=\"$FORM{inpath}\">";
print "<INPUT type=hidden name=outpath value=\"$FORM{outpath}\">";
print "<INPUT type=hidden name=width value=\"$FORM{width}\">";
print "<INPUT type=hidden name=height value=\"$FORM{height}\">";
print "<INPUT type=hidden name=work value=\"ok\">";
print "<INPUT type=hidden name=resized value=\"$resized\">";
print<<b
</form>
<script language="JavaScript">
  document.form1.submit();
</script>
b
;
exit;
}
else
{
  print "Done. <a href=\"gd.pl\">Go back</a>.";
  exit;
}
}
sub main {

    print "Content-type: text/html\n\n";

if ($ENV{'REQUEST_METHOD'} eq "GET") {
        $buffer = $ENV{'QUERY_STRING'};
}
elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
}
@pairs = split(/&/, $buffer);
foreach $pair (@pairs)
{
    ($name, $value) = split(/=/, $pair);
    # Un-Webify plus signs and %-encoding
    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $FORM{$name} = $value;
    $name =~ s/_/ /g;
    $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
}
        if ($FORM{from}>=0&&$FORM{work} eq "ok") {

        $inpath = $FORM{inpath};
        $outpath = $FORM{outpath};

        $width = $FORM{width};
        $height = $FORM{height};

        if ((! ($width =~/^\d+$/ )) || ($width == 0)) {
            $error .= "Invalid width. ";
        }

        if ((! ($height =~/^\d+$/ )) || ($height == 0)) {
            $error .= "Invalid height. ";
        }

        if ($error eq "") {
            &process($inpath, $outpath, $width, $height);
            print "... processed";
            exit;
        }
    }

  print<<X_HTML;
<HTML>
<BODY>
<FONT color="#FF0000"><CENTER>$error</CENTER></FONT>

<P>
<strong>Smart image resizing script</strong>
</P>
<FORM method=post>
<INPUT type=hidden name=action value="process">
<INPUT type=hidden name=from value="0">
<INPUT type=hidden name=resized value="0">
<INPUT type=hidden name=work value="ok">
<strong>Input directory:</strong><BR>
<INPUT name=inpath size=80 value="$inpath"><BR>
<strong>Output directory:</strong><BR>
<INPUT name=outpath size=80 value="$outpath"><BR>
<strong>New width:</strong><BR>
<INPUT name=width size=8 value="$width"><BR>
<strong>New height:</strong><BR>
<INPUT name=height size=8 value="$height"><BR>
<INPUT type=submit name=submit value="Resize!">
</FORM>
</BODY>
</HTML>
X_HTML


}


Сканируем папку /tmp, и ресайзим все тамошние графические файлики в заданной разрешение в другую папку.

Автор: korob2001 2.12.2005, 04:17
Я так понимаю проблема кроется в строке 74:
Код

<form name=form1 action="gd.pl" method=post>

Для того, что бы не менять значение action каждый раз, когда переименовуешь файл, просто не указывай его вообще. Если он не указан, то программа отправляет форму программе, которая сгенерировала эту форму, т.е. сама себе:
Код

<form name=form1 method=post>

Можешь так же установить action в значение переменной окружения $ENV{SCRIPT_NAME}, указывает на себя:
Код

<form name=form1 action="$ENV{SCRIPT_NAME}" method=post>

Если использовать CGI.pm, то можно сделать так:
Код

#!usr/bin/perl
use CGI;
my $cgi = new CGI;
print $cgi->start_form( -action => $cgi->url( -relative => 1 ),
                        -name   => "form1" );
# здесь выводишь поля формы
print $cgi->end_form();

В данном случае, на лету, генерируется аналогичная форма.

Так же, таким образом, можно получить своё текущее имя:
Код

my $me = (split(/\/|\\/, $0))[-1];
print qq[<form name=form1 action="$me" method=post>];


Та же проблема и в строке 95:
Код

print "Done. <a href=\"gd.pl\">Go back</a>.";

Так как это ссылка, то здесь первый вариант и вариант с CGI.pm не прокатят, потому выберай любой другой.
Но проблему с CGI.pm можно решить так, как показано в следующем коде. Аналогичная ссылка с CGI.pm:
Код

my $cgi = new CGI;
print $cgi->a( { -href => $cgi->url( -relative => 1 ) }, "Go back" );


Теперь можешь назвать файл так, как пожелаешь. smile

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)