view release on metacpan or  search on metacpan

lib/Apache/ExtDirect/Router.pm  view on Meta::CPAN

    return unless grep { defined $_ } @file_handles;

    # Despite what CGI documentation says, the values returned
    # as "file names" are actually some kind of key handles
    my @file_keys = $cgi->param($param);

    # Here file uploads get collected
    my @uploads = ();

    # Collect the info we need to repackage it in consistent way
    FILE:
    for my $key ( @file_keys ) {
        # First take a closer look at this "blah-blah handle"
        my $file_handle = shift @file_handles;

        # undef would mean there was upload error (timeout perhaps)
        # Following HTTP POST logic, when one upload breaks that
        # would mean all subsequent uploads in this POST are also
        # broken.
        # We can't do anything about it anyway so just stop trying.
        last FILE unless defined $file_handle;

        # In CGI.pm < 3.41, "lightweight handle" object doesn't support
        # returning IO::Handle so we do it manually to avoid problems
        my $io_handle = IO::Handle->new_from_fd(fileno $file_handle, '<');

        # We also need a lot of info about the file (if provided)
        my $upload_info = $cgi->uploadInfo($key);
        my $temp_file   = $cgi->tmpFileName($key);
        my $file_type   = $upload_info->{'Content-Type'};
        my $file_name   = $class->_get_file_name($upload_info);
        my $file_size   = $class->_get_file_size($io_handle);
        my $base_name   = basename($file_name);

        # Now instead of "blah-blah handle" we have hashref full of info
        push @uploads, {
            type     => $file_type,
            size     => $file_size,
            path     => $temp_file,
            handle   => $io_handle,
            basename => $base_name,
            filename => $file_name,
        };
    };

    return @uploads;
}

### PRIVATE INSTANCE METHOD ###
#
# Tries hard to extract file name from multipart form guts
#

sub _get_file_name {
    my ($class, $upload_info) = @_;

    # Pluck file name from Content-Disposition string
    my ($file_name)
        = $upload_info->{'Content-Disposition'} =~ /filename="(.*?)"/;

    # URL unescape it
    $file_name =~ s/%([\dA-Fa-f]{2})/pack("C", hex $1)/eg;

    return $file_name;
}

### PRIVATE INSTANCE METHOD ###
#
# Enquiries IO::Handle supplied by CGI for file size
#

sub _get_file_size {
    my ($class, $handle) = @_;

    # Fall through in case $handle is invalid
    return unless $handle;

    return ($handle->stat)[7];
}

1;

__END__

=pod

=head1 NAME

Apache::ExtDirect::Router - Apache handler for Ext.Direct remoting requests

=head1 DESCRIPTION

This module is not intended to be used directly. See L<Apache::ExtDirect>
for more information.

=head1 AUTHOR

Alexander Tokarev, E<lt>tokarev@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012 by Alexander Tokarev

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See L<perlartistic>.

=cut