Модераторы: korob2001, ginnie
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> загрузка файлов на сервер, загрузка файлов на сервер 
:(
    Опции темы
Vinnety
  Дата 13.12.2004, 21:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 69
Регистрация: 8.4.2003

Репутация: нет
Всего: нет



Помогите, пожалуйста!
Никак не могу сделать нормальную загрузку файлов на сервер! 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. В чем дело? Как от этого избавиться?
PM MAIL   Вверх
korob2001
Дата 13.12.2004, 22:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

Репутация: 13
Всего: 61



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

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

Удачи


--------------------
"Время проходит", - привыкли говорить вы по неверному пониманию. 
"Время стоит - проходите вы".
PM MAIL WWW ICQ MSN   Вверх
Phoinix
Дата 14.12.2004, 02:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 41
Регистрация: 16.11.2004
Где: Moskau

Репутация: 1
Всего: 2



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
PM WWW ICQ   Вверх
korob2001
Дата 14.12.2004, 02:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

Репутация: 13
Всего: 61



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

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


--------------------
"Время проходит", - привыкли говорить вы по неверному пониманию. 
"Время стоит - проходите вы".
PM MAIL WWW ICQ MSN   Вверх
Kiber_rat
Дата 23.12.2004, 09:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


MACMANIAC
**


Профиль
Группа: Участник
Сообщений: 276
Регистрация: 18.4.2002
Где: Ashdod, Israel

Репутация: 1
Всего: 9



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


--------------------
Best regards!                                                             
@..@_____Ku6ep
=*=______\______KPbIC
Код
print join "",map{chr}(split/(\w{2})/,hex(int(2175.57302796298**2)))
PM WWW ICQ Skype Jabber YIM   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Perl: CGI программирование"
korob2001
sharq
  • В этом разделе обсуждаются вопросы относящиеся только к CGI программированию
  • Если ваш вопрос не относится к системному или CGI программированию, задавайте его в общем разделе
  • Если ваш вопрос относится к системному программированию, задавайте его здесь
  • Интерпретатор Perl можно скачать здесь ActiveState, O'REILLY, The source for Perl
  • Справочное руководство "Установка perl-модулей", качать здесь


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, korob2001, sharq.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Perl: разработка для Web | Следующая тема »


 




[ Время генерации скрипта: 0.0730 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.