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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Выгрузка .gif и .jpg файлов на сервер 
:(
    Опции темы
korob2001
Дата 16.10.2003, 11:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

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



Всем здрасте!
Появилось желание написать что-то типа фото-альбома smile.gif
Перейду сразу к вопросу. Есть такая форма:
Код

#!/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?
Где нужно указывать каталог в который будут сохраняться файлы?
Можно ли передавать файлы с текстом как в скипте выше?

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

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


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


Связист
****


Профиль
Группа: Экс. модератор
Сообщений: 4043
Регистрация: 3.8.2003
Где: Russia, Volgograd

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



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


--------------------
Мышки плакали, кололись, но продолжали жрать кактусы (с) cisco
PM ICQ AOL   Вверх
korob2001
Дата 16.10.2003, 17:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 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);
 }
}

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

Это сообщение отредактировал(а) korob2001 - 16.10.2003, 17:06


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


Новичок



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

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



Подскажите, пожалуйста, почему файлы сохраняются пустыми (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

PM MAIL   Вверх
tzirechnoy
Дата 21.1.2012, 19:32 (ссылка)  | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1173
Регистрация: 30.1.2009

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



Тут удивляет не то, что файлы получаются в 0 байт, а то, что они вообще откуда-то появляются: ведь sub upload нигде не вызывается, и вообще представленный скрипт на самом деле пустой.
PM MAIL   Вверх
tzirechnoy
Дата 21.1.2012, 20:10 (ссылка)  | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1173
Регистрация: 30.1.2009

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



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));
};

PM MAIL   Вверх
Vavilen
Дата 22.1.2012, 00:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



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

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



Цитата(tzirechnoy @  21.1.2012,  20:10 Найти цитируемый пост)
1) Используйте $cgi->upload для получения хэндла файла и $cgi->param для получения возможного имени.
2) Кстати, маленькую картинку не генерировать на сервере -- это, как минимум, очень эклектично.

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

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


PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Perl: CGI программирование"
korob2001
sharq
  • В этом разделе обсуждаются вопросы относящиеся только к CGI программированию
  • Если ваш вопрос не относится к системному или CGI программированию, задавайте его в общем разделе
  • Если ваш вопрос относится к системному программированию, задавайте его здесь
  • Интерпретатор Perl можно скачать здесь ActiveState, O'REILLY, The source for Perl
  • Справочное руководство "Установка perl-модулей", качать здесь


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

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


 




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


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

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