X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine.pm;h=3a73c04fa2a7b8df2308410139be1c67ccba188f;hb=264bac8c94a84d7dbac9912946d1a639fa37d1cd;hp=2082f59c9c8417ae26a78207e58ee865f272370a;hpb=0c2b4ac08eb8e3a3932b4487ebce81c946e3db3b;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index 2082f59..3a73c04 100644 --- a/lib/Catalyst/Engine.pm +++ b/lib/Catalyst/Engine.pm @@ -2,12 +2,13 @@ package Catalyst::Engine; use strict; use base 'Class::Accessor::Fast'; -use CGI::Cookie; -use Data::Dumper; +use CGI::Simple::Cookie; +use Data::Dump qw/dump/; use HTML::Entities; use HTTP::Body; use HTTP::Headers; use URI::QueryParam; +use Scalar::Util (); # input position and length __PACKAGE__->mk_accessors(qw/read_position read_length/); @@ -40,7 +41,8 @@ Finalize body. Prints the response output. sub finalize_body { my ( $self, $c ) = @_; my $body = $c->response->body; - if ( ref $body && ($body->can('read') || ref($body) eq 'GLOB') ) { + no warnings 'uninitialized'; + if ( Scalar::Util::blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) { while ( !eof $body ) { read $body, my ($buffer), $CHUNKSIZE; last unless $self->write( $c, $buffer ); @@ -54,7 +56,8 @@ sub finalize_body { =head2 $self->finalize_cookies($c) -Create CGI::Cookies from $c->res->cookies, and set them as response headers. +Create CGI::Simple::Cookie objects from $c->res->cookies, and set them as +response headers. =cut @@ -62,15 +65,22 @@ sub finalize_cookies { my ( $self, $c ) = @_; my @cookies; - while ( my ( $name, $cookie ) = each %{ $c->response->cookies } ) { - - my $cookie = CGI::Cookie->new( - -name => $name, - -value => $cookie->{value}, - -expires => $cookie->{expires}, - -domain => $cookie->{domain}, - -path => $cookie->{path}, - -secure => $cookie->{secure} || 0 + + foreach my $name ( keys %{ $c->response->cookies } ) { + + my $val = $c->response->cookies->{$name}; + + my $cookie = ( + Scalar::Util::blessed($val) + ? $val + : CGI::Simple::Cookie->new( + -name => $name, + -value => $val->{value}, + -expires => $val->{expires}, + -domain => $val->{domain}, + -path => $val->{path}, + -secure => $val->{secure} || 0 + ) ); push @cookies, $cookie->as_string; @@ -93,13 +103,12 @@ sub finalize_error { my ( $self, $c ) = @_; $c->res->content_type('text/html; charset=utf-8'); - my $name = $c->config->{name} || 'Catalyst Application'; + my $name = $c->config->{name} || join(' ', split('::', ref $c)); my ( $title, $error, $infos ); if ( $c->debug ) { # For pretty dumps - local $Data::Dumper::Terse = 1; $error = join '', map { '

' . encode_entities($_) @@ -120,15 +129,11 @@ sub finalize_error { # Don't show response header state in dump delete $c->res->{_finalized_headers}; - my $req = encode_entities Dumper $c->req; - my $res = encode_entities Dumper $c->res; - my $stash = encode_entities Dumper $c->stash; - my @infos; my $i = 0; for my $dump ( $c->dump_these ) { my $name = $dump->[0]; - my $value = encode_entities( Dumper $dump->[1] ); + my $value = encode_entities( dump( $dump->[1] )); push @infos, sprintf <<"EOF", $name, $value;

%s

@@ -180,13 +185,13 @@ EOF body { font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana, Tahoma, Arial, helvetica, sans-serif; - color: #ddd; + color: #333; background-color: #eee; margin: 0px; padding: 0px; } :link, :link:hover, :visited, :visited:hover { - color: #ddd; + color: #000; } div.box { position: relative; @@ -194,30 +199,26 @@ EOF border: 1px solid #aaa; padding: 4px; margin: 10px; - -moz-border-radius: 10px; } div.error { - background-color: #977; + background-color: #cce; border: 1px solid #755; padding: 8px; margin: 4px; margin-bottom: 10px; - -moz-border-radius: 10px; } div.infos { - background-color: #797; + background-color: #eee; border: 1px solid #575; padding: 8px; margin: 4px; margin-bottom: 10px; - -moz-border-radius: 10px; } div.name { - background-color: #779; + background-color: #cce; border: 1px solid #557; padding: 8px; margin: 4px; - -moz-border-radius: 10px; } code.error { display: block; @@ -317,7 +318,8 @@ sub prepare_body { unless ( $c->request->{_body} ) { $c->request->{_body} = HTTP::Body->new( $type, $self->read_length ); - $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp} if exists $c->config->{uploadtmp}; + $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp} + if exists $c->config->{uploadtmp}; } if ( $self->read_length > 0 ) { @@ -327,9 +329,10 @@ sub prepare_body { # paranoia against wrong Content-Length header my $remaining = $self->read_length - $self->read_position; - if ($remaining > 0) { + if ( $remaining > 0 ) { $self->finalize_read($c); - Catalyst::Exception->throw("Wrong Content-Length value: ". $self->read_length); + Catalyst::Exception->throw( + "Wrong Content-Length value: " . $self->read_length ); } } } @@ -367,7 +370,7 @@ sub prepare_connection { } =head2 $self->prepare_cookies($c) -Parse cookies from header. Sets a L object. +Parse cookies from header. Sets a L object. =cut @@ -375,7 +378,7 @@ sub prepare_cookies { my ( $self, $c ) = @_; if ( my $header = $c->request->header('Cookie') ) { - $c->req->cookies( { CGI::Cookie->parse($header) } ); + $c->req->cookies( { CGI::Simple::Cookie->parse($header) } ); } } @@ -395,13 +398,15 @@ sub prepare_parameters { my ( $self, $c ) = @_; # We copy, no references - while ( my ( $name, $param ) = each %{ $c->request->query_parameters } ) { + foreach my $name ( keys %{ $c->request->query_parameters } ) { + my $param = $c->request->query_parameters->{$name}; $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param; $c->request->parameters->{$name} = $param; } # Merge query and body parameters - while ( my ( $name, $param ) = each %{ $c->request->body_parameters } ) { + foreach my $name ( keys %{ $c->request->body_parameters } ) { + my $param = $c->request->body_parameters->{$name}; $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param; if ( my $old_param = $c->request->parameters->{$name} ) { if ( ref $old_param eq 'ARRAY' ) { @@ -578,6 +583,7 @@ sub write { print STDOUT $buffer; } + =head2 $self->finalize_output , see finalize_body