1 package Catalyst::Engine::CGI;
4 use base 'Catalyst::Engine';
10 $CGI::Simple::POST_MAX = 1048576;
11 $CGI::Simple::DISABLE_UPLOADS = 0;
13 __PACKAGE__->mk_accessors('cgi');
17 Catalyst::Engine::CGI - The CGI Engine
24 use lib '/path/to/MyApp/lib';
33 This is the CGI engine for Catalyst.
35 The script shown above must be designated as a "Non-parsed Headers"
36 script to function properly.
37 To do this in Apache name the script starting with C<nph->.
39 The performance of this way of using Catalyst is not expected to be
40 useful in production applications, but it may be helpful for development.
46 To be called from a CGI script to start the Catalyst application.
50 This config parameter contains the C<CGI::Simple> object.
52 =head2 OVERLOADED METHODS
54 This class overloads some methods from C<Catalyst>.
56 =head3 finalize_headers
60 sub finalize_headers {
62 my %headers = ( -nph => 1 );
63 $headers{-status} = $c->response->status if $c->response->status;
64 for my $name ( $c->response->headers->header_field_names ) {
65 $headers{"-$name"} = $c->response->headers->header($name);
68 while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
69 push @cookies, $c->cgi->cookie(
71 -value => $cookie->{value},
72 -expires => $cookie->{expires},
73 -domain => $cookie->{domain},
74 -path => $cookie->{path},
75 -secure => $cookie->{secure} || 0
78 $headers{-cookie} = \@cookies if @cookies;
79 print $c->cgi->header(%headers);
82 =head3 finalize_output
88 print $c->response->output;
91 =head3 prepare_cookies
95 sub prepare_cookies { shift->req->cookies( { CGI::Cookie->fetch } ) }
97 =head3 prepare_headers
101 sub prepare_headers {
103 $c->req->method( $c->cgi->request_method );
104 for my $header ( $c->cgi->http ) {
105 ( my $field = $header ) =~ s/^HTTPS?_//;
106 $c->req->headers->header( $field => $c->cgi->http($header) );
110 =head3 prepare_parameters
114 sub prepare_parameters {
116 my %vars = $c->cgi->Vars;
117 while ( my ( $key, $value ) = each %vars ) {
118 my @values = split "\0", $value;
119 $vars{$key} = @values <= 1 ? $values[0] : \@values;
121 $c->req->parameters( {%vars} );
130 $c->req->path( $c->cgi->url( -absolute => 1, -path_info => 1 ) );
131 my $loc = $c->cgi->url( -absolute => 1 );
132 no warnings 'uninitialized';
133 $c->req->{path} =~ s/^($loc)?\///;
134 $c->req->{path} .= '/' if $c->req->path eq $loc;
135 my $base = $c->cgi->url;
136 if ( $ENV{CATALYST_TEST} ) {
137 my $script = $c->cgi->script_name;
138 $base =~ s/$script$//i;
140 $base = URI->new($base);
141 $base->path('/') if ( $ENV{CATALYST_TEST} || !$base->path );
142 $c->req->base( $base->as_string );
145 =head3 prepare_request
149 sub prepare_request { shift->cgi( CGI::Simple->new ) }
151 =head3 prepare_uploads
155 sub prepare_uploads {
157 for my $name ( $c->cgi->upload ) {
158 $c->req->uploads->{$name} = {
159 fh => $c->cgi->upload($name),
160 size => $c->cgi->upload_info( $name, 'size' ),
161 type => $c->cgi->upload_info( $name, 'mime' )
166 sub run { shift->handler }
174 Sebastian Riedel, C<sri@cpan.org>
178 This program is free software, you can redistribute it and/or modify it under
179 the same terms as Perl itself.