lib/Catalyst/Engine/CGI/APR.pm

   1 package Catalyst::Engine::CGI::APR;
   2
   3 use strict;
   4 use base 'Catalyst::Engine::CGI::Base';
   5
   6 use APR;
   7 use APR::Pool;
   8 use APR::Request;
   9 use APR::Request::CGI;
  10 use APR::Request::Param;
  11
  12 __PACKAGE__->mk_accessors( qw[apr pool] );
  13
  14 =head1 NAME
  15
  16 Catalyst::Engine::CGI::APR - The CGI APR Engine
  17
  18 =head1 SYNOPSIS
  19
  20 A script using the Catalyst::Engine::CGI::APR module might look like:
  21
  22     #!/usr/bin/perl -w
  23
  24     BEGIN {
  25        $ENV{CATALYST_ENGINE} = 'CGI::APR';
  26     }
  27
  28     use strict;
  29     use lib '/path/to/MyApp/lib';
  30     use MyApp;
  31
  32     MyApp->run;
  33
  34 =head1 DESCRIPTION
  35
  36 This Catalyst engine uses C<APR::Request::CGI> for parsing of message body.
  37
  38 =head1 METHODS
  39
  40 =over 4
  41
  42 =item $c->apr
  43
  44 Contains the C<APR::Request::CGI> object.
  45
  46 =item $c->pool
  47
  48 Contains the C<APR::Pool> object.
  49
  50 =back
  51
  52 =head1 OVERLOADED METHODS
  53
  54 This class overloads some methods from C<Catalyst::Engine::CGI::Base>.
  55
  56 =over 4
  57
  58 =item $c->prepare_parameters
  59
  60 =cut
  61
  62 sub prepare_parameters {
  63     my $c = shift;
  64
  65     my @params;
  66
  67     if ( my $table = $c->apr->param ) {
  68
  69         $table->do( sub {
  70             my ( $field, $value ) = @_;
  71             push( @params, $field, $value );
  72             return 1;
  73         });
  74
  75         $c->request->param(@params);
  76     }
  77 }
  78
  79 =item $c->prepare_request
  80
  81 =cut
  82
  83 sub prepare_request {
  84     my $c = shift;
  85     $c->pool(  APR::Pool->new );
  86     $c->apr( APR::Request::CGI->handle( $c->pool ) );
  87 }
  88
  89 =item $c->prepare_uploads
  90
  91 =cut
  92
  93 sub prepare_uploads {
  94     my $c = shift;
  95
  96     my @uploads;
  97
  98     if ( my $body = $c->apr->body ) {
  99
 100         $body->param_class('APR::Request::Param');
 101
 102         $body->uploads( $c->pool )->do( sub {
 103             my ( $field, $upload ) = @_;
 104
 105             my $object = Catalyst::Request::Upload->new(
 106                 filename => $upload->upload_filename,
 107                 size     => $upload->upload_size,
 108                 tempname => $upload->upload_tempname,
 109                 type     => $upload->upload_type
 110             );
 111
 112             push( @uploads, $field, $object );
 113
 114             return 1;
 115         });
 116
 117         $c->request->upload(@uploads);
 118     }
 119 }
 120
 121 =back
 122
 123 =head1 SEE ALSO
 124
 125 L<Catalyst>, L<APR::Request::CGI>, L<Catalyst::Engine::CGI::Base>.
 126
 127 =head1 AUTHOR
 128
 129 Sebastian Riedel, C<sri@cpan.org>
 130 Christian Hansen, C<ch@ngmedia.com>
 131
 132 =head1 COPYRIGHT
 133
 134 This program is free software, you can redistribute it and/or modify it under
 135 the same terms as Perl itself.
 136
 137 =cut
 138
 139 1;