From: Tomas Doran Date: Mon, 3 Jun 2013 17:32:50 +0000 (+0100) Subject: Entirely remove Path dispatch, in favour of Chained. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=976220fb6507cadfbeebdd98e30861e2636e9b14 Entirely remove Path dispatch, in favour of Chained. Appears to work in a trivial testapp, from the dispatch table. However this no doubt breaks the core tests significantly and I've no idea if it works in all cases. --- diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index 28b54be..afa3e3f 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -458,7 +458,10 @@ sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); } sub _parse_Local_attr { my ( $self, $c, $name, $value ) = @_; # _parse_attr will call _parse_Path_attr for us - return Path => $name; + return ( + 'Chained' => '/', + 'PathPart' => join( '/', $self->path_prefix($c), $name) + ); } sub _parse_Relative_attr { shift->_parse_Local_attr(@_); } @@ -466,14 +469,23 @@ sub _parse_Relative_attr { shift->_parse_Local_attr(@_); } sub _parse_Path_attr { my ( $self, $c, $name, $value ) = @_; $value = '' if !defined $value; - if ( $value =~ m!^/! ) { - return ( 'Path', $value ); + if ( $value =~ s!^/!! ) { + return ( + 'Chained' => '/', + 'PathPart' => $value + ); } elsif ( length $value ) { - return ( 'Path', join( '/', $self->path_prefix($c), $value ) ); + return ( + 'Chained' => '/', + 'PathPart' => join( '/', $self->path_prefix($c), $value ) + ); } else { - return ( 'Path', $self->path_prefix($c) ); + return ( + 'Chained' => '/', + 'PathPart' => $self->path_prefix($c) + ); } } diff --git a/lib/Catalyst/DispatchType/Path.pm b/lib/Catalyst/DispatchType/Path.pm deleted file mode 100644 index 0578ff4..0000000 --- a/lib/Catalyst/DispatchType/Path.pm +++ /dev/null @@ -1,171 +0,0 @@ -package Catalyst::DispatchType::Path; - -use Moose; -extends 'Catalyst::DispatchType'; - -use Text::SimpleTable; -use Catalyst::Utils; -use URI; - -has _paths => ( - is => 'rw', - isa => 'HashRef', - required => 1, - default => sub { +{} }, - ); - -no Moose; - -=head1 NAME - -Catalyst::DispatchType::Path - Path DispatchType - -=head1 SYNOPSIS - -See L. - -=head1 DESCRIPTION - -Dispatch type managing full path matching behaviour. For more information on -dispatch types, see: - -=over 4 - -=item * L for how they affect application authors - -=item * L for implementation information. - -=back - -=head1 METHODS - -=head2 $self->list($c) - -Debug output for Path dispatch points - -=cut - -sub list { - my ( $self, $c ) = @_; - my $avail_width = Catalyst::Utils::term_width() - 9; - my $col1_width = ($avail_width * .50) < 35 ? 35 : int($avail_width * .50); - my $col2_width = $avail_width - $col1_width; - my $paths = Text::SimpleTable->new( - [ $col1_width, 'Path' ], [ $col2_width, 'Private' ] - ); - foreach my $path ( sort keys %{ $self->_paths } ) { - foreach my $action ( @{ $self->_paths->{$path} } ) { - my $args = $action->attributes->{Args}->[0]; - my $parts = defined($args) ? '/*' x $args : '/...'; - - my $display_path = "/$path/$parts"; - $display_path =~ s{/{1,}}{/}g; - - $paths->row( $display_path, "/$action" ); - } - } - $c->log->debug( "Loaded Path actions:\n" . $paths->draw . "\n" ) - if ( keys %{ $self->_paths } ); -} - -=head2 $self->match( $c, $path ) - -For each action registered to this exact path, offers the action a chance to -match the path (in the order in which they were registered). Succeeds on the -first action that matches, if any; if not, returns 0. - -=cut - -sub match { - my ( $self, $c, $path ) = @_; - - $path = '/' if !defined $path || !length $path; - - my @actions = @{ $self->_paths->{$path} || [] }; - - foreach my $action ( @actions ) { - next unless $action->match($c); - $c->req->action($path); - $c->req->match($path); - $c->action($action); - $c->namespace( $action->namespace ); - return 1; - } - - return 0; -} - -=head2 $self->register( $c, $action ) - -Calls register_path for every Path attribute for the given $action. - -=cut - -sub register { - my ( $self, $c, $action ) = @_; - - my @register = @{ $action->attributes->{Path} || [] }; - - $self->register_path( $c, $_, $action ) for @register; - - return 1 if @register; - return 0; -} - -=head2 $self->register_path($c, $path, $action) - -Registers an action at a given path. - -=cut - -sub register_path { - my ( $self, $c, $path, $action ) = @_; - $path =~ s!^/!!; - $path = '/' unless length $path; - $path = URI->new($path)->canonical; - $path =~ s{(?<=[^/])/+\z}{}; - - $self->_paths->{$path} = [ - sort { $a->compare($b) } ($action, @{ $self->_paths->{$path} || [] }) - ]; - - return 1; -} - -=head2 $self->uri_for_action($action, $captures) - -get a URI part for an action; always returns undef is $captures is set -since Path actions don't have captures - -=cut - -sub uri_for_action { - my ( $self, $action, $captures ) = @_; - - return undef if @$captures; - - if (my $paths = $action->attributes->{Path}) { - my $path = $paths->[0]; - $path = '/' unless length($path); - $path = "/${path}" unless ($path =~ m/^\//); - $path = URI->new($path)->canonical; - return $path; - } else { - return undef; - } -} - -=head1 AUTHORS - -Catalyst Contributors, see Catalyst.pm - -=head1 COPYRIGHT - -This library is free software. You can redistribute it and/or modify it under -the same terms as Perl itself. - -=cut - -__PACKAGE__->meta->make_immutable; - -1; diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm index d9fe5b3..ea0710b 100644 --- a/lib/Catalyst/Dispatcher.pm +++ b/lib/Catalyst/Dispatcher.pm @@ -22,7 +22,7 @@ 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/; +our @PRELOAD = qw/Index/; # Postload these action types our @POSTLOAD = qw/Default/;