Upload File (Загрузка файла на сервер средствами Perl)

В статье представлен пример загрузки файла на сервер средствами Perl.
Код программы:

#!/usr/bin/perl # используйте -T для CGI-скриптов
  $SIG{ALRM} = sub { die "$0 timed out" }; # эти 2 строки не работают под
  alarm 900; # Windows, но они необязательны
  use strict; # спасает от глупых ошибок
  use Fcntl; # O_EXCL, O_CREAT и O_WRONLY
  use CGI qw (:standard); # читайте "perldoc CGI"
  use CGI::Carp qw (fatalsToBrowser); # вывод ошибок к browser-у 
  $CGI::POST_MAX = 131072; # максимальный ввод = 128 KB
  my $foto = param ('foto'); # имя файла и одноврем. handle
  my $DIR = '/home/alex/pics' # не забудьте "chmod 777 pics"
  my $JS = " // JavaScript-функция для пред-
  // варительной проверки формы
  function check (form)
  {
  if (form.elements['foto'].value.length < 4)// foto должно быть заполнено
  {
  alert ('A gde zhe foto?'); // показать JavaScript-окошко
  form.elements['foto'].select (); // выделить текст в поле foto
  form.elements['foto'].focus (); // и прыгнуть туда курсором
  return false; // false запретит browser-у
  } // отправлять данные к серверу
  return true; // все OK - можно отправлять
  }";
  print header (-type => 'text/html; charset=koi8-r'),
  start_html (-title => 'МИСС ИHТЕРHЕТ', # напечатать заголовок и $JS
  -script => $JS);
   
  # regex внизу проверяет, есть ли .gif или .jp(e)g в конце и кладет имя
  # файла в $1
  if ($foto !~ /([\w-]+ \. (?: gif | jpe?g ))$/ix) #только имя,путь выкидывается
  {
  print h1 ('Отправьте нам фото!'), #start_form работать не будет
  start_multipart_form (-onsubmit => 'return check (this)'),
  filefield (-name => 'foto'),
  submit (-value => 'Go baby go!'), # напечатать форму с кнопкой
  end_form; # напечатать 
  }
  # Этот скрипт никому не мешает вводить мусор (например xxxx.gif) в поле foto,
  # что приведет к созданию пустых файлов; если это Вас беспокоит, установите
  # новую версию CGI.pm и прочтите
  # http://stein.cshl.org/WWW/software/CGI/#upload 
  elsif (not sysopen FILE, "$DIR/$1", O_EXCL | O_CREAT | O_WRONLY, 0444)
  {
  print h1 ("Hе могу создать $DIR/$1: $!"); # ошибка или такой файл уже есть
  }
  # Портятся файлы при посылке? См. ниже!
  else # все в порядке - файл создан
  {
  binmode FILE; # включить binmode для Windows
  print FILE while (<$foto>); # и скопировать данные в файл
  close FILE;
  print h1 ('Сердечное Вам спасибо!'); # воспитывать как собак Павлова
  }
  print end_html; # напечатать 


Если закачка некоторых файлов происходит с глюками - видимо, файл перекодируется на лету русским апачем.
Варианты решения:
1.запретите все перекодировки для скрипта, который разбирает FileUpload, например таким способом: CharsetDisable On и делайте перекодировку сами.
2.Используйте директиву CharsetRecodeMultipartForms, которая появилась в PL23, но при этом вам все равно придется перекодировать вручную текстовые части запросов. Для этого можно использовать Russian Apache API, доступное в других модулях или Russian Apache Perl API, доступное из mod_perl.


Источник: http://ucozmaster.ru/publ/perl_cgi/upload_file_zagruzka_fajla_na_server_sredstvami_perl/4-1-0-13
| Автор: Денис
X
Ссылка:
BB-код:
HTML-код:

Похожие материалы
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Войти на сайт
%