Forum Webscript.Ru
Программирование => Perl => Тема начата: Yuraz от 19 Июля 2002, 09:14:13
-
Всех приветствую!
Встретился с такой проблемой, в первый раз решил использовать закачку файлов на сайте, сделал все по книге CGI-программирование, Павлова.
Форма на экран выводится, после заполнения полей и указания файла, нажимаю кнопку отправить. Браузер начинает отсчитывать секунды и минуты, и ни чего. Подскажите, в чём проблема?
Пользуюсь W2K, Apache 3.12, Perl, на локалхосте.
#!/usr/local/bin/perl
#fileput.pl
#############
#############
$datafile="fotos.txt"; #
$fotodir="."; #
$cgi = "http://127.0.0.8/cgi-bin/fileput.pl";
#############
#
#############
print "Content-type: text/html\\n\\n"; #
if($ENV{\'REQUEST_METHOD\'} eq \'GET\'){$query=$ENV{\'QUERY_STRING\'};}
else{sysread(STDIN,$query,$ENV{\'CONTENT_LENGTH\'});}
if($query eq \'\'){
print <
FORM
}
else{
if($ENV{\'CONTENT_TYPE\'}=~/multipart/){
($bound)=($ENV{\'CONTENT_TYPE\'}=~/boundary=(\\S+)/);
@parts=split(/\\n--$bound(-)*/,$query);
@parts=grep($_ ne \'\' ,@parts);
foreach(@parts){
($header,$body)=split(/\\n\\s*\\n/,$_,2);
($name)=(/name=\\"([^\\"]*)\\"/);
$body=~s/\\n$//;
$body=~s/\\r$//;
($filename)=(/filename\\"([^\\"]*)\\"/);
if($name eq \'username\'){$username=$body;}
if($name eq \'useremail\'){$useremail=$body;}
if($name eq \'usercomment\'){$usercomment=$body;}
if($name eq \'userfoto\'){$userfoto=$body;$userfilename=$filename;}
}
}
else{}
$userfilename1=$userfilename;
$filedup=0;
while(-e "$fotodir/$userfilename1"){
$userfilename1="$filedup_$userfilename";
$filedup++;
}
open(F,">$fotodir/$userfilename1");
print F $userfoto;
close(F);
open(DATA,">>$datafile");
print DATA "$username::$useremail::$userfilename1::$usercomment\\n";
close(DATA);
print "";
print "!!!!!!!!!!!!!!!!!!!!!!";
print "";
}
-
Фак смотрим, да?
Там есть работающий пример.
P.S.: И каждый раз находиться кто-то, кто пытается сделать разбор параметров ручками. Ээээ...надоели....
-
Да, забыл указать, после Submit, Apache подвисает, комп работает под 100%, пока Apache принудительно не закроешь, так и будет под 100% висеть. В логах Apache ничего не пишет.
PS: Может у кого есть другой примитив скрипта этой же реализации?
-
Фак смотрим, да?
Там есть работающий пример.
Сорри, сейчас смотрю.
-
Да, забыл указать, после Submit, Apache подвисает, комп работает под 100%, пока Apache принудительно не закроешь, так и будет под 100% висеть. В логах Apache ничего не пишет.
PS: Может у кого есть другой примитив скрипта этой же реализации?
Это ещё что значит? После выполнения скрипта Апач перезапускать надо? В чем проблема может быть?
-
use strict;
use Fcntl;
Хорош пример, ничего не скажешь.
-
А вообще, без модулей, как закачка реализуется? Откуда данные файла считываются? Из STDIN читаются?
Ни у кого нет работающего примера?
-
Откуда данные файла считываются? Из STDIN читаются?
А модуль посмотреть? :)
-
Хорош пример, ничего не скажешь.
Сарказм? Напрасно.
-
А модуль посмотреть?
А подсказать? ;)
-
А подсказать?
Предлагаешь мне его поковырять? :)
-
Сарказм? Напрасно.
Не хочется инсталировать различные модули. Хотя да, с этими модулями код уж очень простой в факе.
Вопрос, почему ж мой то не пашет, из книги Павлова? Набрал вроде один к одному, 500 ошибок не выдаёт. Может дело в
-
Не хочется инсталировать различные модули.
Сложно их вырезать из стандартной поставки Perl...Вопрос, почему ж мой то не пашет, из книги Павлова?
Это вопрос, вероятно, к Павлову. :)
-
Вопрос, почему ж мой то не пашет, из книги Павлова?
//quote]
Ну давайте начнем обсуждать правильно ли в книге Павлова сделан разбор multpart/form-data.:)
Если очень интересно посмотри как сделано тоже самое в CGI.
-
Короче говоря, проанализировав твой(Павлова) код и симптомы Апач, я пришел к выводу, что баг в этих местах:
...
foreach(@parts){
($header,$body)=split(/\\n\\s*\\n/,$_,2);
($name)=(/name=\\"([^\\"]*)\\"/); - - - - - лажа
$body=~s/\\n$//;
$body=~s/\\r$//;
($filename)=(/filename\\"([^\\"]*)\\"/); - - - - - лажа
...
попробуй ($name) = ($header =~ /name=\\"?([^"\\]*\\"/);
($filename) = ($header =~ /filename=\\"?([^"\\]*\\"/) соответственно.
Может я и ошибаюсь, но в любом случае используй хотя бы -w.
А вот в конструкции
...
while(-e "$fotodir/$userfilename1"){
$userfilename1="$filedup_$userfilename"; - - - полная лажа
$filedup++;
}
...
правильно будет $userfilename1="$filedup\\_$userfilename";
тут ошибка на 100%, потому как "$filedup_$userfilename" интерпретируеться как "$filedup_"+"$userfilename". Первое у нас - андеф, соответственно мы получаем замкнутый цыкл - потому Апач и виснет.
На первый взгляд болше топорных ошыбок я не встретил.
Удачи!
-
Serchey спасибочи за разбор, сейчас ещё возьмусь за этот скрипт, о результатах расскажу.
-
($name)=(/name=\\"([^\\"]*)\\"/); - - - - - лажа
$body=~s/\\n$//;
$body=~s/\\r$//;
($filename)=(/filename\\"([^\\"]*)\\"/); - - - - - лажа
...
попробуй ($name) = ($header =~ /name=\\"?([^"\\]*\\"/);
($filename) = ($header =~ /filename=\\"?([^"\\]*\\"/) соответственно.
С этим вообще не работает, а вот
правильно будет $userfilename1="$filedup\\_$userfilename";
действительно помогло, но не совсем, теперь файлы как бы уходят, прописывается в txt файл что пришло, а вот сам файл (картинка, архив) превр. в бинарный файл размером от 3 до 60 байт
-
Извени, вышла ошибочка:
($name) = ($header =~ /name=\\"?([^"\\]*\\"/);
($filename) = ($header =~ /filename=\\"?([^"\\]*\\"/) соответственно
не поставил ")":
($name) = ($header =~ /name=\\"([^"\\]*)\\"/);
($filename) = ($header =~ /filename=\\"([^"\\]*)\\"/) соответственно.
Ты 100% процентов работаешь под Виндой(ну ладно, 99%), а потому перед записью в файл укажи binmode:
open(F,">$fotodir/$userfilename1") || die "Can\'t write: $!\\n";
binmode(F);
print F $userfoto;
close F;
-
В общем такой скрипт получился, ошибок нет, но и файлы не сохраняет.. даже однобайтовых сейчас не делает..
#!/usr/local/bin/perl -w
#fileput.pl
#############
#############
$datafile="fotos.txt"; #
$fotodir="C:/"; #
$cgi = "http://127.0.0.8/cgi-bin/fileput.pl"; #ÊÀÊ_ÂÛ_ÎÁÎÇÂÀËÈ_ÑÊÐÈÏÒ
#############
#
#############
print "Content-type: text/html\\n\\n"; #
if($ENV{\'REQUEST_METHOD\'} eq \'GET\'){$query=$ENV{\'QUERY_STRING\'};}
else{sysread(STDIN,$query,$ENV{\'CONTENT_LENGTH\'});}
if($query eq \'\'){
print <
FORM
}
else{
if($ENV{\'CONTENT_TYPE\'}=~/multipart/){
($bound)=($ENV{\'CONTENT_TYPE\'}=~/boundary=(\\S+)/);
@parts=split(/\\n--$bound(-)*/,$query);
@parts=grep($_ ne \'\' ,@parts);
foreach(@parts){
($header,$body)=split(/\\n\\s*\\n/,$_,2);
($name) = ($header =~ /name=\\"([^\\"]*)\\"/);
$body=~s/\\n$//;
$body=~s/\\r$//;
($filename) = ($header =~ /filename=\\"([^\\"]*)\\"/);
if($name eq \'username\'){$username=$body;}
if($name eq \'useremail\'){$useremail=$body;}
if($name eq \'usercomment\'){$usercomment=$body;}
if($name eq \'userfoto\'){$userfoto=$body;$userfilename=$filename;}
}
}
else{}
$userfilename1=$userfilename;
$filedup=0;
while(-e "$fotodir/$userfilename1"){
$userfilename1="$filedup\\_$userfilename";
$filedup++;
}
open(F,">$fotodir/$userfilename1");
binmode(F);
print F $userfoto;
close(F);
open(DATA,">>$datafile");
print DATA "$username::$useremail::$userfilename1::$usercomment\\n";
close(DATA);
print "";
print "Файлик закачан";
print "";
}
-
Скрипт закачки из FAQ точно ли рабочий?
http://progres.h1.ru/cgi-bin/up2.pl
не работает
Люди! Помогите! Я устал от этих закачек, 2 недили не могу настроить.... Есть сервер, пустой, на фри хостинге(http://ini.h1.ru). Скину пароли кто сможет хотя бы этот примитивный скрипт настроить там. Оплачу работу в этот же день, почтовым переводом. Мне очень очень надо чтобы была простая закачка - и тут же (ниже формы) обзор всей директории с галочками(кнопками) для удаления файла. Всё. По цене обговорим, напишите rec@ezmail.ru, по возможности отвечу сразу, на тех же условиях приму готовый скрипт
-
А как насчёт обменника? если надо он там (http://66.hoha.ru/obmennik/)
логин: script
пасс: LLk9F8rS
-
Yuraz вот попробуй запустить эту функцию закачки, единственное эта функция которая обрабатывает, не полный скрипт...
что будешь зачачивать -> $praiz.
sub praiz_close
{
my $praiz = param(\'praiz\');
my($format1);
my $path_praiz="../www/name/file/"; #### куда закачивать будем
# проверяем
if ($praiz eq "")
{
error(\'Файл не был выгружен !\');
}
else
{
my $name=$praiz;
my($filename,$i,$TOname,$savename,$bytesread,$buffer);
$filename=$name;
$i = rindex( $filename,"\\\\") + 1 ;
$TOname = substr( $filename, $i, 255 );
$savename = "$path_praiz/".$TOname;
#### проверка какой файл был закачен, допускаем только файл с расширением zip, xls, doc
if ( ($filename !~ /zip/i) && ($filename !~ /xls/i) && ($filename !~ /doc/i) )
{
error(\'Файл должен быть загружен в формате - Zip, Excel или Word\');
}
#### delite old
opendir(DIR,"$path_praiz") or die;
my @files=readdir DIR;
closedir(DIR);
foreach my $files(@files)
{
unlink("$path_praiz/$files");
}
### close
open (IMG, "> $savename") || die "Can\'t open $savename: $!";
flock IMG, $LOCK_EX;
while ($bytesread=read($filename,$buffer,1024)) { print IMG $buffer; }
flock IMG, $LOCK_UN;
close(IMG);
$praiz=$TOname;
$format1=$praiz;
my @temp=split /\\./,$format1;
$format1=$temp[1];
}
}
-
Energizer, спасибо, уже справился с этой задачей, благодаря Глебу с этого форума, так же ещё нащёл много файловых скриптов, как раз с закачкой и ещё многих функции, ссылка ниже
http://www.scriptsearch.com/Perl/Scripts_and_Programs/File_Management