if ( my $location = $c->res->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 ) {
Forward processing to a private action or a method from a class.
If you define a class without method it will default to process().
- $c->forward('foo');
+ $c->forward('/foo');
$c->forward('index');
$c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
$c->forward('MyApp::View::TT');
}
my $caller = caller(0);
my $namespace = '/';
- if ( $command =~ /^\/$/ ) {
+ if ( $command =~ /^\// ) {
$command =~ /^(.*)\/(\w+)$/;
$namespace = $1 || '/';
$command = $2;
my $status = -1;
eval {
my $handler = sub {
- my $c = $class->prepare($r);
+ my $c = $class->prepare($r);
+ $c->{stats} = [];
my $action = $c->req->action;
my $namespace = '';
$namespace = ( join( '/', @{ $c->req->args } ) || '/' )
for my $begin ( @{ $c->get_action( 'begin', $namespace ) } ) {
$c->state( $c->execute( @{ $begin->[0] } ) );
}
- for my $result ( @{ $c->get_action( $action, $default ) } ) {
+ for my $result ( @{ $c->get_action( $action, $default ) }[-1] )
+ {
$c->state( $c->execute( @{ $result->[0] } ) );
last unless $default;
}
- for my $end ( @{ $c->get_action( 'end', $namespace ) } ) {
+ for my $end ( reverse @{ $c->get_action( 'end', $namespace ) } )
+ {
$c->state( $c->execute( @{ $end->[0] } ) );
}
+ my @stats = @{ $c->{stats} };
+ $c->log->debug( 'Processed', @stats )
+ if ( @stats && $c->debug );
}
else {
my $path = $c->req->path;
}
$c->prepare_request($r);
$c->prepare_path;
- $c->prepare_cookies;
$c->prepare_headers;
+ $c->prepare_cookies;
$c->prepare_connection;
my $method = $c->req->method || '';
my $path = $c->req->path || '';
my @params;
for my $key ( keys %{ $c->req->params } ) {
my $value = $c->req->params->{$key} || '';
- push @params, "$key=$value";
+ push @params, " $key=$value";
}
- $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
+ $c->log->debug( 'Parameters', @params );
}
$c->prepare_uploads;
return $c;
eval {
if ( $c->debug )
{
- my $action = $c->actions->{reverse}->{"$code"} || "$code";
+ my $action = $c->actions->{reverse}->{"$code"};
+ $action = "/$action" unless $action =~ /\-\>/;
my ( $elapsed, @state ) =
$c->benchmark( $code, $class, $c, @{ $c->req->args } );
- $c->log->info( sprintf qq/Processing "$action" took %fs/, $elapsed )
- if $c->debug;
+ push @{ $c->{stats} },
+ _prettify( $action, sprintf( '%fs', $elapsed ), '' );
$c->state(@state);
}
else { $c->state( &$code( $class, $c, @{ $c->req->args } ) ) }
sub set_action {
my ( $c, $method, $code, $namespace, $attrs ) = @_;
- my $prefix = _class2prefix($namespace) || '';
- my $action = 0;
- my $public = 0;
- my $regex = 0;
- my $arg = '';
- my $absolute = 0;
+ my $prefix = _class2prefix($namespace) || '';
+ my %flags;
for my $attr ( @{$attrs} ) {
- if ( $attr =~ /^Action$/ ) {
- $action++;
- $arg = $1 if $1;
- }
- elsif ( $attr =~ /^Path\((.+)\)$/i ) {
- $arg = $1;
- $public++;
- }
- elsif ( $attr =~ /^Public$/i ) {
- $public++;
- }
- elsif ( $attr =~ /^Private$/i ) {
- $action++;
- }
- elsif ( $attr =~ /Regex(?:\((.+)\))?$/i ) {
- $regex++;
- $action++;
- $arg = $1 if $1;
- }
- elsif ( $attr =~ /Absolute(?:\((.+)\))?$/i ) {
- $action++;
- $absolute++;
- $public++;
- $arg = $1 if $1;
- }
- elsif ( $attr =~ /Relative(?:\((.+)\))?$/i ) {
- $action++;
- $public++;
- $arg = $1 if $1;
- }
+ if ( $attr =~ /^(Local|Relative)$/ ) { $flags{local}++ }
+ elsif ( $attr =~ /^(Global|Absolute)$/ ) { $flags{global}++ }
+ elsif ( $attr =~ /^Path\((.+)\)$/i ) { $flags{path} = $1 }
+ elsif ( $attr =~ /^Private$/i ) { $flags{private}++ }
+ elsif ( $attr =~ /^(Regex|Regexp)\((.+)\)$/i ) { $flags{regex} = $2 }
}
- return unless $action;
+ return unless keys %flags;
my $parent = $c->tree;
my $visitor = Tree::Simple::Visitor::FindByPath->new;
my $uid = $parent->getUID;
$c->actions->{private}->{$uid}->{$method} = [ $namespace, $code ];
my $forward = $prefix ? "$prefix/$method" : $method;
- $c->log->debug(qq|Private "/$forward" is "$namespace->$method"|)
- if $c->debug;
- $arg =~ s/^\w+//;
- $arg =~ s/\w+$//;
- if ( $arg =~ /^'(.*)'$/ ) { $arg = $1 }
- if ( $arg =~ /^"(.*)"$/ ) { $arg = $1 }
+ if ( $flags{path} ) {
+ $flags{path} =~ s/^\w+//;
+ $flags{path} =~ s/\w+$//;
+ if ( $flags{path} =~ /^'(.*)'$/ ) { $flags{path} = $1 }
+ if ( $flags{path} =~ /^"(.*)"$/ ) { $flags{path} = $1 }
+ }
+ if ( $flags{regex} ) {
+ $flags{regex} =~ s/^\w+//;
+ $flags{regex} =~ s/\w+$//;
+ if ( $flags{regex} =~ /^'(.*)'$/ ) { $flags{regex} = $1 }
+ if ( $flags{regex} =~ /^"(.*)"$/ ) { $flags{regex} = $1 }
+ }
- my $reverse = $prefix ? "$method ($prefix)" : $method;
+ my $reverse = $prefix ? "$prefix/$method" : $method;
- if ($public) {
- my $is_absolute = 0;
- $is_absolute = 1 if $absolute;
- if ( $arg =~ /^\/(.+)/ ) {
- $arg = $1;
- $is_absolute = 1;
+ if ( $flags{local} || $flags{global} || $flags{path} ) {
+ my $path = $flags{path} || $method;
+ my $absolute = 0;
+ if ( $path =~ /^\/(.+)/ ) {
+ $path = $1;
+ $absolute = 1;
}
- my $name =
- $is_absolute ? ( $arg || $method ) : "$prefix/" . ( $arg || $method );
+ $absolute = 1 if $flags{global};
+ my $name = $absolute ? $path : "$prefix/$path";
$c->actions->{plain}->{$name} = [ $namespace, $code ];
- $c->log->debug(qq|Public "/$name" is "/$forward"|) if $c->debug;
}
- if ($regex) {
- push @{ $c->actions->{compiled} }, [ $arg, qr#$arg# ];
- $c->actions->{regex}->{$arg} = [ $namespace, $code ];
- $c->log->debug(qq|Public "$arg" is "/$forward"|) if $c->debug;
+ if ( my $regex = $flags{regex} ) {
+ push @{ $c->actions->{compiled} }, [ $regex, qr#$regex# ];
+ $c->actions->{regex}->{$regex} = [ $namespace, $code ];
}
$c->actions->{reverse}->{"$code"} = $reverse;
my ( $code, $attrs ) = @{$action};
my $name = '';
no strict 'refs';
- for my $sym ( values %{ $comp . '::' } ) {
- if ( *{$sym}{CODE} && *{$sym}{CODE} == $code ) {
- $name = *{$sym}{NAME};
- $self->set_action( $name, $code, $comp, $attrs );
+ my @cache = ( $comp, @{"$comp\::ISA"} );
+ my %namespaces;
+ while ( my $namespace = shift @cache ) {
+ $namespaces{$namespace}++;
+ for my $isa ( @{"$comp\::ISA"} ) {
+ next if $namespaces{$isa};
+ push @cache, $isa;
+ $namespaces{$isa}++;
+ }
+ }
+ for my $namespace ( keys %namespaces ) {
+ for my $sym ( values %{ $namespace . '::' } ) {
+ if ( *{$sym}{CODE} && *{$sym}{CODE} == $code ) {
+ $name = *{$sym}{NAME};
+ $self->set_action( $name, $code, $comp, $attrs );
+ last;
+ }
}
}
}
$self->components->{ ref $comp } = $comp;
$self->setup_actions($comp);
}
- $self->log->debug( 'Initialized components "'
- . join( ' ', keys %{ $self->components } )
- . '"' )
- if $self->debug;
+ my @comps;
+ push @comps, " $_" for keys %{ $self->components };
+ $self->log->debug( 'Loaded components', @comps )
+ if ( @comps && $self->debug );
+ my $actions = $self->actions;
+ my @messages = ('Loaded private actions');
+ my $walker = sub {
+ my ( $walker, $parent, $messages, $prefix ) = @_;
+ $prefix .= $parent->getNodeValue || '';
+ $prefix .= '/' unless $prefix =~ /\/$/;
+ my $uid = $parent->getUID;
+ for my $action ( keys %{ $actions->{private}->{$uid} } ) {
+ my ( $class, $code ) = @{ $actions->{private}->{$uid}->{$action} };
+ push @$messages, _prettify( "$prefix$action", $class, $code );
+ }
+ $walker->( $walker, $_, $messages, $prefix )
+ for $parent->getAllChildren;
+ };
+ $walker->( $walker, $self->tree, \@messages, '' );
+ $self->log->debug(@messages) if ( $#messages && $self->debug );
+ @messages = ('Loaded plain actions');
+ for my $plain ( sort keys %{ $actions->{plain} } ) {
+ my ( $class, $code ) = @{ $actions->{plain}->{$plain} };
+ push @messages, _prettify( "/$plain", $class, $code );
+ }
+ $self->log->debug(@messages) if ( $#messages && $self->debug );
+ @messages = ('Loaded regex actions');
+ for my $regex ( sort keys %{ $actions->{regex} } ) {
+ my ( $class, $code ) = @{ $actions->{regex}->{$regex} };
+ push @messages, _prettify( $regex, $class, $code );
+ }
+ $self->log->debug(@messages) if ( $#messages && $self->debug );
}
=item $c->stash
sub _class2prefix {
my $class = shift || '';
- $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/;
- my $prefix = lc $2 || '';
- $prefix =~ s/\:\:/\//g;
+ my $prefix;
+ if ( $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/ ) {
+ $prefix = lc $2;
+ $prefix =~ s/\:\:/\//g;
+ }
return $prefix;
}
+sub _prettify {
+ my ( $val1, $val2, $val3 ) = @_;
+ formline
+' @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>>>>>>>> ',
+ $val1, $val2, $val3;
+ my $formatted = $^A;
+ $^A = '';
+ return $formatted;
+}
+
=back
=head1 AUTHOR
projects / catagits/Catalyst-Runtime.git / blobdiff