Fixed MP2, removed dependency of libapreq in MP engines, fixed C::E::C::APR
Christian Hansen [Mon, 16 May 2005 22:13:52 +0000 (22:13 +0000)]
18 files changed:
Build.PL
lib/Catalyst.pm
lib/Catalyst/Engine/Apache/Base.pm
lib/Catalyst/Engine/Apache/MP13.pm
lib/Catalyst/Engine/Apache/MP13/APR.pm [new file with mode: 0644]
lib/Catalyst/Engine/Apache/MP13/Base.pm [new file with mode: 0644]
lib/Catalyst/Engine/Apache/MP19.pm
lib/Catalyst/Engine/Apache/MP19/APR.pm [new file with mode: 0644]
lib/Catalyst/Engine/Apache/MP19/Base.pm [new file with mode: 0644]
lib/Catalyst/Engine/Apache/MP20.pm
lib/Catalyst/Engine/Apache/MP20/APR.pm [new file with mode: 0644]
lib/Catalyst/Engine/Apache/MP20/Base.pm [new file with mode: 0644]
lib/Catalyst/Engine/CGI.pm
lib/Catalyst/Engine/CGI/APR.pm
lib/Catalyst/Engine/CGI/Base.pm
lib/Catalyst/Engine/FastCGI.pm
lib/Catalyst/Engine/SpeedyCGI.pm
t/lib/TestApp/Controller/Dump.pm

index 7922e24..b346735 100644 (file)
--- a/Build.PL
+++ b/Build.PL
@@ -6,10 +6,12 @@ my $build = Module::Build->new(
     license            => 'perl',
     module_name        => 'Catalyst',
     requires           => {
+        'perl'                              => '5.8.1',
         'UNIVERSAL::require'                => 0,
         'CGI'                               => 0,
         'Class::Accessor::Fast'             => 0,
         'Class::Data::Inheritable'          => 0,
+        'File::Temp'                        => 0.14,
         'HTTP::Daemon'                      => 0,
         'HTML::Entities'                    => 0,
         'HTTP::Headers'                     => 0,
index e573b0d..be14489 100644 (file)
@@ -154,23 +154,52 @@ sub import {
     my $dispatcher = 'Catalyst::Dispatcher';
 
     if ( $ENV{MOD_PERL} ) {
-    
-        mod_perl->require;
 
-        if ( $mod_perl::VERSION >= 1.99_90_22 ) {
-            $engine = 'Catalyst::Engine::Apache::MP20';
-        }
+        my ( $software, $version ) = $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
+
+        $version =~ s/_//g;
+        $version =~ s/(\.[^.]+)\./$1/g;
+
+        if ( $software eq 'mod_perl') {
+
+            if ( $version >= 1.99922 ) {
+
+                $engine = 'Catalyst::Engine::Apache::MP20';
+
+                if ( Apache2::Request->require ) {
+                    $engine = 'Catalyst::Engine::Apache::MP20::APR';
+                }
+            }
+
+            elsif ( $version >= 1.9901 ) {
+
+                $engine = 'Catalyst::Engine::Apache::MP19';
 
-        elsif ( $mod_perl::VERSION >= 1.99_01 ) {
-            $engine = 'Catalyst::Engine::Apache::MP19';
+                if ( Apache::Request->require ) {
+                    $engine = 'Catalyst::Engine::Apache::MP19::APR';
+                }
+            }
+
+            elsif ( $version >= 1.24 ) {
+
+                $engine = 'Catalyst::Engine::Apache::MP13';
+
+                if ( Apache::Request->require ) {
+                    $engine = 'Catalyst::Engine::Apache::MP13::APR';
+                }
+            }
+
+            else {
+                die( qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
+            }
         }
 
-        elsif ( $mod_perl::VERSION >= 1.27 ) {
-            $engine = 'Catalyst::Engine::Apache::MP13';
+        elsif ( $software eq 'Zeus-Perl' ) {
+            $engine = 'Catalyst::Engine::Zeus';
         }
 
         else {
-            die( qq/Unsupported mod_perl version: "$mod_perl::VERSION"/ );
+            die( qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
         }
     }
 
index 8d383da..bcf8458 100644 (file)
@@ -91,24 +91,6 @@ sub prepare_headers {
     $c->request->header( %{ $c->apache->headers_in } );
 }
 
-=item $c->prepare_parameters
-
-=cut
-
-sub prepare_parameters {
-    my $c = shift;
-
-    my @params;
-    
-    $c->apache->param->do( sub {
-        my ( $field, $value ) = @_;
-        push( @params, $field, $value );
-        return 1;    
-    });
-    
-    $c->request->param(@params);
-}
-
 =item $c->prepare_path
 
 =cut
@@ -147,6 +129,15 @@ sub prepare_path {
     $c->req->path($path);
 }
 
+=item $c->prepare_request($r)
+
+=cut
+
+sub prepare_request {
+    my ( $c, $r ) = @_;
+    $c->apache($r);
+}
+
 =item $c->run
 
 =cut
index 6415457..27066c3 100644 (file)
@@ -1,13 +1,7 @@
 package Catalyst::Engine::Apache::MP13;
 
 use strict;
-use base 'Catalyst::Engine::Apache::Base';
-
-use Apache            ();
-use Apache::Constants ();
-use Apache::Request   ();
-
-Apache::Constants->import(':common');
+use base qw[Catalyst::Engine::Apache::MP13::Base Catalyst::Engine::CGI];
 
 =head1 NAME
 
@@ -23,75 +17,49 @@ This is the Catalyst engine specialized for Apache mod_perl version 1.3x.
 
 =head1 OVERLOADED METHODS
 
-This class overloads some methods from C<Catalyst::Engine::Apache::Base>.
+This class overloads some methods from C<Catalyst::Engine::Apache::MP13::Base>
+and C<Catalyst::Engine::CGI>.
 
 =over 4
 
-=item $c->finalize_headers
+=item $c->prepare_body
 
 =cut
 
-sub finalize_headers {
-    my $c = shift;
-
-    for my $name ( $c->response->headers->header_field_names ) {
-        next if $name =~ /Content-Type/i;
-        my @values = $c->response->header($name);
-        $c->apache->headers_out->add( $name => $_ ) for @values;
-    }
-
-    if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) {
-        my @values = $c->response->header('Set-Cookie');
-        $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values;
-    }
-
-    $c->apache->status( $c->response->status );
-    $c->apache->content_type( $c->response->header('Content-Type') );
-
-    $c->apache->send_http_header;
-
-    return 0;
+sub prepare_body { 
+    shift->Catalyst::Engine::CGI::prepare_body(@_);
 }
 
-=item $c->handler
+=item $c->prepare_parameters
 
 =cut
 
-sub handler ($$) {
-    shift->SUPER::handler(@_);
+sub prepare_parameters { 
+    shift->Catalyst::Engine::CGI::prepare_parameters(@_);
 }
 
-=item $c->prepare_request($r)
+=item $c->prepare_request
 
 =cut
 
 sub prepare_request {
-    my ( $c, $r ) = @_;
-    $c->apache( Apache::Request->new($r) );
+    my ( $c, $r, @arguments ) = @_;
+    
+    $ENV{CONTENT_TYPE}   = $r->header_in("Content-Type");
+    $ENV{CONTENT_LENGTH} = $r->header_in("Content-Length");
+    $ENV{QUERY_STRING}   = $r->args;
+    $ENV{REQUEST_METHOD} = $r->method;
+
+    $c->SUPER::prepare_request($r);
+    $c->Catalyst::Engine::CGI::prepare_request( $r, @arguments );
 }
 
 =item $c->prepare_uploads
 
 =cut
 
-sub prepare_uploads {
-    my $c = shift;
-
-    my @uploads;
-
-    for my $upload ( $c->apache->upload ) {
-
-        my $object = Catalyst::Request::Upload->new(
-            filename => $upload->filename,
-            size     => $upload->size,
-            tempname => $upload->tempname,
-            type     => $upload->type
-        );
-
-        push( @uploads, $upload->name, $object );
-    }
-
-    $c->request->upload(@uploads);
+sub prepare_uploads { 
+    shift->Catalyst::Engine::CGI::prepare_uploads(@_);
 }
 
 =back
diff --git a/lib/Catalyst/Engine/Apache/MP13/APR.pm b/lib/Catalyst/Engine/Apache/MP13/APR.pm
new file mode 100644 (file)
index 0000000..d978f9c
--- /dev/null
@@ -0,0 +1,96 @@
+package Catalyst::Engine::Apache::MP13::APR;
+
+use strict;
+use base 'Catalyst::Engine::Apache::MP13::Base';
+
+use Apache::Request ();
+
+=head1 NAME
+
+Catalyst::Engine::Apache::MP13::APR - APR class for MP 1.3 Engines
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This is the Catalyst engine specialized for Apache mod_perl version 1.3x.
+
+=head1 OVERLOADED METHODS
+
+This class overloads some methods from C<Catalyst::Engine::Apache::MP13::Base>.
+
+=over 4
+
+=item $c->prepare_request($r)
+
+=cut
+
+sub prepare_request {
+    my ( $c, $r ) = @_;
+    $c->apache( Apache::Request->new($r) );
+}
+
+
+=item $c->prepare_parameters
+
+=cut
+
+sub prepare_parameters {
+    my $c = shift;
+
+    my @params;
+
+    $c->apache->param->do( sub {
+        my ( $field, $value ) = @_;
+        push( @params, $field, $value );
+        return 1;
+    });
+
+    $c->request->param(@params);
+}
+
+=item $c->prepare_uploads
+
+=cut
+
+sub prepare_uploads {
+    my $c = shift;
+
+    my @uploads;
+
+    for my $upload ( $c->apache->upload ) {
+
+        my $object = Catalyst::Request::Upload->new(
+            filename => $upload->filename,
+            size     => $upload->size,
+            tempname => $upload->tempname,
+            type     => $upload->type
+        );
+
+        push( @uploads, $upload->name, $object );
+    }
+
+    $c->request->upload(@uploads);
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache::MP13::Base>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Catalyst/Engine/Apache/MP13/Base.pm b/lib/Catalyst/Engine/Apache/MP13/Base.pm
new file mode 100644 (file)
index 0000000..ca38f40
--- /dev/null
@@ -0,0 +1,81 @@
+package Catalyst::Engine::Apache::MP13::Base;
+
+use strict;
+use base 'Catalyst::Engine::Apache::Base';
+
+use Apache            ();
+use Apache::Constants ();
+
+Apache::Constants->import(':common');
+
+=head1 NAME
+
+Catalyst::Engine::Apache::MP13::Base - Base class for MP 1.3 Engines
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This is a base class for MP 1.3 Engines.
+
+=head1 OVERLOADED METHODS
+
+This class overloads some methods from C<Catalyst::Engine::Apache::Base>.
+
+=over 4
+
+=item $c->finalize_headers
+
+=cut
+
+sub finalize_headers {
+    my $c = shift;
+
+    for my $name ( $c->response->headers->header_field_names ) {
+        next if $name =~ /Content-Type/i;
+        my @values = $c->response->header($name);
+        $c->apache->headers_out->add( $name => $_ ) for @values;
+    }
+
+    if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) {
+        my @values = $c->response->header('Set-Cookie');
+        $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values;
+    }
+
+    $c->apache->status( $c->response->status );
+    $c->apache->content_type( $c->response->header('Content-Type') );
+
+    $c->apache->send_http_header;
+
+    return 0;
+}
+
+=item $c->handler
+
+=cut
+
+sub handler ($$) {
+    shift->SUPER::handler(@_);
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache::Base>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
index a22c8e0..5a44984 100644 (file)
@@ -1,18 +1,7 @@
 package Catalyst::Engine::Apache::MP19;
 
 use strict;
-use base 'Catalyst::Engine::Apache::Base';
-
-use Apache2             ();
-use Apache::Connection  ();
-use Apache::Const       ();
-use Apache::RequestIO   ();
-use Apache::RequestRec  ();
-use Apache::RequestUtil ();
-use Apache::Request     ();
-use Apache::Upload      ();
-
-Apache::Const->import( -compile => ':common' );
+use base qw[Catalyst::Engine::Apache::MP19::Base Catalyst::Engine::CGI];
 
 =head1 NAME
 
@@ -28,79 +17,49 @@ This is the Catalyst engine specialized for Apache mod_perl version 1.9x.
 
 =head1 OVERLOADED METHODS
 
-This class overloads some methods from C<Catalyst::Engine::Apache::Base>.
+This class overloads some methods from C<Catalyst::Engine::Apache::MP13::Base>
+and C<Catalyst::Engine::CGI>.
 
 =over 4
 
-=item $c->finalize_headers
+=item $c->prepare_body
 
 =cut
 
-sub finalize_headers {
-    my $c = shift;
-
-    for my $name ( $c->response->headers->header_field_names ) {
-        next if $name =~ /Content-Type/i;
-        my @values = $c->response->header($name);
-        $c->apache->headers_out->add( $name => $_ ) for @values;
-    }
-
-    if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) {
-        my @values = $c->response->header('Set-Cookie');
-        $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values;
-    }
-
-    $c->apache->status( $c->response->status );
-    $c->apache->content_type( $c->response->header('Content-Type') );
-
-    return 0;
+sub prepare_body { 
+    shift->Catalyst::Engine::CGI::prepare_body(@_);
 }
 
-=item $c->handler
+=item $c->prepare_parameters
 
 =cut
 
-sub handler : method {
-    shift->SUPER::handler(@_);
+sub prepare_parameters { 
+    shift->Catalyst::Engine::CGI::prepare_parameters(@_);
 }
 
-=item $c->prepare_request($r)
+=item $c->prepare_request
 
 =cut
 
 sub prepare_request {
-    my ( $c, $r ) = @_;
-    $c->apache( Apache::Request->new($r) );
+    my ( $c, $r, @arguments ) = @_;
+    
+    $ENV{CONTENT_TYPE}   = $r->headers_in->get("Content-Type");
+    $ENV{CONTENT_LENGTH} = $r->headers_in->get("Content-Length");
+    $ENV{QUERY_STRING}   = $r->args;
+    $ENV{REQUEST_METHOD} = $r->method;
+
+    $c->SUPER::prepare_request($r);
+    $c->Catalyst::Engine::CGI::prepare_request( $r, @arguments );
 }
 
 =item $c->prepare_uploads
 
 =cut
 
-sub prepare_uploads {
-    my $c = shift;
-
-    # This is a workaround for a know bug with libapreq <= 2.0.4
-    # http://svn.apache.org/viewcvs.cgi?rev=122925&view=rev
-    
-    my @uploads;    
-
-    for my $field ( $c->request->param ) {
-
-        for my $upload ( $c->apache->upload($field) ) {
-
-            my $object = Catalyst::Request::Upload->new(
-                filename => $upload->filename,
-                size     => $upload->size,
-                tempname => $upload->tempname,
-                type     => $upload->type
-            );
-
-            push( @uploads, $field, $object );
-        }
-    }
-
-    $c->request->upload(@uploads);
+sub prepare_uploads { 
+    shift->Catalyst::Engine::CGI::prepare_uploads(@_);
 }
 
 =back
diff --git a/lib/Catalyst/Engine/Apache/MP19/APR.pm b/lib/Catalyst/Engine/Apache/MP19/APR.pm
new file mode 100644 (file)
index 0000000..b8c507d
--- /dev/null
@@ -0,0 +1,102 @@
+package Catalyst::Engine::Apache::MP19::APR;
+
+use strict;
+use base 'Catalyst::Engine::Apache::MP19::Base';
+
+use Apache::Request ();
+use Apache::Upload  ();
+
+=head1 NAME
+
+Catalyst::Engine::Apache::MP19::APR - APR class for MP 1.9 Engines
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This is the Catalyst engine specialized for Apache mod_perl version 1.99.
+
+=head1 OVERLOADED METHODS
+
+This class overloads some methods from C<Catalyst::Engine::Apache::MP19::Base>.
+
+=over 4
+
+=item $c->prepare_parameters
+
+=cut
+
+sub prepare_parameters {
+    my $c = shift;
+
+    my @params;
+
+    $c->apache->param->do( sub {
+        my ( $field, $value ) = @_;
+        push( @params, $field, $value );
+        return 1;
+    });
+
+    $c->request->param(@params);
+}
+
+=item $c->prepare_request($r)
+
+=cut
+
+sub prepare_request {
+    my ( $c, $r ) = @_;
+    $c->apache( Apache::Request->new($r) );
+}
+
+=item $c->prepare_uploads
+
+=cut
+
+sub prepare_uploads {
+    my $c = shift;
+
+    # This is a workaround for a know bug with libapreq <= 2.0.4
+    # http://svn.apache.org/viewcvs.cgi?rev=122925&view=rev
+    
+    my @uploads;    
+
+    for my $field ( $c->request->param ) {
+
+        for my $upload ( $c->apache->upload($field) ) {
+
+            my $object = Catalyst::Request::Upload->new(
+                filename => $upload->filename,
+                size     => $upload->size,
+                tempname => $upload->tempname,
+                type     => $upload->type
+            );
+
+            push( @uploads, $field, $object );
+        }
+    }
+
+    $c->request->upload(@uploads);
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache::MP19::Base>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Catalyst/Engine/Apache/MP19/Base.pm b/lib/Catalyst/Engine/Apache/MP19/Base.pm
new file mode 100644 (file)
index 0000000..0a08ba1
--- /dev/null
@@ -0,0 +1,83 @@
+package Catalyst::Engine::Apache::MP19::Base;
+
+use strict;
+use base 'Catalyst::Engine::Apache::Base';
+
+use Apache2             ();
+use Apache::Connection  ();
+use Apache::Const       ();
+use Apache::RequestIO   ();
+use Apache::RequestRec  ();
+use Apache::RequestUtil ();
+
+Apache::Const->import( -compile => ':common' );
+
+=head1 NAME
+
+Catalyst::Engine::Apache::MP19::Base - Base class for MP 1.9 Engines
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This is a base class for MP 1.99 Engines.
+
+=head1 OVERLOADED METHODS
+
+This class overloads some methods from C<Catalyst::Engine::Apache::Base>.
+
+=over 4
+
+=item $c->finalize_headers
+
+=cut
+
+sub finalize_headers {
+    my $c = shift;
+
+    for my $name ( $c->response->headers->header_field_names ) {
+        next if $name =~ /Content-Type/i;
+        my @values = $c->response->header($name);
+        $c->apache->headers_out->add( $name => $_ ) for @values;
+    }
+
+    if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) {
+        my @values = $c->response->header('Set-Cookie');
+        $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values;
+    }
+
+    $c->apache->status( $c->response->status );
+    $c->apache->content_type( $c->response->header('Content-Type') );
+
+    return 0;
+}
+
+=item $c->handler
+
+=cut
+
+sub handler : method {
+    shift->SUPER::handler(@_);
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache::Base>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
index c09722a..d03ae88 100644 (file)
@@ -1,17 +1,7 @@
 package Catalyst::Engine::Apache::MP20;
 
 use strict;
-use base 'Catalyst::Engine::Apache::Base';
-
-use Apache2::Connection  ();
-use Apache2::Const       ();
-use Apache2::RequestIO   ();
-use Apache2::RequestRec  ();
-use Apache2::RequestUtil ();
-use Apache2::Request     ();
-use Apache2::Upload      ();
-
-Apache2::Const->import( -compile => ':common' );
+use base qw[Catalyst::Engine::Apache::MP20::Base Catalyst::Engine::CGI];
 
 =head1 NAME
 
@@ -27,76 +17,49 @@ This is the Catalyst engine specialized for Apache mod_perl version 2.0.
 
 =head1 OVERLOADED METHODS
 
-This class overloads some methods from C<Catalyst::Engine::Apache::Base>.
+This class overloads some methods from C<Catalyst::Engine::Apache::MP20::Base>
+and C<Catalyst::Engine::CGI>.
 
 =over 4
 
-=item $c->finalize_headers
+=item $c->prepare_body
 
 =cut
 
-sub finalize_headers {
-    my $c = shift;
-
-    for my $name ( $c->response->headers->header_field_names ) {
-        next if $name =~ /Content-Type/i;
-        my @values = $c->response->header($name);
-        $c->apache->headers_out->add( $name => $_ ) for @values;
-    }
-
-    if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) {
-        my @values = $c->response->header('Set-Cookie');
-        $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values;
-    }
-
-    $c->apache->status( $c->response->status );
-    $c->apache->content_type( $c->response->header('Content-Type') );
-
-    return 0;
+sub prepare_body { 
+    shift->Catalyst::Engine::CGI::prepare_body(@_);
 }
 
-=item $c->handler
+=item $c->prepare_parameters
 
 =cut
 
-sub handler : method {
-    shift->SUPER::handler(@_);
+sub prepare_parameters { 
+    shift->Catalyst::Engine::CGI::prepare_parameters(@_);
 }
 
-=item $c->prepare_request($r)
+=item $c->prepare_request
 
 =cut
 
 sub prepare_request {
-    my ( $c, $r ) = @_;
-    $c->apache( Apache2::Request->new($r) );
+    my ( $c, $r, @arguments ) = @_;
+
+    $ENV{CONTENT_TYPE}   = $r->headers_in->get("Content-Type");
+    $ENV{CONTENT_LENGTH} = $r->headers_in->get("Content-Length");
+    $ENV{QUERY_STRING}   = $r->args;
+    $ENV{REQUEST_METHOD} = $r->method;
+
+    $c->SUPER::prepare_request($r);
+    $c->Catalyst::Engine::CGI::prepare_request( $r, @arguments );
 }
 
 =item $c->prepare_uploads
 
 =cut
 
-sub prepare_uploads {
-    my $c = shift;
-
-    my @uploads;
-
-    $c->apache->upload->do( sub {
-        my ( $field, $upload ) = @_;
-
-        my $object = Catalyst::Request::Upload->new(
-            filename => $upload->filename,
-            size     => $upload->size,
-            tempname => $upload->tempname,
-            type     => $upload->type
-        );
-
-        push( @uploads, $field, $object );
-
-        return 1;
-    });
-
-    $c->request->upload(@uploads);
+sub prepare_uploads { 
+    shift->Catalyst::Engine::CGI::prepare_uploads(@_);
 }
 
 =back
diff --git a/lib/Catalyst/Engine/Apache/MP20/APR.pm b/lib/Catalyst/Engine/Apache/MP20/APR.pm
new file mode 100644 (file)
index 0000000..a7352c5
--- /dev/null
@@ -0,0 +1,102 @@
+package Catalyst::Engine::Apache::MP20::APR;
+
+use strict;
+use base 'Catalyst::Engine::Apache::MP20::Base';
+
+use Apache2::Request ();
+use Apache2::Upload  ();
+
+=head1 NAME
+
+Catalyst::Engine::Apache::MP20 - APR class for MP 2.0 Engines
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This is the Catalyst engine specialized for Apache mod_perl version 2.0.
+
+=head1 OVERLOADED METHODS
+
+This class overloads some methods from C<Catalyst::Engine::Apache::MP20::Base>.
+
+=over 4
+
+=item $c->prepare_parameters
+
+=cut
+
+sub prepare_parameters {
+    my $c = shift;
+
+    my @params;
+
+    if ( my $table = $c->apache->param ) {
+
+        $table->do( sub {
+            my ( $field, $value ) = @_;
+            push( @params, $field, $value );
+            return 1;
+        });
+
+        $c->request->param(@params);
+    }
+}
+
+=item $c->prepare_request($r)
+
+=cut
+
+sub prepare_request {
+    my ( $c, $r ) = @_;
+    $c->apache( Apache2::Request->new($r) );
+}
+
+=item $c->prepare_uploads
+
+=cut
+
+sub prepare_uploads {
+    my $c = shift;
+
+    my @uploads;
+
+    $c->apache->upload->do( sub {
+        my ( $field, $upload ) = @_;
+
+        my $object = Catalyst::Request::Upload->new(
+            filename => $upload->filename,
+            size     => $upload->size,
+            tempname => $upload->tempname,
+            type     => $upload->type
+        );
+
+        push( @uploads, $field, $object );
+
+        return 1;
+    });
+
+    $c->request->upload(@uploads);
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache::MP20::Base>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/lib/Catalyst/Engine/Apache/MP20/Base.pm b/lib/Catalyst/Engine/Apache/MP20/Base.pm
new file mode 100644 (file)
index 0000000..72b111d
--- /dev/null
@@ -0,0 +1,82 @@
+package Catalyst::Engine::Apache::MP20::Base;
+
+use strict;
+use base 'Catalyst::Engine::Apache::Base';
+
+use Apache2::Connection  ();
+use Apache2::Const       ();
+use Apache2::RequestIO   ();
+use Apache2::RequestRec  ();
+use Apache2::RequestUtil ();
+
+Apache2::Const->import( -compile => ':common' );
+
+=head1 NAME
+
+Catalyst::Engine::Apache::MP20::Base - Base class for MP 2.0 Engines
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+This is a base class for MP 2.0 Engines.
+
+=head1 OVERLOADED METHODS
+
+This class overloads some methods from C<Catalyst::Engine::Apache::Base>.
+
+=over 4
+
+=item $c->finalize_headers
+
+=cut
+
+sub finalize_headers {
+    my $c = shift;
+
+    for my $name ( $c->response->headers->header_field_names ) {
+        next if $name =~ /Content-Type/i;
+        my @values = $c->response->header($name);
+        $c->apache->headers_out->add( $name => $_ ) for @values;
+    }
+
+    if ( $c->response->header('Set-Cookie') && $c->response->status >= 300 ) {
+        my @values = $c->response->header('Set-Cookie');
+        $c->apache->err_headers_out->add( 'Set-Cookie' => $_ ) for @values;
+    }
+
+    $c->apache->status( $c->response->status );
+    $c->apache->content_type( $c->response->header('Content-Type') );
+
+    return 0;
+}
+
+=item $c->handler
+
+=cut
+
+sub handler : method {
+    shift->SUPER::handler(@_);
+}
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Engine>, L<Catalyst::Engine::Apache::Base>.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen C<ch@ngmedia.com>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
index 0044681..1a8f37c 100644 (file)
@@ -100,9 +100,35 @@ sub prepare_parameters {
 =cut
 
 sub prepare_request {
-    my ( $c, $cgi ) = @_;
+    my ( $c, $object ) = @_;
+
+    my $cgi;
+
+    if ( defined($object) && ref($object) ) {
+
+        if ( $object->isa('Apache') ) {                   # MP 1.3
+            $cgi = CGI->new($object);
+        }
+
+        elsif ( $object->isa('Apache::RequestRec') ) {    # MP 1.99
+            $cgi = CGI->new($object);
+        }
+
+        elsif ( $object->isa('Apache2::RequestRec') ) {   # MP 2.00
+            $cgi = CGI->new($object);
+        }
+
+        elsif ( $object->isa('CGI') ) {
+            $cgi = $object;
+        }
+
+        else {
+            my $class = ref($object);
+            die( qq/Invalid argument $object/ );
+        }
+    }
+
     $c->cgi( $cgi || CGI->new );
-    $c->cgi->_reset_globals;
 }
 
 =item $c->prepare_uploads
index 964e879..81cfb6a 100644 (file)
@@ -9,7 +9,7 @@ use APR::Request;
 use APR::Request::CGI;
 use APR::Request::Param;
 
-__PACKAGE__->mk_accessors('apr');
+__PACKAGE__->mk_accessors( qw[apr pool] );
 
 =head1 NAME
 
@@ -43,6 +43,10 @@ This Catalyst engine uses C<APR::Request::CGI> for parsing of message body.
 
 Contains the C<APR::Request::CGI> object.
 
+=item $c->pool
+
+Contains the C<APR::Pool> object.
+
 =back
 
 =head1 OVERLOADED METHODS
@@ -59,14 +63,17 @@ sub prepare_parameters {
     my $c = shift;
 
     my @params;
-
-    $c->apr->param->do( sub {
-        my ( $field, $value ) = @_;
-        push( @params, $field, $value );
-        return 1;    
-    });
-
-    $c->request->param(@params);
+    
+    if ( my $table = $c->apr->param ) {
+    
+        $table->do( sub {
+            my ( $field, $value ) = @_;
+            push( @params, $field, $value );
+            return 1;    
+        });
+    
+        $c->request->param(@params);
+    }
 }
 
 =item $c->prepare_request
@@ -75,7 +82,8 @@ sub prepare_parameters {
 
 sub prepare_request {
     my $c = shift;
-    $c->apr( APR::Request::CGI->handle( APR::Pool->new ) );
+    $c->pool(  APR::Pool->new );
+    $c->apr( APR::Request::CGI->handle( $c->pool ) );
 }
 
 =item $c->prepare_uploads
@@ -86,23 +94,28 @@ sub prepare_uploads {
     my $c = shift;
 
     my @uploads;
+    
+    if ( my $body = $c->apr->body ) {
+    
+        $body->param_class('APR::Request::Param');
 
-    $c->apr->upload->do( sub {
-        my ( $field, $upload ) = @_;
+        $body->uploads( $c->pool )->do( sub {
+            my ( $field, $upload ) = @_;
 
-        my $object = Catalyst::Request::Upload->new(
-            filename => $upload->filename,
-            size     => $upload->size,
-            tempname => $upload->tempname,
-            type     => $upload->type
-        );
+            my $object = Catalyst::Request::Upload->new(
+                filename => $upload->upload_filename,
+                size     => $upload->upload_size,
+                tempname => $upload->upload_tempname,
+                type     => $upload->upload_type
+            );
 
-        push( @uploads, $field, $object );
+            push( @uploads, $field, $object );
 
-        return 1;
-    });
+            return 1;
+        });
 
-    $c->request->upload(@uploads);
+        $c->request->upload(@uploads);
+    }
 }
 
 =back
index 3b62454..a76537b 100644 (file)
@@ -121,7 +121,9 @@ sub prepare_path {
         $base = $base->canonical->as_string;
     }
 
+    my $location = $ENV{SCRIPT_NAME} || '/';
     my $path = $ENV{PATH_INFO} || '/';
+    $path =~ s/^($location)?\///;
     $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
     $path =~ s/^\///;
 
index e9215f8..1bf8d18 100644 (file)
@@ -55,6 +55,7 @@ sub prepare_parameters {
 
 sub prepare_request {
     my ( $c, $fastcgi, @arguments ) = @_;
+    CGI::_reset_globals();
     $c->SUPER::prepare_request($fastcgi);
     $c->Catalyst::Engine::CGI::prepare_request(@arguments);
 }
index 0afabff..4735cd4 100644 (file)
@@ -55,6 +55,7 @@ sub prepare_parameters {
 
 sub prepare_request {
     my ( $c, $speedycgi, @arguments ) = @_;
+    $speedycgi->register_cleanup( \&CGI::_reset_globals );
     $c->SUPER::prepare_request($speedycgi);
     $c->Catalyst::Engine::CGI::prepare_request(@arguments);
 }
index 0a259e9..df33eb5 100644 (file)
@@ -8,6 +8,12 @@ sub default : Action Private {
     $c->forward('TestApp::View::Dump');
 }
 
+sub env : Action Relative {
+    my ( $self, $c ) = @_;
+    $c->stash( env => \%ENV );
+    $c->forward('TestApp::View::Dump');
+}
+
 sub parameters : Action Relative {
     my ( $self, $c ) = @_;
     $c->forward('TestApp::View::Dump::Parameters');