X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine.pm;h=41a5049c96928f55cd1c7aa815386c2dce7c917f;hb=a135d186f7acefbbab74e8e6d9a43ccd3560d326;hp=21e0da241082ac5c189a16b7f6cf32fa33af9445;hpb=4cf083b156927d49297b5687ff002364203c1be5;p=catagits%2FCatalyst-Runtime.git
diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index 21e0da2..41a5049 100644
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -3,11 +3,14 @@ package Catalyst::Engine;
use strict;
use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
use UNIVERSAL::require;
+use CGI::Cookie;
use Data::Dumper;
use HTML::Entities;
use HTTP::Headers;
use Memoize;
use Time::HiRes qw/gettimeofday tv_interval/;
+use Text::ASCIITable;
+use Text::ASCIITable::Wrap 'wrap';
use Tree::Simple;
use Tree::Simple::Visitor::FindByPath;
use Catalyst::Request;
@@ -92,6 +95,50 @@ sub component {
}
}
+=item $c->dispatch
+
+Dispatch request to actions.
+
+=cut
+
+sub dispatch {
+ my $c = shift;
+ my $action = $c->req->action;
+ my $namespace = '';
+ $namespace = ( join( '/', @{ $c->req->args } ) || '/' )
+ if $action eq 'default';
+ unless ($namespace) {
+ if ( my $result = $c->get_action($action) ) {
+ $namespace = _class2prefix( $result->[0]->[0]->[0] );
+ }
+ }
+ my $default = $action eq 'default' ? $namespace : undef;
+ my $results = $c->get_action( $action, $default );
+ $namespace ||= '/';
+ if ( @{$results} ) {
+ for my $begin ( @{ $c->get_action( 'begin', $namespace ) } ) {
+ $c->execute( @{ $begin->[0] } );
+ }
+ if ( my $action = $c->req->action ) {
+ for my $result ( @{ $c->get_action( $action, $default ) }[-1] ) {
+ $c->execute( @{ $result->[0] } );
+ last unless $default;
+ }
+ }
+ for my $end ( reverse @{ $c->get_action( 'end', $namespace ) } ) {
+ $c->execute( @{ $end->[0] } );
+ }
+ }
+ else {
+ my $path = $c->req->path;
+ my $error = $path
+ ? qq/Unknown resource "$path"/
+ : "No default action defined";
+ $c->log->error($error) if $c->debug;
+ $c->error($error);
+ }
+}
+
=item $c->error
=item $c->error($error, ...)
@@ -115,6 +162,41 @@ sub error {
return $c->{error};
}
+=item $c->execute($class, $coderef)
+
+Execute a coderef in given class and catch exceptions.
+Errors are available via $c->error.
+
+=cut
+
+sub execute {
+ my ( $c, $class, $code ) = @_;
+ $class = $c->comp($class) || $class;
+ $c->state(0);
+ my $callsub = ( caller(1) )[3];
+ eval {
+ if ( $c->debug )
+ {
+ my $action = $c->actions->{reverse}->{"$code"};
+ $action = "/$action" unless $action =~ /\-\>/;
+ $action = "-> $action" if $callsub =~ /forward$/;
+ my ( $elapsed, @state ) =
+ $c->benchmark( $code, $class, $c, @{ $c->req->args } );
+ push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
+ $c->state(@state);
+ }
+ else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
+ };
+ if ( my $error = $@ ) {
+ chomp $error;
+ $error = qq/Caught exception "$error"/;
+ $c->log->error($error);
+ $c->error($error) if $c->debug;
+ $c->state(0);
+ }
+ return $c->state;
+}
+
=item $c->finalize
Finalize request.
@@ -124,26 +206,76 @@ Finalize request.
sub finalize {
my $c = shift;
- if ( my $location = $c->res->redirect ) {
+ $c->finalize_cookies;
+
+ if ( my $location = $c->response->redirect ) {
$c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
- $c->res->headers->header( Location => $location );
- $c->res->headers->remove_content_headers;
- $c->res->status(302);
- return $c->finalize_headers;
- }
-
- if ( !$c->res->output || $#{ $c->error } >= 0 ) {
- $c->res->headers->content_type('text/html');
- my $name = $c->config->{name} || 'Catalyst Application';
- my ( $title, $error, $infos );
- if ( $c->debug ) {
- $error = join '
', @{ $c->error };
- $error ||= 'No output';
- $title = $name = "$name on Catalyst $Catalyst::VERSION";
- my $req = encode_entities Dumper $c->req;
- my $res = encode_entities Dumper $c->res;
- my $stash = encode_entities Dumper $c->stash;
- $infos = <<"";
+ $c->response->header( Location => $location );
+ $c->response->status(302) if $c->response->status !~ /3\d\d$/;
+ }
+
+ if ( $#{ $c->error } >= 0 ) {
+ $c->finalize_error;
+ }
+
+ if ( !$c->response->output && $c->response->status !~ /^(1|3)\d\d$/ ) {
+ $c->finalize_error;
+ }
+
+ if ( $c->response->output && !$c->response->content_length ) {
+ use bytes; # play safe with a utf8 aware perl
+ $c->response->content_length( length $c->response->output );
+ }
+
+ my $status = $c->finalize_headers;
+ $c->finalize_output;
+ return $status;
+}
+
+=item $c->finalize_cookies
+
+Finalize cookies.
+
+=cut
+
+sub finalize_cookies {
+ my $c = shift;
+
+ 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
+ );
+
+ $c->res->headers->push_header( 'Set-Cookie' => $cookie->as_string );
+ }
+}
+
+=item $c->finalize_error
+
+Finalize error.
+
+=cut
+
+sub finalize_error {
+ my $c = shift;
+
+ $c->res->headers->content_type('text/html');
+ my $name = $c->config->{name} || 'Catalyst Application';
+
+ my ( $title, $error, $infos );
+ if ( $c->debug ) {
+ $error = join '
', @{ $c->error };
+ $error ||= 'No output';
+ $title = $name = "$name on Catalyst $Catalyst::VERSION";
+ my $req = encode_entities Dumper $c->req;
+ my $res = encode_entities Dumper $c->res;
+ my $stash = encode_entities Dumper $c->stash;
+ $infos = <<"";
Request
$req
@@ -152,11 +284,11 @@ sub finalize {
Stash
$stash
- }
- else {
- $title = $name;
- $error = '';
- $infos = <<"";
+ }
+ else {
+ $title = $name;
+ $error = '';
+ $infos = <<"";
(en) Please come back later
(de) Bitte versuchen sie es spaeter nocheinmal
@@ -168,67 +300,62 @@ sub finalize {
(it) Ritornato prego più successivamente
- $name = '';
- }
- $c->res->{output} = <<"";
+ $name = '';
+ }
+ $c->res->output( <<"" );
-
- $title
-
-
-
-
-
$error
-
$infos
-
$name
-
+
$error
+
$infos
+
$name
+