CGI-Apache2-Wrapper
view release on metacpan or search on metacpan
0.215 March 18, 2008
- use 'exit 0' in Makefile.PL/Build.PL if mod_perl isn't installed,
to try to silence failed reports from cpantesters
0.21 Apr 11, 2007
- have header() return the defined ''.
0.2 Apr 9, 2007
- add several more methods, especially url(), cookie(), and upload().
- if the USE_CGI_PM environment variable is set, a CGI.pm object
will be returned from the new() method (suggested by
Jonathan Vanasco).
- drop support of use of the mod_perl2/libapreq2 interface in a
cgi environment
0.1 Feb 17, 2007
- initial version
Makefile.PL
MANIFEST This list of files
META.yml
README
t/cgi/cookie.t
t/cgi/cookie2.t
t/cgi/param.t
t/cgi/extra.t
t/cgi/misc.t
t/cgi/pod.t
t/cgi/upload.t
t/cgi/upload1.t
t/conf/extra.conf.in
t/response/TestCGI/basic.pm
t/response/TestCGI/cookie.pm
t/response/TestCGI/cookie2.pm
t/response/TestCGI/cookie3.pm
t/response/TestCGI/param.pm
t/response/TestCGI/misc.pm
t/response/TestCGI/extra.pm
t/response/TestCGI/upload.pm
t/response/TestCGI/upload1.pm
t/response/TestCGI/use_cgi_pm.pm
t/TEST.PL
distribution_type: module
no_index:
file:
- t/response/TestCGI/basic.pm
- t/response/TestCGI/cookie.pm
- t/response/TestCGI/cookie2.pm
- t/response/TestCGI/cookie3.pm
- t/response/TestCGI/param.pm
- t/response/TestCGI/extra.pm
- t/response/TestCGI/misc.pm
- t/response/TestCGI/upload.pm
- t/response/TestCGI/upload1.pm
- t/response/TestCGI/use_cgi_pm.pm
urls:
license: http://dev.perl.org/licenses/
meta-spec:
version: 1.3
url: http://module-build.sourceforge.net/META-spec-v1.3.html
resources:
license: http://dev.perl.org/licenses/
homepage: http://cpan-search.svn.sourceforge.net/viewvc/cpan-search/CGI-Apache2-Wrapper/
bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=CGI-Apache2-Wrapper
lib/CGI/Apache2/Wrapper.pm view on Meta::CPAN
sub cookies {
my $self = shift;
my $cookies = $self->{'.cookies'};
return $cookies if (defined $cookies);
my %cookies = Apache2::Cookie->fetch($self->r);
$self->{'.cookies'} = %cookies ? \%cookies : undef;
return $self->{'.cookies'};
}
sub uploads {
my ($self, $name) = @_;
my $tmpfhs = $self->{'.tmpfhs'}->{$name};
return $tmpfhs if (defined $tmpfhs and ref($tmpfhs) eq 'ARRAY');
my @u = $self->req->upload($name);
return unless @u;
my $uploads = {};
foreach my $u (@u) {
next unless defined $u;
my $tempname = $u->tempname();
open(my $fh, '<', $tempname) or next;
my $info = { %{$u->info()},
name => $name,
filename => $u->filename(),
size => $u->size(),
type => $u->type(),
};
$uploads->{"$fh"} = {filehandle => $fh,
tempname => $tempname,
info => $info,
};
push @$tmpfhs, $fh;
}
$self->{'.uploads'} = $uploads;
$self->{'.tmpfhs'}->{$name} = $tmpfhs;
return $tmpfhs;
}
# Apache2::Request
sub param {
return shift->req->param(@_);
}
lib/CGI/Apache2/Wrapper.pm view on Meta::CPAN
return $cookies->{$name}->value
if defined($name) && $name ne '';
}
return undef unless defined($name) && $name ne ''; # this is an error
my $cookie = CGI::Apache2::Wrapper::Cookie->new($self->r, %args);
return $cookie;
}
# Apache2::Upload
sub upload {
my ($self, $name) = @_;
return unless $name;
my $tmpfhs = $self->uploads($name);
return unless (defined $tmpfhs and ref($tmpfhs) eq 'ARRAY');
return wantarray ? @$tmpfhs : $tmpfhs->[0];
}
sub tmpFileName {
my ($self, $fh) = @_;
return unless (defined $fh and ref($fh) eq 'GLOB');
my $uploads = $self->{'.uploads'};
return unless (defined $uploads and ref($uploads) eq 'HASH');
return (defined $uploads->{"$fh"} and
defined $uploads->{"$fh"}->{tempname} ) ?
$uploads->{"$fh"}->{tempname} : undef;
}
sub uploadInfo {
my ($self, $fh) = @_;
return unless (defined $fh and ref($fh) eq 'GLOB');
my $uploads = $self->{'.uploads'};
return unless (defined $uploads and ref($uploads) eq 'HASH');
return (defined $uploads->{"$fh"} and
defined $uploads->{"$fh"}->{info} ) ?
$uploads->{"$fh"}->{info} : undef;
}
1;
__END__
=head1 NAME
CGI::Apache2::Wrapper - CGI.pm-compatible methods via mod_perl
lib/CGI/Apache2/Wrapper.pm view on Meta::CPAN
A list of all cookie names can be obtained by calling
I<cookie> without any arguments:
my @names = $cgi->cookie();
See also L<CGI::Apache2::Wrapper::Cookie> for a
L<CGI::Cookie>-compatible interface to cookies.
=head2 Apache2::Upload
Uploads can be handled with the I<upload> method:
my $fh = $cgi->upload('filename');
which returns a file handle that can be used to access the
uploaded file. If there are multiple upload fields, calling
I<upload> in a list context:
my @fhs = $cgi->upload('filename');
will return an array of filehandles. There are two
helper methods available for uploads:
=over
=item * my $tmpfile = $cgi-E<gt>tmpFileName($fh);
This returns the name of the temporary file associated with
the I<$fh> fielhandle returned from I<upload>.
=item * my $info = $cgi-E<gt>uploadInfo($fh);
This returns a hash reference containing some information about
the uploaded file associated with the I<$fh> filehandle
returned from I<upload>. The keys of this hash typically include:
=over
=item * Content-Type
The content type, such as I<text/plain>, associated with this upload.
=item * Content-Disposition
This typically is a string such as
I<form-data; name="HTTPUPLOAD"; filename="data.txt">.
=item * size
This is the size of the uploaded file.
=item * name
This is the name of the HTML form element which generated the upload.
=item * filename
The (client-side) filename as submitted in the HTML form.
Note that some agents will submit the file's full pathname,
while others may submit just the basename.
=item * type
This is the MIME type of the upload.
=back
=back
=head2 Helpers
=over
=item * my $r = $cgi-E<gt>r;
lib/CGI/Apache2/Wrapper/Upload.pm view on Meta::CPAN
package CGI::Apache2::Wrapper::Upload;
use Apache2::Request;
push our @ISA, qw/APR::Request::Param/;
our $VERSION = '0.215';
{
no strict 'refs';
for (qw/type size tempname filename/) {
*{$_} = *{"APR::Request::Param::upload_$_"}{CODE};
}
}
sub Apache2::Request::upload {
my $req = shift;
return unless @_;
my $body = $req->body or return;
$body->param_class(__PACKAGE__);
my @uploads = grep $_->upload, $body->get(@_);
return wantarray ? @uploads : $uploads[0];
}
*bb = *APR::Request::Param::upload;
1;
__END__
=head1 NAME
CGI::Apache2::Wrapper::Upload - uploads via libapreq2
=head1 SYNOPSIS
use CGI::Apache2::Wrapper::Upload;
my $cgi = CGI::Apache2::Wrapper->new($r);
my $upload = $cgi->req->upload("foo");
=head1 DESCRIPTION
This module is a mod_perl wrapper around the upload functionality
of L<libapreq2>, for use by L<CGI::Apache2::Wrapper>. It is
very similar to L<Apache2::Upload>, but only provides
the I<tempname> method for accessing the contents
of an uploaded file. It is not intended to be used directly;
rather, the I<upload> method of L<CGI::Apache2::Wrapper> should
be used.
=head1 SEE ALSO
L<CGI>, L<Apache2::Upload>, and L<CGI::Apache2::Wrapper>.
Development of this package takes place at
L<http://cpan-search.svn.sourceforge.net/viewvc/cpan-search/CGI-Apache2-Wrapper/>.
=head1 SUPPORT
t/cgi/upload.t view on Meta::CPAN
use Apache::TestRequest 'UPLOAD_BODY_ASSERT';
print UPLOAD_BODY_ASSERT "/TestCGI__upload", undef, content => "ABCDEFGHIJ";
t/cgi/upload1.t view on Meta::CPAN
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest qw(UPLOAD_BODY GET_BODY_ASSERT);
use constant WIN32 => Apache::TestConfig::WIN32;
use Cwd;
require File::Basename;
my $cwd = getcwd();
my $module = 'TestCGI::upload1';
my $location = Apache::TestRequest::module2url($module);
my %types = (perl => 'application/octet-stream',
httpd => 'application/octet-stream',
);
my $vars = Apache::Test::vars;
my $perlpod = $vars->{perlpod};
if (-d $perlpod) {
opendir(my $dh, $perlpod);
t/response/TestCGI/basic.pm view on Meta::CPAN
use Apache2::Const -compile => qw(OK SERVER_ERROR);
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::RequestUtil ();
my @methods = qw(param header url remote_addr
server_name server_port remote_host
auth_type remote_ident remote_user user_name
query_string server_protocol request_method
content_type path_info redirect status
cookie upload tmpFileName uploadInfo);
sub handler {
my ($r) = @_;
plan $r, tests => 4 + @methods;
my $cgi = CGI::Apache2::Wrapper->new($r);
isa_ok($cgi, 'CGI::Apache2::Wrapper');
my $cgi_r = $cgi->r;
isa_ok($cgi_r, 'Apache2::RequestRec');
my $cgi_req = $cgi->req;
isa_ok($cgi_req, 'Apache2::Request');
foreach my $method (@methods) {
t/response/TestCGI/upload.pm view on Meta::CPAN
package TestCGI::upload;
use strict;
use warnings;
use Apache::Test qw(-withtestmore);
use Apache::TestUtil;
use CGI::Apache2::Wrapper;
use Apache2::Const -compile => qw(OK SERVER_ERROR);
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::RequestUtil ();
sub handler {
my ($r) = @_;
plan $r, tests => 13;
my $cgi = CGI::Apache2::Wrapper->new($r);
my @fhs = $cgi->upload("HTTPUPLOAD");
is(scalar @fhs, 1, "received one upload");
my $fh = $fhs[0];
isa_ok($fh, 'GLOB', "testing ref(\$fh)");
my $tempfile = $cgi->tmpFileName($fh);
like($tempfile, qr/apreq/, "tmpFileName contains 'apreq'");
my $txt = '';
while (<$fh>) {
chomp $_;
$txt .= $_;
}
is($txt, "ABCDEFGHIJ", "file contents are ABCDEFGHIJ");
my $info = $cgi->uploadInfo($fh);
isa_ok($info, 'HASH', "testing ref(\$info)");
is($info->{size}, -s $tempfile, "testing size of tempfile");
is($info->{type}, 'text/plain', "testing type");
is($info->{name}, 'HTTPUPLOAD', "testing name");
is($info->{filename}, 'b', "testing filename");
like($info->{'Content-Type'}, qr{text/plain}, "testing Content-Type");
my $disp = $info->{'Content-Disposition'};
like($disp, qr/form-data/, "Content-Disposition contains 'form-data'");
like($disp, qr/HTTPUPLOAD/, "Content-Disposition contains 'HTTPUPLOAD'");
like($disp, qr/b/, "Content-Disposition contains 'b'");
t/response/TestCGI/upload1.pm view on Meta::CPAN
package TestCGI::upload1;
use strict;
use warnings FATAL => 'all';
use Apache2::RequestRec;
use Apache2::RequestIO;
use Apache2::Request ();
use CGI::Apache2::Wrapper;
use Apache2::Const -compile => qw(OK);
use File::Spec;
require File::Basename;
sub handler {
my $r = shift;
my $cgi = CGI::Apache2::Wrapper->new($r);
my $cgi_fh = $cgi->upload("filename");
my $ref = ref($cgi_fh);
my $temp_dir = File::Spec->tmpdir;
my $has_md5 = $cgi->param('has_md5');
require Digest::MD5 if $has_md5;
my $info = $cgi->uploadInfo($cgi_fh);
my $type = $info->{type};
my $basename = File::Basename::basename($info->{filename});
my ($data);
binmode $cgi_fh;
read $cgi_fh, $data, $info->{size};
close $cgi_fh;
my $temp_file = File::Spec->catfile($temp_dir, $basename);
unlink $temp_file if -f $temp_file;
( run in 2.475 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )