File Coverage

blib/lib/Coro/Generator.pm
Criterion Covered Total %
statement 4 6 66.6
branch n/a
condition n/a
subroutine 2 2 100.0
pod n/a
total 6 8 75.0


line stmt bran cond sub pod time code
1             package Coro::Generator;
2              
3             =head1 NAME
4              
5             Coro::Generator - Create generators using Coro
6              
7             =head1 SYNOPSIS
8              
9             use 5.10.0; # This module does NOT require 5.10, but 'say' does
10             use strict;
11             use Coro::Generator;
12              
13             my $even = generator {
14             my $x = 0;
15             while(1) {
16             $x++; $x++;
17             yield $x;
18             }
19             };
20              
21             for my $i (1..10) {
22             say $even->();
23             }
24              
25             =head1 DESCRIPTION
26              
27             In the words of wikipedia, generators look like functions but act like
28             iterators.
29              
30             =head2 EXPORT
31              
32             generator, yield
33              
34             =cut
35              
36 5     5   217724 use strict;
  5         11  
  5         199  
37 5     5   11696 use Coro;
  0            
  0            
38             use Exporter;
39             our @ISA = qw(Exporter);
40             our @EXPORT = qw(generator yield);
41             our $VERSION = '0.02';
42              
43             our @yieldstack;
44             our $retval;
45             our @params;
46              
47             sub generator (&) {
48             my $code = shift;
49             my $prev = new Coro::State;
50             my $coro = Coro::State->new(sub {
51             yield();
52             $code->(@params) while 1;
53             });
54             push @yieldstack, [$coro, $prev];
55             $prev->transfer($coro);
56             return sub {
57             @params = @_;
58             push @yieldstack, [$coro, $prev];
59             $prev->transfer($coro);
60             return $retval;
61             };
62             }
63              
64             sub yield {
65             $retval = shift;
66             my ($coro, $prev) = @{pop @yieldstack};
67             $coro->transfer($prev);
68             return wantarray ? @params : $params[0];
69             }
70              
71             =head1 SEE ALSO
72              
73             L
74              
75             =head1 AUTHOR
76              
77             Brock Wilcox, Eawwaiid@thelackthereof.orgE
78              
79             =head1 COPYRIGHT AND LICENSE
80              
81             Copyright (C) 2008 by Brock Wilcox
82              
83             This library is free software; you can redistribute it and/or modify
84             it under the same terms as Perl itself, either Perl version 5.10.0 or,
85             at your option, any later version of Perl 5 you may have available.
86              
87             =cut
88              
89             1;
90