Достала меня эта загрузка файлов???
Задача такая:
1) Надо загрузить только фотографии на сервер формата JPG, GIF или PNG размером меньше 3 метров.
2) Каким образом определить тип файла, не по его расширению. Наподобие IMAGE::INFO
3) Каким образом определить размер файла.
4) Сохранить файл в каталоге, но если такой файл существует, то переименовать в любой другой.
Если есть, у кого код такой Приблуды попрошу предоставить
Но ответы типа смотри Perldoc меня не устраивают, желательно реальные примеры.
Спасибо за внимание

1,2,3 - никто за Вас писать готовый код не будет, Вам arto уже пожсказал как узнать тип файла.
размер файла можно узнать прочитав, например, $ENV{'CONTENT_LENGTH'}.
4 -

Код

if(-e "имя_файла") { $new_file_name="ново_имя"; }

Цитата

1) Надо загрузить только фотографии на сервер формата JPG, GIF или PNG размером меньше 3 метров.

смотри поиск + ре на проверку типа файла

Цитата

2) Каким образом определить тип файла, не по его расширению. Наподобие IMAGE::INFO

Чем тебя готовые решения в виде модулей не устаривают?
Можешь открывать файл на чтение и искать в них: GIF87 (.gif) или JFIF (.jpeg) и т.д. - хотя это геморр.

Цитата

3) Каким образом определить размер файла.

Код

my $file = '/path/img.jpg'; my $size = -s $file;

Цитата

4) Сохранить файл в каталоге, но если такой файл существует, то переименовать в любой другой.

Сохранить - это открыть файл на запись , и записать в него содержимое картинки.

ЗЫ Если ты думаешь, что за тебя кто-нибудь весь код напишет, то ты ошибаешься.
Попробуй сам, есил не получится, поможем.

Размер файла можешь так же определять по ходу загрузки на сервер, примерно так:

Код

# Максимально допустимый размер файла в килобайтах my $max = 700;  # Переводим в байты $max *= 1024; my $file = $cgi->param('file'); my $size = 0; my $buff; my( $type ) = $file =~ /(\.(?:gif|jpg|png))$/i; open( W, "> upload_file$type" ) or die $!; binmode W; while ( read( $file, $buff, 512 ) ) {             # Вот здесь проверяем размер с максимально допустимым             if ( $size > $max ) {                  close(W);                  unlink("new_file$type") or die $!;                  print "Your file is big\n";                  exit 0;             }             print W $buff;             $size += 512; } close(W);

Другими словами, мы грузим только нужно кол-во байт, как только размер привысил максимально допустимый размер, згрузка прекращается. Только код я не тестировал.

Код

; use CGI 2.47 ; use Image::Info qw/image_info/ ; $CGI::POST_MAX=3000 * 1024 #Максимальный размер - 3 Мб (п. 1) ; my $q = new CGI ; print $q->header # ... текст скрипта ... ; my $IMG = $q->upload('img') ; my $imgi = image_info($IMG) ; unless($imgi->{error} and $imgi->{file_ext}!~/jpg|gif|png/) # подходящий файл (п. 2)    { print "image is ".$imgi->{file_ext}    ; print $q->br() x 2    ; seek($IMG, 0, 2)    ; print "image size ".tell($IMG) # размер файла (п. 3)    ; seek($IMG, 0, 0)    ; my $filename=$IMG    ; if(-e "/tmp/$filename") # генерирование уникального имени файла (п. 4)       { while(1) { last unless -e "/tmp/".($filename = "@{[int rand 10}$filename") }       }    ; if(open FH, ">/tmp/$filename")       { binmode FH       ; print FH $_ while(<$IMG>)       ; close FH       }    }   else    { print "Нераспознанный формат файла!"     }

Это сообщение отредактировал(а) Kannabismus - 22.11.2005, 03:53

Вот мой пример записи и определения типа файла.

Код

use CGI qw/:standard/; use File::Spec(); $CGI::POST_MAX = 3074 * 1024; $CGI::DISABLE_UPLOADS = 0; foreach my $TEMP (upload('files')) {         my $err='0';         if (uploadInfo($TEMP)->{'Content-Type'} eq 'image/gif') {}         elsif (uploadInfo($TEMP)->{'Content-Type'} eq 'image/bmp') {}         elsif (uploadInfo($TEMP)->{'Content-Type'} eq 'image/png') {}         elsif (uploadInfo($TEMP)->{'Content-Type'} eq 'image/jpeg') {}         elsif (uploadInfo($TEMP)->{'Content-Type'} eq 'image/x-png') {}         elsif (uploadInfo($TEMP)->{'Content-Type'} eq 'image/pjpeg') {}         else {$err='1';}         if ($err eq '0') {           ( my $name = $TEMP ) =~ s#.*[\]:\\/]##;           $name =~ tr/ /_/ unless $^O eq 'MSWin32';           $name =~ tr/-+@a-zA-Z0-9. /_/cs;           ($name) = $name =~ /^([-+@\w. ]+)$/;           my $path = File::Spec->catfile( "/home/images/news/", $name );           my $i = 2;           while (1) {             last unless -e $path;             $name =~ s/([^.]+?)(?:_\d+)?(\.|$)/$1_$i$2/;             $path = File::Spec->catfile( "/home/images/news/", $name );             $i++;           }           open my $OUT, '>', $path;           binmode $OUT;           while ( read $TEMP, my $buffer, 1024 ) {             print $OUT $buffer;           }           close $TEMP;           close $OUT;         }       }

все работает если поле files не одно а несколько
но как только я вставляю модуль Image::Info

Код

my $img = image_info($TEMP);

тогда файл записывается но при просмотре он неотображается
в теле нет заголовка GIF... и т.д.

Думаю проблема в этих строках:

Код

open my $OUT, '>', $path; binmode $OUT; while ( read $TEMP, my $buffer, 1024 ) {             print $OUT $buffer; } close $OUT; close $TEMP;

Что-то открытие файла у тебя очень странно выглядит, да и его дескриптор. Попробуй эту часть заменить на такую.

Код

open (OUT, "> $path") or die $!; binmode OUT; while ( read $TEMP, my $buffer, 1024 ) {             print OUT $buffer; } close OUT;

korob2001 ты не прав, так можно делать и так даже лучше, не надо беспокоиться об именование дескриптора, perl сам это сделает и можно не закрывать дескриптор.


ежик

Цитата

foreach my $TEMP (upload('files')) {

Лучше писать так:

Код

my $desciptors = upload('files'); # ссылка на массив дескрипторов foreach my $temp (@$descriptors) { ... }

Цитата

my $err='0';         if (uploadInfo($TEMP)->{'Content-Type'} eq 'image/gif') {}         elsif (uploadInfo($TEMP)->{'Content-Type'} eq 'image/bmp') {}         elsif (uploadInfo($TEMP)->{'Content-Type'} eq 'image/png') {}         elsif (uploadInfo($TEMP)->{'Content-Type'} eq 'image/jpeg') {}         elsif (uploadInfo($TEMP)->{'Content-Type'} eq 'image/x-png') {}         elsif (uploadInfo($TEMP)->{'Content-Type'} eq 'image/pjpeg') {}         else {$err='1';}         if ($err eq '0') {         ...         }

Это вообще ужас, как так можно писать???

Код

my $mime = uploadInfo($TEMP)->{'Content-Type'}; unless ($mime eq 'image/gif' || $mime eq 'image/png' || $mime eq 'image/jpeg' || $mime eq image/x-png' || $mime eq 'image/pjpeg') {  print "Ok!";  ... } else {  print "Error!";  ... }

Цитата

open my $OUT, '>', $path;           binmode $OUT;           while ( read $TEMP, my $buffer, 1024 ) {             print $OUT $buffer;           }           close $TEMP;           close $OUT;

Если ты используешь upload, то используй его до конца.

Код

open my $out, '>', $path; binmode $out; print $out while <$temp>;

Цитата

но как только я вставляю модуль Image::Info Выделить всёкод Perl 1: my $img = image_info($TEMP); тогда файл записывается но при просмотре он неотображается в теле нет заголовка GIF... и т.д.

Значит ты не пишешь заголовок картинки.

И последнее - раз ты ограничиваешь POST, то

Код

if ((!$description || !@$description) && cgi_error()) {       print header(-status=>cgi_error());       exit 0;    }

Это сообщение отредактировал(а) sharq - 22.11.2005, 12:31

Цитата

korob2001 ты не прав, так можно делать и так даже лучше, не надо беспокоиться об именование дескриптора, perl сам это сделает и можно не закрывать дескриптор.

sharq - насчёт именования понятно, всё же код выглядит намного понятнее, когда ты сам даёшь имя дескриптору. Объясни мне пожалуйста, чем же лучше, когда Perl выберает дескриптор самостоятельно?

Насчёт закрытия не прав ты. Файл можно конечно не закрывать, но это всё же рекомендуют делать практически в каждом учебнике по Perl. Так же при работа с базой, можно и не отключаться от базы, это произойдёт автоматически, но опять же это рекомендуют делать. Наверное не просто так.

korob2001 вопрос не в наглядности, а в том, что глобальный дескриптор, назначаемый нами, может уже существовать и произойдут нехорошие вещи. Поэтому когда ты описываешь переменную, ты заботишься только о название переменной и все, а название дескриптора тебя уже не интересует.

Ларри Уолл. Camel Book.

Цитата

[19] Opening an already opened filehandle implicitly closes the first file, making it inaccessible to the filehandle, and opens a different file. You must be careful that this is what you really want to do. Sometimes it happens accidentally, like when you say open($handle,$file), and $handle happens to contain the null string. Be sure to set $handle to something unique, or you'll just open a new file on the null filehandle.

На счет закрытия я не спорю, но иногда полезно не закрывать.

Цитата

$out, '>', $path;

понимает Perl начиная с версии 5.006 (кстати Уолл именно так и рекомендует работать с файлами)
недавно столкнулся с этим, залив скрипт на хостера у которого стоит Perl v.5.004 и PHP 5… ммм-да.
т.е. или проверять версию Perl в начале скрипта или писать традиционно

Цитата

OUT, "> $path"