Помогите, пожалуйста!
Никак не могу сделать нормальную загрузку файлов на сервер!
Подскажите пример загрузки файлов на сервер !!!
А я делаю так :

Код

sub manager_ImageSave() {  my ($Name, $ImageData) = @_;    # Полный путь к файлу  my $FileName = $path_Images_Abs . $Name;     #  binmode ($ImageData);  open(TMPFILE, "$ImageData");  my @inf = <TMPFILE>;  close(TMPFILE);    # Записываем файл на диск   eval {    open (FILE, ">$FileName") || warn($^E);    binmode FILE;    print FILE @inf;    close (FILE);   }; }

где
$Name - имя сохраняемого файла,
$ImageData - полный путь сохраняемого файла (т.е. источник)
$FileName - полный путь файла для сохранения (т.е. приемник)

Проблема : почему то не всегда корректно сохраняет,
бывает что пишет размер файла = 0 , или если сохраняешь картинку
то не все цвета сохраняет и т.д. Но и иногда нормально работает.
В чем дело? Как от этого избавиться?

Проблема2 : почему то в Internet Explorere работает почти всегда нормально
загрузка графических файлов, а вот например в Mozilla FireFox - вообще не сохраняет
графические файлы - пишет размер = 0. В чем дело? Как от этого избавиться?

Попробуй такой пример:

Код

#-> Подпрограмма получает имя файла и имя каталога куда #    нужно загрузить файл загружает его в указанную дерикторию #    и возвращает true - если файл #   успешно загружен и false если была ошибка sub writeUploadFile {  my $file = shift;  my $dir  = shift;  my $uri  = $file;  my ( $size, $buff, $bytes );       $size = $bytes = 0;       $file =~ s/\s+$//;       return(0) unless $file =~ /\.(?:gif|jpg)$/i;       $file =~ s/\w://i;       $file =~ s/([^\/\\]+)$//;       $file = $1;       $file =~ s/\.\.+//g;       $file =~ s/^\s+//;       $file =~ s/\s+//g;       return(0) unless $file =~ /^(?:[A-Z,a-z,0-9]+\.(?:gif|jpg))$/i;  local *SAVE;   open (SAVE, ">$dir/$file") or die "Can\'t create file \"$dir/$file\": $!";    binmode SAVE;    while ($bytes = read($uri, $buff, 2096)) {      $size += $bytes;      print SAVE $buff;    }   close(SAVE) or die "Can\'t close file \"$dir/$file\": $!"; if ( -e "$dir/$file" ) {   return(1); } else {   return(0); } }

Но он пропустит только файлы с расширением .gif, .jpg. Если понадобятся другие, то придется немного подправить.

Удачи

korob2001
Я, конечно, извиняюсь, но Ваш код несколько... перемудрен...
в часности:

Код

close(SAVE) or die "Can\'t close file \"$dir/$file\": $!";

и т.д.
про flock совсем забыли, нехорошо

Все можно сделать гораздо проще:

Код

sub writeUploadFile { my $file = shift; #handle файла my $dir  = shift; #директория, куда сохраняем # Эти сложные манипуляции весьма непонятны # my $uri  = $file; # my ( $size, $buff, $bytes ); #      $size = $bytes = 0; #      $file =~ s/\s+$//; #      return(0) unless $file =~ /\.(?:gif|jpg)$/i; #      $file =~ s/\w://i; #      $file =~ s/([^\/\\]+)$//; #      $file = $1; #      $file =~ s/\.\.+//g; #      $file =~ s/^\s+//; #      $file =~ s/\s+//g; #      return(0) unless $file =~ /^(?:[A-Z,a-z,0-9]+\.(?:gif|jpg))$/i; # local *SAVE;  my ($filename, $file_ext) = $file =~m/^.*(?:\/|\\|^)(\w+)\.(\w+)$/;  if (!$filename || !$file_ext) {return 'false'}  if (!grep{/^$file_ext$/}qw(gif jpg png)) {return 'false'} #соответственно (gif jpg png) - разрешенные типы файлов   open (SAVE, ">$dir/$filename.$file_ext") or die "Can\'t create file \"$dir/$filename.$file_ext\": $!";   binmode SAVE;   flock SAVE, 2;   print SAVE while (<$file>);   close(SAVE);# or die "Can\'t close file \"$dir/$file\": $!";   close($file);   chmod 0644, "$dir/$filename.$file_ext"; # Лишняя проверка, т.к. если мы смогли его открыть, то он существует #if ( -e "$dir/$file" ) { #  return(1); #} else { # return(0); #}   return 'true' }

И все... код сократился в 2 раза без потери функциональности...

Это сообщение отредактировал(а) Phoinix - 14.12.2004, 02:04

Согласен.
Но, давай тогда и этот код маланько сократим.

Цитата

if (!$filename || !$file_ext) {return 'false'} if (!grep{/^$file_ext$/}qw(gif jpg png)) {return 'false'}

От фигурных скобок можно избавиться, лишний мусор.

Код

return 'false' if (!$filename || !$file_ext) return 'false' if (!grep{/^$file_ext$/}qw(gif jpg png))

Возвращать лучше всётаки цифры, так как они возвращаются для того что бы их сравнивали, а цифры Perl сравнивает быстрее, да и компактнее получится условие.
Зачем использовать if, если в условии сразу установлено отрицание? Не проще ли заюзать unless? Код будет понтнее.

А почему не использовать библиотеку CGI?

Код

use CGI qw(:standard); my $fh = CGI::param('infile'); exit if $fh !~ /gif|jpg|png$/; open OUT,">/tmp/$fh"; print OUT $_ while(<$fh>); close OUT;

infile - имя поля <INPUT TYPE=FILE NAME=infile> в форме

Это сообщение отредактировал(а) Kiber_rat - 23.12.2004, 09:34