1 package Catalyst::Engine::CGI;
4 use base 'Catalyst::Engine';
10 __PACKAGE__->mk_accessors('cgi');
14 Catalyst::Engine::CGI - The CGI Engine
22 This is the CGI engine for Catalyst.
28 To be called from a CGI script to start the Catalyst application.
32 This config parameter contains the C<CGI::Simple> object.
34 =head2 OVERLOADED METHODS
36 This class overloads some methods from C<Catalyst>.
38 =head3 finalize_headers
42 sub finalize_headers {
44 my %headers = ( -nph => 1 );
45 $headers{-status} = $c->response->status if $c->response->status;
46 for my $name ( $c->response->headers->header_field_names ) {
47 $headers{"-$name"} = $c->response->headers->header($name);
50 while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
51 push @cookies, $c->cgi->cookie(
53 -value => $cookie->{value},
54 -expires => $cookie->{expires},
55 -domain => $cookie->{domain},
56 -path => $cookie->{path},
57 -secure => $cookie->{secure} || 0
60 $headers{-cookie} = \@cookies if @cookies;
61 print $c->cgi->header(%headers);
64 =head3 finalize_output
70 print $c->response->output;
73 =head3 prepare_cookies
77 sub prepare_cookies { shift->req->cookies( { CGI::Cookie->fetch } ) }
79 =head3 prepare_headers
85 $c->req->method( $c->cgi->request_method );
86 for my $header ( $c->cgi->http ) {
87 ( my $field = $header ) =~ s/^HTTPS?_//;
88 $c->req->headers->header( $field => $c->cgi->http($header) );
92 =head3 prepare_parameters
96 sub prepare_parameters {
98 my %vars = $c->cgi->Vars;
99 while ( my ( $key, $value ) = each %vars ) {
100 my @values = split "\0", $value;
101 $vars{$key} = @values <= 1 ? $values[0] : \@values;
103 $c->req->parameters( {%vars} );
112 $c->req->path( $c->cgi->url( -absolute => 1, -path_info => 1 ) );
113 my $loc = $c->cgi->url( -absolute => 1 );
114 no warnings 'uninitialized';
115 $c->req->{path} =~ s/^($loc)?\///;
116 $c->req->{path} .= '/' if $c->req->path eq $loc;
117 my $base = $c->cgi->url;
118 $base = URI->new($base);
119 $base->path('/') if ( $ENV{CATALYST_TEST} || !$base->path );
120 $c->req->base( $base->as_string );
123 =head3 prepare_request
127 sub prepare_request { shift->cgi( CGI::Simple->new ) }
129 =head3 prepare_uploads
133 sub prepare_uploads {
135 for my $name ( $c->cgi->upload ) {
136 my $filename = $c->req->params->{$name};
137 $c->req->uploads->{$name} = {
138 fh => $c->cgi->upload($filename),
139 filename => $filename,
140 size => $c->cgi->upload_info( $filename, 'size' ),
141 type => $c->cgi->upload_info( $filename, 'mime' )
146 sub run { shift->handler }
154 Sebastian Riedel, C<sri@cpan.org>
158 This program is free software, you can redistribute it and/or modify it under
159 the same terms as Perl itself.
164 ## Please see file perltidy.ERR