use Text::SimpleTable;
use Tree::Simple;
use Tree::Simple::Visitor::FindByPath;
+use Class::Load qw(load_class try_load_class);
use namespace::clean -except => 'meta';
# See Catalyst-Plugin-Server for them being added to, which should be much less ugly.
# Preload these action types
-our @PRELOAD = qw/Index Path Regex/;
+our @PRELOAD = qw/Index Path/;
# Postload these action types
our @POSTLOAD = qw/Default/;
# 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";
unless ( $registered->{$class} ) {
# 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 $@;
+ # see also try_load_class
+ eval { load_class($class) };
+ my $load_failed = $@;
+ $self->_check_deprecated_dispatch_type( $key, $load_failed );
+ push( @{ $self->dispatch_types }, $class->new ) unless $load_failed;
$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;
=head2 $self->setup_actions( $class, $context )
-Loads all of the preload dispatch types, registers their actions and then
-loads all of the postload dispatch types, and iterates over the tree of
+Loads all of the pre-load dispatch types, registers their actions and then
+loads all of the post-load dispatch types, and iterates over the tree of
actions, displaying the debug information if appropriate.
=cut
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 {
for my $type (@types) {
# 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;
+
+ my ($success, $error) = try_load_class($class);
+ Catalyst::Exception->throw( message => $error ) if not $success;
+ 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) = @_;
-
+
# 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;
}
+sub _check_deprecated_dispatch_type {
+ my ($self, $key, $load_failed) = @_;
+
+ return unless $key =~ /^(Local)?Regexp?/;
+
+ # TODO: Should these throw an exception rather than just warning?
+ if ($load_failed) {
+ warn( "Attempt to use deprecated $key dispatch type.\n"
+ . " Use Chained methods or install the standalone\n"
+ . " Catalyst::DispatchType::Regex if necessary.\n" );
+ } elsif ( !defined $Catalyst::DispatchType::Regex::VERSION
+ || $Catalyst::DispatchType::Regex::VERSION le '5.90020' ) {
+ # We loaded the old core version of the Regex module this will break
+ warn( "The $key DispatchType has been removed from Catalyst core.\n"
+ . " An old version of the core Catalyst::DispatchType::Regex\n"
+ . " has been loaded and will likely fail. Please remove\n"
+ . " $INC{'Catalyst/DispatchType/Regex.pm'}\n"
+ . " and use Chained methods or install the standalone\n"
+ . " Catalyst::DispatchType::Regex if necessary.\n" );
+ }
+}
+
use Moose;
# 5.70 backwards compatibility hacks.
# 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;
$package_hash{$class}++ || do {
warn("Class $class is calling the deprecated method\n"
. " Catalyst::Dispatcher::$public_method_name,\n"
- . " this will be removed in Catalyst 5.9X\n");
+ . " this will be removed in Catalyst 5.9\n");
};
});
}
=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