X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FDispatchType%2FPath.pm;h=bd74c79d6190ecf173687a7069eed41a2030bdfb;hb=1627551a60fe1e220d390a565f793dea27cd36a6;hp=bec5b1c2d2b8ca141faac647aac8821addf93b50;hpb=a9cbd748a5bef5badba4a3f012e5df75cccd60ca;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/DispatchType/Path.pm b/lib/Catalyst/DispatchType/Path.pm index bec5b1c..bd74c79 100644 --- a/lib/Catalyst/DispatchType/Path.pm +++ b/lib/Catalyst/DispatchType/Path.pm @@ -2,7 +2,8 @@ package Catalyst::DispatchType::Path; use strict; use base qw/Catalyst::DispatchType/; -use Text::ASCIITable; +use Text::SimpleTable; +use URI; =head1 NAME @@ -16,78 +17,69 @@ See L. =head1 METHODS -=over 4 - -=item $self->list($c) +=head2 $self->list($c) =cut sub list { my ( $self, $c ) = @_; - my $paths = Text::ASCIITable->new; - $paths->setCols( 'Public', 'Private' ); - $paths->setColWidth( 'Public', 36, 1 ); - $paths->setColWidth( 'Private', 37, 1 ); + my $paths = Text::SimpleTable->new( [ 36, 'Path' ], [ 37, 'Private' ] ); for my $path ( sort keys %{ $self->{paths} } ) { my $action = $self->{paths}->{$path}; - $paths->addRow( "/$path", "/$action" ); + $path = "/$path" unless $path eq '/'; + $paths->row( "$path", "/$action" ); } $c->log->debug( "Loaded Path actions:\n" . $paths->draw ) - if ( @{ $paths->{tbl_rows} } ); + if ( keys %{ $self->{paths} } ); } -=item $self->match( $c, $path ) +=head2 $self->match( $c, $path ) =cut sub match { my ( $self, $c, $path ) = @_; + $path ||= '/'; if ( my $action = $self->{paths}->{$path} ) { + return 0 unless $action->match($c); $c->req->action($path); $c->req->match($path); $c->action($action); - $c->namespace( $action->prefix ); + $c->namespace( $action->namespace ); return 1; } return 0; } -=item $self->register( $c, $action ) +=head2 $self->register( $c, $action ) =cut sub register { my ( $self, $c, $action ) = @_; - my $attrs = $action->attributes; - my @register; + my @register = @{ $action->attributes->{Path} || [] }; - foreach my $r ( @{ $attrs->{Path} || [] } ) { - unless ( $r =~ m!^/! ) { # It's a relative path - $r = $action->prefix . "/$r"; - } - push( @register, $r ); - } + $self->register_path( $c, $_, $action ) for @register; - if ( $attrs->{Global} || $attrs->{Absolute} ) { - push( @register, $action->name ); # Register sub name against root - } + return 1 if @register; + return 0; +} - if ( $attrs->{Local} || $attrs->{Relative} ) { - push( @register, join( '/', $action->prefix, $action->name ) ); +=head2 $self->register_path($c, $path, $action) - # Register sub name as a relative path - } +=cut - foreach my $r (@register) { - $r =~ s!^/!!; - $self->{paths}{$r} = $action; - } -} +sub register_path { + my ( $self, $c, $path, $action ) = @_; + $path =~ s!^/!!; + $path = '/' unless length $path; + $path = URI->new($path)->canonical; -=back + $self->{paths}{$path} = $action; +} =head1 AUTHOR