File Coverage

blib/lib/Pipe.pm
Criterion Covered Total %
statement 222 224 99.1
branch 17 20 85.0
condition n/a
subroutine 60 61 98.3
pod 2 2 100.0
total 301 307 98.0


line stmt bran cond sub pod time code
1             package Pipe;
2 1     1   102186 use strict;
  1         2  
  1         32  
3 1     1   5 use warnings;
  1         14  
  1         28  
4 1     1   16 use 5.006;
  1         3  
5              
6 1     1   522 use Want qw(want);
  1         1804  
  1         749  
7             our $DEBUG;
8              
9             our $VERSION = '0.06';
10              
11             sub logger {
12 1560     1560 1 12098 my ($self, $msg, $class) = @_;
13              
14 1560 100       3103 return if not $DEBUG;
15              
16 6 50       12 $class = $self if not $class;
17 6         152 my $t = localtime;
18 6 50       263 open my $fh, ">>", "pipe.log" or return;
19 6         77 print $fh "[$t] [$class] $msg\n";
20              
21 6         202 return;
22             }
23              
24             our $AUTOLOAD;
25              
26             AUTOLOAD {
27 53     53   21319 my ($self) = @_;
28              
29 53         102 my $module = $AUTOLOAD;
30 53         279 $module =~ s/.*:://;
31 53         97 $module =~ s/=.*//;
32 53         122 my $class = "Pipe::Tube::" . ucfirst $module;
33 53         203 $self->logger("AUTOLOAD: '$AUTOLOAD', module: '$module', class: '$class'");
34             ## no critic (ProhibitStringyEval)
35 1     1   287 eval "use $class";
  0     1   0  
  0     1   0  
  1     1   613  
  1     1   3  
  1     1   19  
  1     1   7  
  1     1   2  
  1     1   15  
  1     1   6  
  1     1   3  
  1     1   13  
  1     1   6  
  1     1   2  
  1     1   14  
  1     1   7  
  1     1   2  
  1     1   14  
  1     1   7  
  1     1   2  
  1     1   14  
  1     1   588  
  1     1   3  
  1     1   17  
  1     1   6  
  1     1   2  
  1     1   18  
  1     1   583  
  1     1   3  
  1     1   15  
  1     1   6  
  1     1   2  
  1     1   13  
  1     1   7  
  1     1   2  
  1     1   14  
  1     1   7  
  1     1   2  
  1     1   15  
  1     1   5  
  1     1   2  
  1     1   13  
  1     1   6  
  1     1   2  
  1     1   15  
  1     1   607  
  1     1   3  
  1     1   15  
  1     1   6  
  1     1   4  
  1     1   14  
  1     1   7  
  1     1   2  
  1         13  
  1         12  
  1         1  
  1         15  
  1         7  
  1         1  
  1         13  
  1         583  
  1         3  
  1         14  
  1         7  
  1         2  
  1         15  
  1         6  
  1         2  
  1         13  
  1         7  
  1         2  
  1         32  
  1         587  
  1         3  
  1         18  
  1         6  
  1         2  
  1         14  
  1         7  
  1         2  
  1         14  
  1         7  
  1         2  
  1         14  
  1         596  
  1         2  
  1         15  
  1         6  
  1         7  
  1         15  
  1         6  
  1         2  
  1         14  
  1         6  
  1         2  
  1         15  
  1         6  
  1         2  
  1         22  
  1         595  
  1         4  
  1         14  
  1         581  
  1         3  
  1         18  
  1         7  
  1         2  
  1         15  
  1         585  
  1         3  
  1         15  
  1         7  
  1         2  
  1         14  
  1         6  
  1         2  
  1         14  
  1         6  
  1         2  
  1         15  
  1         6  
  1         2  
  1         15  
  1         583  
  1         3  
  1         18  
  1         7  
  1         2  
  1         16  
  1         6  
  1         3  
  1         13  
  1         6  
  1         2  
  1         13  
  1         558  
  1         3  
  1         15  
  1         7  
  1         2  
  1         13  
  1         7  
  1         2  
  1         16  
  1         610  
  1         2  
  1         16  
  1         8  
  1         2  
  1         15  
  1         7  
  1         2  
  1         11  
  1         7  
  1         2  
  1         13  
  1         6  
  1         2  
  1         13  
  53         2923  
36 53 100       166 die "Could not load '$class' $@\n" if $@;
37              
38 52 100       198 if ($self eq "Pipe") {
39 27         66 $self = bless {}, "Pipe";
40             }
41             #my $last_thingy = (want('VOID') or want('LIST') or (want('SCALAR') and not want('OBJECT')) ? 1 : 0);
42 52         211 $self->logger("context: $_: " . want($_)) for (qw(VOID SCALAR LIST OBJECT));
43              
44 52         209 $self->logger("params: " . join "|", @_);
45 52         200 my $obj = $class->new(@_);
46 52         71 push @{ $self->{Pipe} }, $obj;
  52         193  
47              
48             #if ($last_thingy) {
49             # $self->logger("last thingy");
50             # return $self->run_pipe;
51             #}
52 52         251 return $self;
53             }
54              
55             sub run {
56 26     26 1 436 my ($self) = @_;
57 26         53 $self->logger("Pipe::run_pipe called");
58 26 50       27 return if not @{ $self->{Pipe} };
  26         55  
59              
60 26         38 my $in = shift @{ $self->{Pipe} };
  26         46  
61 26         33 my $in_finished = 0;
62 26         33 my @results;
63 26         31 while (1) {
64 256         713 $self->logger("Pipe::run_pipe calls in: $in");
65 256         490 my @res = $in->run;
66 256         706 $self->logger("Pipe::run_pipe resulted in {" . join("|", @res) . "}");
67 256 100       453 if (not @res) {
68 51         98 $self->logger("Pipe::run_pipe calling finish");
69 51         138 @res = $in->finish();
70 51         69 $in_finished = 1;
71             }
72 256         321 foreach my $i (0..@{ $self->{Pipe} }-1) {
  256         580  
73 180         243 my $call = $self->{Pipe}[$i];
74 180         489 $self->logger("Pipe::run_pipe calls: $call");
75 180         376 @res = $call->run(@res);
76 180         562 $self->logger("Pipe::run_pipe results: {" . join("}{", @res) . "}");
77 180 100       435 last if not @res;
78             }
79 256         380 push @results, @res;
80 256 100       465 if ($in_finished) {
81 51         103 $self->logger("IN finished");
82 51         56 $in = shift @{ $self->{Pipe} };
  51         479  
83 51 100       167 last if not defined $in;
84 25         46 $in_finished = 0;
85             }
86             }
87 26         116 return @results;
88             }
89              
90              
91              
92              
93       0     DESTROY {
94             # to avoid trouble because of AUTOLOAD catching this as well
95             }
96              
97             =head1 NAME
98              
99             Pipe - Framework for creating pipes using iterators
100              
101             =head1 SYNOPSIS
102              
103             use Pipe;
104             my @input = Pipe->cat("t/data/file1", "t/data/file2")->run;
105             my @lines = Pipe->cat("t/data/file1", "t/data/file2")->chomp->run;
106             my @uniqs = Pipe->cat("t/data/file1", "t/data/file2")->chomp->uniq->run;
107              
108             my $pipe = Pipe->cat("t/data/file1", "t/data/file2")->uniq->print("t/data/out");
109             $pipe->run;
110              
111              
112             =head1 WARNING
113              
114             This is Alpha version. The user API might still change
115              
116             =head1 DESCRIPTION
117              
118             Building an iterating pipe with prebuilt and home made tubes.
119              
120             =head2 Methods
121              
122             =over 4
123              
124             =item logger
125              
126             Method to print something to the log file, especially for debugging
127             This method is here to be use by Tube authors
128              
129             $self->logger("log messages");
130              
131             =item run
132              
133             The method that actually executes the whole pipe.
134              
135             my $pipe = Pipe->cat("file");
136             $pipe->run;
137              
138             =back
139              
140             =head2 Tubes
141              
142             Tubes available in this distibution:
143              
144             =over 4
145              
146             =item cat
147              
148             Read in the lines of one or more file.
149              
150             =item chomp
151              
152             Remove trailing newlines from each line.
153              
154              
155             =item find
156              
157             Pipe->find(".")
158              
159             Returns every file, directory, etc. under the directory tree passed to it.
160              
161             =item for
162              
163             Pipe->for(@array)
164              
165             Iterates over the elements of an array. Basically the same as the for or foreach loop of Perl.
166              
167             =item glob
168              
169             Implements the Perl glob function.
170              
171             =item grep
172              
173             Selectively pass on values.
174              
175             Can be used either with a regex:
176              
177             ->grep( qr/regex/ )
178              
179             Or with a sub:
180              
181             ->grep( sub { length($_[0]) > 12 } )
182              
183              
184             Very similar to the built-in grep command of Perl but instead of regex
185             you have to pass a compiled regex using qr// and instead of a block you
186             have to pass an anonymous sub {}
187              
188             =item map
189              
190             Similar to the Perl map construct, except that instead of a block you pass
191             an anonymous function sub {}.
192              
193             ->map( sub { length $_[0] } );
194              
195             =item print
196              
197             Prints out its input.
198             By default it prints to STDOUT but the user can supply a filename or a filehandle.
199              
200             Pipe->cat("t/data/file1", "t/data/file2")->print;
201             Pipe->cat("t/data/file1", "t/data/file2")->print("out.txt");
202             Pipe->cat("t/data/file1", "t/data/file2")->print(':a', "out.txt");
203              
204             =item say
205              
206             It is the same as print but adds a newline at the end of each line.
207             The name is Perl6 native.
208              
209             =item sort
210              
211             Similar to the built in sort function of Perl. As sort needs to have all
212             the data in the memory, once you use sort in the Pipe it stops being
213             an iterator for the rest of the pipe.
214              
215             By default it sorts based on ascii table but you can provide your own
216             sorting function. The two values to be compared are passed to this function.
217              
218             Pipe->cat("t/data/numbers1")->chomp->sort( sub { $_[0] <=> $_[1] } );
219              
220             =item split
221              
222             Given a regex (or a simple string), will split all the incoming strings and return
223             an array reference for each row.
224              
225             Param: string or regex using qr//
226              
227             Input: string(s)
228              
229             Output: array reference(s)
230              
231             =item tuple
232              
233             Given one or more array references, on every iteration it will return an n-tuple
234             (n is the number of arrays), one value from each source array.
235              
236             my @a = qw(foo bar baz moo);
237             my @b = qw(23 37 77 42);
238              
239             my @one_tuple = Pipe->tuple(\@a);
240             # @one_tuple is ['foo'], ['bar'], ['baz'], ['moo']
241              
242             my @two_tuple = Pipe->tuple(\@a, \@b);
243             # @two_tuple is ['foo', 23], ['bar', 37], ['baz', 77], ['moo', 42]
244              
245             Input: disregards any input so it can be used as a starting element of a Pipe
246              
247             Ouput: array refs of n elements
248              
249             =item uniq
250              
251             Similary to the unix uniq command eliminate duplicate consecutive values.
252              
253             23, 23, 19, 23 becomes 23, 19, 23
254              
255             Warning: as you can see from the example this method does not give real unique
256             values, it only eliminates consecutive duplicates.
257              
258             =back
259              
260             =head1 Building your own tube
261              
262             If you would like to build a tube called "thing" create a module called
263             Pipe::Tube::Thing that inherits from Pipe::Tube, our abstract Tube.
264              
265             Implement one or more of these methods in your subclass as you please.
266              
267             =over 4
268              
269             =item init
270              
271             Will be called once when initializing the pipeline.
272             It will get ($self, @args) where $self is the Pipe::Tube::Thing object
273             and @args are the values given as parameters to the ->thing(@args) call
274             in the pipeline.
275              
276             =item run
277              
278             Will be called every time the previous tube in the pipe returns one or more values.
279             It can return a list of values that will be passed on to the next tube.
280             If based on the current state of Thing there is nothing to do you should call
281             return; with no parameters.
282              
283             =item finish
284              
285             Will be called once when the Pipe Manager notices that this Thing should be finished.
286             This happens when Thing is the first active element in the pipe (all the previous tubes
287             have already finshed) and its run() method returns an empty list.
288              
289             The finish() method should return a list of values that will be passed on to the next
290             tube in the pipe. This is especially useful for Tubes such as sort that can to their thing
291             only after they have received all the input.
292              
293             =back
294              
295             =head2 Debugging your tube
296              
297             You can call $self->logger("some message") from your tube.
298             It will be printed to pipe.log if someone sets $Pipe::DEBUG = 1;
299              
300             =head1 Examples
301              
302             A few examples of UNIX Shell commands combined with pipelines
303              
304             =over 4
305              
306             =item *
307              
308             cat several files together
309              
310             UNIX:
311              
312             cat file1 file2 > filenew
313              
314             Perl:
315              
316             open my $out, ">", "filenew" or die $!;
317             while (<>) {
318             print $out $_;
319             }
320              
321              
322             Perl with Pipe:
323              
324             perl -MPipe 'Pipe->cat(@ARG)->print("filenew")'
325              
326             =item *
327              
328             UNIX:
329              
330             grep REGEX file* | uniq
331              
332             Perl:
333              
334             my $last;
335             while (<>) {
336             next if not /REGEX/;
337              
338             if (not defined $last) {
339             $last = $_;
340             print;
341             next;
342             }
343             next if $last eq $_;
344             $last = $_;
345             print;
346             }
347              
348             Perl with Pipe:
349              
350             one of these will work, we hope:
351              
352             Pipe->grep(qr/REGEX/, <file*>)->uniq->print
353             Pipe->cat(<file*>)->grep(qr/REGEX/)->uniq->print
354             Pipe->files("file*")->cat->grep(qr/REGEX/)->uniq->print
355              
356             =item *
357              
358             UNIX:
359              
360             find / -name filename -print
361              
362             Perl with Pipe:
363              
364             perl -MPipe -e'Pipe->find("/")->grep(qr/filename/)->print'
365              
366             =item *
367              
368             Delete all the CVS directories in a directory tree (from the journal of brian_d_foy)
369             http://use.perl.org/~brian_d_foy/journal/29267
370              
371             UNIX:
372              
373             find . -name CVS | xargs rm -rf
374              
375             find . -name CVS -type d -exec rm -rf '{}' \;
376              
377             Perlish:
378              
379             find2perl . -name CVS -type d -exec rm -rf '{}' \; > rm-cvs.pl
380             perl rm-cvs.pl
381              
382             Perl with Pipe:
383              
384             perl -MPipe -e'Pipe->find(".")->grep(qr/^CVS$/)->rmtree;
385              
386              
387             =back
388              
389              
390              
391             =head1 BUGS
392              
393             Probably plenty but nothing I know of. Please report them to the author.
394              
395             =head1 Thanks
396              
397             to Gaal Yahas
398              
399             =head1 AUTHOR
400              
401             Gabor Szabo L<http://szabgab.com/>
402              
403             =head1 COPYRIGHT
404              
405             Copyright 2006 by Gabor Szabo <szabgab@cpan.org>.
406              
407             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
408              
409             See http://www.perl.com/perl/misc/Artistic.html
410              
411             =head1 See Also
412              
413             L<Shell::Autobox> and L<File::Tools>
414              
415              
416             =cut
417              
418             # TODOs, ideas
419             # ----------------
420             # Every pipe element have
421             # @output = $obj->run(@input)
422             # @output = $obj->finish is called when the previous thing in the pipe finishes
423             #
424             # The run function of a pipe element should return () if it has nothing more to do
425             # (either because of lack of input or some other reason. e.g. sort cannot output anything
426             # until it has all the its input data ready and thus its finish method was called
427             # The finish method also returns the output or () if notthing to say
428             #
429             # the Pipe manager can recognize that a Pipe element finished if it is the first element (so it has nothing
430             # else to wait for) and its run method returned (). Then its finish method is called and it is dropped
431             #
432             # the Pipe can easily recognize which is the first piece (it is called as class method)
433             #
434             # the Pipe needs to recognize what is the last call, we can enforce it by a speciall call ->run
435             # but if would be also nice to recognize it in other way
436             # using the Want module:
437             # $o->thing VOID
438             # $z = $o->thing SCALAR
439             # if ($o->thing) SCALAR and BOOL
440             # @ret = $o->thing LIST
441              
442             # $o->thing->other SCALAR and OBJECT
443              
444             # TODO
445             # find
446             # Improve find to provid full interface to File::Find::Rule or
447             # implement a simple version for the standard Pipe and move the one
448             # using File::Find::Rule to a separate distribution.
449             # sub
450             # Pipe->sub( sub {} ) can get any subroutine and will insert it in the pipe
451             # tupple
452             # given two or more array, on each call reaturn an array created from one element
453             # of each of the input array. Behavior in case the arrays are not the same length
454             # should be defined.
455             #
456             # process groups of values
457             # given an input stream once every n iteration return an array of the n latest elemenets
458             # and in the other n-1 iterations return (). What should happen if number of elements is
459             # not dividable by n ?
460             #
461             # say
462             # print with \n added like in Perl6 but with optional ("filename") to print to that file
463             # without explicitely opening it.
464             #
465             #=item flat
466              
467             #Will flatten a pipe. I am not sure it is useful at all.
468             #The issue is that most of the tubes are iterators but "sort" needs to collect all the inputs
469             #before it can do its job. Then, once its done, it returns the whole array in its finish()
470             #method. The rest of the pipe will get copies of this array. Including a ->flat tube in the
471             #pipe will receive all the array but then will serve them one by one
472             #
473             # Actualy I think ->for will do the same
474             #
475              
476             # - Enable alternative Pipe Manager ?
477             # - Add a call to every tube to be executed before we start running the pipe but after building it ?
478             # - Describe the access to the Pipe object from the Tubes to see how a tube could change the pipe....
479             #
480             # For each tube, describe what are the expected input values, command line values and output values
481             #
482             # Check if the context checking needs any improvement
483             # Go over all the contexts mentioned in Want and try to build a test to each one of them
484             #
485             #
486             # split up the input stream and have more than one tails
487             #
488              
489             # A tube might need to be able to terminate itself (or the whole pipe ?) without calling exit or die.
490             # We might allow any tube to tell the pipe to skip any further call to it.
491             # Or it can just decide it will keep calling return; on every call except in finish() ?
492             #
493             #
494              
495             # Trim
496              
497             # TODO: add 3rd parameter of split
498            
499             1;
500