1 package Catalyst::Engine;
4 use base 'Class::Accessor::Fast';
11 # input position and length
12 __PACKAGE__->mk_accessors( qw/read_position read_length/ );
15 use overload '""' => sub { return ref shift }, fallback => 1;
17 # Amount of data to read from input on each pass
18 our $CHUNKSIZE = 4096;
22 Catalyst::Engine - The Catalyst Engine
34 =item $self->finalize_output
36 <obsolete>, see finalize_body
38 =item $self->finalize_body($c)
40 Finalize body. Prints the response output.
45 my ( $self, $c ) = @_;
47 $self->write( $c, $c->response->output );
50 =item $self->finalize_cookies($c)
54 sub finalize_cookies {
55 my ( $self, $c ) = @_;
58 while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
60 my $cookie = CGI::Cookie->new(
62 -value => $cookie->{value},
63 -expires => $cookie->{expires},
64 -domain => $cookie->{domain},
65 -path => $cookie->{path},
66 -secure => $cookie->{secure} || 0
69 push @cookies, $cookie->as_string;
73 $c->res->headers->push_header( 'Set-Cookie' => join ',', @cookies );
77 =item $self->finalize_error($c)
82 my ( $self, $c ) = @_;
84 $c->res->headers->content_type('text/html');
85 my $name = $c->config->{name} || 'Catalyst Application';
87 my ( $title, $error, $infos );
91 local $Data::Dumper::Terse = 1;
93 map { '<code class="error">' . encode_entities($_) . '</code>' }
95 $error ||= 'No output';
96 $title = $name = "$name on Catalyst $Catalyst::VERSION";
98 # Don't show context in the dump
99 delete $c->req->{_context};
100 delete $c->res->{_context};
102 # Don't show body parser in the dump
103 delete $c->req->{_body};
105 # Don't show response header state in dump
106 delete $c->res->{_finalized_headers};
108 my $req = encode_entities Dumper $c->req;
109 my $res = encode_entities Dumper $c->res;
110 my $stash = encode_entities Dumper $c->stash;
113 <b><u>Request</u></b><br/>
115 <b><u>Response</u></b><br/>
117 <b><u>Stash</u></b><br/>
126 (en) Please come back later
127 (de) Bitte versuchen sie es spaeter nocheinmal
128 (nl) Gelieve te komen later terug
129 (no) Vennligst prov igjen senere
130 (fr) Veuillez revenir plus tard
131 (es) Vuelto por favor mas adelante
132 (pt) Voltado por favor mais tarde
133 (it) Ritornato prego piĆ¹ successivamente
138 $c->res->body( <<"" );
141 <title>$title</title>
142 <style type="text/css">
144 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
145 Tahoma, Arial, helvetica, sans-serif;
147 background-color: #eee;
152 background-color: #ccc;
153 border: 1px solid #aaa;
156 -moz-border-radius: 10px;
159 background-color: #977;
160 border: 1px solid #755;
164 -moz-border-radius: 10px;
167 background-color: #797;
168 border: 1px solid #575;
172 -moz-border-radius: 10px;
175 background-color: #779;
176 border: 1px solid #557;
179 -moz-border-radius: 10px;
191 <div class="error">$error</div>
192 <div class="infos">$infos</div>
193 <div class="name">$name</div>
200 =item $self->finalize_headers($c)
204 sub finalize_headers { }
206 =item $self->finalize_read($c)
211 my ( $self, $c ) = @_;
213 undef $self->{_prepared_read};
216 =item $self->finalize_uploads($c)
220 sub finalize_uploads {
221 my ( $self, $c ) = @_;
223 if ( keys %{ $c->request->uploads } ) {
224 for my $key ( keys %{ $c->request->uploads } ) {
225 my $upload = $c->request->uploads->{$key};
226 unlink map { $_->tempname }
227 grep { -e $_->tempname }
228 ref $upload eq 'ARRAY' ? @{$upload} : ($upload);
233 =item $self->prepare_body($c)
238 my ( $self, $c ) = @_;
240 $self->read_length( $c->request->header('Content-Length') || 0 );
241 my $type = $c->request->header('Content-Type');
243 unless ( $c->request->{_body} ) {
244 $c->request->{_body} = HTTP::Body->new( $type, $self->read_length );
247 if ( $self->read_length > 0 ) {
248 while ( my $buffer = $self->read( $c ) ) {
249 $c->prepare_body_chunk( $buffer );
254 =item $self->prepare_body_chunk($c)
258 sub prepare_body_chunk {
259 my ( $self, $c, $chunk ) = @_;
261 $c->request->{_body}->add( $chunk );
264 =item $self->prepare_body_parameters($c)
268 sub prepare_body_parameters {
269 my ( $self, $c ) = @_;
270 $c->request->body_parameters( $c->request->{_body}->param );
273 =item $self->prepare_connection($c)
277 sub prepare_connection { }
279 =item $self->prepare_cookies($c)
283 sub prepare_cookies {
284 my ( $self, $c ) = @_;
286 if ( my $header = $c->request->header('Cookie') ) {
287 $c->req->cookies( { CGI::Cookie->parse($header) } );
291 =item $self->prepare_headers($c)
295 sub prepare_headers { }
297 =item $self->prepare_parameters($c)
301 sub prepare_parameters {
302 my ( $self, $c ) = @_;
304 # We copy, no references
305 while ( my ( $name, $param ) = each %{ $c->request->query_parameters } ) {
306 $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
307 $c->request->parameters->{$name} = $param;
310 # Merge query and body parameters
311 while ( my ( $name, $param ) = each %{ $c->request->body_parameters } ) {
312 $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
313 if ( my $old_param = $c->request->parameters->{$name} ) {
314 if ( ref $old_param eq 'ARRAY' ) {
315 push @{ $c->request->parameters->{$name} },
316 ref $param eq 'ARRAY' ? @$param : $param;
318 else { $c->request->parameters->{$name} = [ $old_param, $param ] }
320 else { $c->request->parameters->{$name} = $param }
324 =item $self->prepare_path($c)
330 =item $self->prepare_request($c)
332 =item $self->prepare_query_parameters($c)
336 sub prepare_query_parameters { }
338 =item $self->prepare_read($c)
343 my ( $self, $c ) = @_;
345 # Reset the read position
346 $self->read_position( 0 );
349 =item $self->prepare_request(@arguments)
353 sub prepare_request { }
355 =item $self->prepare_uploads($c)
359 sub prepare_uploads {
360 my ( $self, $c ) = @_;
361 my $uploads = $c->request->{_body}->upload;
362 for my $name ( keys %$uploads ) {
363 my $files = $uploads->{$name};
364 $files = ref $files eq 'ARRAY' ? $files : [$files];
366 for my $upload (@$files) {
367 my $u = Catalyst::Request::Upload->new;
368 $u->headers( HTTP::Headers->new( %{ $upload->{headers} } ) );
369 $u->type( $u->headers->content_type );
370 $u->tempname( $upload->{tempname} );
371 $u->size( $upload->{size} );
372 $u->filename( $upload->{filename} );
375 $c->request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0];
379 =item $self->prepare_write($c)
383 sub prepare_write { }
385 =item $self->read($c, [$maxlength])
390 my ( $self, $c, $maxlength ) = @_;
392 unless ( $self->{_prepared_read} ) {
393 $self->prepare_read( $c );
394 $self->{_prepared_read} = 1;
397 my $remaining = $self->read_length - $self->read_position;
398 $maxlength ||= $CHUNKSIZE;
400 # Are we done reading?
401 if ( $remaining <= 0 ) {
402 $self->finalize_read( $c );
406 my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
407 my $rc = $self->read_chunk( $c, my $buffer, $readlen );
409 $self->read_position( $self->read_position + $rc );
413 Catalyst::Exception->throw(
414 message => "Unknown error reading input: $!"
419 =item $self->read_chunk($c, $buffer, $length)
421 Each engine inplements read_chunk as its preferred way of reading a chunk
428 =item $self->read_length
430 The length of input data to be read. This is obtained from the Content-Length
433 =item $self->read_position
435 The amount of input data that has already been read.
443 =item $self->write($c, $buffer)
448 my ( $self, $c, $buffer ) = @_;
450 unless ( $self->{_prepared_write} ) {
451 $self->prepare_write( $c );
452 $self->{_prepared_write} = 1;
455 my $handle = $c->response->handle;
457 print $handle $buffer;
464 Sebastian Riedel, <sri@cpan.org>
466 Andy Grundman, <andy@hybridized.org>
470 This program is free software, you can redistribute it and/or modify it under
471 the same terms as Perl itself.