lib/Catalyst/ActionChain.pm

   1 package Catalyst::ActionChain;
   2
   3 use strict;
   4 use base qw/Catalyst::Action/;
   5
   6 __PACKAGE__->mk_accessors(qw/chain/);
   7
   8 use overload (
   9
  10     # Stringify to reverse for debug output etc.
  11     q{""} => sub { shift->{reverse} },
  12
  13     # Codulate to execute to invoke the encapsulated action coderef
  14     '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; },
  15
  16     # Make general $stuff still work
  17     fallback => 1,
  18
  19 );
  20
  21 =head1 NAME
  22
  23 Catalyst::ActionChain - Chain of Catalyst Actions
  24
  25 =head1 SYNOPSIS
  26
  27 See L<Catalyst>.
  28
  29 =head1 DESCRIPTION
  30
  31 This class represents a chain of Catalyst Actions. It behaves exactly like
  32 the action at the *end* of the chain except on dispatch it will execute all
  33 the actions in the chain in order.
  34
  35 =head1 METHODS
  36
  37 =head2 chain
  38
  39 Accessor for the action chain; will be an arrayref of the Catalyst::Action
  40 objects encapsulated by this chain.
  41
  42 =head2 dispatch( $c )
  43
  44 Dispatch this action chain against a context; will dispatch the encapsulated
  45 actions in order.
  46
  47 =cut
  48
  49 sub dispatch {
  50     my ( $self, $c ) = @_;
  51     my @captures = @{$c->req->captures||[]};
  52     my @chain = @{ $self->chain };
  53     my $last = pop(@chain);
  54     foreach my $action ( @chain ) {
  55         my @args;
  56         if (my $cap = $action->attributes->{CaptureArgs}) {
  57           @args = splice(@captures, 0, $cap->[0]);
  58         }
  59         local $c->request->{arguments} = \@args;
  60         $action->dispatch( $c );
  61     }
  62     $last->dispatch( $c );
  63 }
  64
  65 =head2 from_chain( \@actions )
  66
  67 Takes a list of Catalyst::Action objects and constructs and returns a
  68 Catalyst::ActionChain object representing a chain of these actions
  69
  70 =cut
  71
  72 sub from_chain {
  73     my ( $self, $actions ) = @_;
  74     my $final = $actions->[-1];
  75     return $self->new({ %$final, chain => $actions });
  76 }
  77
  78 =head1 AUTHOR
  79
  80 Matt S. Trout
  81
  82 =head1 COPYRIGHT
  83
  84 This program is free software, you can redistribute it and/or modify it under
  85 the same terms as Perl itself.
  86
  87 =cut
  88
  89 1;