File Coverage

blib/lib/CPS/Governor.pm
Criterion Covered Total %
statement 14 14 100.0
branch 1 2 50.0
condition n/a
subroutine 5 5 100.0
pod 1 2 50.0
total 21 23 91.3


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-2012 -- leonerd@leonerd.org.uk
5              
6             package CPS::Governor;
7              
8 18     18   119 use strict;
  18         24  
  18         407  
9 18     18   85 use warnings;
  18         25  
  18         354  
10              
11 18     18   67 use Carp;
  18         27  
  18         2552  
12              
13             our $VERSION = '0.19';
14              
15             =head1 NAME
16              
17             C - control the iteration of the C functions
18              
19             =head1 DESCRIPTION
20              
21             Objects based on this abstract class are used by the C variants of the
22             L functions, to control their behavior. These objects are expected to
23             provide a method, C, which the functions will use to re-invoke
24             iterations of loops, and so on. By providing a different implementation of
25             this method, governor objects can provide such behaviours as rate-limiting,
26             asynchronisation or parallelism, and integration with event-based IO
27             frameworks.
28              
29             =cut
30              
31             =head1 CONSTRUCTOR
32              
33             =cut
34              
35             =head2 $gov = CPS::Governor->new
36              
37             Must be called on a subclass which implements the C method. Returns a
38             new instance of a governor object in that class.
39              
40             =cut
41              
42             sub new
43             {
44 158     158 1 1153 my $class = shift;
45 158 50       508 $class->can( "again" ) or croak "Expected to be class that can ->again";
46 158         311 return bless {}, $class;
47             }
48              
49             # We're using this internally in gkpar() but not documenting it currently.
50             # Details are still experimental.
51             sub enter
52             {
53 103     103 0 581 my $self = shift;
54 103         204 $self->again( @_ );
55             }
56              
57             =head1 SUBCLASS METHODS
58              
59             Because this is an abstract class, instances of it can only be constructed on
60             a subclass which implements the following methods:
61              
62             =cut
63              
64             =head2 $gov->again( $code, @args )
65              
66             Execute the function given in the C reference C<$code>, passing in the
67             arguments C<@args>. If this is going to be executed immediately, it should
68             be invoked using a tail-call directly by the C method, so that the
69             stack does not grow arbitrarily. This can be achieved by, for example:
70              
71             @_ = @args;
72             goto &$code;
73              
74             Alternatively, the L may be used to apply syntactic sugar,
75             allowing you to write instead:
76              
77             use Sub::Call::Tail;
78             ...
79             tail $code->( @args );
80              
81             =cut
82              
83             =head1 EXAMPLES
84              
85             =head2 A Governor With A Time Delay
86              
87             Consider the following subclass, which implements a C subclass
88             that calls C between every invocation.
89              
90             package Governor::Sleep
91              
92             use base qw( CPS::Governor );
93              
94             sub new
95             {
96             my $class = shift;
97             my ( $delay ) = @_;
98              
99             my $self = $class->SUPER::new;
100             $self->{delay} = $delay;
101              
102             return $self;
103             }
104              
105             sub again
106             {
107             my $self = shift;
108             my $code = shift;
109              
110             sleep $self->{delay};
111              
112             # @args are still in @_
113             goto &$code;
114             }
115              
116             =cut
117              
118             =head1 SEE ALSO
119              
120             =over 4
121              
122             =item *
123              
124             L - Tail calls for subroutines and methods
125              
126             =back
127              
128             =head1 AUTHOR
129              
130             Paul Evans
131              
132             =cut
133              
134             0x55AA;