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;
19 Catalyst::Engine - The Catalyst Engine
31 =item $self->finalize_output
33 <obsolete>, see finalize_body
35 =item $self->finalize_body($c)
37 Finalize body. Prints the response output.
42 my ( $self, $c ) = @_;
44 $self->write( $c, $c->response->output );
47 =item $self->finalize_cookies($c)
51 sub finalize_cookies {
52 my ( $self, $c ) = @_;
55 while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) {
57 my $cookie = CGI::Cookie->new(
59 -value => $cookie->{value},
60 -expires => $cookie->{expires},
61 -domain => $cookie->{domain},
62 -path => $cookie->{path},
63 -secure => $cookie->{secure} || 0
66 push @cookies, $cookie->as_string;
70 $c->res->headers->push_header( 'Set-Cookie' => join ',', @cookies );
74 =item $self->finalize_error($c)
79 my ( $self, $c ) = @_;
81 $c->res->headers->content_type('text/html');
82 my $name = $c->config->{name} || 'Catalyst Application';
84 my ( $title, $error, $infos );
88 local $Data::Dumper::Terse = 1;
90 map { '<code class="error">' . encode_entities($_) . '</code>' }
92 $error ||= 'No output';
93 $title = $name = "$name on Catalyst $Catalyst::VERSION";
95 # Don't show context in the dump
96 delete $c->req->{_context};
97 delete $c->res->{_context};
99 # Don't show body parser in the dump
100 delete $c->req->{_body};
102 # Don't show response header state in dump
103 delete $c->res->{_finalized_headers};
105 my $req = encode_entities Dumper $c->req;
106 my $res = encode_entities Dumper $c->res;
107 my $stash = encode_entities Dumper $c->stash;
110 <b><u>Request</u></b><br/>
112 <b><u>Response</u></b><br/>
114 <b><u>Stash</u></b><br/>
123 (en) Please come back later
124 (de) Bitte versuchen sie es spaeter nocheinmal
125 (nl) Gelieve te komen later terug
126 (no) Vennligst prov igjen senere
127 (fr) Veuillez revenir plus tard
128 (es) Vuelto por favor mas adelante
129 (pt) Voltado por favor mais tarde
130 (it) Ritornato prego piĆ¹ successivamente
135 $c->res->body( <<"" );
138 <title>$title</title>
139 <style type="text/css">
141 font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
142 Tahoma, Arial, helvetica, sans-serif;
144 background-color: #eee;
149 background-color: #ccc;
150 border: 1px solid #aaa;
153 -moz-border-radius: 10px;
156 background-color: #977;
157 border: 1px solid #755;
161 -moz-border-radius: 10px;
164 background-color: #797;
165 border: 1px solid #575;
169 -moz-border-radius: 10px;
172 background-color: #779;
173 border: 1px solid #557;
176 -moz-border-radius: 10px;
188 <div class="error">$error</div>
189 <div class="infos">$infos</div>
190 <div class="name">$name</div>
197 =item $self->finalize_headers($c)
201 sub finalize_headers { }
203 =item $self->finalize_read($c)
208 my ( $self, $c ) = @_;
210 undef $self->{_prepared_read};
213 =item $self->finalize_uploads($c)
217 sub finalize_uploads {
218 my ( $self, $c ) = @_;
220 if ( keys %{ $c->request->uploads } ) {
221 for my $key ( keys %{ $c->request->uploads } ) {
222 my $upload = $c->request->uploads->{$key};
223 unlink map { $_->tempname }
224 grep { -e $_->tempname }
225 ref $upload eq 'ARRAY' ? @{$upload} : ($upload);
230 =item $self->prepare_body($c)
235 my ( $self, $c ) = @_;
237 $self->read_length( $c->request->header('Content-Length') || 0 );
238 my $type = $c->request->header('Content-Type');
240 unless ( $c->request->{_body} ) {
241 $c->request->{_body} = HTTP::Body->new( $type, $self->read_length );
244 if ( $self->read_length > 0 ) {
245 while ( my $buffer = $self->read( $c ) ) {
246 $c->request->{_body}->add( $buffer );
251 =item $self->prepare_body_parameters($c)
255 sub prepare_body_parameters {
256 my ( $self, $c ) = @_;
257 $c->request->body_parameters( $c->request->{_body}->param );
260 =item $self->prepare_connection($c)
264 sub prepare_connection { }
266 =item $self->prepare_cookies($c)
270 sub prepare_cookies {
271 my ( $self, $c ) = @_;
273 if ( my $header = $c->request->header('Cookie') ) {
274 $c->req->cookies( { CGI::Cookie->parse($header) } );
278 =item $self->prepare_headers($c)
282 sub prepare_headers { }
284 =item $self->prepare_parameters($c)
288 sub prepare_parameters {
289 my ( $self, $c ) = @_;
291 # We copy, no references
292 while ( my ( $name, $param ) = each %{ $c->request->query_parameters } ) {
293 $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
294 $c->request->parameters->{$name} = $param;
297 # Merge query and body parameters
298 while ( my ( $name, $param ) = each %{ $c->request->body_parameters } ) {
299 $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
300 if ( my $old_param = $c->request->parameters->{$name} ) {
301 if ( ref $old_param eq 'ARRAY' ) {
302 push @{ $c->request->parameters->{$name} },
303 ref $param eq 'ARRAY' ? @$param : $param;
305 else { $c->request->parameters->{$name} = [ $old_param, $param ] }
307 else { $c->request->parameters->{$name} = $param }
311 =item $self->prepare_path($c)
317 =item $self->prepare_request($c)
319 =item $self->prepare_query_parameters($c)
323 sub prepare_query_parameters { }
325 =item $self->prepare_read($c)
330 my ( $self, $c ) = @_;
332 # Reset the read position
333 $self->read_position( 0 );
336 =item $self->prepare_request(@arguments)
340 sub prepare_request { }
342 =item $self->prepare_uploads($c)
346 sub prepare_uploads {
347 my ( $self, $c ) = @_;
348 my $uploads = $c->request->{_body}->upload;
349 for my $name ( keys %$uploads ) {
350 my $files = $uploads->{$name};
351 $files = ref $files eq 'ARRAY' ? $files : [$files];
353 for my $upload (@$files) {
354 my $u = Catalyst::Request::Upload->new;
355 $u->headers( HTTP::Headers->new( %{ $upload->{headers} } ) );
356 $u->type( $u->headers->content_type );
357 $u->tempname( $upload->{tempname} );
358 $u->size( $upload->{size} );
359 $u->filename( $upload->{filename} );
362 $c->request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0];
366 =item $self->prepare_write($c)
370 sub prepare_write { }
372 =item $self->read($c, [$maxlength])
377 my ( $self, $c, $maxlength ) = @_;
379 unless ( $self->{_prepared_read} ) {
380 $self->prepare_read( $c );
381 $self->{_prepared_read} = 1;
384 my $remaining = $self->read_length - $self->read_position;
385 $maxlength ||= $self->read_length;
387 # Are we done reading?
388 if ( $remaining <= 0 ) {
389 $self->finalize_read( $c );
393 my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
394 my $rc = $self->read_chunk( $c, my $buffer, $readlen );
396 $self->read_position( $self->read_position + $rc );
400 Catalyst::Exception->throw(
401 message => "Unknown error reading input: $!"
406 =item $self->read_chunk($c, $buffer, $length)
408 Each engine inplements read_chunk as its preferred way of reading a chunk
415 =item $self->read_length
417 The length of input data to be read. This is obtained from the Content-Length
420 =item $self->read_position
422 The amount of input data that has already been read.
430 =item $self->write($c, $buffer)
435 my ( $self, $c, $buffer ) = @_;
437 unless ( $self->{_prepared_write} ) {
438 $self->prepare_write( $c );
439 $self->{_prepared_write} = 1;
442 my $handle = $c->response->handle;
444 print $handle $buffer;
451 Sebastian Riedel, <sri@cpan.org>
453 Andy Grundman, <andy@hybridized.org>
457 This program is free software, you can redistribute it and/or modify it under
458 the same terms as Perl itself.