| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Generator::Object; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | =head1 NAME | 
| 4 |  |  |  |  |  |  |  | 
| 5 |  |  |  |  |  |  | Generator::Object - Generator objects for Perl using Coro | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | =head1 SYNOPSIS | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | use strict; use warnings; | 
| 10 |  |  |  |  |  |  | use Generator::Object; | 
| 11 |  |  |  |  |  |  |  | 
| 12 |  |  |  |  |  |  | my $gen = generator { | 
| 13 |  |  |  |  |  |  | my $x = 0; | 
| 14 |  |  |  |  |  |  | while (1) { | 
| 15 |  |  |  |  |  |  | $x += 2; | 
| 16 |  |  |  |  |  |  | $_->yield($x); | 
| 17 |  |  |  |  |  |  | } | 
| 18 |  |  |  |  |  |  | }; | 
| 19 |  |  |  |  |  |  |  | 
| 20 |  |  |  |  |  |  | print $gen->next; # 2 | 
| 21 |  |  |  |  |  |  | print $gen->next; # 4 | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | =head1 DESCRIPTION | 
| 24 |  |  |  |  |  |  |  | 
| 25 |  |  |  |  |  |  | L provides a class for creating Python-like generators for | 
| 26 |  |  |  |  |  |  | Perl using C. Calling the C method will invoke the generator, while | 
| 27 |  |  |  |  |  |  | inside the generator body, calling the C method on the object will | 
| 28 |  |  |  |  |  |  | suspend the interpreter and return execution to the main thread. When C | 
| 29 |  |  |  |  |  |  | is called again the execution will return to the point of the C inside | 
| 30 |  |  |  |  |  |  | the generator body. Arguments passed to C are returned from C. | 
| 31 |  |  |  |  |  |  | This pattern allows for long-running processes to return values, possibly | 
| 32 |  |  |  |  |  |  | forever, with lazy evaluation. | 
| 33 |  |  |  |  |  |  |  | 
| 34 |  |  |  |  |  |  | For convenience the generator object is provided to the function body as C<$_>. | 
| 35 |  |  |  |  |  |  | Further the context of the C method call is provided via the C | 
| 36 |  |  |  |  |  |  | object method. When/if the generator is exhausted, the C method will | 
| 37 |  |  |  |  |  |  | return C and the C method will return true. Any return value | 
| 38 |  |  |  |  |  |  | from the body will then be available from the C method. The generator | 
| 39 |  |  |  |  |  |  | may be restarted at any time by using the C method. C will | 
| 40 |  |  |  |  |  |  | be empty after the generator restarts. | 
| 41 |  |  |  |  |  |  |  | 
| 42 |  |  |  |  |  |  | Note: in version 0.01 of this module the generator would automatically | 
| 43 |  |  |  |  |  |  | restart when calling C again after it was exhausted. This behavior was | 
| 44 |  |  |  |  |  |  | removed in version 0.02 because upon reflection this is not usually what the | 
| 45 |  |  |  |  |  |  | author means and since C is available it can be done manually. | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  | The internals of the object are entirely off-limits and where possible they | 
| 48 |  |  |  |  |  |  | have been hidden to prevent access. No subclass api is presented nor planned. | 
| 49 |  |  |  |  |  |  | The use of L internally shouldn't interfere with use of L | 
| 50 |  |  |  |  |  |  | externally. | 
| 51 |  |  |  |  |  |  |  | 
| 52 |  |  |  |  |  |  | =cut | 
| 53 |  |  |  |  |  |  |  | 
| 54 | 2 |  |  | 2 |  | 28791 | use strict; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 60 |  | 
| 55 | 2 |  |  | 2 |  | 7 | use warnings; | 
|  | 2 |  |  |  |  | 2 |  | 
|  | 2 |  |  |  |  | 78 |  | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  | our $VERSION = '0.04'; | 
| 58 |  |  |  |  |  |  | $VERSION = eval $VERSION; | 
| 59 |  |  |  |  |  |  |  | 
| 60 | 2 |  |  | 2 |  | 1757 | use Coro (); | 
|  | 0 |  |  |  |  |  |  | 
|  | 0 |  |  |  |  |  |  | 
| 61 |  |  |  |  |  |  |  | 
| 62 |  |  |  |  |  |  | =head1 EXPORTS | 
| 63 |  |  |  |  |  |  |  | 
| 64 |  |  |  |  |  |  | =head2 generator | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | my $gen = generator { ...; $_->yield($val) while 1 }; | 
| 67 |  |  |  |  |  |  |  | 
| 68 |  |  |  |  |  |  | Convenience function for creating instances of L. Takes a | 
| 69 |  |  |  |  |  |  | block (subref) which is the body of the generator. Returns an instance of | 
| 70 |  |  |  |  |  |  | L. | 
| 71 |  |  |  |  |  |  |  | 
| 72 |  |  |  |  |  |  | =cut | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | sub import { | 
| 75 |  |  |  |  |  |  | my $class = shift; | 
| 76 |  |  |  |  |  |  | my $caller = caller; | 
| 77 |  |  |  |  |  |  |  | 
| 78 |  |  |  |  |  |  | no strict 'refs'; | 
| 79 |  |  |  |  |  |  | *{"${caller}::generator"} = sub (&) { | 
| 80 |  |  |  |  |  |  | my $sub = shift; | 
| 81 |  |  |  |  |  |  | return $class->new($sub); | 
| 82 |  |  |  |  |  |  | }; | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  | # yield?? | 
| 85 |  |  |  |  |  |  | } | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | =head1 CONSTRUCTOR | 
| 88 |  |  |  |  |  |  |  | 
| 89 |  |  |  |  |  |  | =head2 new | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | my $gen = Generator::Object->new(sub{...; $_->yield}); | 
| 92 |  |  |  |  |  |  |  | 
| 93 |  |  |  |  |  |  | Takes a subref which is the body of the generator. Returns an instance of | 
| 94 |  |  |  |  |  |  | L. | 
| 95 |  |  |  |  |  |  |  | 
| 96 |  |  |  |  |  |  | =cut | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | sub new { | 
| 99 |  |  |  |  |  |  | my $class = shift; | 
| 100 |  |  |  |  |  |  | my $sub = shift; | 
| 101 |  |  |  |  |  |  | return bless { sub => $sub, retval => [] }, $class; | 
| 102 |  |  |  |  |  |  | } | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  | =head1 METHODS | 
| 105 |  |  |  |  |  |  |  | 
| 106 |  |  |  |  |  |  | =head2 exhausted | 
| 107 |  |  |  |  |  |  |  | 
| 108 |  |  |  |  |  |  | while (1) { | 
| 109 |  |  |  |  |  |  | next if defined $gen->next; | 
| 110 |  |  |  |  |  |  | print "Done\n" if $gen->exhausted; | 
| 111 |  |  |  |  |  |  | } | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | When the generator is exhausted the C method will return C. | 
| 114 |  |  |  |  |  |  | However, since C might legitimately return C, this method is | 
| 115 |  |  |  |  |  |  | provided to check that the generator has indeed been exhausted. If the | 
| 116 |  |  |  |  |  |  | generator is restarted, then this method will again returns false. | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | =cut | 
| 119 |  |  |  |  |  |  |  | 
| 120 |  |  |  |  |  |  | sub exhausted { shift->{exhausted} } | 
| 121 |  |  |  |  |  |  |  | 
| 122 |  |  |  |  |  |  | =head2 next | 
| 123 |  |  |  |  |  |  |  | 
| 124 |  |  |  |  |  |  | my $first  = $gen->next; | 
| 125 |  |  |  |  |  |  | my $second = $gen->next; | 
| 126 |  |  |  |  |  |  |  | 
| 127 |  |  |  |  |  |  | This method iterates the generator until C is called or the body is | 
| 128 |  |  |  |  |  |  | returned from. It returns any value passed to C, in list context all | 
| 129 |  |  |  |  |  |  | arguments are returned, in scalar context the first argument is returned. The | 
| 130 |  |  |  |  |  |  | context of the C call is available from the C method for more | 
| 131 |  |  |  |  |  |  | manual control. | 
| 132 |  |  |  |  |  |  |  | 
| 133 |  |  |  |  |  |  | When the generator is exhausted, that is to say, when the body function | 
| 134 |  |  |  |  |  |  | returns, C returns C. Check C to differentiate between | 
| 135 |  |  |  |  |  |  | exhaustion and a yielded C. Any values returned from the body are | 
| 136 |  |  |  |  |  |  | available via the C method, again list return is emulated and the | 
| 137 |  |  |  |  |  |  | C method (of the final C call) can be checked when returning. | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | =cut | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | sub next { | 
| 142 |  |  |  |  |  |  | my $self = shift; | 
| 143 |  |  |  |  |  |  | return undef if $self->exhausted; | 
| 144 |  |  |  |  |  |  |  | 
| 145 |  |  |  |  |  |  | # protect some state values from leaking | 
| 146 |  |  |  |  |  |  | local $self->{orig} = $Coro::current; | 
| 147 |  |  |  |  |  |  | local $self->{wantarray} = wantarray; | 
| 148 |  |  |  |  |  |  | local $self->{yieldval}; | 
| 149 |  |  |  |  |  |  |  | 
| 150 |  |  |  |  |  |  | $self->{coro} = Coro->new(sub { | 
| 151 |  |  |  |  |  |  | local $_ = $self; | 
| 152 |  |  |  |  |  |  | $self->{retval} = [ $self->{sub}->() ]; | 
| 153 |  |  |  |  |  |  | $self->{exhausted} = 1; | 
| 154 |  |  |  |  |  |  | $self->{orig}->schedule_to; | 
| 155 |  |  |  |  |  |  | }) unless $self->{coro}; | 
| 156 |  |  |  |  |  |  |  | 
| 157 |  |  |  |  |  |  | $self->{coro}->schedule_to; | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | my $yield = $self->{yieldval} || []; | 
| 160 |  |  |  |  |  |  | return $self->{wantarray} ? @$yield : $yield->[0]; | 
| 161 |  |  |  |  |  |  | } | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | =head2 restart | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | my $gen = generator { my $x = 1; $_->yield($x++) while 1 }; | 
| 166 |  |  |  |  |  |  | my $first = $gen->next; | 
| 167 |  |  |  |  |  |  | $gen->restart; | 
| 168 |  |  |  |  |  |  | $first == $gen->next; # true | 
| 169 |  |  |  |  |  |  |  | 
| 170 |  |  |  |  |  |  | Restarts the generator to its initial state. Of course if your generator has | 
| 171 |  |  |  |  |  |  | made external changes, those will remain. Any values in C are cleared | 
| 172 |  |  |  |  |  |  | and C is reset (if applicable). | 
| 173 |  |  |  |  |  |  |  | 
| 174 |  |  |  |  |  |  | Note: C is no longer implicitly called when C is invoked on an | 
| 175 |  |  |  |  |  |  | exhasted generator. You may recreate the old behavior by simply doing | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | $gen->restart if $gen->exhausted; | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  | =cut | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | sub restart { | 
| 182 |  |  |  |  |  |  | my $self = shift; | 
| 183 |  |  |  |  |  |  | delete $self->{coro}; | 
| 184 |  |  |  |  |  |  | delete $self->{exhausted}; | 
| 185 |  |  |  |  |  |  | $self->{retval} = []; | 
| 186 |  |  |  |  |  |  | } | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  | =head2 retval | 
| 189 |  |  |  |  |  |  |  | 
| 190 |  |  |  |  |  |  | my $gen = generator { return 'val' }; | 
| 191 |  |  |  |  |  |  | $gen->next; | 
| 192 |  |  |  |  |  |  | my $val = $gen->retval; # 'val' | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | Returns the value or values returned from the generator upon exhaustion if any. | 
| 195 |  |  |  |  |  |  | In list context all returned values are given, in scalar context the first | 
| 196 |  |  |  |  |  |  | element is returned. Note that the context in which C was called as the | 
| 197 |  |  |  |  |  |  | generator is exhausted is available via the C method for manual | 
| 198 |  |  |  |  |  |  | control. | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | Before the generator is exhausted (and therefore before it has really returned | 
| 201 |  |  |  |  |  |  | anything) the value of retval is C in scalar context and an empty list | 
| 202 |  |  |  |  |  |  | in list context. Note that version 0.01 returned C in both contexts but | 
| 203 |  |  |  |  |  |  | this has been corrected in version 0.02. | 
| 204 |  |  |  |  |  |  |  | 
| 205 |  |  |  |  |  |  | =cut | 
| 206 |  |  |  |  |  |  |  | 
| 207 |  |  |  |  |  |  | sub retval { | 
| 208 |  |  |  |  |  |  | my $self = shift; | 
| 209 |  |  |  |  |  |  | return undef unless $self->{retval}; | 
| 210 |  |  |  |  |  |  | return | 
| 211 |  |  |  |  |  |  | wantarray | 
| 212 |  |  |  |  |  |  | ? @{ $self->{retval} } | 
| 213 |  |  |  |  |  |  | : $self->{retval}[0]; | 
| 214 |  |  |  |  |  |  | } | 
| 215 |  |  |  |  |  |  |  | 
| 216 |  |  |  |  |  |  | =head2 wantarray | 
| 217 |  |  |  |  |  |  |  | 
| 218 |  |  |  |  |  |  | my $gen = generator { | 
| 219 |  |  |  |  |  |  | while (1) { | 
| 220 |  |  |  |  |  |  | $_->wantarray | 
| 221 |  |  |  |  |  |  | ? $_->yield('next called in list context') | 
| 222 |  |  |  |  |  |  | : $_->yield('next called in scalar context'); | 
| 223 |  |  |  |  |  |  | } | 
| 224 |  |  |  |  |  |  | } | 
| 225 |  |  |  |  |  |  |  | 
| 226 |  |  |  |  |  |  | my ($list) = $gen->next; | 
| 227 |  |  |  |  |  |  | my $scalar = $gen->next; | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | Much like the Perl built-in of the same name, this method provides the context | 
| 230 |  |  |  |  |  |  | in which the C method is called, making that information available to the | 
| 231 |  |  |  |  |  |  | generator body. | 
| 232 |  |  |  |  |  |  |  | 
| 233 |  |  |  |  |  |  | =cut | 
| 234 |  |  |  |  |  |  |  | 
| 235 |  |  |  |  |  |  | sub wantarray { shift->{wantarray} } | 
| 236 |  |  |  |  |  |  |  | 
| 237 |  |  |  |  |  |  | =head2 yield | 
| 238 |  |  |  |  |  |  |  | 
| 239 |  |  |  |  |  |  | my $gen = generator { ...; $_->yield($val) while 1 }; | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | This method is the guts of the generator. When called C suspends the | 
| 242 |  |  |  |  |  |  | state of the interpreter as it exists inside the generator body and returns to | 
| 243 |  |  |  |  |  |  | the point at which C was called. The values passed will be returned by | 
| 244 |  |  |  |  |  |  | C (see its documentation for more). | 
| 245 |  |  |  |  |  |  |  | 
| 246 |  |  |  |  |  |  | This method should not be called outside the generator body. For now, doing | 
| 247 |  |  |  |  |  |  | so dies. In the future though this might change to be a safer no-op in the | 
| 248 |  |  |  |  |  |  | future, or else the method may only be made available inside the body as | 
| 249 |  |  |  |  |  |  | safe-guards. In the meantime, just don't do it! | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | =cut | 
| 252 |  |  |  |  |  |  |  | 
| 253 |  |  |  |  |  |  | sub yield { | 
| 254 |  |  |  |  |  |  | my $self = shift; | 
| 255 |  |  |  |  |  |  | die "Must not call yield outside the generator!\n" | 
| 256 |  |  |  |  |  |  | unless $self->{orig}; | 
| 257 |  |  |  |  |  |  |  | 
| 258 |  |  |  |  |  |  | $self->{yieldval} = [ @_ ]; | 
| 259 |  |  |  |  |  |  | $self->{orig}->schedule_to; | 
| 260 |  |  |  |  |  |  | } | 
| 261 |  |  |  |  |  |  |  | 
| 262 |  |  |  |  |  |  | =head1 FUTURE WORK | 
| 263 |  |  |  |  |  |  |  | 
| 264 |  |  |  |  |  |  | I intend (possibly soon) to allow arguments to be passed to the generator body | 
| 265 |  |  |  |  |  |  | possibly even on every call to C. Stay tuned. | 
| 266 |  |  |  |  |  |  |  | 
| 267 |  |  |  |  |  |  | =head1 SEE ALSO | 
| 268 |  |  |  |  |  |  |  | 
| 269 |  |  |  |  |  |  | =over | 
| 270 |  |  |  |  |  |  |  | 
| 271 |  |  |  |  |  |  | =item L | 
| 272 |  |  |  |  |  |  |  | 
| 273 |  |  |  |  |  |  | =back | 
| 274 |  |  |  |  |  |  |  | 
| 275 |  |  |  |  |  |  | A few similar modules already exist. Their API and design choices weren't to my | 
| 276 |  |  |  |  |  |  | liking, but they may appeal to you. Certainly I used them as reference and | 
| 277 |  |  |  |  |  |  | thanks are due. | 
| 278 |  |  |  |  |  |  |  | 
| 279 |  |  |  |  |  |  | =over | 
| 280 |  |  |  |  |  |  |  | 
| 281 |  |  |  |  |  |  | =item L | 
| 282 |  |  |  |  |  |  |  | 
| 283 |  |  |  |  |  |  | =item L | 
| 284 |  |  |  |  |  |  |  | 
| 285 |  |  |  |  |  |  | =back | 
| 286 |  |  |  |  |  |  |  | 
| 287 |  |  |  |  |  |  | =head1 SOURCE REPOSITORY | 
| 288 |  |  |  |  |  |  |  | 
| 289 |  |  |  |  |  |  | L | 
| 290 |  |  |  |  |  |  |  | 
| 291 |  |  |  |  |  |  | =head1 AUTHOR | 
| 292 |  |  |  |  |  |  |  | 
| 293 |  |  |  |  |  |  | Joel Berger, Ejoel.a.berger@gmail.comE | 
| 294 |  |  |  |  |  |  |  | 
| 295 |  |  |  |  |  |  | =head1 COPYRIGHT AND LICENSE | 
| 296 |  |  |  |  |  |  |  | 
| 297 |  |  |  |  |  |  | Copyright (C) 2013-2015 by Joel Berger | 
| 298 |  |  |  |  |  |  |  | 
| 299 |  |  |  |  |  |  | This library is free software; you can redistribute it and/or modify | 
| 300 |  |  |  |  |  |  | it under the same terms as Perl itself. | 
| 301 |  |  |  |  |  |  |  | 
| 302 |  |  |  |  |  |  | =cut | 
| 303 |  |  |  |  |  |  |  | 
| 304 |  |  |  |  |  |  | 1; | 
| 305 |  |  |  |  |  |  |  |