File Coverage

blib/lib/MCE/Channel/SimpleFast.pm
Criterion Covered Total %
statement 135 142 95.0
branch 70 124 56.4
condition 14 27 51.8
subroutine 15 15 100.0
pod 11 11 100.0
total 245 319 76.8


line stmt bran cond sub pod time code
1             ###############################################################################
2             ## ----------------------------------------------------------------------------
3             ## Channel tuned for one producer and one consumer involving no locking.
4             ##
5             ###############################################################################
6              
7             package MCE::Channel::SimpleFast;
8              
9 1     1   1968 use strict;
  1         2  
  1         29  
10 1     1   5 use warnings;
  1         1  
  1         25  
11              
12 1     1   4 no warnings qw( uninitialized once );
  1         2  
  1         43  
13              
14             our $VERSION = '1.887';
15              
16 1     1   4 use base 'MCE::Channel';
  1         1  
  1         1440  
17              
18             my $LF = "\012"; Internals::SvREADONLY($LF, 1);
19             my $is_MSWin32 = ( $^O eq 'MSWin32' ) ? 1 : 0;
20              
21             sub new {
22 1     1 1 4 my ( $class, %obj ) = ( @_, impl => 'SimpleFast' );
23              
24 1         4 $obj{init_pid} = MCE::Channel::_pid();
25 1         5 MCE::Util::_sock_pair( \%obj, 'p_sock', 'c_sock' );
26              
27 1         5 return bless \%obj, $class;
28             }
29              
30             ###############################################################################
31             ## ----------------------------------------------------------------------------
32             ## Queue-like methods.
33             ##
34             ###############################################################################
35              
36             sub end {
37 1     1 1 8 my ( $self ) = @_;
38              
39 1 50       4 local $\ = undef if (defined $\);
40 1 50       3 MCE::Util::_sock_ready_w( $self->{p_sock} ) if $is_MSWin32;
41 1         2 print { $self->{p_sock} } pack('i', -1);
  1         8  
42              
43 1         4 $self->{ended} = 1;
44             }
45              
46             sub enqueue {
47 13     13 1 2038 my $self = shift;
48 13 100       32 return MCE::Channel::_ended('enqueue') if $self->{ended};
49              
50 12 50       24 local $\ = undef if (defined $\);
51 12 50       19 MCE::Util::_sock_ready_w( $self->{p_sock} ) if $is_MSWin32;
52              
53 12         22 while ( @_ ) {
54 22         44 my $data = ''.shift;
55 22         22 print { $self->{p_sock} } pack('i', length $data) . $data;
  22         233  
56             }
57              
58 12         30 return 1;
59             }
60              
61             sub dequeue {
62 8     8 1 20 my ( $self, $count ) = @_;
63 8 100 66     23 $count = 1 if ( !$count || $count < 1 );
64              
65 8 50       20 local $/ = $LF if ( $/ ne $LF );
66              
67 8 100       16 if ( $count == 1 ) {
68 7         10 my ( $plen, $data );
69 7 50       10 MCE::Util::_sock_ready( $self->{c_sock} ) if $is_MSWin32;
70              
71             $is_MSWin32
72             ? sysread( $self->{c_sock}, $plen, 4 )
73 7 50       52 : read( $self->{c_sock}, $plen, 4 );
74              
75 7         19 my $len = unpack('i', $plen);
76 7 50       20 if ( $len < 0 ) {
77 0         0 $self->end;
78 0 0       0 return wantarray ? () : undef;
79             }
80              
81 7 100       21 return '' unless $len;
82             $is_MSWin32
83             ? MCE::Channel::_read( $self->{c_sock}, $data, $len )
84 5 50       12 : read( $self->{c_sock}, $data, $len );
85              
86 5         23 $data;
87             }
88             else {
89 1         3 my ( $plen, @ret );
90 1 50       4 MCE::Util::_sock_ready( $self->{c_sock} ) if $is_MSWin32;
91              
92 1         4 while ( $count-- ) {
93 3         4 my $data;
94              
95             $is_MSWin32
96             ? sysread( $self->{c_sock}, $plen, 4 )
97 3 50       16 : read( $self->{c_sock}, $plen, 4 );
98              
99 3         7 my $len = unpack('i', $plen);
100 3 50       8 if ( $len < 0 ) {
101 0         0 $self->end;
102 0         0 last;
103             }
104              
105 3 50       5 push(@ret, ''), next unless $len;
106             $is_MSWin32
107             ? MCE::Channel::_read( $self->{c_sock}, $data, $len )
108 3 50       8 : read( $self->{c_sock}, $data, $len );
109              
110 3         8 push @ret, $data;
111             }
112              
113 1 50       8 wantarray ? @ret : $ret[-1];
114             }
115             }
116              
117             sub dequeue_nb {
118 10     10 1 27 my ( $self, $count ) = @_;
119 10 100 66     26 $count = 1 if ( !$count || $count < 1 );
120              
121 10         14 my ( $plen, @ret );
122 10 50       24 local $/ = $LF if ( $/ ne $LF );
123              
124 10         18 while ( $count-- ) {
125 12         13 my $data;
126 12         32 MCE::Util::_nonblocking( $self->{c_sock}, 1 );
127              
128             $is_MSWin32
129             ? sysread( $self->{c_sock}, $plen, 4 )
130 12 50       78 : read( $self->{c_sock}, $plen, 4 );
131              
132 12         36 MCE::Util::_nonblocking( $self->{c_sock}, 0 );
133              
134 12 50       25 my $len; $len = unpack('i', $plen) if $plen;
  12         33  
135 12 100 66     40 if ( !$len || $len < 0 ) {
136 2 50 33     10 $self->end if defined $len && $len < 0;
137 2 50 33     10 push @ret, '' if defined $len && $len == 0;
138 2         4 last;
139             }
140              
141             $is_MSWin32
142             ? MCE::Channel::_read( $self->{c_sock}, $data, $len )
143 10 50       29 : read( $self->{c_sock}, $data, $len );
144              
145 10         25 push @ret, $data;
146             }
147              
148 10 100       71 wantarray ? @ret : $ret[-1];
149             }
150              
151             ###############################################################################
152             ## ----------------------------------------------------------------------------
153             ## Methods for two-way communication; producer(s) to consumers.
154             ##
155             ###############################################################################
156              
157             sub send {
158 7     7 1 653 my $self = shift;
159 7 100       21 return MCE::Channel::_ended('send') if $self->{ended};
160              
161 6         12 my $data = ''.shift;
162              
163 6 50       15 local $\ = undef if (defined $\);
164 6 50       12 MCE::Util::_sock_ready_w( $self->{p_sock} ) if $is_MSWin32;
165 6         7 print { $self->{p_sock} } pack('i', length $data) . $data;
  6         96  
166              
167 6         21 return 1;
168             }
169              
170             sub recv {
171 3     3 1 7 my ( $self ) = @_;
172 3         5 my ( $plen, $data );
173              
174 3 50       9 local $/ = $LF if ( $/ ne $LF );
175 3 50       6 MCE::Util::_sock_ready( $self->{c_sock} ) if $is_MSWin32;
176              
177             $is_MSWin32
178             ? sysread( $self->{c_sock}, $plen, 4 )
179 3 50       46 : read( $self->{c_sock}, $plen, 4 );
180              
181 3         12 my $len = unpack('i', $plen);
182 3 50       8 if ( $len < 0 ) {
183 0         0 $self->end;
184 0 0       0 return wantarray ? () : undef;
185             }
186              
187 3 100       12 return '' unless $len;
188              
189             $is_MSWin32
190             ? MCE::Channel::_read( $self->{c_sock}, $data, $len )
191 1 50       4 : read( $self->{c_sock}, $data, $len );
192              
193 1         5 $data;
194             }
195              
196             sub recv_nb {
197 3     3 1 10 my ( $self ) = @_;
198 3         6 my ( $plen, $data );
199              
200 3 50       8 local $/ = $LF if ( $/ ne $LF );
201 3         11 MCE::Util::_nonblocking( $self->{c_sock}, 1 );
202              
203             $is_MSWin32
204             ? sysread( $self->{c_sock}, $plen, 4 )
205 3 50       31 : read( $self->{c_sock}, $plen, 4 );
206              
207 3         11 MCE::Util::_nonblocking( $self->{c_sock}, 0 );
208              
209 3 50       4 my $len; $len = unpack('i', $plen) if $plen;
  3         26  
210 3 100 66     26 if ( !$len || $len < 0 ) {
211 2 50 33     10 $self->end if defined $len && $len < 0;
212 2 50 33     13 return '' if defined $len && $len == 0;
213 0 0       0 return wantarray ? () : undef;
214             }
215              
216             $is_MSWin32
217             ? MCE::Channel::_read( $self->{c_sock}, $data, $len )
218 1 50       7 : read( $self->{c_sock}, $data, $len );
219              
220 1         5 $data;
221             }
222              
223             ###############################################################################
224             ## ----------------------------------------------------------------------------
225             ## Methods for two-way communication; consumers to producer(s).
226             ##
227             ###############################################################################
228              
229             sub send2 {
230 6     6 1 1294 my $self = shift;
231 6         12 my $data = ''.shift;
232              
233 6 50       16 local $\ = undef if (defined $\);
234 6         8 local $MCE::Signal::SIG;
235              
236             {
237 6         6 local $MCE::Signal::IPC = 1;
  6         10  
238              
239 6 50       9 MCE::Util::_sock_ready_w( $self->{c_sock} ) if $is_MSWin32;
240 6         7 print { $self->{c_sock} } pack('i', length $data) . $data;
  6         88  
241             }
242              
243 6 50       19 CORE::kill($MCE::Signal::SIG, $$) if $MCE::Signal::SIG;
244              
245 6         13 return 1;
246             }
247              
248             sub recv2 {
249 3     3 1 10 my ( $self ) = @_;
250 3         4 my ( $plen, $data );
251              
252 3 50       7 local $/ = $LF if ( $/ ne $LF );
253 3 50       7 MCE::Util::_sock_ready( $self->{p_sock} ) if $is_MSWin32;
254              
255             $is_MSWin32
256             ? sysread( $self->{p_sock}, $plen, 4 )
257 3 50       39 : read( $self->{p_sock}, $plen, 4 );
258              
259 3         11 my $len = unpack('i', $plen);
260              
261 3 100       13 return '' unless $len;
262              
263             $is_MSWin32
264             ? MCE::Channel::_read( $self->{p_sock}, $data, $len )
265 1 50       4 : read( $self->{p_sock}, $data, $len );
266              
267 1         6 $data;
268             }
269              
270             sub recv2_nb {
271 3     3 1 9 my ( $self ) = @_;
272 3         4 my ( $plen, $data );
273              
274 3 50       9 local $/ = $LF if ( $/ ne $LF );
275 3         10 MCE::Util::_nonblocking( $self->{p_sock}, 1 );
276              
277             $is_MSWin32
278             ? sysread( $self->{p_sock}, $plen, 4 )
279 3 50       32 : read( $self->{p_sock}, $plen, 4 );
280              
281 3         10 MCE::Util::_nonblocking( $self->{p_sock}, 0 );
282              
283 3 50       4 my $len; $len = unpack('i', $plen) if $plen;
  3         10  
284              
285 3 100 66     19 return '' if defined $len && $len == 0;
286 1 0       3 return wantarray ? () : undef unless $len;
    50          
287              
288             $is_MSWin32
289             ? MCE::Channel::_read( $self->{p_sock}, $data, $len )
290 1 50       40 : read( $self->{p_sock}, $data, $len );
291              
292 1         6 $data;
293             }
294              
295             1;
296              
297             __END__
298              
299             ###############################################################################
300             ## ----------------------------------------------------------------------------
301             ## Module usage.
302             ##
303             ###############################################################################
304              
305             =head1 NAME
306              
307             MCE::Channel::SimpleFast - Fast channel tuned for one producer and one consumer
308              
309             =head1 VERSION
310              
311             This document describes MCE::Channel::SimpleFast version 1.887
312              
313             =head1 DESCRIPTION
314              
315             A channel class providing queue-like and two-way communication
316             for one process or thread on either end; no locking needed.
317              
318             This is similar to L<MCE::Channel::Simple> but optimized for
319             non-Unicode strings only. The main difference is that this module
320             lacks freeze-thaw serialization. Non-string arguments become
321             stringified; i.e. numbers and undef.
322              
323             The API is described in L<MCE::Channel> with the sole difference
324             being C<send> and C<send2> handle one argument.
325              
326             Current module available since MCE 1.877.
327              
328             =over 3
329              
330             =item new
331              
332             use MCE::Channel;
333              
334             my $chnl = MCE::Channel->new( impl => 'SimpleFast' );
335              
336             =back
337              
338             =head1 QUEUE-LIKE BEHAVIOR
339              
340             =over 3
341              
342             =item enqueue
343              
344             =item dequeue
345              
346             =item dequeue_nb
347              
348             =item end
349              
350             =back
351              
352             =head1 TWO-WAY IPC - PRODUCER TO CONSUMER
353              
354             =over 3
355              
356             =item send
357              
358             =item recv
359              
360             =item recv_nb
361              
362             =back
363              
364             =head1 TWO-WAY IPC - CONSUMER TO PRODUCER
365              
366             =over 3
367              
368             =item send2
369              
370             =item recv2
371              
372             =item recv2_nb
373              
374             =back
375              
376             =head1 AUTHOR
377              
378             Mario E. Roy, S<E<lt>marioeroy AT gmail DOT comE<gt>>
379              
380             =cut
381