Apache-ExtDirect
view release on metacpan or search on metacpan
lib/Apache/ExtDirect/Router.pm view on Meta::CPAN
# If form is not involved, it's easy: just return POSTDATA (or undef)
if ( !$is_form ) {
my $postdata = $cgi->param('POSTDATA') || join '', $cgi->keywords;
return $postdata ne '' ? $postdata
: undef
;
};
# If any files are attached, extUpload will contain 'true'
my $has_uploads = $cgi->param('extUpload') eq 'true';
# Here file uploads data is stored
my @_uploads = ();
# Now if the form IS involved, it gets a little bit complicated
PARAM:
for my $param ( keys %keyword ) {
# Defang CGI's idiosyncratic way to return multi-valued params
my @values = $cgi->param( $param );
$keyword{ $param } = @values == 0 ? undef
: @values == 1 ? $values[0]
: [ @values ]
;
# Try to see if $param is a field with associated file upload
# Skip the standard ones first, of course
next PARAM if $STANDARD_KEYWORD{ $param } || !$has_uploads;
# Look for file uploads in this field
my @field_uploads = $class->_parse_uploads($cgi, $param);
# Found some, add them to general stash and kill the field
if ( @field_uploads ) {
push @_uploads, @field_uploads;
delete $keyword{ $param };
};
};
# Remove extType because it's meaningless later on
delete $keyword{ extType };
# Fix TID so that it comes as number (JavaScript is picky)
$keyword{ extTID } += 0 if exists $keyword{ extTID };
# Now add files to hash, if any
$keyword{ '_uploads' } = \@_uploads if @_uploads;
return \%keyword;
}
### PRIVATE INSTANCE METHOD ###
#
# Parses CGI form input field looking for file uploads
#
sub _parse_uploads {
my ($class, $cgi, $param) = @_;
# CGI returns "lightweight file handles", or undef
my @file_handles = $cgi->upload($param);
# Empty list means no uploads for this field
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
t/02_route.t view on Meta::CPAN
BEGIN { use_ok 'Apache::ExtDirect::Router'; }
my $dfile = 't/data/extdirect/route';
my $tests = eval do { local $/; open my $fh, '<', $dfile; <$fh> } ## no critic
or die "Can't eval $dfile: '$@'";
for my $test ( @$tests ) {
my $name = $test->{name};
my $url = $test->{plack_url};
my $method = lc $test->{method};
my $upload = $test->{upload};
my $input_content = $test->{input_content} || '';
my $http_status_exp = $test->{http_status};
my $content_regex = $test->{content_type};
my $expected_output = $test->{expected_content};
my $ua = LWP::UserAgent->new(requests_redirectable => []);
my $res = $ua->$method($url, @$input_content);
if ( ok $res, "$name not empty" ) {
t/02_route.t view on Meta::CPAN
return [ content => $content ];
}
sub form_post {
my ($uri, %fields) = @_;
return [ [ %fields ] ];
}
sub form_upload {
my ($uri, $files_ref, %fields) = @_;
delete @fields{ qw/action method/ };
my @files = map {;
upload =>
[
"t/data/files/$_", $_,
'Content-Type' => 'application/octet-stream',
]
} @$files_ref;
return [
Content_Type => 'form-data',
Content => [
%fields,
t/03_poll.t view on Meta::CPAN
use bytes;
my $cgi_input = CGI::Test::Input::URL->new();
for my $field ( keys %fields ) {
my $value = $fields{ $field };
$cgi_input->add_field($field, $value);
};
return $cgi_input;
}
sub form_upload {
my ($files, %fields) = @_;
my $cgi_input = CGI::Test::Input::Multipart->new();
for my $field ( keys %fields ) {
my $value = $fields{ $field };
$cgi_input->add_field($field, $value);
};
for my $file ( @$files ) {
$cgi_input->add_file_now("upload", "t/data/cgi-data/$file");
};
return $cgi_input;
}
BEGIN { use_ok 'Apache::ExtDirect::Router'; }
my $dfile = 't/data/extdirect/route';
my $tests = eval do { local $/; open my $fh, '<', $dfile; <$fh> } ## no critic
or die "Can't eval $dfile: '$@'";
for my $test ( @$tests ) {
my $name = $test->{name};
my $url = $test->{plack_url};
my $method = lc $test->{method};
my $upload = $test->{upload};
my $input_content = $test->{input_content} || '';
my $http_status_exp = $test->{http_status};
my $content_regex = $test->{content_type};
my $expected_output = $test->{expected_content};
my $ua = LWP::UserAgent->new(requests_redirectable => []);
my $res = $ua->$method($url, @$input_content);
if ( ok $res, "$name not empty" ) {
return [ Cookie => 'foo=bar', Content => $content ];
}
sub form_post {
my ($uri, %fields) = @_;
return [ [ %fields ] ];
}
sub form_upload {
my ($uri, $files_ref, %fields) = @_;
delete @fields{ qw/action method/ };
my @files = map {;
upload =>
[
"t/data/files/$_", $_,
'Content-Type' => 'application/octet-stream',
]
} @$files_ref;
return [
Content_Type => 'form-data',
Content => [
%fields,
t/data/extdirect/route view on Meta::CPAN
expected_content
=> q|[{"action":"Qux","method":"foo_foo",|.
q|"result":"foo! 'foo'","tid":1,"type":"rpc"},|.
q|{"action":"Qux","method":"foo_bar",|.
q|"result":["foo! bar!","bar1","bar2"],"tid":2,"type":"rpc"},|.
q|{"action":"Qux","method":"foo_baz",|.
q|"result":{"bar":"baz2","baz":"baz3","foo":"baz1",|.
q|"msg":"foo! bar! baz!"},"tid":3,"type":"rpc"}]|,
},
{
name => 'Form request, no uploads', method => 'POST',
cgi_url => 'http://localhost/cgi-bin/router1.cgi',
plack_url => 'http://localhost:8529/router',
plack_input => [ router_path => '/router', debug => 1, ],
input_content =>
form_post('http://localhost/router',
action => '/router.cgi', method => 'POST',
extAction => 'Bar', extMethod => 'bar_baz',
extTID => 123, field1 => 'foo', field2 => 'bar',
extType => 'rpc'),
http_status => 200, content_type => qr|^application/json\b|,
expected_content =>
q|{"action":"Bar","method":"bar_baz",|.
q|"result":{"field1":"foo","field2":"bar"},|.
q|"tid":123,"type":"rpc"}|,
},
{
name => 'Form request, one upload', method => 'POST',
cgi_url => 'http://localhost/cgi-bin/router2.cgi',
plack_url => 'http://localhost:8529/router', upload => 1,
plack_input => [ router_path => '/router', debug => 1, ],
input_content =>
form_upload('http://localhost/router',
['qux.txt'],
action => '/router.cgi', method => 'POST',
extAction => 'JuiceBar', extMethod => 'bar_baz',
extTID => 7, extType => 'rpc', foo_field => 'foo',
bar_field => 'bar', extUpload => 'true',),
http_status => 200, content_type => qr|^text/html\b|,
expected_content =>
q|<html><body><textarea>|.
q|{"action":"JuiceBar","method":"bar_baz",|.
q|"result":{"bar_field":"bar",|.
q|"foo_field":"foo",|.
q|"upload_response":"The following files were |.
q|processed:\n|.
q|qux.txt application/octet-stream 29 ok\n"|.
q|},"tid":7,|.
q|"type":"rpc"}|.
q|</textarea></body></html>|,
},
{
name => 'Form request, multiple uploads', method => 'POST',
cgi_url => 'http://localhost/cgi-bin/router2.cgi',
plack_url => 'http://localhost:8529/router',
plack_input => [ router_path => '/router', debug => 1, ],
input_content =>
form_upload('http://localhost/router',
['foo.jpg', 'bar.png', 'script.js'],
action => '/router.cgi', method => 'POST',
extAction => 'JuiceBar', extMethod => 'bar_baz',
extTID => 8, field => 'value', extUpload => 'true',
extType => 'rpc'),
http_status => 200, content_type => qr|^text/html\b|,
expected_content =>
q|<html><body><textarea>|.
q|{"action":"JuiceBar","method":"bar_baz",|.
q|"result":{|.
q|"field":"value",|.
q|"upload_response":"The following files were |.
q|processed:\n|.
q|foo.jpg application/octet-stream 16157 ok\n|.
q|bar.png application/octet-stream 20691 ok\n|.
q|script.js application/octet-stream 78 ok\n"|.
q|},"tid":8,"type":"rpc"}|.
q|</textarea></body></html>|,
},
]
t/lib/RPC/ExtDirect/Test/Bar.pm view on Meta::CPAN
# Return number of passed arguments
sub bar_bar : ExtDirect(5) { shift; pop; return scalar @_; }
# This is a form handler
sub bar_baz : ExtDirect( formHandler ) {
my ($class, %param) = @_;
delete $param{_env};
# Simulate uploaded file handling
my $uploads = $param{file_uploads};
return \%param unless $uploads;
# Return 'uploads' data
my $response = "The following files were processed:\n";
for my $upload ( @$uploads ) {
my $name = $upload->{basename};
my $type = $upload->{type};
my $size = $upload->{size};
$response .= "$name $type $size\n";
};
delete $param{file_uploads};
$param{upload_response} = $response;
return \%param;
}
1;
t/lib/RPC/ExtDirect/Test/JuiceBar.pm view on Meta::CPAN
# Return number of passed arguments
sub bar_bar : ExtDirect(5) { shift; pop; return scalar @_; }
# This is a form handler
sub bar_baz : ExtDirect( formHandler ) {
my ($class, %param) = @_;
my $cgi = delete $param{_env};
# Simulate uploaded file handling
my $uploads = $param{file_uploads};
return \%param unless $uploads;
# Return 'uploads' data
my $response = "The following files were processed:\n";
for my $upload ( @$uploads ) {
my $name = $upload->{basename};
my $type = $upload->{type};
my $size = $upload->{size};
# CTI::Test somehow uploads files so that
# they are 2 bytes shorter than actual size
# This allows for the same test results to be
# applied across all gateways and test frameworks
#
# Well, in all truthiness this should be the opposite
# but CGI::Test was there first...
$size -= 2 if $CHEAT;
my $ok = (defined $upload->{handle} &&
$upload->{handle}->opened) ? "ok" : "not ok";
$response .= "$name $type $size $ok\n";
};
delete $param{file_uploads};
$param{upload_response} = $response;
return \%param;
}
1;
( run in 2.789 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )