X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FDispatchType%2FPath.pm;h=ac28382976e48d63656a0165ecaf0ddb3728f0f7;hb=0bd5f8a2e3fb6c7ad7faeb128cc2991a1bb3ce98;hp=98ef3034a7ed981e001563ca375727bd5ca1384b;hpb=61a9002d77ce79bc038b3ec6212e275015801594;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/DispatchType/Path.pm b/lib/Catalyst/DispatchType/Path.pm index 98ef303..ac28382 100644 --- a/lib/Catalyst/DispatchType/Path.pm +++ b/lib/Catalyst/DispatchType/Path.pm @@ -3,6 +3,7 @@ package Catalyst::DispatchType::Path; use strict; use base qw/Catalyst::DispatchType/; use Text::SimpleTable; +use URI; =head1 NAME @@ -18,15 +19,18 @@ See L. =head2 $self->list($c) +Debug output for Path dispatch points + =cut sub list { my ( $self, $c ) = @_; - my $paths = Text::SimpleTable->new( [ 36, 'Path' ], [ 37, 'Private' ] ); - for my $path ( sort keys %{ $self->{paths} } ) { - my $action = $self->{paths}->{$path}; - $path = "/$path" unless $path eq '/'; - $paths->row( "$path", "/$action" ); + my $paths = Text::SimpleTable->new( [ 35, 'Path' ], [ 36, 'Private' ] ); + foreach my $path ( sort keys %{ $self->{paths} } ) { + foreach my $action ( @{ $self->{paths}->{$path} } ) { + $path = "/$path" unless $path eq '/'; + $paths->row( "$path", "/$action" ); + } } $c->log->debug( "Loaded Path actions:\n" . $paths->draw ) if ( keys %{ $self->{paths} } ); @@ -34,13 +38,17 @@ sub list { =head2 $self->match( $c, $path ) +Check for paths that match the given path. + =cut sub match { my ( $self, $c, $path ) = @_; $path ||= '/'; - if ( my $action = $self->{paths}->{$path} ) { + + foreach my $action ( @{ $self->{paths}->{$path} || [] } ) { + next unless $action->match($c); $c->req->action($path); $c->req->match($path); $c->action($action); @@ -53,49 +61,36 @@ sub match { =head2 $self->register( $c, $action ) +Call register_path for every path attribute in the given $action. + =cut sub register { my ( $self, $c, $action ) = @_; - my $attrs = $action->attributes; - my @register; - - foreach my $r ( @{ $attrs->{Path} || [] } ) { - unless ($r) { - $r = $action->namespace; - $r = '/' unless $r; - } - elsif ( $r !~ m!^/! ) { # It's a relative path - $r = $action->namespace . "/$r"; - } - push( @register, $r ); - } - - if ( $attrs->{Global} || $attrs->{Absolute} ) { - push( @register, $action->name ); # Register sub name against root - } - - if ( $attrs->{Local} || $attrs->{Relative} ) { - push( @register, join( '/', $action->namespace, $action->name ) ); - - # Register sub name as a relative path - } + 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) +register an action at a given path. + =cut sub register_path { my ( $self, $c, $path, $action ) = @_; $path =~ s!^/!!; - $path = '/' unless $path; - $self->{paths}{$path} = $action; + $path = '/' unless length $path; + $path = URI->new($path)->canonical; + + unshift( @{ $self->{paths}{$path} ||= [] }, $action); + + return 1; } =head1 AUTHOR