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
|
|
110
|
use strict; |
|
18
|
|
|
|
|
35
|
|
|
18
|
|
|
|
|
1358
|
|
9
|
18
|
|
|
18
|
|
191
|
use warnings; |
|
18
|
|
|
|
|
34
|
|
|
18
|
|
|
|
|
579
|
|
10
|
|
|
|
|
|
|
|
11
|
18
|
|
|
18
|
|
95
|
use Carp; |
|
18
|
|
|
|
|
31
|
|
|
18
|
|
|
|
|
4194
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
our $VERSION = '0.18'; |
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
|
1469
|
my $class = shift; |
45
|
158
|
50
|
|
|
|
852
|
$class->can( "again" ) or croak "Expected to be class that can ->again"; |
46
|
158
|
|
|
|
|
522
|
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
|
635
|
my $self = shift; |
54
|
103
|
|
|
|
|
318
|
$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; |