File Coverage

blib/lib/CPS/Governor/Deferred.pm
Criterion Covered Total %
statement 33 33 100.0
branch 2 2 100.0
condition 8 8 100.0
subroutine 9 9 100.0
pod 6 6 100.0
total 58 58 100.0


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2009 -- leonerd@leonerd.org.uk
5              
6             package CPS::Governor::Deferred;
7              
8 2     2   58366 use strict;
  2         11  
  2         48  
9 2     2   8 use warnings;
  2         2  
  2         80  
10              
11 2     2   10 use base qw( CPS::Governor );
  2         2  
  2         735  
12              
13             our $VERSION = '0.19';
14              
15             =head1 NAME
16              
17             C - iterate at some later point
18              
19             =head1 SYNOPSIS
20              
21             use CPS qw( gkforeach );
22             use CPS::Governor::Deferred;
23              
24             my $gov = CPS::Governor::Deferred->new;
25              
26             gkforeach( $gov, [ 1 .. 10 ],
27             sub {
28             my ( $item, $knext ) = @_;
29              
30             print "A$item ";
31             goto &$knext;
32             },
33             sub {},
34             );
35              
36             gkforeach( $gov, [ 1 .. 10 ],
37             sub {
38             my ( $item, $knext ) = @_;
39              
40             print "B$item ";
41             goto &$knext;
42             },
43             sub {},
44             );
45              
46             $gov->flush;
47              
48             =head1 DESCRIPTION
49              
50             This L allows the functions using it to delay their iteration
51             until some later point when the containing program invokes it. This allows two
52             main advantages:
53              
54             =over 4
55              
56             =item *
57              
58             CPU-intensive operations may be split apart and mixed with other IO operations
59              
60             =item *
61              
62             Multiple control functions may be executed in pseudo-parallel, interleaving
63             iterations of each giving a kind of concurrency
64              
65             =back
66              
67             These are achieved by having the governor store a list of code references that
68             need to be invoked, rather than invoking them immediately. These references
69             can then be invoked later, perhaps by using an idle watcher in an event
70             framework.
71              
72             Because each code reference hasn't yet been invoked by the time the C
73             method is called, the original caller is free to store more pending references
74             with the governor. This allows multiple control functions to be interleaved,
75             as in the C and C example above.
76              
77             =cut
78              
79             =head1 CONSTRUCTOR
80              
81             =cut
82              
83             =head2 $gov = CPS::Governor::Deferred->new( %args )
84              
85             Returns a new instance of a C object. Requires no
86             parameters but may take any of the following to adjust its default behaviour:
87              
88             =over 8
89              
90             =item defer_after => INT
91              
92             If given some positive number, C<$n> then the first C<$n-1> invocations of the
93             C method will in fact be executed immediately. Thereafter they will be
94             enqueued in the normal mechanism. This gives the effect that longrunning loops
95             will be executed in batches of C<$n>.
96              
97             If not supplied then every invocation of C will use the queueing
98             mechanism.
99              
100             =back
101              
102             =cut
103              
104             sub new
105             {
106 2     2 1 73 my $class = shift;
107 2         4 my %args = @_;
108              
109 2         10 my $self = $class->SUPER::new( %args );
110              
111 2   100     10 $self->{defer_after} = $args{defer_after} || 0;
112              
113 2         10 return $self;
114             }
115              
116             sub again
117             {
118 11     11 1 43 my $self = shift;
119              
120 11 100 100     30 if( $self->{defer_after} and ++$self->{count} < $self->{defer_after} ) {
121 4         4 my $code = shift;
122             # args still in @_
123              
124 4         12 goto &$code;
125             }
126              
127 7         11 $self->later( @_ );
128             }
129              
130             sub later
131             {
132 7     7 1 28 my $self = shift;
133              
134 7         9 push @{ $self->{queue} }, [ @_ ];
  7         22  
135             }
136              
137             =head1 METHODS
138              
139             =cut
140              
141             =head2 $pending = $gov->is_pending
142              
143             Returns true if at least one code reference has been stored that hasn't yet
144             been invoked.
145              
146             =cut
147              
148             sub is_pending
149             {
150 9     9 1 719 my $self = shift;
151              
152 9   100     27 return $self->{queue} && @{ $self->{queue} } > 0;
153             }
154              
155             =head2 $gov->prod
156              
157             Invokes all of the currently-stored code references, in the order they were
158             stored. If any new references are stored by these, they will not yet be
159             invoked, but will be available for the next time this method is called.
160              
161             =cut
162              
163             sub prod
164             {
165 6     6 1 458 my $self = shift;
166              
167 6         9 $self->{count} = 0;
168              
169 6         7 my $queue = $self->{queue};
170 6         9 $self->{queue} = [];
171              
172 6         8 foreach my $item ( @$queue ) {
173 6         9 my ( $code, @args ) = @$item;
174 6         11 $code->( @args );
175             }
176             }
177              
178             =head2 $gov->flush
179              
180             Repeatedly calls C until no more code references are pending.
181              
182             =cut
183              
184             sub flush
185             {
186 1     1 1 2 my $self = shift;
187              
188 1         3 $self->prod while $self->is_pending;
189             }
190              
191             =head1 SUBCLASS METHODS
192              
193             The following methods are used internally to implement the functionality,
194             which may be useful to implementors of subclasses.
195              
196             =cut
197              
198             =head2 $gov->later( $code, @args )
199              
200             Used to enqueue the C<$code> ref to be invoked later with the given C<@args>,
201             once it is determined this should be deferred (rather than being invoked
202             immediately in the case of the first few invocations when C is
203             set).
204              
205             =cut
206              
207             =head1 AUTHOR
208              
209             Paul Evans
210              
211             =cut
212              
213             0x55AA;