File Coverage

blib/lib/Catalyst/Plugin/Continuation.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package Catalyst::Plugin::Continuation;
2              
3 1     1   30590 use strict;
  1         2  
  1         40  
4 1     1   5 use warnings;
  1         2  
  1         31  
5              
6 1     1   578 use Catalyst::Continuation;
  0            
  0            
7             use NEXT;
8              
9             use base qw/Class::Accessor/;
10              
11             __PACKAGE__->mk_accessors(qw/continuation/);
12              
13             our $VERSION = '0.01';
14              
15             *continue = \&cont;
16              
17             =head1 NAME
18              
19             Catalyst::Plugin::Continuation - Catalyst Continuation Plugin
20              
21             =head1 SYNOPSIS
22              
23             # Make sure to load session plugins too!
24             package MyApp;
25             use Catalyst qw/Session Session::Store::File
26             Session::State::Cookie Continuation/;
27              
28             # Create a controller
29             package MyApp::Controller::Test;
30             use base 'Catalyst::Controller';
31              
32             # Add a action with attached action class
33             sub counter : Global {
34             my ( $self, $c ) = @_;
35             my $up = $c->continue('up');
36             my $down = $c->continue('down');
37             my $counter = $c->stash->{counter} || 0;
38             $c->res->body(<<"EOF");
39             Counter: $counter<br/>
40             <a href="$up">++</a>
41             <a href="$down">--</a>
42             EOF
43             }
44              
45             # Add private actions for continuations
46             sub up : Private { $_[1]->stash->{counter}++ }
47             sub down : Private { $_[1]->stash->{counter}-- }
48              
49             =head1 DESCRIPTION
50              
51             Catalyst Continuation Plugin.
52              
53             =head1 OVERLOADED METHODS
54              
55             =head2 prepare_action
56              
57             =head2 dispatch
58              
59             These methods are overridden to allow the special continuation dispatch.
60              
61             =head1 METHODS
62              
63             =head2 continuation
64              
65             Contains the continuation object that was restored.
66              
67             =head2 set_continuation $id, $structure
68              
69             =head2 get_continuation $id
70              
71             =head2 delete_continuation $id
72              
73             =head2 active_continuations
74              
75             =head2 clear_continuations
76              
77             =head2 generate_continuation_id
78              
79             These are internal methods which you can override.
80              
81             They default to storing inside C<< $c->session >>, and using
82             L<Catalyst::Plugin::Session/generate_session_id>.
83              
84             If you want your continuations to be garbage collected in some way you need to
85             override this to store the data in some other backend.
86              
87             Note that C<active_continuations> returns a hash reference which you can edit.
88             Be careful.
89              
90             =cut
91              
92             sub get_continuation {
93             my ( $c, $id ) = @_;
94             $c->session->{_continuations}{$id};
95             }
96              
97             sub set_continuation {
98             my ( $c, $id, $value ) = @_;
99             $c->session->{_continuations}{$id} = $value;
100             }
101              
102             sub delete_continuation {
103             my ( $c, $id ) = @_;
104             delete $c->session->{_continuations}{$id};
105             }
106              
107             sub active_continuations {
108             my $c = shift;
109             return $c->session->{_continuations};
110             }
111              
112             sub clear_continuations {
113             my $c = shift;
114             %{ $c->session->{_continuations} } = ();
115             }
116              
117             sub generate_continuation_id {
118             my $c = shift;
119             $c->generate_session_id;
120             }
121              
122             sub prepare_action {
123             my $c = shift;
124             if ( $c->req->path eq "" and my $k = $c->req->params->{_k} ) {
125             $c->log->debug(qq/Found continuation "$k"/) if $c->debug;
126             if ( my $cont = $c->cont_class->new_from_store( $c, $k ) ) {
127             $c->log->debug(qq/Restored continuation "$k"/) if $c->debug;
128             $c->continuation($cont);
129             } else {
130             $c->continuation_expired($k);
131             }
132             } else {
133             $c->NEXT::prepare_action(@_);
134             }
135             }
136              
137             sub dispatch {
138             my $c = shift;
139              
140             if ( my $cont = $c->continuation ) {
141             return $cont->execute;
142             } else {
143             return $c->NEXT::dispatch(@_);
144             }
145             }
146              
147             =head2 $c->continuation_expired( $id )
148              
149             This handler is called when the continuation with the ID $id tried to get
150             invoked but did not exist
151              
152             =cut
153              
154             sub continuation_expired {
155             my ( $c, $k ) = @_;
156             die "The continuation has expired";
157             }
158              
159             =head2 $c->resume_continuation( $cont_or_id );
160              
161             Resume a continuation based on an ID or an object.
162              
163             This is a convenience method intended on saving you the need to load and
164             execute the continuation yourself.
165              
166             =cut
167              
168             sub resume_continuation {
169             my ( $c, $id_or_cont, @args ) = @_;
170              
171             (
172             Scalar::Util::blessed($id_or_cont)
173             ? $id_or_cont
174             : $c->cont_class->new_from_store( $c, $id_or_cont )
175             || $c->continuation_expired($id_or_cont)
176             )->execute(@args);
177             }
178              
179             =head2 $c->continue($method)
180              
181             =head2 $c->cont($method)
182              
183             Returns the L<Catalyst::Continuation> object for given method.
184              
185             Takes the same arguments as L<Catalyst/forward> and it's relatives.
186              
187             =cut
188              
189             sub cont {
190             my ( $c, @args ) = @_;
191             $c->cont_class->new( c => $c, forward => \@args );
192             }
193              
194             =head2 $c->caller_continuation
195              
196             A pseudo-cc - a continuation to your caller.
197              
198             Note that this does B<NOT> honor the call stack in any way - it is B<ONLY> to
199             reinvoke the immediate caller. See the NeedsLogin test controller in the test
200             suite for an example of how to use this effectively.
201              
202             =cut
203              
204             sub caller_continuation {
205             my $c = shift;
206             my $caller = $c->stack->[-2] or die "No caller";
207              
208             $c->cont_class->new(
209             c => $c,
210             forward => [ "/" . $caller->reverse ],
211             forward_to_caller => 0,
212             );
213             }
214              
215             =head2 $c->cont_class
216              
217             Returns the string C<Catalyst::Continuation> by default. You may override this
218             to replace the continuation class.
219              
220             =cut
221              
222             sub cont_class { "Catalyst::Continuation" }
223              
224             sub _uri_to_cont {
225             my ( $c, $cont ) = @_;
226             $c->uri_for( "/", { _k => $cont->id } );
227             }
228              
229             =head1 CAVEATS
230              
231             Continuations take up space, and are by default stored in the session.
232              
233             When invoked a session will delete itself by default, but anything else will
234             leak, until the session expires.
235              
236             If this is a concern for you, override the C<get_continuation> family of
237             functions to have a better scheme for storage.
238              
239             Some approaches you could implement, depending on how you use continuations:
240              
241             =over 4
242              
243             =item size limiting
244              
245             Store up to $x continuations, and toss out old ones once this starts to
246             overflow. This is essentially an LRU policy.
247              
248             =item continuation grouping
249              
250             Group all the continuations saved in a single request together. When one of
251             them is deleted, all the rest go with it.
252              
253             =item use the fine grained session expiry feature
254              
255             L<Catalyst::Plugin::Session> allows you to expire some session keys before the
256             entire session expired. You can associate each session with it's own unique
257             key, and avoid extending the continuation's time-to-live.
258              
259             =back
260              
261             If you override all these functions then you don't need the
262             L<Catalyst::Plugin::Session> dependency.
263              
264             =head1 SEE ALSO
265              
266             L<Catalyst>, Seaside (http://www.seaside.st/), L<Jifty>, L<Coro::Cont>, psychiatrist(1).
267              
268             =head1 AUTHOR
269              
270             Sebastian Riedel, C<sri@oook.de>
271             Yuval Kogman, C<nothingmuch@woobling.org>
272              
273             =head1 LICENSE
274              
275             This library is free software, you can redistribute it and/or modify it under
276             the same terms as Perl itself.
277              
278             =cut
279              
280             1;