Форум dkLab и Denwer
Здесь общаются Web-разработчики.
Генеральный спонсор:
Хостинг «Джино»

Разбор строки запроса. Загрузка (upload) файлов на сервер. (Ant)
Author Message
Ant
Сотрудник «Лаборатории»



Joined: 17 Jun 2003
Posts: 6836
Карма: 131
   поощрить/наказать


PostPosted: Sat Jun 26, 2004 11:58 pm ()
   Post subject: Разбор строки запроса. Загрузка (upload) файлов на сервер.
Reply with quote

По мотивам: Разбор строки запроса. (forum.dklab.ru/perl/heap/AnalysisOfALineOfInquiry.html).

Функция обрабатывает входные данные (либо GET-формата, либо POST, либо всё вместе — как недавно выяснилось, и такое возможно) и возвращает хэш данных. Если происходит загрузка файлов, то загружает их. Если передаются данные с одинаковыми именами (что-то вроде «q=1&q=2&w=3&w=4»), то возвращает хэш, где ключ — имя, а значение — анонимный массив, в котором содержатся все данные повторяющихся имён. Возможен многократный вызов функции — даже если метод передачи — «POST».
Code (perl): скопировать код в буфер обмена
# Parsing CGI query. If there's file to upload, then uploading file.
# If there're many values for one name then creating anonymous array.
{{{
my $cache; # «cache» for next calls
sub getQuery {
        return (www.perldoc.com/perl5.6/pod/func/return.html) %$cache if $cache;
        my ( $buffer, %in );

        # «multipart/form-data» request.
        if ( $ENV{ 'CONTENT_TYPE' } and $ENV{ 'CONTENT_TYPE' } =~ m (www.perldoc.com/perl5.6/pod/func/m.html){^multipart/form-data} ) {
                if ( $ENV{'REQUEST_METHOD'} ne 'POST' ) { return (www.perldoc.com/perl5.6/pod/func/return.html) } # wrong request for «multipart/form-data»

                # Read STDIN to buffer.
                binmode (www.perldoc.com/perl5.6/pod/func/binmode.html)( STDIN ); seek (www.perldoc.com/perl5.6/pod/func/seek.html)( STDIN, 0, 0 ); read (www.perldoc.com/perl5.6/pod/func/read.html)( STDIN, $buffer, $ENV{ 'CONTENT_LENGTH' } );
                my $boundary = "--".( $ENV{ 'CONTENT_TYPE' } =~ /boundary=("?)(\S+|[^"]+)\1/ )[ 1 ];
                $buffer = substr (www.perldoc.com/perl5.6/pod/func/substr.html)( $buffer, length (www.perldoc.com/perl5.6/pod/func/length.html)( $boundary ), index (www.perldoc.com/perl5.6/pod/func/index.html)( $buffer, $boundary."--\x0D\x0A" ) - length (www.perldoc.com/perl5.6/pod/func/length.html)( $boundary ) );

                # Parse buffer.
                for ( split (www.perldoc.com/perl5.6/pod/func/split.html)( /$boundary\x0D\x0A/, $buffer ) ) {
                           $_      = substr (www.perldoc.com/perl5.6/pod/func/substr.html)( $_, 0, length (www.perldoc.com/perl5.6/pod/func/length.html)( $_ ) - 2 );
                        my $pos    = index (www.perldoc.com/perl5.6/pod/func/index.html)( $_, "\x0D\x0A\x0D\x0A" );
                        my $header = substr (www.perldoc.com/perl5.6/pod/func/substr.html)( $_, 0, $pos );
                        my $value  = substr (www.perldoc.com/perl5.6/pod/func/substr.html)( $_, $pos + 4 );
                        my $name   = ( $header =~ /\bname=("?)([^\s:;]+|[^"]+)\1/     )[ 1 ];
                        my $fname  = ( $header =~ /\bfilename=("?)([^\s:;]+|[^"]*)\1/ )[ 1 ];
                          #$fname  = substr( $fname, rindex( $fname, "\\" ) + 1 ) if $fname;

                        # Uploading file.
                        if ( $header =~ /filename=/i ) {
                                if ( $in{ $name } ) {
                                        if ( ref (www.perldoc.com/perl5.6/pod/func/ref.html) $in{ $name }[ 0 ] ) {
                                                push (www.perldoc.com/perl5.6/pod/func/push.html)( @{ $in{ $name } }, [ $fname, $value ] )
                                        } else {
                                                my @temp = delete (www.perldoc.com/perl5.6/pod/func/delete.html)( $in{ $name } );
                                                push (www.perldoc.com/perl5.6/pod/func/push.html)( @{ $in{ $name } }, @temp, [ $fname, $value ] );
                                        }
                                } else { $in{ $name } = [ $fname, $value ] }
                        # Usual variable.
                        } else {
                                if ( $in{ $name } ) {
                                        if ( ref (www.perldoc.com/perl5.6/pod/func/ref.html) $in{ $name } ) {
                                                push (www.perldoc.com/perl5.6/pod/func/push.html)( @{ $in{ $name } }, $value )
                                        } else {
                                                my $temp = delete (www.perldoc.com/perl5.6/pod/func/delete.html)( $in{ $name } );
                                                push (www.perldoc.com/perl5.6/pod/func/push.html)( @{ $in{ $name } }, $temp, $value );
                                        }
                                } else { $in{ $name } = $value }
                        }
                }
        # Usual request.
        } else {
                if ( $ENV{ 'REQUEST_METHOD' } eq "POST" ) { read (www.perldoc.com/perl5.6/pod/func/read.html)( STDIN, $buffer, $ENV{ 'CONTENT_LENGTH' } ) }
                $buffer .= $buffer ? $ENV{ 'QUERY_STRING' } : '&'.$ENV{ 'QUERY_STRING' };

                $buffer =~ s (www.perldoc.com/perl5.6/pod/func/s.html)/&(?!amp;)/&/g; # XHTML standard
                for ( split (www.perldoc.com/perl5.6/pod/func/split.html)( /&/, $buffer ) ) {
                        my ( $name, $value ) = split (www.perldoc.com/perl5.6/pod/func/split.html)( /=/ );
                        if ( $name ) {
                                for ( $name, $value ) {        tr (www.perldoc.com/perl5.6/pod/func/tr.html)/+/ /; s (www.perldoc.com/perl5.6/pod/func/s.html)/%([a-fA-F0-9][a-fA-F0-9])/pack (www.perldoc.com/perl5.6/pod/func/pack.html)("C", hex (www.perldoc.com/perl5.6/pod/func/hex.html)($1))/eg; }
                                if ( $in{ $name } ) {
                                        if ( ref (www.perldoc.com/perl5.6/pod/func/ref.html) $in{ $name } ) {
                                                push (www.perldoc.com/perl5.6/pod/func/push.html)( @{ $in{ $name } }, $value )
                                        } else {
                                                my $temp = delete (www.perldoc.com/perl5.6/pod/func/delete.html)( $in{ $name } );
                                                push (www.perldoc.com/perl5.6/pod/func/push.html)( @{ $in{ $name } }, $temp, $value );
                                        }
                                } else { $in{ $name } = $value }
                        }
                }
        }
        $cache = \%in;
        return (www.perldoc.com/perl5.6/pod/func/return.html) %$cache;
}}}}
Вызов:
Code (perl): скопировать код в буфер обмена
my %in = getQuery();
Примеры:
[1] При передачи обычных переменных («host/cgi-bin/script.pl?q=1&q=2&w=2&e=3», например) получим хеш:
Code (perl): скопировать код в буфер обмена
#
%in == (
    'q' => [ 1, 2 ],
    'w' => '2',
    'e' => '3'
);

#
$in{ 'q' }[ 0 ] == '1';
$in{ 'q' }[ 1 ] == '2';
$in{ 'w' } == '2';
$in{ 'e' } == '3';
[2] При закачке файлов получим следующее:
Code (perl): скопировать код в буфер обмена
# Получаем хэш:
%in == (
    'q'          => [ 1, 2 ], # простые данные
    'w'          => '2',      # простые данные
    'e'          => '3',      # простые данные
    'file'       => [ имя_файла, содержимое_файла ], # файл
    'many_files' => [ [ имя_файла, содержимое_файла  ], [ имя_файла, содержимое_файла  ] ] # файлы из полей с одинаковым именем
);

# Или (что тоже самое):
$in{ 'q' }[ 0 ] == '1';
$in{ 'q' }[ 1 ] == '2';
$in{ 'w' } == '2';
$in{ 'e' } == '3';
$in{ 'file' }[ 0 ] == 'имя_файла';
$in{ 'file' }[ 1 ] == 'содержимое_файла';
$in{ 'many_files' }[ 0 ][ 0 ] == 'имя_файла';
$in{ 'many_files' }[ 0 ][ 1 ] == 'содержимое_файла';
$in{ 'many_files' }[ 1 ][ 0 ] == 'имя_файла';
$in{ 'many_files' }[ 1 ][ 1 ] == 'содержимое_файла';
Дмитрий Котеров:
Огромное спасибо за предыдущую критику. Новая приветствуется. (-;

М

Обсуждение всего, что каким-либо образом связано с функцией в данной теме, прошу проводить здесь: Разбор строки запроса. (forum.dklab.ru/perl/heap/AnalysisOfALineOfInquiry.html)
Back to top
View user's profile Send private message Send e-mail
Ant
Сотрудник «Лаборатории»



Joined: 17 Jun 2003
Posts: 6836
Карма: 131
   поощрить/наказать


PostPosted: Sun Jun 27, 2004 4:57 pm (спустя 16 часов 58 минут)
   Post subject:
Reply with quote


!

Я же просил все обсуждения проводить в теме Разбор строки запроса. (forum.dklab.ru/perl/heap/AnalysisOfALineOfInquiry.html)! Захотите получить ответ, пишите туда.
Back to top
View user's profile Send private message Send e-mail
Ant
Сотрудник «Лаборатории»



Joined: 17 Jun 2003
Posts: 6836
Карма: 131
   поощрить/наказать


PostPosted: Sun Jun 27, 2004 4:57 pm (спустя 22 секунды)
   Post subject:
Reply with quote


М

Тема закрыта.
Back to top
View user's profile Send private message Send e-mail
Display posts from previous:   
Post new topic   This topic is locked: you cannot edit posts or make replies. All times are GMT + 3 Hours
Page 1 of 1    Email to a Friend.
You cannot post new topics in this forum. You cannot reply to topics in this forum. You cannot edit your posts in this forum. You cannot delete your posts in this forum. You cannot vote in polls in this forum. You cannot attach files in this forum. You can download files in this forum.
XML