# Note - see back-compat methods at end of file.
has _tree => (is => 'rw', builder => '_build__tree');
-has _dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
+has dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1);
has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1);
has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
-has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
-has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
-
-# Wrap accessors so you can assign a list and it will capture a list ref.
-around qw/preload_dispatch_types postload_dispatch_types/ => sub {
- my $orig = shift;
- my $self = shift;
- return $self->$orig([@_]) if (scalar @_ && ref $_[0] ne 'ARRAY');
- return $self->$orig(@_);
-};
+my %dispatch_types = ( pre => \@PRELOAD, post => \@POSTLOAD );
+foreach my $type (keys %dispatch_types) {
+ has $type . "load_dispatch_types" => (
+ is => 'rw', required => 1, lazy => 1, default => sub { $dispatch_types{$type} },
+ traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'], # List assignment is CAF style
+ );
+}
=head1 NAME
=head1 METHODS
-=head2 new
+=head2 new
Construct a new dispatcher.
my (@args, @captures);
if ( ref( $extra_params[-2] ) eq 'ARRAY' ) {
- @captures = @{ pop @extra_params };
+ @captures = @{ splice @extra_params, -2, 1 };
}
if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
$action = $self->_invoke_as_path( $c, "$command", \@args );
}
- # go to a component ( "MyApp::*::Foo" or $c->component("...")
+ # go to a component ( "View::Foo" or $c->component("...")
# - a path or an object)
unless ($action) {
my $method = @extra_params ? $extra_params[0] : "process";
sub go {
my $self = shift;
$self->_do_visit('go', @_);
- die $Catalyst::GO;
+ Catalyst::Exception::Go->throw;
}
=head2 $self->forward( $c, $command [, \@arguments ] )
sub detach {
my ( $self, $c, $command, @args ) = @_;
$self->_do_forward(detach => $c, $command, @args ) if $command;
- die $Catalyst::DETACH;
+ Catalyst::Exception::Detach->throw;
}
sub _action_rel2abs {
reverse => "$component_class->$method",
class => $component_class,
namespace => Catalyst::Utils::class2prefix(
- $component_class, $c->config->{case_sensitive}
+ $component_class, ref($c)->config->{case_sensitive}
),
}
);
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
- foreach my $type ( @{ $self->_dispatch_types } ) {
+ foreach my $type ( @{ $self->dispatch_types } ) {
last DESCEND if $type->match( $c, $path );
}
return $self->_action_hash->{"${namespace}/${name}"};
}
-=head2 $self->get_action_by_path( $path );
+=head2 $self->get_action_by_path( $path );
Returns the named action by its full private path.
}
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)
sub uri_for_action {
my ( $self, $action, $captures) = @_;
$captures ||= [];
- foreach my $dispatch_type ( @{ $self->_dispatch_types } ) {
+ foreach my $dispatch_type ( @{ $self->dispatch_types } ) {
my $uri = $dispatch_type->uri_for_action( $action, $captures );
return( $uri eq '' ? '/' : $uri )
if defined($uri);
sub expand_action {
my ($self, $action) = @_;
- foreach my $dispatch_type (@{ $self->_dispatch_types }) {
+ foreach my $dispatch_type (@{ $self->dispatch_types }) {
my $expanded = $dispatch_type->expand_action($action);
return $expanded if $expanded;
}
my $registered = $self->_registered_dispatch_types;
- #my $priv = 0; #seems to be unused
foreach my $key ( keys %{ $action->attributes } ) {
next if $key eq 'Private';
my $class = "Catalyst::DispatchType::$key";
# FIXME - Some error checking and re-throwing needed here, as
# we eat exceptions loading dispatch types.
eval { Class::MOP::load_class($class) };
- push( @{ $self->_dispatch_types }, $class->new ) unless $@;
+ push( @{ $self->dispatch_types }, $class->new ) unless $@;
$registered->{$class} = 1;
}
}
+ 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;
sub _display_action_tables {
my ($self, $c) = @_;
- my $column_width = Catalyst::Utils::term_width() - 20 - 36 - 12;
+ my $avail_width = Catalyst::Utils::term_width() - 12;
+ my $col1_width = ($avail_width * .25) < 20 ? 20 : int($avail_width * .25);
+ my $col2_width = ($avail_width * .50) < 36 ? 36 : int($avail_width * .50);
+ my $col3_width = $avail_width - $col1_width - $col2_width;
my $privates = Text::SimpleTable->new(
- [ 20, 'Private' ], [ 36, 'Class' ], [ $column_width, 'Method' ]
+ [ $col1_width, 'Private' ], [ $col2_width, 'Class' ], [ $col3_width, 'Method' ]
);
my $has_private = 0;
if $has_private;
# List all public actions
- $_->list($c) for @{ $self->_dispatch_types };
+ $_->list($c) for @{ $self->dispatch_types };
}
sub _load_dispatch_types {
my ( $self, @types ) = @_;
my @loaded;
-
# Preload action types
for my $type (@types) {
- my $class =
- ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}";
+ # first param is undef because we cannot get the appclass
+ my $class = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $type);
eval { Class::MOP::load_class($class) };
Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ )
if $@;
- push @{ $self->_dispatch_types }, $class->new;
+ push @{ $self->dispatch_types }, $class->new;
push @loaded, $class;
}
Get the DispatchType object of the relevant type, i.e. passing C<$type> of
C<Chained> would return a L<Catalyst::DispatchType::Chained> object (assuming
-of course it's being used.)
+of course it's being used.)
=cut
sub dispatch_type {
my ($self, $name) = @_;
- unless ($name =~ s/^\+//) {
- $name = "Catalyst::DispatchType::" . $name;
- }
+ # first param is undef because we cannot get the appclass
+ $name = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $name);
- for (@{ $self->_dispatch_types }) {
+ for (@{ $self->dispatch_types }) {
return $_ if ref($_) eq $name;
}
return undef;
# Various plugins (e.g. Plugin::Server and Plugin::Authorization::ACL)
# need the methods here which *should* be private..
-# However we can't really take them away until there is a sane API for
-# building actions and configuring / introspecting the dispatcher.
-# In 5.90, we should build that infrastructure, port the plugins which
-# use it, and then take the crap below away.
+# You should be able to use get_actions or get_containers appropriately
+# instead of relying on these methods which expose implementation details
+# of the dispatcher..
+#
+# IRC backlog included below, please come ask if this doesn't work for you.
+#
+# <@t0m> 5.80, the state of. There are things in the dispatcher which have
+# been deprecated, that we yell at anyone for using, which there isn't
+# a good alternative for yet..
+# <@mst> er, get_actions/get_containers provides that doesn't it?
+# <@mst> DispatchTypes are loaded on demand anyway
+# <@t0m> I'm thinking of things like _tree which is aliased to 'tree' with
+# warnings otherwise shit breaks.. We're issuing warnings about the
+# correct set of things which you shouldn't be calling..
+# <@mst> right
+# <@mst> basically, I don't see there's a need for a replacement for anything
+# <@mst> it was never a good idea to call ->tree
+# <@mst> nothingmuch was the only one who did AFAIK
+# <@mst> and he admitted it was a hack ;)
+
# See also t/lib/TestApp/Plugin/AddDispatchTypes.pm
# Alias _method_name to method_name, add a before modifier to warn..
-foreach my $public_method_name (qw/
- tree
- dispatch_types
- registered_dispatch_types
- method_action_class
- action_hash
+foreach my $public_method_name (qw/
+ tree
+ registered_dispatch_types
+ method_action_class
+ action_hash
container_hash
/) {
my $private_method_name = '_' . $public_method_name;
my %package_hash; # Only warn once per method, per package. These are infrequent enough that
# I haven't provided a way to disable them, patches welcome.
$meta->add_before_method_modifier($public_method_name, sub {
- my $class = blessed(shift);
my $class = caller(2);
chomp($class);
$package_hash{$class}++ || do {
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut