use strict;
use base qw/Class::Data::Inheritable Class::Accessor::Fast/;
use UNIVERSAL::require;
-use B;
use Data::Dumper;
use HTML::Entities;
use HTTP::Headers;
=head1 DESCRIPTION
-=head2 METHODS
+=head1 METHODS
-=head3 action
+=over 4
+
+=item $c->action( $name => $coderef, ... )
+
+=item $c->action( $name )
+
+=item $c->action
Add one or more actions.
$_[1] ? ( $action = {@_} ) : ( $action = shift );
if ( ref $action eq 'HASH' ) {
while ( my ( $name, $code ) = each %$action ) {
- my $class = B::svref_2object($code)->STASH->NAME;
- my $caller = caller(0);
+ my $class = caller(0);
if ( $name =~ /^\/(.*)\/$/ ) {
my $regex = $1;
$self->actions->{compiled}->{qr/$regex/} = $name;
}
elsif ( $name =~ /^\?(.*)$/ ) {
$name = $1;
- $name = _prefix( $caller, $name );
+ $name = _prefix( $class, $name );
$self->actions->{plain}->{$name} = [ $class, $code ];
}
elsif ( $name =~ /^\!\?(.*)$/ ) {
$name = $1;
- $name = _prefix( $caller, $name );
+ $name = _prefix( $class, $name );
$name = "\!$name";
$self->actions->{plain}->{$name} = [ $class, $code ];
}
else { $self->actions->{plain}->{$name} = [ $class, $code ] }
$self->actions->{reverse}->{"$code"} = $name;
- $self->log->debug(
- qq/"$caller" defined "$name" as "$code" from "$class"/)
+ $self->log->debug(qq/"$class" defined "$name" as "$code"/)
if $self->debug;
}
}
if ( my $p = $self->actions->{plain}->{$action} ) { return [$p] }
elsif ( my $r = $self->actions->{regex}->{$action} ) { return [$r] }
else {
- while ( my ( $regex, $name ) =
- each %{ $self->actions->{compiled} } )
- {
+ for my $regex ( keys %{ $self->actions->{compiled} } ) {
+ my $name = $self->actions->{compiled}->{$regex};
if ( $action =~ $regex ) {
my @snippets;
for my $i ( 1 .. 9 ) {
last unless ${$i};
push @snippets, ${$i};
}
- return [ $name, \@snippets ];
+ return [ $self->actions->{regex}->{$name},
+ $name, \@snippets ];
}
}
}
}
}
-=head3 benchmark
+
+=item $c->benchmark($coderef)
Takes a coderef with arguments and returns elapsed time as float.
return wantarray ? ( $elapsed, @return ) : $elapsed;
}
-=head3 component (comp)
+=item $c->comp($name)
+
+=item $c->component($name)
Get a component object by name.
}
}
-=head3 errors
+=item $c->errors
+
+=item $c->errors($error, ...)
+
+=item $c->errors($arrayref)
Returns an arrayref containing errors messages.
return $c->{errors};
}
-=head3 finalize
+=item $c->finalize
Finalize request.
sub finalize {
my $c = shift;
+
+ if ( my $location = $c->res->redirect ) {
+ $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
+ $c->res->headers->header( Location => $location );
+ $c->res->status(302);
+ }
+
if ( !$c->res->output || $#{ $c->errors } >= 0 ) {
$c->res->headers->content_type('text/html');
my $name = $c->config->{name} || 'Catalyst Application';
</html>
}
- if ( my $location = $c->res->redirect ) {
- $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
- $c->res->headers->header( Location => $location );
- $c->res->status(302);
- }
$c->res->headers->content_length( length $c->res->output );
my $status = $c->finalize_headers;
$c->finalize_output;
return $status;
}
-=head3 finalize_headers
+=item $c->finalize_headers
Finalize headers.
sub finalize_headers { }
-=head3 finalize_output
+=item $c->finalize_output
Finalize output.
sub finalize_output { }
-=head3 forward
+=item $c->forward($command)
Forward processing to a private/public action or a method from a class.
If you define a class without method it will default to process().
$command = _prefix( $caller, $command );
$command = "\!$command";
}
+ elsif ( $command =~ /^\!(.*)$/ ) {
+ my $try = $1;
+ my $caller = caller(0);
+ my $prefix = _class2prefix($caller);
+ $try = "!$prefix/$command";
+ $command = $try if $c->actions->{plain}->{$try};
+ }
my ( $class, $code );
if ( my $action = $c->action($command) ) {
+ if ( $action->[2] ) {
+ $c->log->debug(qq/Couldn't forward "$command" to regex action/)
+ if $c->debug;
+ return 0;
+ }
( $class, $code ) = @{ $action->[0] };
}
else {
return $c->process( $class, $code );
}
-=head3 handler
+=item $c->handler($r)
Handles the request.
eval {
my $handler = sub {
my $c = $class->prepare($r);
- if ( $c->req->action ) {
+ if ( my $action = $c->action( $c->req->action ) ) {
my ( $begin, $end );
- if ( my $prefix = $c->req->args->[0] ) {
+ my $class = ${ $action->[0] }[0];
+ my $prefix = _class2prefix($class);
+ if ($prefix) {
if ( $c->actions->{plain}->{"\!$prefix/begin"} ) {
$begin = "\!$prefix/begin";
}
}
elsif ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
}
+ else {
+ if ( $c->actions->{plain}->{'!begin'} ) {
+ $begin = '!begin';
+ }
+ if ( $c->actions->{plain}->{'!end'} ) { $end = '!end' }
+ }
$c->forward($begin) if $begin;
$c->forward( $c->req->action ) if $c->req->action;
$c->forward($end) if $end;
my $action = $c->req->path;
my $error = $action
? qq/Unknown resource "$action"/
- : "Congratulations, you're on Catalyst!";
+ : "No default action defined";
$c->log->error($error) if $c->debug;
$c->errors($error);
}
return $status;
}
-=head3 prepare
+=item $c->prepare($r)
-Turns the request (Apache, CGI...) into a Catalyst context.
+Turns the engine-specific request (Apache, CGI...) into a Catalyst context.
=cut
}
$c->prepare_request($r);
$c->prepare_path;
- my $path = $c->request->path;
- $c->log->debug(qq/Requested path "$path"/) if $c->debug;
$c->prepare_cookies;
$c->prepare_headers;
+ my $method = $c->req->method || '';
+ my $path = $c->req->path || '';
+ $c->log->debug(qq/"$method" request for "$path"/) if $c->debug;
$c->prepare_action;
$c->prepare_parameters;
+
+ if ( $c->debug && keys %{ $c->req->params } ) {
+ my @params;
+ for my $key ( keys %{ $c->req->params } ) {
+ my $value = $c->req->params->{$key} || '';
+ push @params, "$key=$value";
+ }
+ $c->log->debug( 'Parameters are "' . join( ' ', @params ) . '"' );
+ }
$c->prepare_uploads;
return $c;
}
-=head3 prepare_action
+=item $c->prepare_action
Prepare action.
my @path = split /\//, $c->req->path;
$c->req->args( \my @args );
while (@path) {
- my $path = join '/', @path;
+ $path = join '/', @path;
if ( my $result = $c->action($path) ) {
# It's a regex
if ($#$result) {
- my $match = $result->[0];
- my @snippets = @{ $result->[1] };
+ my $match = $result->[1];
+ my @snippets = @{ $result->[2] };
$c->log->debug(qq/Requested action "$path" matched "$match"/)
if $c->debug;
$c->log->debug(
$c->log->debug(qq/Requested action "$path"/) if $c->debug;
}
$c->req->match($path);
- $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
- if ( $c->debug && @args );
last;
}
unshift @args, pop @path;
$c->log->debug('Using default action') if $c->debug;
}
}
+ $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' )
+ if ( $c->debug && @args );
}
-=head3 prepare_cookies;
+=item $c->prepare_cookies;
Prepare cookies.
sub prepare_cookies { }
-=head3 prepare_headers
+=item $c->prepare_headers
Prepare headers.
sub prepare_headers { }
-=head3 prepare_parameters
+=item $c->prepare_parameters
Prepare parameters.
sub prepare_parameters { }
-=head3 prepare_path
+=item $c->prepare_path
Prepare path and base.
sub prepare_path { }
-=head3 prepare_request
+=item $c->prepare_request
Prepare the engine request.
sub prepare_request { }
-=head3 prepare_uploads
+=item $c->prepare_uploads
Prepare uploads.
sub prepare_uploads { }
-=head3 process
+=item $c->process($class, $coderef)
Process a coderef in given class and catch exceptions.
Errors are available via $c->errors.
return $status;
}
-=head3 remove_action
+=item $c->remove_action($action)
Remove an action.
}
}
-=head3 request (req)
+=item $c->request
+
+=item $c->req
Returns a C<Catalyst::Request> object.
my $req = $c->req;
-=head3 response (res)
+=item $c->response
+
+=item $c->res
Returns a C<Catalyst::Response> object.
my $res = $c->res;
-=head3 setup
+=item $class->setup
Setup.
}
}
-=head3 setup_components
+=item $class->setup_components
Setup components.
if $self->debug;
}
-=head3 stash
+=item $c->stash
Returns a hashref containing all your data.
sub _prefix {
my ( $class, $name ) = @_;
+ my $prefix = _class2prefix($class);
+ $name = "$prefix/$name" if $prefix;
+ return $name;
+}
+
+sub _class2prefix {
+ my $class = shift;
$class =~ /^.*::[(M)(Model)(V)(View)(C)(Controller)]+::(.*)$/;
my $prefix = lc $1 || '';
$prefix =~ s/\:\:/_/g;
- $name = "$prefix/$name" if $prefix;
- return $name;
+ return $prefix;
}
+=back
+
=head1 AUTHOR
Sebastian Riedel, C<sri@cpan.org>
projects / catagits/Catalyst-Runtime.git / blobdiff