CGI-Apache2-Wrapper
view release on metacpan or search on metacpan
lib/CGI/Apache2/Wrapper.pm view on Meta::CPAN
require Apache2::RequestRec;
require Apache2::RequestUtil;
require Apache2::Connection;
require Apache2::Access;
require Apache2::URI;
require Apache2::Log;
require APR::URI;
require APR::Pool;
require Apache2::Request;
require CGI::Apache2::Wrapper::Cookie;
require CGI::Apache2::Wrapper::Upload;
$MOD_PERL = 2;
}
else {
die qq{mod_perl 2 required};
}
}
else {
die qq{Must be running under mod_perl};
}
my $self = {};
bless $self, ref $class || $class;
$self->r($r) unless $self->r;
$self->c($r->connection) unless $self->c;
$self->req(Apache2::Request->new($self->r)) unless $self->req;
return $self;
}
sub r {
my $self = shift;
my $r = $self->{'.r'};
$self->{'.r'} = shift if @_;
return $r;
}
sub c {
my $self = shift;
my $c = $self->{'.c'};
$self->{'.c'} = shift if @_;
return $c;
}
sub req {
my $self = shift;
my $req = $self->{'.req'};
$self->{'.req'} = shift if @_;
return $req;
}
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(@_);
}
# Apache2::Connection
sub remote_addr {
return shift->c->remote_ip;
}
sub remote_host {
return shift->c->remote_host;
}
# Apache2::Access
sub auth_type {
return shift->r->auth_type;
}
sub remote_ident {
return shift->r->get_remote_logname;
}
# Apache2::RequestUtil
sub remote_user {
return shift->r->user;
}
sub user_name {
my $self = shift;
return ($self->remote_ident || $self->remote_user);
}
sub server_name {
return shift->r->get_server_name;
}
sub server_port {
return shift->r->get_server_port;
}
# Apache2::RequestRec
sub header {
my $self = shift;
my $header_extra;
if (@_) {
if (scalar @_ == 1) {
$header_extra = shift;
}
else {
my %args = @_;
lib/CGI/Apache2/Wrapper.pm view on Meta::CPAN
}
last SWITCH;
};
$opts{query} and do {
last SWITCH;
};
die qq{Unknown option passed to url};
}
unless ($rv) {
$rv = $parsed->unparse(APR::Const::URI_UNP_OMITQUERY);
if ($path_info) {
$rv =~ s/$path_info//;
}
}
if ($opts{query}) {
$rv .= '?' . $self->query_string;
}
return $rv;
}
sub self_url {
return shift->url('-path_info' => 1, '-query' => 1);
}
# Apache2::Cookie
sub cookie {
my $self = shift;
my ($name, $value, %args);
if (@_) {
if (scalar @_ == 1) {
$name = shift;
}
else {
%args = @_;
}
}
if (%args and not $name) {
($name, $value) = ( ($args{'-name'} || $args{name} ),
($args{'-value'} || $args{value} ));
}
unless (defined($value)) {
my $cookies = $self->cookies;
return () unless $cookies;
return keys %{$cookies} unless $name;
return () unless $cookies->{$name};
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
=head1 SYNOPSIS
sub handler {
my $r = shift;
my $cgi = CGI::Apache2::Wrapper->new($r);
my $foo = $cgi->param("foo");
my $header = {'Content-Type' => 'text/plain; charset=utf-8',
'X-err_header_out' => 'err_headers_out',
};
$cgi->header($header);
$r->print("You passed in $foo\n");
return Apache2::Const::OK;
}
=head1 DESCRIPTION
Certain modules, such as L<CGI::Ajax> and
L<JavaScript::Autocomplete::Backend>,
require a minimal L<CGI.pm>-compatible module to provide certain methods,
such as I<param()> to fetch parameters. The standard module to
do this is of course L<CGI.pm>; however, especially in a mod_perl
environment, there may be concerns with the resultant memory footprint.
This module provides various CGI.pm-compatible methods via
L<mod_perl2> and L<librapreq2>, and as such, it may be a viable
alternative in a mod_perl scenario.
Note that this module is I<not> a drop-in replacement for
L<CGI.pm>, as only a select few methods that naturally arise
in mod_perl2 and libapreq2 are provided. As well as providing
CGI.pm-compatible methods to other modules, one of the
main intents here is to assist development of porting
CGI applications over to mod_perl2 and libapreq2 and/or
for use in writing applications
that are to be used in either a cgi or mod_perl environment. However,
for applications that are intended only for mod_perl, it is recommended
that the native interface to mod_perl2 and libapreq2 ultimately
be used, as this module will add some overhead.
=head1 Methods
Methods are called via the object created as
my $cgi = CGI::Apache2::Wrapper->new($r);
The L<Apache2::RequestRec> object I<$r> must be
passed in as an argument.
Methods available can be grouped according to what
mod_perl2/libapreq2 modules provide them:
lib/CGI/Apache2/Wrapper.pm view on Meta::CPAN
-expires => '+3M',
-domain => '.capricorn.com',
-path => '/cgi-bin/database',
-secure => 1
);
which is an object of the L<CGI::Apache2::Wrapper::Cookie>
class. The arguments accepted are
=over
=item * I<-name>
This is the name of the cookie (required)
=item * I<-value>
This is the value associated with the cookie (required)
=item * I<-expires>
This accepts any of the relative or absolute date formats
recognized by CGI.pm, for example "+3M" for three months in the future.
See L<CGI.pm> for details.
=item * I<-domain>
This points to a domain name or to a fully qualified
host name. If not specified, the cookie will be returned only
to the Web server that created it.
=item * I<-path>
This points to a partial URL on the current server.
The cookie will be returned to all URLs beginning with
the specified path. If not specified, it defaults to '/',
which returns the cookie to all pages at your site.
=item * I<-secure>
If set to a true value, this instructs the
browser to return the cookie only when a cryptographic protocol is in use.
=back
A value of an existing cookie can be retrieved by
calling I<cookie> without the I<value> parameter:
my $value = $cgi->cookie(-name => 'fred');
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;
This returns the I<Apache2::RequestRec> object I<$r>
passed into the I<new()> method.
=item * my $req = $cgi-E<gt>req;
This returns the I<Apache2::Request> object I<$req>, which
provides the I<param()> method to fetch form parameters.
=back
=head1 SEE ALSO
L<CGI>, L<Apache2::RequestRec>, and L<Apache2::Request>.
Development of this package takes place at
L<http://cpan-search.svn.sourceforge.net/viewvc/cpan-search/CGI-Apache2-Wrapper/>.
=head1 SUPPORT
You can find documentation for this module with the perldoc command:
perldoc CGI::Apache2::Wrapper
You can also look for information at:
=over 4
=item * AnnoCPAN: Annotated CPAN documentation
L<http://annocpan.org/dist/CGI-Apache2-Wrapper>
=item * CPAN::Forum: Discussion forum
L<http:///www.cpanforum.com/dist/CGI-Apache2-Wrapper>
=item * CPAN Ratings
L<http://cpanratings.perl.org/d/CGI-Apache2-Wrapper>
=item * RT: CPAN's request tracker
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CGI-Apache2-Wrapper>
=item * Search CPAN
L<http://search.cpan.org/dist/CGI-Apache2-Wrapper>
=item * UWinnipeg CPAN Search
( run in 1.018 second using v1.01-cache-2.11-cpan-b16cb0d3907 )