Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Perl: разработка для Web > загрузка файлов на сервер

Автор: Vinnety 13.12.2004, 21:58

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

Подскажите пример загрузки файлов на сервер !!! smile

А я делаю так :

Код

 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. В чем дело? Как от этого избавиться?

Автор: korob2001 13.12.2004, 22:22

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

Код


#-> Подпрограмма получает имя файла и имя каталога куда
#    нужно загрузить файл загружает его в указанную дерикторию
#    и возвращает 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. Если понадобятся другие, то придется немного подправить.

Удачи

Автор: Phoinix 14.12.2004, 02:01

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 раза без потери функциональности...

Автор: korob2001 14.12.2004, 02:49

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

Цитата

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? Код будет понтнее.

Автор: Kiber_rat 23.12.2004, 09:27

А почему не использовать библиотеку 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> в форме