=cut
use Moose;
-
+use Scalar::Util 'looks_like_number';
with 'MooseX::Emulate::Class::Accessor::Fast';
+use namespace::clean -except => 'meta';
has class => (is => 'rw');
has namespace => (is => 'rw');
has name => (is => 'rw');
has code => (is => 'rw');
-no Moose;
-
use overload (
# Stringify to reverse for debug output etc.
# Codulate to execute to invoke the encapsulated action coderef
'&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
+ # Which action takes precedence
+ 'cmp' => 'compare',
+ '<=>' => 'compare',
+
# Make general $stuff still work
fallback => 1,
return scalar( @{ $c->req->args } ) == $args;
}
+sub sort_order {
+ my $self = shift;
+
+ my ($args) = @{ $self->attributes->{Args} || [] };
+
+ return $args if looks_like_number($args);
+
+ return ~0;
+}
+
+sub compare {
+ my ($a1, $a2) = @_;
+
+ return $a1->sort_order <=> $a2->sort_order;
+}
+
__PACKAGE__->meta->make_immutable;
1;
Check Args attribute, and makes sure number of args matches the setting.
Always returns true if Args is omitted.
+=head2 sort_order
+
+Returns the value of the C<Args> attribute, or C<~0> if it has no value.
+
+=head2 compare
+
+Returns C<< $a->sort_order <=> $b->sort_order >> .
+
=head2 namespace
Returns the private namespace this action lives in.
sub expand_action { }
+sub _is_low_precedence { 0 }
+
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
sub match {
my ( $self, $c, $path ) = @_;
- return if $path =~ m!/!; # Not at root yet, wait for it ...
+ return if $path ne ''; # Not at root yet, wait for it ...
my $result = ( $c->get_actions( 'default', $c->req->path ) )[-1];
# Find default on namespace or super
return 0;
}
+sub _is_low_precedence { 1 }
+
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
use Moose;
extends 'Catalyst::DispatchType';
-no Moose;
+use namespace::clean -except => 'meta';
=head1 NAME
=back
+=cut
+
+has _actions => (
+ is => 'rw', isa => 'HashRef', default => sub { +{} }
+);
+
=head1 METHODS
=head2 $self->match( $c, $path )
return if @{ $c->req->args };
my $result = $c->get_action( 'index', $path );
+ return 0 unless $result && exists $self->_actions->{ $result->reverse };
+
if ($result && $result->match($c)) {
$c->action($result);
$c->namespace( $result->namespace );
return 0;
}
+=head2 $self->register( $c, $action )
+
+Register an action with this DispatchType.
+
+=cut
+
+sub register {
+ my ( $self, $c, $action ) = @_;
+
+ $self->_actions->{ $action->reverse } = $action;
+
+ return 1;
+}
+
=head2 $self->uri_for_action( $action, $captures )
get a URI part for an action; always returns undef is $captures is set
return "/".$action->namespace;
}
+sub _is_low_precedence { 1 }
+
=head1 AUTHORS
Catalyst Contributors, see Catalyst.pm
use Text::SimpleTable;
use Catalyst::Utils;
use URI;
-use Scalar::Util ();
has _paths => (
is => 'rw',
if ( keys %{ $self->_paths } );
}
-sub _action_args_sort_order {
- my ( $self, $action ) = @_;
-
- my ($args) = @{ $action->attributes->{Args} || [] };
-
- return $args if Scalar::Util::looks_like_number($args);
-
- return ~0;
-}
-
=head2 $self->match( $c, $path )
For each action registered to this exact path, offers the action a chance to
$path = '/' if !defined $path || !length $path;
- # sort from least args to most
- my @actions = sort { $self->_action_args_sort_order($a) <=>
- $self->_action_args_sort_order($b) }
- @{ $self->_paths->{$path} || [] };
+ my @actions = @{ $self->_paths->{$path} || [] };
foreach my $action ( @actions ) {
next unless $action->match($c);
$path =~ s!^/!!;
$path = '/' unless length $path;
$path = URI->new($path)->canonical;
+ $path =~ s{(?<=[^/])/+\z}{};
- unshift( @{ $self->_paths->{$path} ||= [] }, $action);
+ $self->_paths->{$path} = [
+ sort { $a <=> $b } ($action, @{ $self->_paths->{$path} || [] })
+ ];
return 1;
}
DESCEND: while (@path) {
$path = join '/', @path;
- $path =~ s#^/##;
-
- $path = '' if $path eq '/'; # Root action
+ $path =~ s#^/+##;
# Check out dispatch types to see if any will handle the path at
# this level
}
return reverse grep { defined } @containers, $self->_container_hash->{''};
-
- #return (split '/', $namespace); # isnt this more clear?
- my @parts = split '/', $namespace;
}
=head2 $self->uri_for_action($action, \@captures)
}
}
+ my @dtypes = @{ $self->_dispatch_types };
+ my @normal_dtypes;
+ my @low_precedence_dtypes;
+
+ for my $type ( @dtypes ) {
+ if ($type->_is_low_precedence) {
+ push @low_precedence_dtypes, $type;
+ } else {
+ push @normal_dtypes, $type;
+ }
+ }
+
# Pass the action to our dispatch types so they can register it if reqd.
- foreach my $type ( @{ $self->_dispatch_types } ) {
- $type->register( $c, $action );
+ my $was_registered = 0;
+ foreach my $type ( @normal_dtypes ) {
+ $was_registered = 1 if $type->register( $c, $action );
+ }
+
+ if (not $was_registered) {
+ foreach my $type ( @low_precedence_dtypes ) {
+ $type->register( $c, $action );
+ }
}
my $namespace = $action->namespace;
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+our $iters;
+
+BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
+
+use Test::More tests => 6*$iters;
+
+use Catalyst::Test 'TestAppIndexDefault';
+
+if ( $ENV{CAT_BENCHMARK} ) {
+ require Benchmark;
+ Benchmark::timethis( $iters, \&run_tests );
+}
+else {
+ for ( 1 .. $iters ) {
+ run_tests();
+ }
+}
+
+sub run_tests {
+ is(get('/indexchained'), 'index_chained', ':Chained overrides index');
+ is(get('/indexprivate'), 'index_private', 'index : Private still works');
+
+# test :Path overriding default
+ is(get('/one_arg'), 'path_one_arg', ':Path overrides default');
+ is(get('/one_arg/foo/bar'), 'default', 'default still works');
+
+# now the same thing with a namespace, and a trailing / on the :Path
+ is(get('/default/one_arg'), 'default_path_one_arg',
+ ':Path overrides default');
+ is(get('/default/one_arg/foo/bar'), 'default_default',
+ 'default still works');
+}
--- /dev/null
+package TestAppIndexDefault;
+use strict;
+use warnings;
+use Catalyst;
+
+__PACKAGE__->setup;
+
+1;
--- /dev/null
+package TestAppIndexDefault::Controller::Default;
+
+use base 'Catalyst::Controller';
+
+sub default : Private {
+ my ($self, $c) = @_;
+ $c->res->body('default_default');
+}
+
+sub path_one_arg : Path('/default/') Args(1) {
+ my ($self, $c) = @_;
+ $c->res->body('default_path_one_arg');
+}
+
+1;
--- /dev/null
+package TestAppIndexDefault::Controller::IndexChained;
+
+use base 'Catalyst::Controller';
+
+sub index : Chained('/') PathPart('indexchained') CaptureArgs(0) {}
+
+sub index_endpoint : Chained('index') PathPart('') Args(0) {
+ my ($self, $c) = @_;
+ $c->res->body('index_chained');
+}
+
+1;
--- /dev/null
+package TestAppIndexDefault::Controller::IndexPrivate;
+
+use base 'Catalyst::Controller';
+
+sub index : Private {
+ my ($self, $c) = @_;
+ $c->res->body('index_private');
+}
+
+1;
--- /dev/null
+package TestAppIndexDefault::Controller::Root;
+
+use base 'Catalyst::Controller';
+
+__PACKAGE__->config->{namespace} = '';
+
+sub default : Private {
+ my ($self, $c) = @_;
+ $c->res->body('default');
+}
+
+sub path_one_arg : Path('/') Args(1) {
+ my ($self, $c) = @_;
+ $c->res->body('path_one_arg');
+}
+
+1;
projects / catagits/Catalyst-Runtime.git / commitdiff