File Coverage

blib/lib/MCE/Subs.pm
Criterion Covered Total %
statement 91 161 56.5
branch 5 16 31.2
condition 1 9 11.1
subroutine 9 50 18.0
pod 39 39 100.0
total 145 275 52.7


line stmt bran cond sub pod time code
1             ###############################################################################
2             ## ----------------------------------------------------------------------------
3             ## Exports functions mapped directly to MCE methods.
4             ##
5             ###############################################################################
6              
7             package MCE::Subs;
8              
9 1     1   988 use strict;
  1         2  
  1         30  
10 1     1   5 use warnings;
  1         2  
  1         28  
11              
12 1     1   4 no warnings qw( threads recursion uninitialized );
  1         2  
  1         44  
13              
14             our $VERSION = '1.888';
15              
16             ## no critic (Subroutines::ProhibitSubroutinePrototypes)
17             ## no critic (TestingAndDebugging::ProhibitNoStrict)
18              
19 1     1   6 use MCE;
  1         3  
  1         8  
20 1     1   9 use MCE::Relay;
  1         26  
  1         7  
21              
22             ###############################################################################
23             ## ----------------------------------------------------------------------------
24             ## Import routine.
25             ##
26             ###############################################################################
27              
28             sub import {
29              
30 1     1   12 shift;
31              
32 1         2 my $_g_flg = 0; my $_m_flg = 0; my $_w_flg = 0;
  1         1  
  1         2  
33 1     0   4 my $_flag = sub { 1 }; my $_package = caller;
  0         0  
  1         2  
34              
35             ## Process module arguments.
36 1         5 while (my $_argument = shift) {
37 0         0 my $_arg = lc $_argument;
38              
39 0 0 0     0 $_g_flg = $_flag->() and next if ( $_arg eq ':getter' );
40 0 0 0     0 $_m_flg = $_flag->() and next if ( $_arg eq ':manager' );
41 0 0 0     0 $_w_flg = $_flag->() and next if ( $_arg eq ':worker' );
42              
43 0         0 _croak("Error: ($_argument) invalid module option");
44             }
45              
46 1 50       10 $_m_flg = $_w_flg = 1 if ($_m_flg + $_w_flg == 0);
47              
48 1         3 _export_subs($_package, $_g_flg, $_m_flg, $_w_flg);
49              
50 1         14 return;
51             }
52              
53             ###############################################################################
54             ## ----------------------------------------------------------------------------
55             ## Define functions.
56             ##
57             ###############################################################################
58              
59             ## Callable by the manager process only.
60              
61             sub mce_restart_worker (@) {
62 0     0 1 0 return $MCE::MCE->restart_worker(@_);
63             }
64              
65 0     0 1 0 sub mce_forchunk (@) { return $MCE::MCE->forchunk(@_); }
66 0     0 1 0 sub mce_foreach (@) { return $MCE::MCE->foreach(@_); }
67 0     0 1 0 sub mce_forseq (@) { return $MCE::MCE->forseq(@_); }
68 0     0 1 0 sub mce_process (@) { return $MCE::MCE->process(@_); }
69 0     0 1 0 sub mce_relay_final ( ) { return $MCE::MCE->relay_final(); }
70 0     0 1 0 sub mce_run (@) { return $MCE::MCE->run(@_); }
71 0     0 1 0 sub mce_send (@) { return $MCE::MCE->send(@_); }
72 0     0 1 0 sub mce_shutdown ( ) { return $MCE::MCE->shutdown(); }
73 0     0 1 0 sub mce_spawn ( ) { return $MCE::MCE->spawn(); }
74 0     0 1 0 sub mce_status ( ) { return $MCE::MCE->status(); }
75              
76             ## Callable by the worker process only.
77              
78 0     0 1 0 sub mce_exit (@) { return $MCE::MCE->exit(@_); }
79 0     0 1 0 sub mce_gather (@) { return $MCE::MCE->gather(@_); }
80 0     0 1 0 sub mce_last ( ) { return $MCE::MCE->last(); }
81 0     0 1 0 sub mce_next ( ) { return $MCE::MCE->next(); }
82 0     0 1 0 sub mce_relay (;&) { return $MCE::MCE->relay(@_); }
83 0     0 1 0 sub mce_relay_recv ( ) { return $MCE::MCE->relay_recv(); }
84 0     0 1 0 sub mce_sendto (;*@) { return $MCE::MCE->sendto(@_); }
85 0     0 1 0 sub mce_sync ( ) { return $MCE::MCE->sync(); }
86 0     0 1 0 sub mce_yield ( ) { return $MCE::MCE->yield(); }
87              
88             ## Callable by both the manager and worker processes.
89              
90 0     0 1 0 sub mce_abort ( ) { return $MCE::MCE->abort(); }
91 0     0 1 0 sub mce_do (@) { return $MCE::MCE->do(@_); }
92 0     0 1 0 sub mce_freeze (@) { return $MCE::MCE->{freeze}(@_); }
93 0     0 1 0 sub mce_print (;*@) { return $MCE::MCE->print(@_); }
94 0     0 1 0 sub mce_printf (;*@) { return $MCE::MCE->printf(@_); }
95 0     0 1 0 sub mce_say (;*@) { return $MCE::MCE->say(@_); }
96 0     0 1 0 sub mce_thaw (@) { return $MCE::MCE->{thaw}(@_); }
97              
98             ## Callable by both the manager and worker processes.
99              
100 0     0 1 0 sub mce_chunk_id ( ) { return $MCE::MCE->chunk_id(); }
101 0     0 1 0 sub mce_chunk_size ( ) { return $MCE::MCE->chunk_size(); }
102 0     0 1 0 sub mce_max_retries ( ) { return $MCE::MCE->max_retries(); }
103 0     0 1 0 sub mce_max_workers ( ) { return $MCE::MCE->max_workers(); }
104 0     0 1 0 sub mce_pid ( ) { return $MCE::MCE->pid(); }
105 0     0 1 0 sub mce_sess_dir ( ) { return $MCE::MCE->sess_dir(); }
106 0     0 1 0 sub mce_task_id ( ) { return $MCE::MCE->task_id(); }
107 0     0 1 0 sub mce_task_name ( ) { return $MCE::MCE->task_name(); }
108 0     0 1 0 sub mce_task_wid ( ) { return $MCE::MCE->task_wid(); }
109 0     0 1 0 sub mce_tmp_dir ( ) { return $MCE::MCE->tmp_dir(); }
110 0     0 1 0 sub mce_user_args ( ) { return $MCE::MCE->user_args(); }
111 0     0 1 0 sub mce_wid ( ) { return $MCE::MCE->wid(); }
112              
113             ###############################################################################
114             ## ----------------------------------------------------------------------------
115             ## Private methods.
116             ##
117             ###############################################################################
118              
119             sub _croak {
120              
121 0     0   0 goto &MCE::_croak;
122             }
123              
124             sub _export_subs {
125              
126 1     1   3 my ($_package, $_g_flg, $_m_flg, $_w_flg) = @_;
127              
128 1     1   8 no strict 'refs'; no warnings 'redefine';
  1     1   2  
  1         44  
  1         5  
  1         3  
  1         534  
129              
130             ## Callable by the manager process only.
131              
132 1 50       3 if ($_m_flg) {
133 1         2 *{ $_package . '::mce_restart_worker' } = \&mce_restart_worker;
  1         6  
134              
135 1         1 *{ $_package . '::mce_forchunk' } = \&mce_forchunk;
  1         4  
136 1         2 *{ $_package . '::mce_foreach' } = \&mce_foreach;
  1         3  
137 1         1 *{ $_package . '::mce_forseq' } = \&mce_forseq;
  1         3  
138 1         2 *{ $_package . '::mce_process' } = \&mce_process;
  1         3  
139 1         2 *{ $_package . '::mce_relay_final' } = \&mce_relay_final;
  1         3  
140 1         2 *{ $_package . '::mce_run' } = \&mce_run;
  1         3  
141 1         2 *{ $_package . '::mce_send' } = \&mce_send;
  1         3  
142 1         2 *{ $_package . '::mce_shutdown' } = \&mce_shutdown;
  1         2  
143 1         2 *{ $_package . '::mce_spawn' } = \&mce_spawn;
  1         2  
144 1         2 *{ $_package . '::mce_status' } = \&mce_status;
  1         3  
145             }
146              
147             ## Callable by the worker process only.
148              
149 1 50       2 if ($_w_flg) {
150 1         2 *{ $_package . '::mce_exit' } = \&mce_exit;
  1         4  
151 1         2 *{ $_package . '::mce_gather' } = \&mce_gather;
  1         3  
152 1         2 *{ $_package . '::mce_last' } = \&mce_last;
  1         3  
153 1         2 *{ $_package . '::mce_next' } = \&mce_next;
  1         13  
154 1         3 *{ $_package . '::mce_relay' } = \&mce_relay;
  1         4  
155 1         1 *{ $_package . '::mce_relay_recv' } = \&mce_relay_recv;
  1         4  
156 1         1 *{ $_package . '::mce_sendto' } = \&mce_sendto;
  1         3  
157 1         2 *{ $_package . '::mce_sync' } = \&mce_sync;
  1         3  
158 1         1 *{ $_package . '::mce_yield' } = \&mce_yield;
  1         3  
159             }
160              
161             ## Callable by both the manager and worker processes.
162              
163 1 50 33     4 if ($_m_flg || $_w_flg) {
164 1         2 *{ $_package . '::mce_abort' } = \&mce_abort;
  1         3  
165 1         2 *{ $_package . '::mce_do' } = \&mce_do;
  1         4  
166 1         1 *{ $_package . '::mce_freeze' } = \&mce_freeze;
  1         3  
167 1         1 *{ $_package . '::mce_print' } = \&mce_print;
  1         3  
168 1         2 *{ $_package . '::mce_printf' } = \&mce_printf;
  1         3  
169 1         2 *{ $_package . '::mce_say' } = \&mce_say;
  1         2  
170 1         2 *{ $_package . '::mce_thaw' } = \&mce_thaw;
  1         6  
171             }
172              
173 1 50       3 if ($_g_flg) {
174 0         0 *{ $_package . '::mce_chunk_id' } = \&mce_chunk_id;
  0         0  
175 0         0 *{ $_package . '::mce_chunk_size' } = \&mce_chunk_size;
  0         0  
176 0         0 *{ $_package . '::mce_max_retries' } = \&mce_max_retries;
  0         0  
177 0         0 *{ $_package . '::mce_max_workers' } = \&mce_max_workers;
  0         0  
178 0         0 *{ $_package . '::mce_pid' } = \&mce_pid;
  0         0  
179 0         0 *{ $_package . '::mce_sess_dir' } = \&mce_sess_dir;
  0         0  
180 0         0 *{ $_package . '::mce_task_id' } = \&mce_task_id;
  0         0  
181 0         0 *{ $_package . '::mce_task_name' } = \&mce_task_name;
  0         0  
182 0         0 *{ $_package . '::mce_task_wid' } = \&mce_task_wid;
  0         0  
183 0         0 *{ $_package . '::mce_tmp_dir' } = \&mce_tmp_dir;
  0         0  
184 0         0 *{ $_package . '::mce_user_args' } = \&mce_user_args;
  0         0  
185 0         0 *{ $_package . '::mce_wid' } = \&mce_wid;
  0         0  
186             }
187              
188 1         3 return;
189             }
190              
191             1;
192              
193             __END__