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
|
|
|
|
|
|
|
|