File Coverage

blib/lib/MCE/Candy.pm
Criterion Covered Total %
statement 12 115 10.4
branch 2 54 3.7
condition 0 12 0.0
subroutine 4 12 33.3
pod 5 5 100.0
total 23 198 11.6


line stmt bran cond sub pod time code
1             ###############################################################################
2             ## ----------------------------------------------------------------------------
3             ## Sugar methods and output iterators.
4             ##
5             ###############################################################################
6              
7             package MCE::Candy;
8              
9 1     1   2502 use strict;
  1         3  
  1         31  
10 1     1   4 use warnings;
  1         2  
  1         29  
11              
12 1     1   5 no warnings qw( threads recursion uninitialized );
  1         1  
  1         1348  
13              
14             our $VERSION = '1.889';
15              
16             our @CARP_NOT = qw( MCE );
17              
18             ###############################################################################
19             ## ----------------------------------------------------------------------------
20             ## Import routine.
21             ##
22             ###############################################################################
23              
24             my $_imported;
25              
26             sub import {
27              
28 1 50   1   13 return if ($_imported++);
29              
30 1 50       4 unless ($INC{'MCE.pm'}) {
31 0         0 $\ = undef; require Carp;
  0         0  
32 0         0 Carp::croak(
33             "MCE::Candy requires MCE. Please see the MCE::Candy documentation\n".
34             "for more information.\n\n"
35             );
36             }
37              
38 1         9 return;
39             }
40              
41             ###############################################################################
42             ## ----------------------------------------------------------------------------
43             ## Forchunk, foreach, and forseq sugar methods.
44             ##
45             ###############################################################################
46              
47             sub forchunk {
48              
49 0 0   0 1   my $x = shift; my $self = ref($x) ? $x : $MCE::MCE;
  0            
50 0           my $_input_data = $_[0];
51              
52 0           MCE::_validate_runstate($self, 'MCE::forchunk');
53              
54 0           my ($_user_func, $_params_ref);
55              
56 0 0         if (ref $_[1] eq 'HASH') {
57 0           $_user_func = $_[2]; $_params_ref = $_[1];
  0            
58             } else {
59 0           $_user_func = $_[1]; $_params_ref = {};
  0            
60             }
61              
62 0           @_ = ();
63              
64 0 0         MCE::_croak('MCE::forchunk: (input_data) is not specified')
65             unless (defined $_input_data);
66 0 0         MCE::_croak('MCE::forchunk: (code_block) is not specified')
67             unless (defined $_user_func);
68              
69 0           $_params_ref->{input_data} = $_input_data;
70 0           $_params_ref->{user_func} = $_user_func;
71              
72 0           $self->run(1, $_params_ref);
73              
74 0           return $self;
75             }
76              
77             sub foreach {
78              
79 0 0   0 1   my $x = shift; my $self = ref($x) ? $x : $MCE::MCE;
  0            
80 0           my $_input_data = $_[0];
81              
82 0           MCE::_validate_runstate($self, 'MCE::foreach');
83              
84 0           my ($_user_func, $_params_ref);
85              
86 0 0         if (ref $_[1] eq 'HASH') {
87 0           $_user_func = $_[2]; $_params_ref = $_[1];
  0            
88             } else {
89 0           $_user_func = $_[1]; $_params_ref = {};
  0            
90             }
91              
92 0           @_ = ();
93              
94 0 0         MCE::_croak('MCE::foreach: (HASH) not allowed as input by this method')
95             if (ref $_input_data eq 'HASH');
96 0 0         MCE::_croak('MCE::foreach: (input_data) is not specified')
97             unless (defined $_input_data);
98 0 0         MCE::_croak('MCE::foreach: (code_block) is not specified')
99             unless (defined $_user_func);
100              
101 0           $_params_ref->{chunk_size} = 1;
102 0           $_params_ref->{input_data} = $_input_data;
103 0           $_params_ref->{user_func} = $_user_func;
104              
105 0           $self->run(1, $_params_ref);
106              
107 0           return $self;
108             }
109              
110             sub forseq {
111              
112 0 0   0 1   my $x = shift; my $self = ref($x) ? $x : $MCE::MCE;
  0            
113 0           my $_sequence = $_[0];
114              
115 0           MCE::_validate_runstate($self, 'MCE::forseq');
116              
117 0           my ($_user_func, $_params_ref);
118              
119 0 0         if (ref $_[1] eq 'HASH') {
120 0           $_user_func = $_[2]; $_params_ref = $_[1];
  0            
121             } else {
122 0           $_user_func = $_[1]; $_params_ref = {};
  0            
123             }
124              
125 0           @_ = ();
126              
127 0 0         MCE::_croak('MCE::forseq: (sequence) is not specified')
128             unless (defined $_sequence);
129 0 0         MCE::_croak('MCE::forseq: (code_block) is not specified')
130             unless (defined $_user_func);
131              
132 0           $_params_ref->{sequence} = $_sequence;
133 0           $_params_ref->{user_func} = $_user_func;
134              
135 0           $self->run(1, $_params_ref);
136              
137 0           return $self;
138             }
139              
140             ###############################################################################
141             ## ----------------------------------------------------------------------------
142             ## Output iterators for preserving output order.
143             ##
144             ###############################################################################
145              
146             sub out_iter_array {
147              
148 0     0 1   my $_aref = shift; my %_tmp; my $_order_id = 1;
  0            
  0            
149              
150 0 0         if (ref $_aref eq 'MCE::Shared::Object') {
151 0           my $_pkg = $_aref->blessed;
152 0 0         MCE::_croak('The argument to (out_iter_array) is not valid.')
153             unless $_pkg->can('TIEARRAY');
154             }
155             else {
156 0 0         MCE::_croak('The argument to (out_iter_array) is not an array ref.')
157             unless (ref $_aref eq 'ARRAY');
158             }
159              
160             return sub {
161 0     0     my $_chunk_id = shift;
162              
163 0 0 0       if ($_chunk_id == $_order_id && keys %_tmp == 0) {
164             ## already orderly
165 0           $_order_id++, push @{ $_aref }, @_;
  0            
166             }
167             else {
168             ## hold temporarily otherwise until orderly
169 0           @{ $_tmp{ $_chunk_id } } = @_;
  0            
170              
171 0           while (1) {
172 0 0         last unless exists $_tmp{ $_order_id };
173 0           push @{ $_aref }, @{ delete $_tmp{ $_order_id++ } };
  0            
  0            
174             }
175             }
176 0           };
177             }
178              
179             sub out_iter_fh {
180              
181 0     0 1   my $_fh = $_[0]; my %_tmp; my $_order_id = 1;
  0            
  0            
182 0 0 0       $_fh = \$_[0] if (!ref $_fh && ref \$_[0]);
183              
184 0 0         MCE::_croak('The argument to (out_iter_fh) is not a supported file handle.')
185             unless (ref($_fh) =~ /^(?:GLOB|FileHandle|IO::)/);
186              
187 0 0         if ($_fh->can('print')) {
188             return sub {
189 0     0     my $_chunk_id = shift;
190              
191 0 0 0       if ($_chunk_id == $_order_id && keys %_tmp == 0) {
192             ## already orderly
193 0           $_order_id++, $_fh->print(@_);
194             }
195             else {
196             ## hold temporarily otherwise until orderly
197 0           @{ $_tmp{ $_chunk_id } } = @_;
  0            
198              
199 0           while (1) {
200 0 0         last unless exists $_tmp{ $_order_id };
201 0           $_fh->print(@{ delete $_tmp{ $_order_id++ } });
  0            
202             }
203             }
204 0           };
205             }
206             else {
207             return sub {
208 0     0     my $_chunk_id = shift;
209              
210 0 0 0       if ($_chunk_id == $_order_id && keys %_tmp == 0) {
211             ## already orderly
212 0           $_order_id++, print {$_fh} @_;
  0            
213             }
214             else {
215             ## hold temporarily otherwise until orderly
216 0           @{ $_tmp{ $_chunk_id } } = @_;
  0            
217              
218 0           while (1) {
219 0 0         last unless exists $_tmp{ $_order_id };
220 0           print {$_fh} @{ delete $_tmp{ $_order_id++ } };
  0            
  0            
221             }
222             }
223 0           };
224             }
225             }
226              
227             1;
228              
229             __END__