From: Matt S Trout Date: Thu, 22 Jun 2006 14:49:37 +0000 (+0000) Subject: implemented list and uri_for_action for ChildOf X-Git-Tag: 5.7099_04~505 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=792b40acf4b4c3eca61464d33fe5ba8d3a542c44;hp=141459fa3fc9852fd6f05138caddb410bbe2949c implemented list and uri_for_action for ChildOf r9739@cain (orig r4288): matthewt | 2006-06-05 08:10:40 +0000 --- diff --git a/lib/Catalyst/DispatchType/ChildOf.pm b/lib/Catalyst/DispatchType/ChildOf.pm index 094337d..4be4967 100644 --- a/lib/Catalyst/DispatchType/ChildOf.pm +++ b/lib/Catalyst/DispatchType/ChildOf.pm @@ -6,9 +6,11 @@ use Text::SimpleTable; use Catalyst::ActionChain; use URI; +# please don't perltidy this. hairy code within. + =head1 NAME -Catalyst::DispatchType::Path - Path DispatchType +Catalyst::DispatchType::ChildOf - Path Part DispatchType =head1 SYNOPSIS @@ -22,22 +24,42 @@ See L. Debug output for Path Part dispatch points -Matt is an idiot and hasn't implemented this yet. - =cut -#sub list { -# my ( $self, $c ) = @_; -# 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} } ); -#} +sub list { + my ( $self, $c ) = @_; + + return unless $self->{endpoints}; + + my $paths = Text::SimpleTable->new( + [ 35, 'Path Spec' ], [ 36, 'Private' ] + ); + + ENDPOINT: foreach my $endpoint ( + sort { $a->reverse cmp $b->reverse } + @{ $self->{endpoints} } + ) { + my $args = $endpoint->attributes->{Args}->[0]; + my @parts = (defined($args) ? (("*") x $args) : '...'); + my $parent = "DUMMY"; + my $curr = $endpoint; + while ($curr) { + if (my $cap = $curr->attributes->{Captures}) { + unshift(@parts, (("*") x $cap->[0])); + } + if (my $pp = $curr->attributes->{PartPath}) { + unshift(@parts, $pp->[0]) + if (defined $pp->[0] && length $pp->[0]); + } + $parent = $curr->attributes->{ChildOf}->[0]; + $curr = $self->{actions}{$parent}; + } + next ENDPOINT unless $parent eq '/'; # skip dangling action + $paths->row(join('/', '', @parts), "/$endpoint"); + } + + $c->log->debug( "Loaded Path Part actions:\n" . $paths->draw ); +} =head2 $self->match( $c, $path ) @@ -84,8 +106,8 @@ sub recurse_match { next TRY unless ($try_part eq join('/', # assemble equal number of parts splice( # and strip them off @parts as well - @parts, 0, scalar(split('/', $try_part)) - ))); + @parts, 0, scalar(@{[split('/', $try_part)]}) + ))); # @{[]} to avoid split to @_ } my @try_actions = @{$children->{$try_part}}; TRY_ACTION: foreach my $action (@try_actions) { @@ -146,6 +168,8 @@ sub register { $parent = '/'.$action->namespace; } + $action->attributes->{ChildOf} = [ $parent ]; + my $children = ($self->{children_of}{$parent} ||= {}); my @path_part = @{ $action->attributes->{PathPart} || [] }; @@ -160,8 +184,17 @@ sub register { ); } + $action->attributes->{PartPath} = [ $part ]; + unshift(@{ $children->{$part} ||= [] }, $action); + ($self->{actions} ||= {})->{'/'.$action->reverse} = $action; + + if ($action->attributes->{Args}) { + unshift(@{ $self->{endpoints} ||= [] }, $action); + } + + return 1; } =head2 $self->uri_for_action($action, $captures) @@ -173,23 +206,37 @@ Matt is an idiot and hasn't documented this yet. 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; + return undef unless ($action->attributes->{ChildOf} + && $action->attributes->{Args}); + + my @parts = (); + my @captures = @$captures; + my $parent = "DUMMY"; + my $curr = $action; + while ($curr) { + if (my $cap = $curr->attributes->{Captures}) { + return undef unless @captures >= $cap->[0]; # not enough captures + unshift(@parts, splice(@captures, -$cap->[0])); + } + if (my $pp = $curr->attributes->{PartPath}) { + unshift(@parts, $pp->[0]) + if (defined $pp->[0] && length $pp->[0]); + } + $parent = $curr->attributes->{ChildOf}->[0]; + $curr = $self->{actions}{$parent}; } + + return undef unless $parent eq '/'; # fail for dangling action + + return undef if @captures; # fail for too many captures + + return join('/', '', @parts); + } =head1 AUTHOR -Matt S Trout -Sebastian Riedel, C +Matt S Trout =head1 COPYRIGHT diff --git a/t/unit_core_uri_for_action.t b/t/unit_core_uri_for_action.t index 1d8b839..99b4c51 100644 --- a/t/unit_core_uri_for_action.t +++ b/t/unit_core_uri_for_action.t @@ -8,7 +8,7 @@ use lib "$FindBin::Bin/lib"; use Test::More; -plan tests => 12; +plan tests => 17; use_ok('TestApp'); @@ -38,6 +38,9 @@ my $regex_action = $dispatcher->get_action_by_path( ok(!defined($dispatcher->uri_for_action($regex_action)), "Regex action without captures returns undef"); +ok(!defined($dispatcher->uri_for_action($regex_action, [ 1, 2, 3 ])), + "Regex action with too many captures returns undef"); + is($dispatcher->uri_for_action($regex_action, [ 'foo', 123 ]), "/action/regexp/foo/123", "Regex action interpolates captures correctly"); @@ -53,6 +56,20 @@ is($dispatcher->uri_for_action($index_action), "/action/index", "index action returns correct path"); +my $childof_action = $dispatcher->get_action_by_path( + '/action/childof/endpoint', + ); + +ok(!defined($dispatcher->uri_for_action($childof_action)), + "ChildOf action without captures returns undef"); + +ok(!defined($dispatcher->uri_for_action($childof_action, [ 1, 2 ])), + "ChildOf action with too many captures returns undef"); + +is($dispatcher->uri_for_action($childof_action, [ 1 ]), + "/childof/foo/1/end", + "ChildOf action with correct captures returns correct path"); + my $request = Catalyst::Request->new( { base => URI->new('http://127.0.0.1/foo') } ); @@ -76,3 +93,7 @@ ok(!defined($context->uri_for($path_action, [ 'blah' ])), is($context->uri_for($regex_action, [ 'foo', 123 ], qw/bar baz/, { q => 1 }), "http://127.0.0.1/foo/action/regexp/foo/123/bar/baz?q=1", "uri_for correct for regex with captures, args and query"); + +is($context->uri_for($childof_action, [ 1 ], 2, { q => 1 }), + "http://127.0.0.1/foo/childof/foo/1/end/2?q=1", + "uri_for correct for childof with captures, args and query");