| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
package Contize; |
|
3
|
1
|
|
|
1
|
|
24229
|
use strict; |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
33
|
|
|
4
|
1
|
|
|
1
|
|
6
|
use Carp; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
484
|
|
|
5
|
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.3'; |
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $AUTOLOAD; |
|
9
|
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Contize - Help an object be a continuation thingie (suspendable) |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Contize an object |
|
17
|
|
|
|
|
|
|
my $obj = new Contize(new Object); |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# An output-and-suspend method |
|
20
|
|
|
|
|
|
|
sub output { |
|
21
|
|
|
|
|
|
|
my ($self, $msg) = @_; |
|
22
|
|
|
|
|
|
|
print ' |
|
23
|
|
|
|
|
|
|
print $msg; |
|
24
|
|
|
|
|
|
|
print ''; |
|
25
|
|
|
|
|
|
|
$self->suspend; |
|
26
|
|
|
|
|
|
|
} |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# An input method |
|
29
|
|
|
|
|
|
|
sub input { |
|
30
|
|
|
|
|
|
|
my ($self, $msg) = @_; |
|
31
|
|
|
|
|
|
|
$self->output( |
|
32
|
|
|
|
|
|
|
$msg |
|
33
|
|
|
|
|
|
|
. '' |
|
34
|
|
|
|
|
|
|
); |
|
35
|
|
|
|
|
|
|
$q = new CGI; |
|
36
|
|
|
|
|
|
|
return $q->param('response'); |
|
37
|
|
|
|
|
|
|
} |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# Now the magical bit! |
|
40
|
|
|
|
|
|
|
sub addTwo { |
|
41
|
|
|
|
|
|
|
my $self = shift; |
|
42
|
|
|
|
|
|
|
my $a = $self->input("Enter first number:"); |
|
43
|
|
|
|
|
|
|
my $b = $self->input("Enter second number:"); |
|
44
|
|
|
|
|
|
|
$self->output("Total of \$a + \$b = " . ($a + $b)); |
|
45
|
|
|
|
|
|
|
} |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# This example would be completed with a wrapper script to save/restore the |
|
48
|
|
|
|
|
|
|
# object to disk between runs. See the WebGuess example |
|
49
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
51
|
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Contize is primarily meant to be useful in the context of CGI programming. It |
|
53
|
|
|
|
|
|
|
effectively alters the programmer's view of what is happening -- changing it |
|
54
|
|
|
|
|
|
|
from a program which is run and re-run with each input/output into a program |
|
55
|
|
|
|
|
|
|
which is continuously run, sending output and then pausing for input at certain |
|
56
|
|
|
|
|
|
|
intervals. Documentation on using Contize for this style of CGI programming can |
|
57
|
|
|
|
|
|
|
be found elsewhere, the remainder of this documentation will be more directly |
|
58
|
|
|
|
|
|
|
on Contize (and who knows... maybe there is some other use for Contize of which |
|
59
|
|
|
|
|
|
|
I haven't thought). |
|
60
|
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
Contize helps an object to be suspendable and resumeable. For this to happen |
|
62
|
|
|
|
|
|
|
the object must be Contized, which is a lot like being blessed or Memoized. |
|
63
|
|
|
|
|
|
|
Once an object has been Contized several new methods are provided to it. The |
|
64
|
|
|
|
|
|
|
two most important methods are suspend and resume. |
|
65
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
The suspend method logically replaces the normal return statement. So instead |
|
67
|
|
|
|
|
|
|
of a method returning its results directly it instead does |
|
68
|
|
|
|
|
|
|
"$self->suspend(@results)". The suspend method contains an 'exit', so upon |
|
69
|
|
|
|
|
|
|
suspend the entire process is terminated. In order to succesfully be resumed at |
|
70
|
|
|
|
|
|
|
a later point, the owner of this object should have an END block which saves |
|
71
|
|
|
|
|
|
|
the Contized object to long-term storage. |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
The resume method is called by the program after it has restored the Contized |
|
74
|
|
|
|
|
|
|
object from long-term storage. This restores the objects internal state so that |
|
75
|
|
|
|
|
|
|
subsequent calls to its methods will (more or less) pick up right where they |
|
76
|
|
|
|
|
|
|
left off. So, if you have a CGI::Session object for example, you might have |
|
77
|
|
|
|
|
|
|
something like this: |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
my $obj = $session->param('obj') || new Contize(new MyObj); |
|
80
|
|
|
|
|
|
|
$obj->resume(); |
|
81
|
|
|
|
|
|
|
$obj->run(); |
|
82
|
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
Fun, eh? |
|
84
|
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
=head1 METHODS |
|
86
|
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=over |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=item $thingie = new Contize($thingie) |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
Takes a $thingie object and continuizes it... we replace it with ourselves and |
|
92
|
|
|
|
|
|
|
intercept all method calls. |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Note that we take over the following elements of the hash: |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=over |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=item _child - our child object we've overtaken |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=item _cache - count for how we are doing catch-up wise |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=item _nocache - a list of methods not to cache |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=item _callstack - the current call stack (array) |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=item _callstack_count - the current count of the top callstack item |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=back |
|
109
|
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
So you probably should't use these as variables in the real object. |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=cut |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub new { |
|
115
|
0
|
|
|
0
|
1
|
|
my $class = shift; |
|
116
|
0
|
|
|
|
|
|
my $child = shift; |
|
117
|
|
|
|
|
|
|
# For now we assume our child uses a hash as it's data. Lets take it's |
|
118
|
|
|
|
|
|
|
# existing data and make it ours |
|
119
|
0
|
|
|
|
|
|
my $self = { %{$child} }; |
|
|
0
|
|
|
|
|
|
|
|
120
|
0
|
|
|
|
|
|
bless $self, $class; |
|
121
|
|
|
|
|
|
|
# Now we must save our child so we can actually call it's methods later |
|
122
|
0
|
|
|
|
|
|
$self->{_child} = $child; |
|
123
|
|
|
|
|
|
|
# Clear out the callstack and the count for a new trace |
|
124
|
0
|
|
|
|
|
|
undef $self->{_callstack}; |
|
125
|
0
|
|
|
|
|
|
undef $self->{_callstack_count}; |
|
126
|
0
|
|
|
|
|
|
return $self; |
|
127
|
|
|
|
|
|
|
} |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item $thingie->nocache('methodname1', 'methodname2', ...) |
|
131
|
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Turn off caching for the given methods |
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=cut |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
sub nocache { |
|
137
|
0
|
|
|
0
|
1
|
|
my ($self, @methods) = @_; |
|
138
|
0
|
|
|
|
|
|
push @{$self->{_nocache}}, @methods; |
|
|
0
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
} |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=item $thingie->somemethod(@params) ... aka AUTOLOAD |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
AUTOLOAD actually does the work. We intercept method invocations and usually |
|
145
|
|
|
|
|
|
|
cache the results. Difficult to explain... |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=cut |
|
148
|
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub AUTOLOAD { |
|
150
|
0
|
|
|
0
|
|
|
my ($self, @args) = @_; |
|
151
|
0
|
|
|
|
|
|
my $name = $AUTOLOAD; |
|
152
|
0
|
|
|
|
|
|
my $val; |
|
153
|
|
|
|
|
|
|
# Chop off the 'Contize::' namespace |
|
154
|
0
|
|
|
|
|
|
$name =~ s/.*://; |
|
155
|
|
|
|
|
|
|
# Figure out the method's full name |
|
156
|
0
|
|
|
|
|
|
my $method = (ref $self->{_child}) . "::$name"; |
|
157
|
0
|
0
|
|
|
|
|
if($self->{_child}->can($method)) { |
|
158
|
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
# Keep track of this invocation through our internal stacks |
|
160
|
0
|
|
|
|
|
|
push @{$self->{_callstack}}, $name; |
|
|
0
|
|
|
|
|
|
|
|
161
|
0
|
|
|
|
|
|
my $callstack = "@{$self->{_callstack}}"; |
|
|
0
|
|
|
|
|
|
|
|
162
|
0
|
|
|
|
|
|
my $count = ++$self->{_callstack_count}{$callstack}; |
|
163
|
0
|
|
|
|
|
|
push @{$self->{_callstack}}, $count; |
|
|
0
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# Check to see if we should cache the result |
|
166
|
0
|
0
|
|
|
|
|
if(grep {$_ eq $name} @{$self->{_nocache}}) { |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
# We should NOT cache the result. |
|
168
|
0
|
|
|
|
|
|
$val = $self->$method(@args); |
|
169
|
|
|
|
|
|
|
} else { |
|
170
|
0
|
|
|
|
|
|
$callstack = "@{$self->{_callstack}}"; |
|
|
0
|
|
|
|
|
|
|
|
171
|
0
|
0
|
|
|
|
|
if(exists $self->{_cache}{$callstack}) { |
|
172
|
|
|
|
|
|
|
# We've already cached this call, lets just return it |
|
173
|
0
|
|
|
|
|
|
$val = $self->{_cache}{$callstack}; |
|
174
|
|
|
|
|
|
|
} else { |
|
175
|
|
|
|
|
|
|
# We've never done this before, lets run it... |
|
176
|
0
|
|
|
|
|
|
$val = $self->$method(@args); |
|
177
|
|
|
|
|
|
|
# Cache all method calls (direct AND inherited) |
|
178
|
0
|
|
|
|
|
|
$self->{_cache}{$callstack} = $val; |
|
179
|
|
|
|
|
|
|
|
|
180
|
1
|
|
|
1
|
|
1206
|
use Data::Dumper; |
|
|
1
|
|
|
|
|
11192
|
|
|
|
1
|
|
|
|
|
325
|
|
|
181
|
|
|
|
|
|
|
} |
|
182
|
|
|
|
|
|
|
} |
|
183
|
0
|
|
|
|
|
|
pop @{$self->{_callstack}}; # The num |
|
|
0
|
|
|
|
|
|
|
|
184
|
0
|
|
|
|
|
|
pop @{$self->{_callstack}}; # and the name |
|
|
0
|
|
|
|
|
|
|
|
185
|
0
|
|
|
|
|
|
return $val; |
|
186
|
|
|
|
|
|
|
} else { |
|
187
|
0
|
0
|
|
|
|
|
if($name ne 'DESTROY') { |
|
188
|
0
|
|
|
|
|
|
carp "Method '$method' not implemented."; |
|
189
|
|
|
|
|
|
|
} |
|
190
|
|
|
|
|
|
|
} |
|
191
|
|
|
|
|
|
|
} |
|
192
|
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=item $thingie->suspend($retval) |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
This replaces the return function in a subroutine and suspends the object. When |
|
197
|
|
|
|
|
|
|
the object is resumed it will give $retval to the caller. |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=cut |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
sub suspend { |
|
202
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
203
|
0
|
|
|
|
|
|
my $retval = shift; |
|
204
|
0
|
|
|
|
|
|
my $callstack = "@{$self->{_callstack}}"; |
|
|
0
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
$self->{_cache}{$callstack} = $retval; |
|
206
|
|
|
|
|
|
|
#$self->{_child}->cleanup() if ($self->{_child}->can('cleanup')); |
|
207
|
0
|
|
|
|
|
|
$self->cleanup(); |
|
208
|
0
|
|
|
|
|
|
exit; |
|
209
|
|
|
|
|
|
|
} |
|
210
|
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=item $thingie->resume() |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
Reset the thingie so that it will be re-run. This clears the callstack and the |
|
215
|
|
|
|
|
|
|
callstack_count so that it will begin returning cached results. |
|
216
|
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=cut |
|
218
|
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub resume { |
|
220
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
221
|
0
|
|
|
|
|
|
undef $self->{_callstack}; |
|
222
|
0
|
|
|
|
|
|
undef $self->{_callstack_count}; |
|
223
|
|
|
|
|
|
|
} |
|
224
|
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
=item DESTROY |
|
227
|
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
Upon destruction we undef our child, thus calling the child's own DESTROY, if |
|
229
|
|
|
|
|
|
|
such a thing exists. I'm pretty sure this is the proper way to do things, but |
|
230
|
|
|
|
|
|
|
it might break if their DESTROY does more complicated activities. |
|
231
|
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=cut |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
sub DESTROY { |
|
235
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
236
|
0
|
|
|
|
|
|
undef $self->{_child}; |
|
237
|
|
|
|
|
|
|
} |
|
238
|
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=back |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=head1 BUGS/LIMITATIONS |
|
243
|
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
Contize has quite a bit of overhead for internal caching of method invocations. |
|
245
|
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
There should be a bit more documentation here on how Contize actuall works. |
|
247
|
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
Contize will only work on objects which use a hash as their core thingie. |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
251
|
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
L, L |
|
253
|
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head1 AUTHOR |
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
Brock Wilcox |
|
257
|
|
|
|
|
|
|
http://thelackthereof.org/ |
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
260
|
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
Copyright (c) 2004 Brock Wilcox . All rights |
|
262
|
|
|
|
|
|
|
reserved. This program is free software; you can redistribute it and/or |
|
263
|
|
|
|
|
|
|
modify it under the same terms as Perl itself. |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=cut |
|
266
|
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
1; |
|
268
|
|
|
|
|
|
|
|