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