[catagits/Catalyst-Runtime.git] / lib / Catalyst / DispatchType / Chained.pm

package Catalyst::DispatchType::Chained;

use strict;
use base qw/Catalyst::DispatchType/;
use Text::SimpleTable;
use Catalyst::ActionChain;
use URI;

# please don't perltidy this. hairy code within.

=head1 NAME

Catalyst::DispatchType::Chained - Path Part DispatchType

=head1 SYNOPSIS

  #   root action - captures one argument after it
  sub foo_setup : Chained('/') PathPart('foo') CaptureArgs(1) {
      my ( $self, $c, $foo_arg ) = @_;
      ...
  }

  #   child action endpoint - takes one argument
  sub bar : Chained('foo_setup') Args(1) {
      my ( $self, $c, $bar_arg ) = @_;
      ...
  }

=head1 DESCRIPTION

See L</USAGE>.

=head1 METHODS

=head2 $self->list($c)

Debug output for Path Part dispatch points

=cut

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 @parents = ();
        my $parent = "DUMMY";
        my $curr = $endpoint;
        while ($curr) {
            if (my $cap = $curr->attributes->{CaptureArgs}) {
                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->{Chained}->[0];
            $curr = $self->{actions}{$parent};
            unshift(@parents, $curr) if $curr;
        }
        next ENDPOINT unless $parent eq '/'; # skip dangling action
        my @rows;
        foreach my $p (@parents) {
            my $name = "/${p}";
            if (my $cap = $p->attributes->{CaptureArgs}) {
                $name .= ' ('.$cap->[0].')';
            }
            unless ($p eq $parents[0]) {
                $name = "-> ${name}";
            }
            push(@rows, [ '', $name ]);
        }
        push(@rows, [ '', (@rows ? "=> " : '')."/${endpoint}" ]);
        $rows[0][0] = join('/', '', @parts);
        $paths->row(@$_) for @rows;
    }

    $c->log->debug( "Loaded Path Part actions:\n" . $paths->draw );
}

=head2 $self->match( $c, $path )

Calls C<recurse_match> to see if a chain matches the C<$path>.

=cut

sub match {
    my ( $self, $c, $path ) = @_;

    return 0 if @{$c->req->args};

    my @parts = split('/', $path);

    my ($chain, $captures) = $self->recurse_match($c, '/', \@parts);

    return 0 unless $chain;

    my $action = Catalyst::ActionChain->from_chain($chain);

    $c->req->action("/${action}");
    $c->req->match("/${action}");
    $c->req->captures($captures);
    $c->action($action);
    $c->namespace( $action->namespace );

    return 1;
}

=head2 $self->recurse_match( $c, $parent, \@path_parts )

Recursive search for a matching chain.

=cut

sub recurse_match {
    my ( $self, $c, $parent, $path_parts ) = @_;
    my $children = $self->{children_of}{$parent};
    return () unless $children;
    my @captures;
    TRY: foreach my $try_part (sort { length($b) <=> length($a) }
                                   keys %$children) {
                               # $b then $a to try longest part first
        my @parts = @$path_parts;
        if (length $try_part) { # test and strip PathPart
            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)]})
                              ))); # @{[]} to avoid split to @_
        }
        my @try_actions = @{$children->{$try_part}};
        TRY_ACTION: foreach my $action (@try_actions) {
            if (my $capture_attr = $action->attributes->{CaptureArgs}) {
                my @captures;
                my @parts = @parts; # localise

                # strip CaptureArgs into list
                push(@captures, splice(@parts, 0, $capture_attr->[0]));

                # try the remaining parts against children of this action
                my ($actions, $captures) = $self->recurse_match(
                                             $c, '/'.$action->reverse, \@parts
                                           );
                if ($actions) {
                    return [ $action, @$actions ], [ @captures, @$captures ];
                }
            } else {
                {
                    local $c->req->{arguments} = [ @{$c->req->args}, @parts ];
                    next TRY_ACTION unless $action->match($c);
                }
                push(@{$c->req->args}, @parts);
                return [ $action ], [ ];
            }
        }
    }
    return ();
}

=head2 $self->register( $c, $action )

Calls register_path for every Path attribute for the given $action.

=cut

sub register {
    my ( $self, $c, $action ) = @_;

    my @chained_attr = @{ $action->attributes->{Chained} || [] };

    return 0 unless @chained_attr;

    if (@chained_attr > 2) {
        Catalyst::Exception->throw(
          "Multiple Chained attributes not supported registering ${action}"
        );
    }

    my $parent = $chained_attr[0];

    if (defined($parent) && length($parent)) {
        if ($parent eq '.') {
            $parent = '/'.$action->namespace;
        } elsif ($parent !~ m/^\//) {
            $parent = '/'.join('/', $action->namespace, $parent);
        }
    } else {
        $parent = '/'
    }

    $action->attributes->{Chained} = [ $parent ];

    my $children = ($self->{children_of}{$parent} ||= {});

    my @path_part = @{ $action->attributes->{PathPart} || [] };

    my $part = $action->name;

    if (@path_part == 1 && defined $path_part[0]) {
        $part = $path_part[0];
    } elsif (@path_part > 1) {
        Catalyst::Exception->throw(
          "Multiple PathPart attributes not supported registering ${action}"
        );
    }

    if ($part =~ m(^/)) {
        Catalyst::Exception->throw(
          "Absolute parameters to PathPart not allowed registering ${action}"
        );
    }

    $action->attributes->{PartPath} = [ $part ];

    unshift(@{ $children->{$part} ||= [] }, $action);

    ($self->{actions} ||= {})->{'/'.$action->reverse} = $action;

    unless ($action->attributes->{CaptureArgs}) {
        unshift(@{ $self->{endpoints} ||= [] }, $action);
    }

    return 1;
}

=head2 $self->uri_for_action($action, $captures)

Get the URI part for the action, using C<$captures> to fill
the capturing parts.

=cut

sub uri_for_action {
    my ( $self, $action, $captures ) = @_;

    return undef unless ($action->attributes->{Chained}
                           && $action->attributes->{Args});

    my @parts = ();
    my @captures = @$captures;
    my $parent = "DUMMY";
    my $curr = $action;
    while ($curr) {
        if (my $cap = $curr->attributes->{CaptureArgs}) {
            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->{Chained}->[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 USAGE

=head2 Introduction

The C<Chained> attribute allows you to chain public path parts together
by their private names. A chain part's path can be specified with C<PathPart>
and can be declared to expect an arbitrary number of arguments. The endpoint
of the chain specifies how many arguments it gets through the C<Args>
attribute. C<:Args(0)> would be none at all, C<:Args> without an integer
would be unlimited. The path parts that aren't endpoints are using
C<CaptureArgs> to specify how many parameters they expect to receive. As an
example setup:

  package MyApp::Controller::Greeting;
  use base qw/ Catalyst::Controller /;

  #   this is the beginning of our chain
  sub hello : PathPart('hello') Chained('/') CaptureArgs(1) {
      my ( $self, $c, $integer ) = @_;
      $c->stash->{ message } = "Hello ";
      $c->stash->{ arg_sum } = $integer;
  }

  #   this is our endpoint, because it has no :CaptureArgs
  sub world : PathPart('world') Chained('hello') Args(1) {
      my ( $self, $c, $integer ) = @_;
      $c->stash->{ message } .= "World!";
      $c->stash->{ arg_sum } += $integer;

      $c->response->body( join "<br/>\n" =>
          $c->stash->{ message }, $c->stash->{ arg_sum } );
  }

The debug output provides a separate table for chained actions, showing
the whole chain as it would match and the actions it contains. Here's
an example of the startup output with our actions above:

  ...
  [debug] Loaded Path Part actions:
  .-----------------------+------------------------------.
  | Path Spec             | Private                      |
  +-----------------------+------------------------------+
  | /hello/*/world/*      | /greeting/hello (1)          |
  |                       | => /greeting/world           |
  '-----------------------+------------------------------'
  ...

As you can see, Catalyst only deals with chains as whole path and 
builds one for each endpoint, which are the actions with C<:Chained>
but without C<:CaptureArgs>.

Let's assume this application gets a request at the path
C</hello/23/world/12>, what happens then? First, Catalyst will dispatch
to the C<hello> action and pass the value C<23> as argument to it after
the context. It does so because we have previously used C<:CaptureArgs(1)>
to declare that it has one path part after itself as it's argument. We
told Catalyst that this is the beginning of the chain by specifying
C<:Chained('/')>. Also note that instead of saying C<:PathPart('hello')>
we could also just have said C<:PathPart>, as it defaults to the name of
the action.

After C<hello> has run, Catalyst goes on to dispatch to the C<world>
action. This is the last action to be called, as Catalyst knows this
is an endpoint because we specified no C<:CaptureArgs> attribute. Nevertheless
we specify that this action expects an argument, but at this point we're
using C<:Args(1)> to do that. We could also have said C<:Args> or leave 
it out alltogether, which would mean this action gets all arguments that
are there. This action's C<:Chained> attribute says C<hello> and tells
Catalyst that the C<hello> action in the current controller is it's 
parent.

With this we have built a chain consisting of two public path parts.
C<hello> captures one part of the path as it's argument, and also specifies
the path root as it's parent. So this part is C</hello/$arg>. The next part
is the endpoint C<world>, expecting one argument. It sums up to the path
part C<world/$arg>. This leads to a complete chain of 
C</hello/$arg/world/$arg> which is matched against the requested paths.

This example application would, if run and called by e.g. 
C</hello/23/world/12>, set the stash value C<message> to C<Hello > and
the value C<arg_sum> to C<23>. The C<world> action would then append
C<World!> to C<message> and add C<12> to the stash's C<arg_sum> value.
For the sake of simplicity no view is shown. Instead we just put the
values of the stash into our body. So the output would look like:

  Hello World!
  35

And our test server would've given us this debugging output for the
request:

  ...
  [debug] "GET" request for "hello/23/world/12" from "127.0.0.1"
  [debug] Path is "/greeting/world"
  [debug] Arguments are "12"
  [info] Request took 0.164113s (6.093/s)
  .------------------------------------------+-----------.
  | Action                                   | Time      |
  +------------------------------------------+-----------+
  | /greeting/hello                          | 0.000029s |
  | /greeting/world                          | 0.000024s |
  '------------------------------------------+-----------'
  ...

What would be common usecases of this dispatching technique? It gives the
possibility to split up logic that contains steps that each depend on each
other. An example would be, for example, a wiki path like
C</wiki/FooBarPage/rev/23/view>. This chain can be easily built with
these actions:

  sub wiki : PathPart('wiki') Chained('/') CaptureArgs(1) {
      my ( $self, $c, $page_name ) = @_;
      #  load the page named $page_name and put the object
      #  into the stash
  }

  sub rev : PathPart('rev') Chained('wiki') CaptureArgs(1) {
      my ( $self, $c, $revision_id ) = @_;
      #  use the page object in the stash to get at it's
      #  revision with number $revision_id
  }

  sub view : PathPart Chained('rev') Args(0) {
      my ( $self, $c ) = @_;
      #  display the revision in our stash. An other option
      #  would be to forward a compatible object to the action
      #  that displays the default wiki pages, unless we want
      #  a different interface here, for example restore
      #  functionality.
  }

It would now be possible to add other endpoints. For example C<restore> to
restore this specific revision as current state.

Also, you of course don't have to put all the chained actions in one
controller. The specification of the parent through C<:Chained> also takes
an absolute action path as it's argument. Just specify it with a leading
C</>.

If you want, for example, to have actions for the public paths
C</foo/12/edit> and C</foo/12>, just specify two actions with 
C<:PathPart('foo')> and C<:Chained('/')>. The handler for the former
path needs a C<:CaptureArgs(1)> attribute and a endpoint with 
C<:PathPart('edit')> and C<:Chained('foo')>. For the latter path give
the action just a C<:Args(1)> to mark it as endpoint. This sums up to
this debugging output:

  ...
  [debug] Loaded Path Part actions:
  .-----------------------+------------------------------.
  | Path Spec             | Private                      |
  +-----------------------+------------------------------+
  | /foo/*                | /controller/foo_view         |
  | /foo/*/edit           | /controller/foo_load (1)     |
  |                       | => /controller/edit          |
  '-----------------------+------------------------------'
  ...

Here's a more detailed specification of the attributes belonging to 
C<:Chained>:

=head2 Attributes

=over 8

=item PathPart

Sets the name of this part of the chain. If it is specified without
arguments, it takes the name of the action as default. So basically
C<sub foo :PathPart> and C<sub foo :PathPart('foo')> are identical.
This can also contain slashes to bind to a deeper level. An action
with C<sub bar :PathPart('foo/bar') :Chained('/')> would bind to
C</foo/bar/...>. If you don't specify C<:PathPart> it has the same
effect as using C<:PathPart>, it would default to the action name.

=item Chained

Has to be specified for every child in the chain. Possible values are
absolute and relative private action paths, with the relatives pointing
to the current controller, or a single slash C</> to tell Catalyst that
this is the root of a chain. The attribute C<:Chained> without aguments
also defaults to the C</> behaviour.

Due to the fact that you can specify an absolute path to the parent
action, it doesn't matter to Catalyst where that parent is located. So,
if your design requests it, you can redispatch a chain through every
controller or namespace you want.

Another interesting possibility gives C<:Chained('.')>, which chains
itself to an action with the path of the current controllers namespace.
For example:

  #   in MyApp::Controller::Foo
  sub bar : Chained CaptureArgs(1) { ... }

  #   in MyApp::Controller::Foo::Bar
  sub baz : Chained('.') Args(1) { ... }

This builds up a chain like C</bar/*/baz/*>. The specification of C<.>
as argument to Chained here chains the C<baz> action to an action with
the path of the current controller namespace, namely C</foo/bar>. That
action chains directly to C</>, so the above chain comes out as end
product.

=item CaptureArgs

Also has to be specified for every part of the chain that is not an
endpoint. With this attribute Catalyst knows how many of the following
parts of the path (separated by C</>) this action wants to captures as
it's arguments. If it doesn't expect any, just specify C<:CaptureArgs(0)>.
The captures get passed to the action's C<@_> right after the context,
but you can also find them as array reference in 
C<$c-E<gt>request-E<gt>captures-E<gt>[$level]>. The C<$level> is the
level of the action in the chain that captured the parts of the path.

An action that is part of a chain (read: that has a C<:Chained> attribute)
but has no C<:CaptureArgs> attribute is treated by Catalyst as a chain end.

=item Args

By default, endpoints receive the rest of the arguments in the path. You
can tell Catalyst through C<:Args> explicitly how many arguments your
endpoint expects, just like you can with C<:CaptureArgs>. Note that this
also influences if this chain is invoked on a request. A chain with an
endpoint specifying one argument will only match if exactly one argument
exists in the path.

You can specify an exact number of arguments like C<:Args(3)>, including
C<0>. If you just say C<:Args> without any arguments, it is the same as
leaving it out alltogether: The chain is matched independent of the number
of path parts after the endpoint.

Just like with C<:CaptureArgs>, the arguments get passed to the action in
C<@_> after the context object. They can also be reached through
C<$c-E<gt>request-E<gt>arguments>.

=back

=head2 auto actions, dispatching and forwarding

Note that the list of C<auto> actions called depends on the private path
of the endpoint of the chain, not on the chained actions way. The C<auto>
actions will be run before the chain dispatching begins. In every other
aspect, C<auto> actions behave as documented.

The C<forward>ing to other actions does just what you would expect. But if
you C<detach> out of a chain, the rest of the chain will not get called
after the C<detach> returned.

=head1 AUTHOR

Matt S Trout <mst@shadowcatsystems.co.uk>

=head1 COPYRIGHT

This program is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

1;
Commit	Line	Data
5882c86e	1	package Catalyst::DispatchType::Chained;
141459fa	2
	3	use strict;
	4	use base qw/Catalyst::DispatchType/;
	5	use Text::SimpleTable;
	6	use Catalyst::ActionChain;
	7	use URI;
	8
792b40ac	9	# please don't perltidy this. hairy code within.
792b40ac	10
141459fa	11	=head1 NAME
141459fa	12
5882c86e	13	Catalyst::DispatchType::Chained - Path Part DispatchType
141459fa	14
	15	=head1 SYNOPSIS
	16
05a90578	17	# root action - captures one argument after it
	18	sub foo_setup : Chained('/') PathPart('foo') CaptureArgs(1) {
	19	my ( $self, $c, $foo_arg ) = @_;
	20	...
	21	}
	22
	23	# child action endpoint - takes one argument
	24	sub bar : Chained('foo_setup') Args(1) {
	25	my ( $self, $c, $bar_arg ) = @_;
	26	...
	27	}
141459fa	28
	29	=head1 DESCRIPTION
	30
05a90578	31	See L</USAGE>.
05a90578	32
141459fa	33	=head1 METHODS
	34
	35	=head2 $self->list($c)
	36
	37	Debug output for Path Part dispatch points
	38
141459fa	39	=cut
141459fa	40
792b40ac	41	sub list {
	42	my ( $self, $c ) = @_;
	43
	44	return unless $self->{endpoints};
	45
	46	my $paths = Text::SimpleTable->new(
	47	[ 35, 'Path Spec' ], [ 36, 'Private' ]
	48	);
	49
	50	ENDPOINT: foreach my $endpoint (
	51	sort { $a->reverse cmp $b->reverse }
	52	@{ $self->{endpoints} }
	53	) {
	54	my $args = $endpoint->attributes->{Args}->[0];
	55	my @parts = (defined($args) ? (("*") x $args) : '...');
d34667c3	56	my @parents = ();
792b40ac	57	my $parent = "DUMMY";
	58	my $curr = $endpoint;
	59	while ($curr) {
1c34f703	60	if (my $cap = $curr->attributes->{CaptureArgs}) {
792b40ac	61	unshift(@parts, (("*") x $cap->[0]));
	62	}
	63	if (my $pp = $curr->attributes->{PartPath}) {
	64	unshift(@parts, $pp->[0])
	65	if (defined $pp->[0] && length $pp->[0]);
	66	}
5882c86e	67	$parent = $curr->attributes->{Chained}->[0];
792b40ac	68	$curr = $self->{actions}{$parent};
d34667c3	69	unshift(@parents, $curr) if $curr;
792b40ac	70	}
792b40ac	71	next ENDPOINT unless $parent eq '/'; # skip dangling action
d34667c3	72	my @rows;
	73	foreach my $p (@parents) {
	74	my $name = "/${p}";
1c34f703	75	if (my $cap = $p->attributes->{CaptureArgs}) {
d34667c3	76	$name .= ' ('.$cap->[0].')';
	77	}
	78	unless ($p eq $parents[0]) {
	79	$name = "-> ${name}";
	80	}
	81	push(@rows, [ '', $name ]);
	82	}
	83	push(@rows, [ '', (@rows ? "=> " : '')."/${endpoint}" ]);
	84	$rows[0][0] = join('/', '', @parts);
	85	$paths->row(@$_) for @rows;
792b40ac	86	}
	87
	88	$c->log->debug( "Loaded Path Part actions:\n" . $paths->draw );
	89	}
141459fa	90
	91	=head2 $self->match( $c, $path )
	92
05a90578	93	Calls C<recurse_match> to see if a chain matches the C<$path>.
141459fa	94
	95	=cut
	96
	97	sub match {
	98	my ( $self, $c, $path ) = @_;
	99
	100	return 0 if @{$c->req->args};
	101
	102	my @parts = split('/', $path);
	103
	104	my ($chain, $captures) = $self->recurse_match($c, '/', \@parts);
	105
	106	return 0 unless $chain;
	107
	108	my $action = Catalyst::ActionChain->from_chain($chain);
	109
	110	$c->req->action("/${action}");
	111	$c->req->match("/${action}");
	112	$c->req->captures($captures);
	113	$c->action($action);
	114	$c->namespace( $action->namespace );
	115
	116	return 1;
	117	}
	118
	119	=head2 $self->recurse_match( $c, $parent, \@path_parts )
	120
05a90578	121	Recursive search for a matching chain.
141459fa	122
	123	=cut
	124
	125	sub recurse_match {
	126	my ( $self, $c, $parent, $path_parts ) = @_;
	127	my $children = $self->{children_of}{$parent};
	128	return () unless $children;
	129	my @captures;
1b04b972	130	TRY: foreach my $try_part (sort { length($b) <=> length($a) }
cdc97b63	131	keys %$children) {
1b04b972	132	# $b then $a to try longest part first
141459fa	133	my @parts = @$path_parts;
	134	if (length $try_part) { # test and strip PathPart
	135	next TRY unless
	136	($try_part eq join('/', # assemble equal number of parts
	137	splice( # and strip them off @parts as well
792b40ac	138	@parts, 0, scalar(@{[split('/', $try_part)]})
792b40ac	139	))); # @{[]} to avoid split to @_
141459fa	140	}
	141	my @try_actions = @{$children->{$try_part}};
	142	TRY_ACTION: foreach my $action (@try_actions) {
1c34f703	143	if (my $capture_attr = $action->attributes->{CaptureArgs}) {
141459fa	144	my @captures;
141459fa	145	my @parts = @parts; # localise
7a7ac23c	146
1c34f703	147	# strip CaptureArgs into list
7a7ac23c	148	push(@captures, splice(@parts, 0, $capture_attr->[0]));
7a7ac23c	149
141459fa	150	# try the remaining parts against children of this action
	151	my ($actions, $captures) = $self->recurse_match(
	152	$c, '/'.$action->reverse, \@parts
	153	);
	154	if ($actions) {
	155	return [ $action, @$actions ], [ @captures, @$captures ];
	156	}
7a7ac23c	157	} else {
	158	{
	159	local $c->req->{arguments} = [ @{$c->req->args}, @parts ];
	160	next TRY_ACTION unless $action->match($c);
	161	}
	162	push(@{$c->req->args}, @parts);
	163	return [ $action ], [ ];
141459fa	164	}
	165	}
	166	}
	167	return ();
	168	}
	169
	170	=head2 $self->register( $c, $action )
	171
05a90578	172	Calls register_path for every Path attribute for the given $action.
141459fa	173
	174	=cut
	175
	176	sub register {
	177	my ( $self, $c, $action ) = @_;
	178
1dc8af44	179	my @chained_attr = @{ $action->attributes->{Chained} \|\| [] };
141459fa	180
1dc8af44	181	return 0 unless @chained_attr;
141459fa	182
1dc8af44	183	if (@chained_attr > 2) {
141459fa	184	Catalyst::Exception->throw(
5882c86e	185	"Multiple Chained attributes not supported registering ${action}"
141459fa	186	);
	187	}
	188
1dc8af44	189	my $parent = $chained_attr[0];
141459fa	190
141459fa	191	if (defined($parent) && length($parent)) {
1dc8af44	192	if ($parent eq '.') {
	193	$parent = '/'.$action->namespace;
	194	} elsif ($parent !~ m/^\//) {
141459fa	195	$parent = '/'.join('/', $action->namespace, $parent);
	196	}
	197	} else {
1dc8af44	198	$parent = '/'
141459fa	199	}
141459fa	200
5882c86e	201	$action->attributes->{Chained} = [ $parent ];
792b40ac	202
141459fa	203	my $children = ($self->{children_of}{$parent} \|\|= {});
	204
	205	my @path_part = @{ $action->attributes->{PathPart} \|\| [] };
	206
09461385	207	my $part = $action->name;
141459fa	208
09461385	209	if (@path_part == 1 && defined $path_part[0]) {
09461385	210	$part = $path_part[0];
141459fa	211	} elsif (@path_part > 1) {
	212	Catalyst::Exception->throw(
	213	"Multiple PathPart attributes not supported registering ${action}"
	214	);
	215	}
	216
8a6a6581	217	if ($part =~ m(^/)) {
	218	Catalyst::Exception->throw(
	219	"Absolute parameters to PathPart not allowed registering ${action}"
	220	);
	221	}
	222
792b40ac	223	$action->attributes->{PartPath} = [ $part ];
792b40ac	224
141459fa	225	unshift(@{ $children->{$part} \|\|= [] }, $action);
141459fa	226
792b40ac	227	($self->{actions} \|\|= {})->{'/'.$action->reverse} = $action;
792b40ac	228
1c34f703	229	unless ($action->attributes->{CaptureArgs}) {
792b40ac	230	unshift(@{ $self->{endpoints} \|\|= [] }, $action);
	231	}
	232
	233	return 1;
141459fa	234	}
	235
	236	=head2 $self->uri_for_action($action, $captures)
	237
05a90578	238	Get the URI part for the action, using C<$captures> to fill
05a90578	239	the capturing parts.
141459fa	240
	241	=cut
	242
	243	sub uri_for_action {
	244	my ( $self, $action, $captures ) = @_;
	245
5882c86e	246	return undef unless ($action->attributes->{Chained}
792b40ac	247	&& $action->attributes->{Args});
	248
	249	my @parts = ();
	250	my @captures = @$captures;
	251	my $parent = "DUMMY";
	252	my $curr = $action;
	253	while ($curr) {
1c34f703	254	if (my $cap = $curr->attributes->{CaptureArgs}) {
792b40ac	255	return undef unless @captures >= $cap->[0]; # not enough captures
	256	unshift(@parts, splice(@captures, -$cap->[0]));
	257	}
	258	if (my $pp = $curr->attributes->{PartPath}) {
	259	unshift(@parts, $pp->[0])
	260	if (defined $pp->[0] && length $pp->[0]);
	261	}
5882c86e	262	$parent = $curr->attributes->{Chained}->[0];
792b40ac	263	$curr = $self->{actions}{$parent};
141459fa	264	}
792b40ac	265
	266	return undef unless $parent eq '/'; # fail for dangling action
	267
	268	return undef if @captures; # fail for too many captures
	269
	270	return join('/', '', @parts);
	271
141459fa	272	}
141459fa	273
05a90578	274	=head1 USAGE
	275
	276	=head2 Introduction
	277
	278	The C<Chained> attribute allows you to chain public path parts together
	279	by their private names. A chain part's path can be specified with C<PathPart>
	280	and can be declared to expect an arbitrary number of arguments. The endpoint
	281	of the chain specifies how many arguments it gets through the C<Args>
	282	attribute. C<:Args(0)> would be none at all, C<:Args> without an integer
	283	would be unlimited. The path parts that aren't endpoints are using
	284	C<CaptureArgs> to specify how many parameters they expect to receive. As an
	285	example setup:
	286
	287	package MyApp::Controller::Greeting;
	288	use base qw/ Catalyst::Controller /;
	289
	290	# this is the beginning of our chain
	291	sub hello : PathPart('hello') Chained('/') CaptureArgs(1) {
	292	my ( $self, $c, $integer ) = @_;
	293	$c->stash->{ message } = "Hello ";
	294	$c->stash->{ arg_sum } = $integer;
	295	}
	296
	297	# this is our endpoint, because it has no :CaptureArgs
	298	sub world : PathPart('world') Chained('hello') Args(1) {
	299	my ( $self, $c, $integer ) = @_;
	300	$c->stash->{ message } .= "World!";
	301	$c->stash->{ arg_sum } += $integer;
	302
	303	$c->response->body( join "<br/>\n" =>
	304	$c->stash->{ message }, $c->stash->{ arg_sum } );
	305	}
	306
	307	The debug output provides a separate table for chained actions, showing
	308	the whole chain as it would match and the actions it contains. Here's
	309	an example of the startup output with our actions above:
	310
	311	...
	312	[debug] Loaded Path Part actions:
	313	.-----------------------+------------------------------.
	314	\| Path Spec \| Private \|
	315	+-----------------------+------------------------------+
	316	\| /hello//world/ \| /greeting/hello (1) \|
	317	\| \| => /greeting/world \|
	318	'-----------------------+------------------------------'
	319	...
	320
	321	As you can see, Catalyst only deals with chains as whole path and
	322	builds one for each endpoint, which are the actions with C<:Chained>
	323	but without C<:CaptureArgs>.
	324
	325	Let's assume this application gets a request at the path
	326	C</hello/23/world/12>, what happens then? First, Catalyst will dispatch
	327	to the C<hello> action and pass the value C<23> as argument to it after
	328	the context. It does so because we have previously used C<:CaptureArgs(1)>
	329	to declare that it has one path part after itself as it's argument. We
	330	told Catalyst that this is the beginning of the chain by specifying
	331	C<:Chained('/')>. Also note that instead of saying C<:PathPart('hello')>
	332	we could also just have said C<:PathPart>, as it defaults to the name of
	333	the action.
	334
	335	After C<hello> has run, Catalyst goes on to dispatch to the C<world>
	336	action. This is the last action to be called, as Catalyst knows this
	337	is an endpoint because we specified no C<:CaptureArgs> attribute. Nevertheless
338	we specify that this action expects an argument, but at this point we're
339	using C<:Args(1)> to do that. We could also have said C<:Args> or leave
340	it out alltogether, which would mean this action gets all arguments that
341	are there. This action's C<:Chained> attribute says C<hello> and tells
342	Catalyst that the C<hello> action in the current controller is it's
343	parent.
344
345	With this we have built a chain consisting of two public path parts.
346	C<hello> captures one part of the path as it's argument, and also specifies
347	the path root as it's parent. So this part is C</hello/$arg>. The next part
348	is the endpoint C<world>, expecting one argument. It sums up to the path
349	part C<world/$arg>. This leads to a complete chain of
350	C</hello/$arg/world/$arg> which is matched against the requested paths.
351
352	This example application would, if run and called by e.g.
353	C</hello/23/world/12>, set the stash value C<message> to C<Hello > and
354	the value C<arg_sum> to C<23>. The C<world> action would then append
355	C<World!> to C<message> and add C<12> to the stash's C<arg_sum> value.
356	For the sake of simplicity no view is shown. Instead we just put the
357	values of the stash into our body. So the output would look like:
358
359	Hello World!
360	35
361
362	And our test server would've given us this debugging output for the
363	request:
364
365	...
366	[debug] "GET" request for "hello/23/world/12" from "127.0.0.1"
367	[debug] Path is "/greeting/world"
368	[debug] Arguments are "12"
369	[info] Request took 0.164113s (6.093/s)
370	.------------------------------------------+-----------.
371	\| Action \| Time \|
372	+------------------------------------------+-----------+
373	\| /greeting/hello \| 0.000029s \|
374	\| /greeting/world \| 0.000024s \|
375	'------------------------------------------+-----------'
376	...
377
378	What would be common usecases of this dispatching technique? It gives the
379	possibility to split up logic that contains steps that each depend on each
380	other. An example would be, for example, a wiki path like
381	C</wiki/FooBarPage/rev/23/view>. This chain can be easily built with
382	these actions:
383
384	sub wiki : PathPart('wiki') Chained('/') CaptureArgs(1) {
385	my ( $self, $c, $page_name ) = @_;
386	# load the page named $page_name and put the object
387	# into the stash
388	}
389
390	sub rev : PathPart('rev') Chained('wiki') CaptureArgs(1) {
391	my ( $self, $c, $revision_id ) = @_;
392	# use the page object in the stash to get at it's
393	# revision with number $revision_id
394	}
395
396	sub view : PathPart Chained('rev') Args(0) {
397	my ( $self, $c ) = @_;
398	# display the revision in our stash. An other option
399	# would be to forward a compatible object to the action
400	# that displays the default wiki pages, unless we want
401	# a different interface here, for example restore
402	# functionality.
403	}
404
405	It would now be possible to add other endpoints. For example C<restore> to
406	restore this specific revision as current state.
407
408	Also, you of course don't have to put all the chained actions in one
409	controller. The specification of the parent through C<:Chained> also takes
410	an absolute action path as it's argument. Just specify it with a leading
411	C</>.
412
413	If you want, for example, to have actions for the public paths
414	C</foo/12/edit> and C</foo/12>, just specify two actions with
415	C<:PathPart('foo')> and C<:Chained('/')>. The handler for the former
416	path needs a C<:CaptureArgs(1)> attribute and a endpoint with
417	C<:PathPart('edit')> and C<:Chained('foo')>. For the latter path give
418	the action just a C<:Args(1)> to mark it as endpoint. This sums up to
419	this debugging output:
420
421	...
422	[debug] Loaded Path Part actions:
423	.-----------------------+------------------------------.
424	\| Path Spec \| Private \|
425	+-----------------------+------------------------------+
426	\| /foo/* \| /controller/foo_view \|
427	\| /foo/*/edit \| /controller/foo_load (1) \|
428	\| \| => /controller/edit \|
429	'-----------------------+------------------------------'
430	...
431
432	Here's a more detailed specification of the attributes belonging to
433	C<:Chained>:
434
435	=head2 Attributes
436
437	=over 8
438
439	=item PathPart
440
441	Sets the name of this part of the chain. If it is specified without
442	arguments, it takes the name of the action as default. So basically
443	C<sub foo :PathPart> and C<sub foo :PathPart('foo')> are identical.
444	This can also contain slashes to bind to a deeper level. An action
445	with C<sub bar :PathPart('foo/bar') :Chained('/')> would bind to
446	C</foo/bar/...>. If you don't specify C<:PathPart> it has the same
447	effect as using C<:PathPart>, it would default to the action name.
448
449	=item Chained
450
451	Has to be specified for every child in the chain. Possible values are
452	absolute and relative private action paths, with the relatives pointing
453	to the current controller, or a single slash C</> to tell Catalyst that
454	this is the root of a chain. The attribute C<:Chained> without aguments
455	also defaults to the C</> behaviour.
456
457	Due to the fact that you can specify an absolute path to the parent
458	action, it doesn't matter to Catalyst where that parent is located. So,
459	if your design requests it, you can redispatch a chain through every
460	controller or namespace you want.
461
462	Another interesting possibility gives C<:Chained('.')>, which chains
463	itself to an action with the path of the current controllers namespace.
464	For example:
465
466	# in MyApp::Controller::Foo
467	sub bar : Chained CaptureArgs(1) { ... }
468
469	# in MyApp::Controller::Foo::Bar
470	sub baz : Chained('.') Args(1) { ... }
471
472	This builds up a chain like C</bar//baz/>. The specification of C<.>
473	as argument to Chained here chains the C<baz> action to an action with
474	the path of the current controller namespace, namely C</foo/bar>. That
475	action chains directly to C</>, so the above chain comes out as end
476	product.
477
478	=item CaptureArgs
479
480	Also has to be specified for every part of the chain that is not an
481	endpoint. With this attribute Catalyst knows how many of the following
482	parts of the path (separated by C</>) this action wants to captures as
483	it's arguments. If it doesn't expect any, just specify C<:CaptureArgs(0)>.
484	The captures get passed to the action's C<@_> right after the context,
485	but you can also find them as array reference in
486	C<$c-E<gt>request-E<gt>captures-E<gt>[$level]>. The C<$level> is the
487	level of the action in the chain that captured the parts of the path.
488
489	An action that is part of a chain (read: that has a C<:Chained> attribute)
490	but has no C<:CaptureArgs> attribute is treated by Catalyst as a chain end.
491
492	=item Args
493
494	By default, endpoints receive the rest of the arguments in the path. You
495	can tell Catalyst through C<:Args> explicitly how many arguments your
496	endpoint expects, just like you can with C<:CaptureArgs>. Note that this
497	also influences if this chain is invoked on a request. A chain with an
498	endpoint specifying one argument will only match if exactly one argument
499	exists in the path.
500
501	You can specify an exact number of arguments like C<:Args(3)>, including
502	C<0>. If you just say C<:Args> without any arguments, it is the same as
503	leaving it out alltogether: The chain is matched independent of the number
504	of path parts after the endpoint.
505
506	Just like with C<:CaptureArgs>, the arguments get passed to the action in
507	C<@_> after the context object. They can also be reached through
508	C<$c-E<gt>request-E<gt>arguments>.
509
510	=back
511
512	=head2 auto actions, dispatching and forwarding
513
514	Note that the list of C<auto> actions called depends on the private path
515	of the endpoint of the chain, not on the chained actions way. The C<auto>
516	actions will be run before the chain dispatching begins. In every other
517	aspect, C<auto> actions behave as documented.
518
519	The C<forward>ing to other actions does just what you would expect. But if
520	you C<detach> out of a chain, the rest of the chain will not get called
521	after the C<detach> returned.
522
141459fa	523	=head1 AUTHOR
141459fa	524
792b40ac	525	Matt S Trout <mst@shadowcatsystems.co.uk>
141459fa	526
	527	=head1 COPYRIGHT
	528
	529	This program is free software, you can redistribute it and/or modify it under
	530	the same terms as Perl itself.
	531
	532	=cut
	533
	534	1;