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 =~ /^\/(.*)$/ ) { $command = $1 }
+ if ( $command =~ /^\// ) {
+ $command =~ /^(.*)\/(\w+)$/;
+ $namespace = $1 || '/';
+ $command = $2;
+ }
else { $namespace = _class2prefix($caller) || '/' }
my $results = $c->get_action( $command, $namespace );
unless ( @{$results} ) {
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] } ) );
}
}
}
$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 || '';
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;
$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;
- 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->log->debug(qq|Public "$regex" is "/$forward"|) if $c->debug;
}
$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;
+ my %seen;
+ while ( my $namespace = shift @cache ) {
+ push @namespaces, $namespace;
+ for my $isa ( @{"$comp\::ISA"} ) {
+ next if $seen{$isa};
+ push @cache, $isa;
+ $seen{$isa}++;
+ }
+ }
+ for my $namespace (@namespaces) {
+ for my $sym ( values %{ $namespace . '::' } ) {
+ if ( *{$sym}{CODE} && *{$sym}{CODE} == $code ) {
+ $name = *{$sym}{NAME};
+ $self->set_action( $name, $code, $comp, $attrs );
+ last;
+ }
}
}
}
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;
}