X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FDispatchType%2FPath.pm;h=64bc477ed1b726cb308a1a75ad4481e7f05d7103;hp=7f291db4624356d0efe53e601e2bba083bbf03d1;hb=595f3872331fe9d3b2fc22a18a7e03abc1e69d42;hpb=22f3a8dd32e5940d87a1d21642fa39c7813bc921 diff --git a/lib/Catalyst/DispatchType/Path.pm b/lib/Catalyst/DispatchType/Path.pm index 7f291db..64bc477 100644 --- a/lib/Catalyst/DispatchType/Path.pm +++ b/lib/Catalyst/DispatchType/Path.pm @@ -2,47 +2,114 @@ package Catalyst::DispatchType::Path; use strict; use base qw/Catalyst::DispatchType/; +use Text::SimpleTable; +use URI; -sub prepare_action { - my ($self, $c, $path) = @_; +=head1 NAME +Catalyst::DispatchType::Path - Path DispatchType + +=head1 SYNOPSIS + +See L. + +=head1 DESCRIPTION + +=head1 METHODS + +=head2 $self->list($c) + +=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" ); + } + $c->log->debug( "Loaded Path actions:\n" . $paths->draw ) + if ( keys %{ $self->{paths} } ); +} + +=head2 $self->match( $c, $path ) + +=cut + +sub match { + my ( $self, $c, $path ) = @_; + + $path ||= '/'; if ( my $action = $self->{paths}->{$path} ) { $c->req->action($path); $c->req->match($path); $c->action($action); - $c->namespace($action->prefix); + $c->namespace( $action->namespace ); return 1; } return 0; } -sub register_action { +=head2 $self->register( $c, $action ) + +=cut + +sub register { my ( $self, $c, $action ) = @_; my $attrs = $action->attributes; my @register; - foreach my $r (@{$attrs->{Path} || []}) { - unless ($r =~ m!^/!) { # It's a relative path - $r = $action->prefix."/$r"; + foreach my $r ( @{ $attrs->{Path} || [] } ) { + unless ($r) { + $r = $action->namespace; + $r = '/' unless length $r; + } + elsif ( $r !~ m!^/! ) { # It's a relative path + $r = $action->namespace . "/$r"; } - push(@register, $r); + push( @register, $r ); } - if ($attrs->{Global} || $attrs->{Absolute}) { - push(@register, $action->name); # Register sub name against root + if ( $attrs->{Global} || $attrs->{Absolute} ) { + push( @register, $action->name ); # Register sub name against root } - if ($attrs->{Local} || $attrs->{Relative}) { - push(@register, join('/', $action->prefix, $action->name)); - # Register sub name as a relative path - } + if ( $attrs->{Local} || $attrs->{Relative} ) { + push( @register, join( '/', $action->namespace, $action->name ) ); - foreach my $r (@register) { - $r =~ s!^/!!; - $self->{paths}{$r} = $action; + # Register sub name as a relative path } + + $self->register_path( $c, $_, $action ) for @register; + return 1 if @register; + return 0; +} + +=head2 $self->register_path($c, $path, $action) + +=cut + +sub register_path { + my ( $self, $c, $path, $action ) = @_; + $path =~ s!^/!!; + $path = '/' unless length $path; + $path = URI->new($path)->canonical; + $self->{paths}{$path} = $action; } +=head1 AUTHOR + +Matt S Trout +Sebastian Riedel, C + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut + 1;