lib/Catalyst/ActionChain.pm

   1 package Catalyst::ActionChain;
   2
   3 use Moose;
   4 extends qw(Catalyst::Action);
   5
   6 has chain => (is => 'rw');
   7 no Moose;
   8
   9 =head1 NAME
  10
  11 Catalyst::ActionChain - Chain of Catalyst Actions
  12
  13 =head1 SYNOPSIS
  14
  15 See L<Catalyst::Manual::Intro> for more info about Chained actions.
  16
  17 =head1 DESCRIPTION
  18
  19 This class represents a chain of Catalyst Actions. It behaves exactly like
  20 the action at the *end* of the chain except on dispatch it will execute all
  21 the actions in the chain in order.
  22
  23 =cut
  24
  25 sub dispatch {
  26     my ( $self, $c ) = @_;
  27     my @captures = @{$c->req->captures||[]};
  28     my @chain = @{ $self->chain };
  29     my $last = pop(@chain);
  30     foreach my $action ( @chain ) {
  31         my @args;
  32         if (my $cap = $action->number_of_captures) {
  33           @args = splice(@captures, 0, $cap);
  34         }
  35         local $c->request->{arguments} = \@args;
  36         $action->dispatch( $c );
  37
  38         # break the chain if exception occurs in the middle of chain.  We
  39         # check the global config flag 'abort_chain_on_error_fix', but this
  40         # is now considered true by default, so unless someone explicitly sets
  41         # it to false we default it to true (if its not defined).
  42         my $abort = defined($c->config->{abort_chain_on_error_fix}) ?
  43           $c->config->{abort_chain_on_error_fix} : 1;
  44         return if ($c->has_errors && $abort);
  45     }
  46     $last->dispatch( $c );
  47 }
  48
  49 sub from_chain {
  50     my ( $self, $actions ) = @_;
  51     my $final = $actions->[-1];
  52     return $self->new({ %$final, chain => $actions });
  53 }
  54
  55 sub number_of_captures {
  56     my ( $self ) = @_;
  57     my $chain = $self->chain;
  58     my $captures = 0;
  59
  60     $captures += $_->number_of_captures for @$chain;
  61     return $captures;
  62 }
  63
  64 sub match_captures {
  65   my ($self, $c, $captures) = @_;
  66   my @captures = @{$captures||[]};
  67
  68   foreach my $link(@{$self->chain}) {
  69     my @local_captures = splice @captures,0,$link->number_of_captures;
  70     return unless $link->match_captures($c, \@local_captures);
  71   }
  72   return 1;
  73 }
  74
  75 # the scheme defined at the end of the chain is the one we use
  76 # but warn if too many.
  77
  78 sub scheme {
  79   my $self = shift;
  80   my @chain = @{ $self->chain };
  81   my ($scheme, @more) = map {
  82     exists $_->attributes->{Scheme} ? $_->attributes->{Scheme}[0] : ();
  83   } reverse @chain;
  84
  85   warn "$self is a chain with two many Scheme attributes (only one is allowed)"
  86     if @more;
  87
  88   return $scheme;
  89 }
  90
  91 __PACKAGE__->meta->make_immutable;
  92 1;
  93
  94 __END__
  95
  96 =head1 METHODS
  97
  98 =head2 chain
  99
 100 Accessor for the action chain; will be an arrayref of the Catalyst::Action
 101 objects encapsulated by this chain.
 102
 103 =head2 dispatch( $c )
 104
 105 Dispatch this action chain against a context; will dispatch the encapsulated
 106 actions in order.
 107
 108 =head2 from_chain( \@actions )
 109
 110 Takes a list of Catalyst::Action objects and constructs and returns a
 111 Catalyst::ActionChain object representing a chain of these actions
 112
 113 =head2 number_of_captures
 114
 115 Returns the total number of captures for the entire chain of actions.
 116
 117 =head2 match_captures
 118
 119 Match all the captures that this chain encloses, if any.
 120
 121 =head2 scheme
 122
 123 Any defined scheme for the actionchain
 124
 125 =head2 meta
 126
 127 Provided by Moose
 128
 129 =head1 AUTHORS
 130
 131 Catalyst Contributors, see Catalyst.pm
 132
 133 =head1 COPYRIGHT
 134
 135 This library is free software. You can redistribute it and/or modify it under
 136 the same terms as Perl itself.
 137
 138 =cut