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

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

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

Автор: korob2001 16.10.2003, 11:17

Всем здрасте!
Появилось желание написать что-то типа фото-альбома

Перейду сразу к вопросу. Есть такая форма:

Код


#!/usr/bin/perl -w
use strict;
use CGI;
my $cgi = new CGI;
print $cgi->header( -charset => 'Windows-1251' ),
          $cgi->start_html( -title => 'Выгрузка файла' ),
            $cgi->start_multipart_form( -action => $ENV{ SCRIPT_NAME } ),
              $cgi->table( { -width => '300' },
                $cgi->Tr( [
                  $cgi->td( { -width => '150' }, [
                    $cgi->b('Имя фографии:'),
                    $cgi->textfield( -name => 'name',
                                             -size   => '30' ),
                  ] ),
                ] ),
                $cgi->Tr( [
                  $cgi->td( { -width => '150' }, [
                    $cgi->b('Маленькая фото:'),
                    $cgi->filefield( -name => 'sml',
                                           -size   => '30' ),
                  ] ),
                 ] ),
                 $cgi->Tr( [
                   $cgi->td( { -width => '150' }, [
                     $cgi->b('Большая фото:'),
                     $cgi->filefield( -name => 'big',
                                            -size    => '30' ),
                   ] ),
                  ] ),
                  $cgi->Tr( [
                    $cgi->td( { -width => '150' }, [
                      $cgi->b('Коментарии:'),
                      $cgi->textarea( -name => 'com',
                                                -cols    => '30',
                                                -rows  => '5' ),
                    ] ),
                   ] ),
                   $cgi->Tr( [
                     $cgi->td( { -width => '300',
                                       -align  => 'center',
                                       -colspan => '2' },
                       $cgi->submit( -name => 'upl',
                                              -value => 'Загрузить' ),
                       $cgi->reset( -value => 'Отменить' ),
                     ),
                   ] ),
                ),
          $cgi->end_form(),
        $cgi->end_html();

Вопросы такие:

Каким образом получить файлы используя CGI.pm?
Как сделать что бы проходили только файлы с расширениями .gif и .jpg?
Где нужно указывать каталог в который будут сохраняться файлы?
Можно ли передавать файлы с текстом как в скипте выше?

Если есть возможность приведите пример.

Заранее благодарен,
Денис

Автор: Secandr 16.10.2003, 11:58

Я писал такую вещь, но без CGI.pm
На серваке должен остаться пример, вечером выложу.

Автор: korob2001 16.10.2003, 17:04

Написал такую подпрограмму:

Код


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

Вроде работает

Автор: Vavilen 21.1.2012, 18:44

Подскажите, пожалуйста, почему файлы сохраняются пустыми (0 байт)?

Код


sub upload {
    my $self = shift;
    my $filename_received = shift;
    my $file_received = shift;
    #my $file_received = '/home/orbital/001.JPG';
    #print $file_received;
    my $dir = +DIRECTORY;
    my ($name_received, $ext) = $filename_received =~ m/^(.*?)(?:\.(\w+))?$/;
    my $name =substr ( md5_hex(time() . rand()), 0, 10 );
    my $file = $name.".".$ext;
    #print "Content-Type: text/html \n\n";
    #print "Received filename is: ", $file_received, "\n";
    #print "$dir/$file";
    open (my $FH, ">$dir/$file")or die "Can`t open file for uploading! Error: ",$!, "\n\n";
    binmode $FH;
    my $buff;
    while (read($file_received, $buff, 512)) {
        print $FH $buff or die "Can`t print to FH. Error:", $!, "\n";
    }
    close ($FH) or die "Can`t close file. Error: ", $!, "\n";
    #close "$dir/$file";
    #chmod 0644, "$dir/$file";
    #print "The renamed filename is: ", $file, "\n\n";
    return $file;
} # // upload

Автор: tzirechnoy 21.1.2012, 19:32

Тут удивляет не то, что файлы получаются в 0 байт, а то, что они вообще откуда-то появляются: ведь sub upload нигде не вызывается, и вообще представленный скрипт на самом деле пустой.

Автор: tzirechnoy 21.1.2012, 20:10

1) Используйте $cgi->upload для получения хэндла файла и $cgi->param для получения возможного имени.
2) Кстати, маленькую картинку не генерировать на сервере -- это, как минимум, очень эклектично.

Код Вы, в принцыпе и сами в общем поняли, но что-то вроде (требует указать директорию, куда сохранять файл):

Код


my @errors = ();
my $filename = $q->param("sml");
my $fh = $q->upload("sml");
if (defined $fh) {
  $filename =~ m/([a-zA-Z_0-9-]*)\.?([a-zA-Z_0-9-]*)$/;
  my $basename = $1;
  my $ext = $2;
   # $ext вообще лучшэ выбросить, и определять тип по содержымому
  if ($ext =~ m/gif/i) {
    $ext = "gif";
  } else {
    $ext = "jpg";
  };
  if (length($basename) < 2) {
    $basename = time."";
  };
  $outfile = $dir."/".$basename.".".$ext;
  open(OUTFILE, ">$outfile") or die "Error opening file $outfile: $!";
  while ($bytesread = read($fh, $buffer, 1024)) {
     (print OUTFILE $buffer ) or die "Error writing outfile: $!"; 
  };
  die "Error reading file from sml input: $!" unless defined $bytesread; 
} else {
  my $err = "No file uploaded!";
  print STDERR $err;
  push @errors, $err;
};


...
if (length(@errors) > 0 ) {
  $cgi->h1({color => red}, join("<br>", @errors));
};

Автор: Vavilen 22.1.2012, 00:15

Цитата(tzirechnoy @ 21.1.2012, 20:10

)

Спасибо за ответ!
Ну, это не совсем скрипт. Это лишь метод класса. Не стал выкладывать весь модуль. Но вся движуха вокруг аплоада именно здесь.
Еще здесь я не использую CGI.pm. Окружение описывается парой модулей движка.
Приведенный Вами код , в принципе, несильно отличается от моего. Думаю, ошибка не в sub upload.