view release on metacpan or search on metacpan
lib/Apache2/API/Request.pm view on Meta::CPAN
my $self = shift( @_ );
my $name = shift( @_ ) || return;
my $r = Apache2::API::Request::Params->new( $self->request );
if( @_ )
{
return( $r->param( $name, @_ ) );
}
else
{
my $val = $r->param( $name );
my $up = $r->upload( $name );
# Return the Net:::API::REST::Request::Upload object if it is one
return( $up ) if( Scalar::Util::blessed( $up ) );
return( $val );
}
}
sub params
{
my $self = shift( @_ );
return( $self->query ) if( $self->method eq 'GET' );
# my $r = Apache2::Request->new( $self->request );
my $r = Apache2::API::Request::Params->new( request => $self->request );
# https://perl.apache.org/docs/1.0/guide/snippets.html#Reusing_Data_from_POST_request
# my %params = $r->method eq 'POST' ? $r->content : $r->args;
# Data are in pure utf8; not perl's internal, so it is up to us to decode them
my( @params ) = $r->param;
my( @uploads ) = $r->upload;
my $upload_fields = {};
# To make it easy to check if it exists
if( scalar( @uploads ) )
{
@$upload_fields{ @uploads } = ( 1 ) x scalar( @uploads );
}
my $form = {};
#my $io = IO::File->new( ">/tmp/form_data.txt" );
#my $io2 = IO::File->new( ">/tmp/form_data_after_our_decoding.txt" );
#my $raw = IO::File->new( ">/tmp/raw_form_data.txt" );
#$io->binmode( ':utf8' );
#$io2->binmode( ':utf8' );
foreach my $k ( @params )
{
my( @values ) = $r->param( $k );
#$raw->print( "$k => " );
#$io->print( "$k => " );
my $name = utf8::is_utf8( $k ) ? $k : Encode::decode_utf8( $k );
#$io2->print( "$name => " );
$form->{ $name } = scalar( @values ) > 1 ? \@values : $values[0];
if( CORE::exists( $upload_fields->{ $name } ) )
{
my $up = $r->upload( $name );
if( !$up )
{
CORE::warn( "Error: could not get the Apache2::API::Params::Upload object for this upload field \"$name\".\n" );
next;
}
else
{
$form->{ $name } = $up;
}
}
elsif( ref( $form->{ $name } ) )
{
#$raw->print( "[\n" );
lib/Apache2/API/Request.pm view on Meta::CPAN
sub unparsed_uri
{
my $self = shift( @_ );
my $uri = $self->uri;
my $unparseed_path = $self->request->unparsed_uri;
my $unparsed_uri = URI->new( $uri->scheme . '://' . $uri->host_port . $unparseed_path );
return( $unparsed_uri );
}
sub uploads
{
my $self = shift( @_ );
my $r = Apache2::API::Request::Params->new( $self->request );
my( @uploads ) = $r->upload;
my $objs = $self->new_array;
foreach my $name ( @uploads )
{
my $up = $r->upload( $name );
if( !$up )
{
CORE::warn( "Error: could not get the Apache2::API::Params::Upload object for this upload field \"$name\".\n" );
}
else
{
CORE::push( @$objs, $up );
}
}
return( $objs );
}
#sub uri { return( URI->new( shift->request->uri( @_ ) ) ); }
lib/Apache2/API/Request.pm view on Meta::CPAN
my $r = $req->the_request;
my $dt = $req->time2datetime( $time );
say $req->time2str( $seconds );
# text/plain
my $type = $req->type;
my $raw = $req->unparsed_uri;
# Apache2::API::Request::Params
my $uploads = $req->uploads;
my $uri = $req->uri;
my $decoded = $req->url_decode( $url );
my $encoded = $req->url_encode( $url );
my $user = $req->user;
my $agent = $req->user_agent;
=head1 VERSION
v0.4.2
lib/Apache2/API/Request.pm view on Meta::CPAN
my $int = $req->body_status; # should return 0
Returns the final status code of the body parser.
=head2 brigade_limit
my $int = $req->brigade_limit;
$req->brigade_limit( $int );
Get or set the brigade_limit for the current parser. This limit determines how many bytes of a file upload that the parser may spool into main memory. Uploads exceeding this limit are written directly to disk.
See also L</temp_dir>
=head2 call
Provided with an Apache2 API method name, and optionally with some additional arguments, and this will call that Apache2 method and return its result.
This is designed to allow you to call arbitrary Apache2 method that, possibly, are not covered here.
For example:
lib/Apache2/API/Request.pm view on Meta::CPAN
You can also set a maximum size to read by setting the attribute C<PAYLOAD_MAX_SIZE> in Apache configuration file.
For example:
<Directory /home/john/www>
PerlOptions +GlobalRequest
SetHandler modperl
# package inheriting from Apache2::API
PerlResponseHandler My::API
# 2Mb upload limit
PerlSetVar PAYLOAD_MAX_SIZE 2097152
</Directory>
This is just an example and not a recommandation. Your mileage may vary.
=head2 datetime
Returns a new L<Apache2::API::DateTime> object, which is used to parse and format dates for HTTP.
See L<Apache2::API/parse_datetime> and L<Apache2::API/format_datetime>
lib/Apache2/API/Request.pm view on Meta::CPAN
$req->output_filters->fflush( $bb );
$bb->destroy;
}
In fact that's what C<< $req->read() >> does behind the scenes. But it also knows to parse HTTP headers passed together with the data and it also implements buffering, which the above function does not.
=head2 param
Provided a name, this returns its equivalent value, using L<Apache2::API::Request::Params/param>.
If C<$name> is an upload field, ie part of a multipart post data, it returns an L<Apache2::API::Request::Upload> object instead.
If a value is provided, this calls L<Apache2::API::Request::Param/param> providing it with the name ane value. This uses L<APR::Request::Param>.
=head2 params
Get the request parameters (using case-insensitive keys) by mimicing the OO interface of L<CGI::param>.
It can take as argument, only a key and it will then retrieve the corresponding value, or it can take a key and value pair to set them using L<Apache2::API::Request::Params/param>
If the value is an array, this will set multiple entry of the key for each value provided.
lib/Apache2/API/Request.pm view on Meta::CPAN
Deutsch
<!--#else -->
Sorry
<!--#endif -->
=head2 temp_dir
my $dir = $req->temp_dir;
$req->temp_dir( $dir );
Get or set the spool directory for uploads which exceed the configured brigade_limit.
=head2 the_request
my $request = $req->the_request();
my $old_request = $req->uri( $new_request );
Get or set the first HTTP request header as a string by calling L<Apache2::RequestRec/the_request>. For example:
GET /foo/bar/my_path_info?args=3 HTTP/1.0
lib/Apache2/API/Request.pm view on Meta::CPAN
GET /foo/bar/my_path_info?args=3 HTTP/1.0
C<< $req->uri >> returns:
/foo/bar/my_path_info
whereas C<< $req->unparsed_uri >> returns:
/foo/bar/my_path_info?args=3
=head2 uploads
Returns an L<array object|Module::Generic::Array> of L<Apache2::API::Request::Upload> objects.
=head2 uri
Returns a L<URI> object representing the full uri of the request.
This is different from the original L<Apache2::RequestRec> which only returns the path portion of the URI.
So, to get the path portion using our L</uri> method, one would simply do C<< $req->uri->path() >>
lib/Apache2/API/Request/Params.pm view on Meta::CPAN
}
else
{
return( __PACKAGE__->error( "Odd number of parameters provided. I was expecting a hash or hash reference." ) );
}
}
$hash->{request} = $r if( $r );
return( $this->error( "No Apache2::RequestRec was provided to instantiate our object Apache2::API::Request::Params" ) ) if( !$hash->{request} );
return( $this->error( "Object provided is not an Apache2::RequestRec object." ) ) if( !ref( $hash->{request} ) || ( Scalar::Util::blessed( $hash->{request} ) && !$hash->{request}->isa( 'Apache2::RequestRec' ) ) );
my $req = $class->APR::Request::Apache2::handle( $hash->{request} );
my @ok_meth = qw( brigade_limit disable_uploads read_limit temp_dir upload_hook );
foreach my $meth ( @ok_meth )
{
if( CORE::exists( $hash->{ $meth } ) )
{
$req->$meth( $hash->{ $meth } );
}
}
return( $req );
}
lib/Apache2/API/Request/Params.pm view on Meta::CPAN
my $self = shift( @_ );
if( @_ )
{
$ERROR = join( '', @_ );
return;
}
return( $ERROR );
}
# Borrowed from Apache2::Upload so we can better trap exception and implement more methods
sub upload
{
# $self is a APR::Request::Apache2 object itself inheriting from APR::Request
my $self = shift( @_ );
# As per APR::Request: "upload() will throw an APR::Request::Error object whenever body_status() is non-zero"
my $body;
my $return = 0;
# try-catch
local $@;
eval
{
if( $self->body_status != 0 )
{
$ERROR = "APR::Request::body_status returned non-zero (" . $self->body_status . ")";
$return++;
lib/Apache2/API/Request/Params.pm view on Meta::CPAN
};
return if( $return );
if( $@ )
{
return( $self->error( "Unable to get the APR::Request body objet: $@" ) );
}
# So further call on this object will be handled by Apache2::API::Request::Params::Field below
$body->param_class( 'Apache2::API::Request::Upload' );
if( @_ )
{
my @uploads = grep( $_->upload, $body->get( @_ ) );
return( wantarray() ? @uploads : $uploads[0] );
}
return map{ $_->upload ? $_->name : () } values( %$body ) if( wantarray() );
return( $body->uploads( $self->pool ) );
}
sub uploads
{
my $self = shift( @_ );
my $body;
my $return = 0;
# try-catch
local $@;
eval
{
if( $self->body_status != 0 )
{
lib/Apache2/API/Request/Params.pm view on Meta::CPAN
}
$body = $self->body or ++$return;
};
return if( $return );
if( $@ )
{
return( $self->error( "Unable to get the APR::Request body objet: $@" ) );
}
# So further call on this object will be handled by Apache2::API::Request::Params::Field below
$body->param_class( __PACKAGE__ . '::Field' );
return( $body->uploads( $self->pool ) );
}
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
Apache2::API::Request::Params - Apache2 Request Fields Object
=head1 SYNOPSIS
use Apache2::API::Request::Params;
## $r is the Apache2::RequestRec object
my $req = Apache2::API::Request::Params->new(
request => $r,
# pool of 2Mb
brigade_limit => 2097152,
disable_uploads => 0,
# For example: 3Mb
read_limit => 3145728,
temp_dir => '/home/me/my/tmp'
upload_hook => sub
{
my( $upload, $new_data ) = @_;
# do something
},
);
my $form = $req->args;
# but it is more efficient to call $request->params with $request being a Apache2::API::Request object
my @args = $req->args;
my $val = $req->args( 'first_name' );
my $status = $req->args_status;
my @names = $req->body;
my @vals = $req->body( 'field' );
my $status = $req->body_status;
$req->brigade_limit( 1024 );
my $bucket = $req->bucket_alloc;
# No upload please
$req->disable_uploads( 1 );
# Returns a APR::Request::Cookie::Table object
my $jar = $req->jar;
my $cookie = $req->jar( 'cookie_name' );
my @all = $req->jar( 'cookie_name' );
my $status = $req->jar_status;
# Returns a APR::Request::Param::Table object
my $object = $req->param;
my $val = $req->param( 'first_name' );
lib/Apache2/API/Request/Params.pm view on Meta::CPAN
my $status = $req->param_status;
$req->parse;
# Returns a APR::Pool object
my $pool = $req->pool;
my $limit = $req->read_limit;
my $temp_dir = $req->temp_dir;
my $upload_accessor = $req->upload;
# Returns a Apache2::API::Request::Upload object
my $object = $req->upload( 'file_upload' );
# Returns a APR::Request::Param::Table object
my $uploads = $req->uploads;
$req->upload_hook( \&some_sub );
=head1 VERSION
v0.1.1
=head1 DESCRIPTION
This is an interface to Apache mod_perl methods to access and manipulate the request data and the way Apache handles those incoming data.
This is taken from L<APR::Request>, L<APR::Request::Params>, L<APR::Request::Apache2> and L<Apache2::Request>
lib/Apache2/API/Request/Params.pm view on Meta::CPAN
Finally, it provides access to more L<APR::Request> methods.
=head1 METHODS
=head2 new
This takes an hash or an hash reference of parameters, of which 1 is mandatory: the C<request> parameter that must be an L<Apache2::RequestRec> object.
The L<Apache2::RequestRec> object can be retrieved with L<Apache2::API::Request/request> and this module object can be instantiated more simply by calling L<Apache2::API::Request/apr>, which is basically a shortcut.
Other possible parameters are: L</brigade_limit>, L</disable_uploads>, L</read_limit>, L</temp_dir>, L</upload_hook>.
They can also be accessed as methods as documented below.
=head2 args
With no arguments, this method returns a tied L<APR::Request::Param::Table> object (or undef if the query string is absent) in scalar context, or the names (in order, with repetitions) of all the parsed query-string arguments.
With the $key argument, in scalar context this method fetches the first matching query-string arg. In list context it returns all matching args.
args() will throw an L<APR::Request::Error> object whenever args_status() is non-zero and the return value is potentially invalid (eg C<< scalar $req->args($key) >> will not die if the desired query argument was successfully parsed).
lib/Apache2/API/Request/Params.pm view on Meta::CPAN
my $alpha = $req->body( 'alpha' );
my @beta = $req->body( 'beta' );
=head2 body_status
Returns the final status code of the L<Apache2::RequestRec> handle's body parser.
=head2 brigade_limit integer
Get or sets the brigade_limit for the current parser. This limit determines how many bytes of a file upload that the parser may spool into main memory. Uploads exceeding this limit are written directly to disk.
=head2 bucket_alloc
Returns the L<APR::BucketAlloc> object associated to this L<Apache2::RequestRec> handle.
=head2 disable_uploads boolean
Engage the disable_uploads hook for this request.
=for Pod::Coverage error
=head2 jar
With no arguments, this method returns a tied L<APR::Request::Cookie::Table> object (or undef if the "Cookie" header is absent) in scalar context, or the names (in order, with repetitions) of all the parsed cookies.
With the C<$key> argument, in scalar context this method fetches the first matching cookie. In list context it returns all matching cookies. The returned cookies are the values as they appeared in the incoming Cookie header.
This will trigger an L<APR::Request::Error> if L</jar_status> returned value is not zero.
lib/Apache2/API/Request/Params.pm view on Meta::CPAN
=head2 pool
Returns the L<APR::Pool> object associated to this L<Apache2::RequestRec> handle.
=head2 read_limit integer
Get/set the read limit, which controls the total amount of bytes that can be fed to the current parser.
=head2 temp_dir string
Get/set the spool directory for uploads which exceed the configured brigade_limit.
=head2 upload
With no arguments, this method returns a tied L<APR::Request::Param::Table> object (or undef if the request body is absent) in scalar context (whose entries are L<Apache2::API::Request::Params::Upload> objects inherited from L<APR::Request::Param>), ...
If one ore more arguments are provided, they are taken as data upload field names and their corresponding L<Apache2::API::Request::Params::Upload> objects are returned as a list in list context or the first one on the list in scalar context.
More generally, L</upload> follows the same pattern as L</param> with respect to its return values and argument list. The main difference is that its returned values are L<Apache2::API::Request::Param::Upload> object refs, not simple scalars.
=head2 uploads
This returns an L<APR::Request::Param::Table>. This is different from the L<Apache2::API::Request/upload> who returns an array reference of L<Apache2::API::Request::Params::Upload> objects.
=head2 upload_hook code reference
Provided with a code reference, this adds an upload hook callback for this request. The arguments to the C<$callback> sub are (C<$upload>, C<$new_data>).
$r->upload_hook(sub
{
my( $upload, $new_data ) = @_;
# do something
});
=head1 AUTHOR
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
=head1 SEE ALSO
L<Apache2::Request>, L<APR::Request>, L<APR::Request::Param>, L<APR::Request::Apache2>
lib/Apache2/API/Request/Upload.pm view on Meta::CPAN
{
use strict;
use warnings;
warnings::register_categories( 'Apache2::API' );
use parent qw( APR::Request::Param );
use version;
use APR::Request::Param;
our $VERSION = 'v0.1.0';
};
sub bucket { return( shift->upload( @_ ) ); }
# This one is not very useful, since the charaset value here is an integer: 0, 1, 2, 8
# sub charset
sub fh { return( shift->upload_fh( @_ ) ); }
sub filename { return( shift->upload_filename( @_ ) ); }
# The header for this field
# sub info
sub io { return( shift->upload_io( @_ ) ); }
# sub is_tainted
sub length { return( shift->upload_size( @_ ) ); }
sub link { return( shift->upload_link( @_ ) ); }
# sub make
# sub name
sub size { return( shift->upload_size( @_ ) ); }
sub slurp { return( shift->upload_slurp( @_ ) ); }
sub tempname { return( shift->upload_tempname( @_ ) ); }
sub type { return( shift->upload_type( @_ ) ); }
# Returns an APR::Brigade, if any
# upload
# sub value
1;
# NOTE: POD
__END__
=encoding utf8
=head1 NAME
lib/Apache2/API/Request/Upload.pm view on Meta::CPAN
Apache2::API::Request::Upload - Apache2 Request Upload Object
=head1 SYNOPSIS
use Apache2::API::Request::Params;
## $r is the Apache2::RequestRec object
my $req = Apache2::API::Request::Params->new(
request => $r,
# pool of 2Mb
brigade_limit => 2097152,
disable_uploads => 0,
# For example: 3Mb
read_limit => 3145728,
temp_dir => '/home/me/my/tmp'
upload_hook => sub
{
my( $upload, $new_data ) = @_;
# do something
},
);
my $file = $req->upload( 'file_upload' );
# or more simply
use parent qw( Apache2::API )
# in your sub
my $self = shift( @_ );
my $file = $self->request->upload( 'file_upload' );
# or
my $file = $self->request->param( 'file_upload' );
print( "No check done on data? ", $file->is_tainted ? 'no' : 'yes', "\n" );
print( "Is it encoded in utf8? ", $file->charset == 8 ? 'yes' : 'no', "\n" );
my $field_header = $file->info;
# Returns the APR::Brigade object content for file_upload
my $brigade = $field->bucket
printf( "File name provided by client is: %s\n", $file->filename );
# link to the temporary file or make a copy if on different file system
$file->link( '/to/my/temp/file.png' );
my $buff;
# Read in our buffer if this is less than 500Kb
$file->slurp( $buff ) if( $file->length < 512000 );
print( "Uploaded data is %d bytes big\n, $file->length );
print( "MIME type of uploaded data is: %s\n", $file->type );
print( "Temporary file name is: %s\n", $file->tempname );
my $io = $file->io;
print while( $io->read( $_ ) );
# overloaded object reverting to $file->value
print( "Data is: $file\n" );
print( "Data is: ", $file->value, "\n" );
=head1 VERSION
v0.1.0
=head1 DESCRIPTION
This is a module that inherits from L<APR::Request::Param> to deal with data upload leveraging directly Apache mod_perl's methods making it fast and powerful.
=head1 METHODS
=head2 bucket
Get or set the L<APR::Brigade> file-upload content for this param.
May also be called as B<upload>
=head2 charset
$param->charset();
$param->charset( $set );
Get or sets the param's internal charset. The charset is a number between 0 and 255; the current recognized values are
=over 4
lib/Apache2/API/Request/Upload.pm view on Meta::CPAN
print( "Data in utf8 ? ", $up->charset == 8 ? 'yes' : 'no', "\n" );
=head2 filename
Returns the client-side filename associated with this param.
Depending on the user agent, this may be the file full path name or just the file base name.
=head2 fh
Returns a seekable filehandle representing the file-upload content.
=head2 info
Get or set the L<APR::Table> headers for this param.
my $info = $up->info;
while( my( $hdr_name, $hdr_value ) = each( %$info ) )
{
# etc
}
lib/Apache2/API/Request/Upload.pm view on Meta::CPAN
=head2 is_tainted
$param->is_tainted();
$param->is_tainted(0); # untaint it
Get or set the param's internal tainted flag.
=head2 length
Returns the size of the param's file-upload content.
May also be called as B<size>
=head2 link
Provided with a file path and this will link the file-upload content with the local file named $path. Creates a hard-link if the spoolfile's (see upload_tempname) temporary directory is on the same device as $path; otherwise this writes a copy.
This is useful to avoid recreating the data. This works on *nix-like systems
my $up = $req->param( 'file_upload' );
$up->link( '/to/my/location.png' ) ||
die( sprintf( "Cannot symlink from %s: $!\n", $up->tempname ) );
=head2 make
Fast XS param constructor.
my $param = Apache2::API::Request::Param::Upload->make( $pool, $name, $value );
=head2 name
$param->name();
Returns the param's name, i.e. the html form field name. This attribute cannot be modified.
=head2 size
$param->size();
Returns the size of the param's file-upload content.
=head2 slurp
Provided with a variable, such as C<$data> and this reads the entire file-upload content into C<$data> and returns an integer representing the size of C<$data>.
my $up = $req->param( 'file_upload' );
my $size = $up->slurp( $data );
=head2 tempname
Provided with a string and this returns the name of the local spoolfile for this param.
=head2 type
Provided with a string and this returns the MIME-type of the param's file-upload content.
=head2 upload
my $brigade = $param->upload();
$param->upload( $brigade );
Get or set the L<APR::Brigade> file-upload content for this param.
=head2 upload_fh
my $fh = $param->upload_fh();
Returns a seekable filehandle representing the file-upload content.
=head2 upload_filename
my $filename = $param->upload_filename();
Returns the client-side filename associated with this param.
=head2 upload_io
my $fh = $param->upload_io();
Returns an L<APR::Request::Brigade::IO> object, which can be treated as a non-seekable IO stream.
See also L</upload_fh>
=head2 upload_link
$param->upload_link( $path );
Links the file-upload content with the local file named $path. Creates a hard-link if the spoolfile's (see upload_tempname) temporary directory is on the same device as $path; otherwise this writes a copy.
=head2 upload_size
my $nbytes = $param->upload_size();
Returns the size of the param's file-upload content.
=head2 upload_slurp
$param->upload_slurp( $data );
Reads the entire file-upload content into $data.
=head2 upload_tempname
my $filename = $param->upload_tempname();
Returns the name of the local spoolfile for this param.
=head2 upload_type
my $type = $param->upload_type();
Returns the MIME-type of the param's file-upload content.
=head2 value
$param->value();
Returns the param's value. This attribute cannot be modified.
=head1 AUTHOR
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
lib/Apache2/API/Status.pm view on Meta::CPAN
Connection: close
Content-Type: text/plain
Content-Length: 19
Too slow! Try again
=head2 HTTP_CONFLICT (409)
See L<rfc 7231, section 6.5.8|https://tools.ietf.org/html/rfc7231#section-6.5.8>
This is returned to indicate a request conflict with the current state of the target resource, such as uploading with C<PUT> a file older than the remote one.
=head2 HTTP_GONE (410)
See L<rfc 7231, section 6.5.9|https://tools.ietf.org/html/rfc7231#section-6.5.9>
This is returned to indicate that the target resource is gone permanently. The subtle difference with the status code C<404> is that with C<404>, the resource may be only temporally unavailable whereas with C<410>, this is irremediable. For example:
HTTP/1.1 410 Gone
Server: Apache/2.4
Content-Type: text/plain
t/lib/Test/Apache2/API/Request.pm view on Meta::CPAN
sub the_request { return( shift->_test({ method => 'the_request', expect => 'GET /tests/request/the_request HTTP/1.1' }) ); }
# time2datetime
# 2021-11-1T167:12:10+0900
sub time2str { return( shift->_test({ method => 'time2str', expect => 'Mon, 01 Nov 2021 08:12:10 GMT', args => [1635754330] }) ); }
sub type { return( shift->_test({ method => 'type', expect => 'text/plain' }) ); }
# unparsed_uri
# uploads
sub uri { return( shift->_test({ method => 'uri', expect => 'URI', type => 'isa' }) ); }
# url_decode
# url_encode
# user
sub user_agent { return( shift->_test({ method => 'user_agent', expect => 'Test-Apache2-API/v0.1.0' }) ); }
sub _target { return( shift->api->request ); }