AnyEvent-HTTPD-ExtDirect

 view release on metacpan or  search on metacpan

lib/AnyEvent/HTTPD/ExtDirect.pm  view on Meta::CPAN

    # If form is not involved, it's easy: just return raw POST (or undef)
    if ( !$is_form ) {
        my $postdata = $req->content;
        return $postdata ne '' ? $postdata
               :                 undef
               ;
    };

    # If any files are attached, extUpload field will be set to 'true'
    my $has_uploads = $req->param('extUpload') eq 'true';

    # Outgoing hash
    my %keyword;

    # Pluck all parameters from the Request object
    for my $param ( $req->params ) {
        my @values = $req->param($param);
        $keyword{ $param } = @values == 0 ? undef
                           : @values == 1 ? $values[0]
                           :                [ @values ]
                           ;
    };

    # Find all file uploads
    for ( $has_uploads ? ($has_uploads) : () ) {
        # The list of fields that contain file uploads
        my @upload_fields = $req->upload_fields;
        
        last unless @upload_fields;
        
        my @uploaded_files;
        
        for my $field_name ( @upload_fields ) {
            my $uploads = $req->raw_param($field_name);

            # We need files as a formatted list
            my @field_uploads = map { $self->_format_upload($_) } @$uploads;
            push @uploaded_files, @field_uploads;

            # Now remove the field that contained files
            delete @keyword{ $field_name };
        }

        $keyword{ '_uploads' } = \@uploaded_files if @uploaded_files;
    };

    # Metadata is JSON encoded; decode_metadata lives by side effects!
    if ( exists $keyword{metadata} ) {
        RPC::ExtDirect::Util::decode_metadata($self, \%keyword);
    }

    # Remove extType because it's meaningless later on
    delete $keyword{ extType };

lib/AnyEvent/HTTPD/ExtDirect.pm  view on Meta::CPAN

    return \%keyword;
}

### PRIVATE INSTANCE METHOD ###
#
# Take the file content and metadata and format it in a way
# that RPC::ExtDirect handlers expect
#

sub _format_upload {
    my ($self, $upload) = @_;
    
    my $content_length = do { use bytes; length $upload->[0] };
    
    my ($fh, $fname) = File::Temp::tempfile;
    
    binmode $fh;
    syswrite $fh, $upload->[0], $content_length;
    
    sysseek $fh, 0, 0;
    
    # We don't need the file content anymore, so try to release
    # the memory it takes
    $upload->[0] = undef;
    
    my $filename = $upload->[2];
    my $basename = File::Basename::basename($filename);
    my $type     = $upload->[1];
    my $handle   = IO::File->new_from_fd($fh->fileno, '<');

    return {
        filename => $filename,
        basename => $basename,
        type     => $type,
        size     => $content_length,
        path     => $fname,
        handle   => $handle,
    };

lib/AnyEvent/HTTPD/ExtDirect.pm  view on Meta::CPAN

    AnyEvent::HTTPD::ExtDirect::Env;

use parent 'AnyEvent::HTTPD::Request';

#
# AnyEvent::HTTPD::Request stores the form parameters in a peculiar format:
# $self->{parm} is a hashref of arrayrefs; each arrayref contain one
# or more values, again in arrayrefs with fixed number of items: 
# [ content, content-type, file-name ]
#
# For anything but file uploads, the last 2 elements are undef; for the
# file uploads they're the file MIME type and name, respectively.
#
# A dump might look like this:
#
# $self->{parm}:
# 0 HASH
#   'formFieldName' => ARRAY
#       0 ARRAY =>
#           0 'form field value'
#           1 undef
#           2 undef

lib/AnyEvent/HTTPD/ExtDirect.pm  view on Meta::CPAN

#       0 ARRAY =>
#           0 'first file content (all of it!)'
#           1 'first file MIME type'
#           2 'first file name'
#       1 ARRAY =>
#           0 'second file content'
#           1 'second file MIME type'
#           2 'second file name'
# 
# There is no method that returns multiple values for a non-file field,
# and no method that returns file upload parameters, so we have to
# roll our own
#

sub param {
    my ($self, $key) = @_;
    
    return $self->params unless defined $key;
    
    # [] is to avoid autovivification biting my ass ;)
    my @values = map { $_->[0] } @{ $self->{parm}->{$key} || [] };
    
    return wantarray ? @values : shift @values;
}

# Go over the fields and return the list of names for the fields
# that contain file uploads
sub upload_fields {
    my ($self) = @_;
    
    my @upload_fields;
    
    my $params = $self->{parm};
    
    FIELD:
    for my $field_name ( keys %$params ) {
        my $values = $params->{ $field_name };
        
        for my $value ( @$values ) {
            
            # We surmise that for a file upload, at least MIME type
            # should be defined (name is optional)
            if ( defined $value->[1] ) {
                push @upload_fields, $field_name;
                next FIELD;
            }
        }
    }
    
    return @upload_fields;
}

sub raw_param {
    my ($self, $key) = @_;
    
    return $self->{parm}->{$key};
}

sub cookie {
    my ($self, $key) = @_;

t/lib/RPC/ExtDirect/Test/Util/AnyEvent.pm  view on Meta::CPAN

    my $req = HTTP::Request::Common::POST $url, Content => [ @fields ];
    $req->protocol('HTTP/1.0');
    
    return $req;
}

### NON EXPORTED PUBLIC PACKAGE SUBROUTINE ###
#
# Return a new HTTP::Request object for a form call
# with file uploads
#

sub form_upload {
    # This can be called either as a class method, or a plain sub
    shift if $_[0] eq __PACKAGE__;
    
    my ($url, $files, @fields) = @_;

    my $type = 'application/octet-stream';

    my $req = HTTP::Request::Common::POST $url,
           Content_Type => 'form-data',
           Content      => [ @fields,
                             map {
                                    (   upload => [
                                            "t/data/cgi-data/$_",
                                            $_,
                                            'Content-Type' => $type,
                                        ]
                                    )
                                 } @$files
                           ]
    ;
    $req->protocol('HTTP/1.0');