File Coverage

blib/lib/Pipe.pm
Criterion Covered Total %
statement 223 226 98.6
branch 17 20 85.0
condition n/a
subroutine 60 61 98.3
pod 2 2 100.0
total 302 309 97.7


line stmt bran cond sub pod time code
1             package Pipe;
2 1     1   79356 use strict;
  1         4  
  1         44  
3 1     1   5 use warnings;
  1         1  
  1         40  
4 1     1   28 use 5.006;
  1         9  
  1         38  
5              
6 1     1   990 use Want qw(want);
  1         6391  
  1         1260  
7             our $DEBUG;
8              
9             our $VERSION = '0.05';
10              
11             sub logger {
12 1554     1554 1 11076 my ($self, $msg, $class) = @_;
13              
14 1554 100       4779 return if not $DEBUG;
15              
16 6 50       14 $class = $self if not $class;
17 6         264 my $t = localtime;
18 6 50       314 open my $fh, ">>", "pipe.log" or return;
19 6         54 print $fh "[$t] [$class] $msg\n";
20              
21 6         239 return;
22             }
23              
24             our $AUTOLOAD;
25              
26             AUTOLOAD {
27 53     53   28511 my ($self) = @_;
28              
29 53         91 my $module = $AUTOLOAD;
30 53         282 $module =~ s/.*:://;
31 53         94 $module =~ s/=.*//;
32 53         123 my $class = "Pipe::Tube::" . ucfirst $module;
33 53         197 $self->logger("AUTOLOAD: '$AUTOLOAD', module: '$module', class: '$class'");
34             ## no critic (ProhibitStringyEval)
35 1     1   418 eval "use $class";
  0     1   0  
  0     1   0  
  1     1   979  
  1     1   3  
  1     1   14  
  1     1   7  
  1     1   1  
  1     1   14  
  1     1   5  
  1     1   2  
  1     1   10  
  1     1   5  
  1     1   1  
  1     1   11  
  1     1   6  
  1     1   1  
  1     1   14  
  1     1   7  
  1     1   1  
  1     1   14  
  1     1   885  
  1     1   3  
  1     1   14  
  1     1   8  
  1     1   2  
  1     1   14  
  1     1   1274  
  1     1   3  
  1     1   16  
  1     1   7  
  1     1   1  
  1     1   14  
  1     1   8  
  1     1   2  
  1     1   49  
  1     1   7  
  1     1   1  
  1     1   16  
  1     1   5  
  1     1   1  
  1     1   15  
  1     1   7  
  1     1   1  
  1     1   14  
  1     1   1266  
  1     1   2  
  1     1   18  
  1     1   8  
  1     1   2  
  1     1   32  
  1     1   5  
  1     1   4  
  1         12  
  1         6  
  1         2  
  1         15  
  1         6  
  1         2  
  1         13  
  1         867  
  1         3  
  1         12  
  1         8  
  1         2  
  1         15  
  1         4  
  1         2  
  1         14  
  1         5  
  1         2  
  1         11  
  1         1213  
  1         3  
  1         15  
  1         6  
  1         3  
  1         11  
  1         5  
  1         2  
  1         12  
  1         6  
  1         2  
  1         14  
  1         993  
  1         2  
  1         16  
  1         9  
  1         2  
  1         18  
  1         6  
  1         2  
  1         13  
  1         6  
  1         1  
  1         14  
  1         6  
  1         2  
  1         10  
  1         1150  
  1         3  
  1         15  
  1         838  
  1         4  
  1         25  
  1         9  
  1         3  
  1         20  
  1         975  
  1         3  
  1         13  
  1         8  
  1         2  
  1         17  
  1         4  
  1         2  
  1         13  
  1         6  
  1         2  
  1         14  
  1         4  
  1         2  
  1         13  
  1         856  
  1         2  
  1         13  
  1         8  
  1         3  
  1         18  
  1         5  
  1         3  
  1         16  
  1         5  
  1         1  
  1         11  
  1         933  
  1         3  
  1         15  
  1         6  
  1         1  
  1         12  
  1         5  
  1         2  
  1         14  
  1         894  
  1         3  
  1         15  
  1         6  
  1         2  
  1         13  
  1         7  
  1         2  
  1         13  
  1         5  
  1         2  
  1         10  
  1         6  
  1         3  
  1         9  
  53         3419  
36 53 100       164 die "Could not load '$class' $@\n" if $@;
37              
38 52 100       212 if ($self eq "Pipe") {
39 27         69 $self = bless {}, "Pipe";
40             }
41             #my $last_thingy = (want('VOID') or want('LIST') or (want('SCALAR') and not want('OBJECT')) ? 1 : 0);
42 52         261 $self->logger("context: $_: " . want($_)) for (qw(VOID SCALAR LIST OBJECT));
43              
44 52         249 $self->logger("params: " . join "|", @_);
45 52         234 my $obj = $class->new(@_);
46 52         65 push @{ $self->{Pipe} }, $obj;
  52         213  
47              
48             #if ($last_thingy) {
49             # $self->logger("last thingy");
50             # return $self->run_pipe;
51             #}
52 52         361 return $self;
53             }
54              
55             sub run {
56 26     26 1 558 my ($self) = @_;
57 26         55 $self->logger("Pipe::run_pipe called");
58 26 50       35 return if not @{ $self->{Pipe} };
  26         76  
59              
60 26         32 my $in = shift @{ $self->{Pipe} };
  26         57  
61 26         33 my $in_finished = 0;
62 26         37 my @results;
63 26         32 while (1) {
64 253         810 $self->logger("Pipe::run_pipe calls in: $in");
65 253         690 my @res = $in->run;
66 253         928 $self->logger("Pipe::run_pipe resulted in {" . join("|", @res) . "}");
67 253 100       541 if (not @res) {
68 51         106 $self->logger("Pipe::run_pipe calling finish");
69 51         239 @res = $in->finish();
70 51         79 $in_finished = 1;
71             }
72 253         335 foreach my $i (0..@{ $self->{Pipe} }-1) {
  253         689  
73 180         300 my $call = $self->{Pipe}[$i];
74 180         563 $self->logger("Pipe::run_pipe calls: $call");
75 180         503 @res = $call->run(@res);
76 180         828 $self->logger("Pipe::run_pipe results: {" . join("}{", @res) . "}");
77 180 100       505 last if not @res;
78             }
79 253         401 push @results, @res;
80 253 100       569 if ($in_finished) {
81 51         115 $self->logger("IN finished");
82 51         61 $in = shift @{ $self->{Pipe} };
  51         103  
83 51 100       690 last if not defined $in;
84 25         49 $in_finished = 0;
85             }
86             }
87 26         163 return @results;
88             }
89              
90              
91              
92              
93 0     0     DESTROY {
94             # to avoid trouble because of AUTOLOAD catching this as well
95             }
96              
97             =head1 NAME
98              
99             Pipe - Framework to create 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/, )->uniq->print
353             Pipe->cat()->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 Development
396              
397             The Subversion repository is here: http://svn1.hostlocal.com/szabgab/trunk/Pipe/
398              
399             =head1 Thanks
400              
401             to Gaal Yahas
402              
403             =head1 AUTHOR
404              
405             Gabor Szabo
406              
407             =head1 COPYRIGHT
408              
409             Copyright 2006 by Gabor Szabo .
410              
411             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
412              
413             See http://www.perl.com/perl/misc/Artistic.html
414              
415             =head1 See Also
416              
417             L and L
418              
419              
420             =cut
421              
422             # TODOs, ideas
423             # ----------------
424             # Every pipe element have
425             # @output = $obj->run(@input)
426             # @output = $obj->finish is called when the previous thing in the pipe finishes
427             #
428             # The run function of a pipe element should return () if it has nothing more to do
429             # (either because of lack of input or some other reason. e.g. sort cannot output anything
430             # until it has all the its input data ready and thus its finish method was called
431             # The finish method also returns the output or () if notthing to say
432             #
433             # the Pipe manager can recognize that a Pipe element finished if it is the first element (so it has nothing
434             # else to wait for) and its run method returned (). Then its finish method is called and it is dropped
435             #
436             # the Pipe can easily recognize which is the first piece (it is called as class method)
437             #
438             # the Pipe needs to recognize what is the last call, we can enforce it by a speciall call ->run
439             # but if would be also nice to recognize it in other way
440             # using the Want module:
441             # $o->thing VOID
442             # $z = $o->thing SCALAR
443             # if ($o->thing) SCALAR and BOOL
444             # @ret = $o->thing LIST
445              
446             # $o->thing->other SCALAR and OBJECT
447              
448             # TODO
449             # find
450             # Improve find to provid full interface to File::Find::Rule or
451             # implement a simple version for the standard Pipe and move the one
452             # using File::Find::Rule to a separate distribution.
453             # sub
454             # Pipe->sub( sub {} ) can get any subroutine and will insert it in the pipe
455             # tupple
456             # given two or more array, on each call reaturn an array created from one element
457             # of each of the input array. Behavior in case the arrays are not the same length
458             # should be defined.
459             #
460             # process groups of values
461             # given an input stream once every n iteration return an array of the n latest elemenets
462             # and in the other n-1 iterations return (). What should happen if number of elements is
463             # not dividable by n ?
464             #
465             # say
466             # print with \n added like in Perl6 but with optional ("filename") to print to that file
467             # without explicitely opening it.
468             #
469             #=item flat
470              
471             #Will flatten a pipe. I am not sure it is useful at all.
472             #The issue is that most of the tubes are iterators but "sort" needs to collect all the inputs
473             #before it can do its job. Then, once its done, it returns the whole array in its finish()
474             #method. The rest of the pipe will get copies of this array. Including a ->flat tube in the
475             #pipe will receive all the array but then will serve them one by one
476             #
477             # Actualy I think ->for will do the same
478             #
479              
480             # - Enable alternative Pipe Manager ?
481             # - Add a call to every tube to be executed before we start running the pipe but after building it ?
482             # - Describe the access to the Pipe object from the Tubes to see how a tube could change the pipe....
483             #
484             # For each tube, describe what are the expected input values, command line values and output values
485             #
486             # Check if the context checking needs any improvement
487             # Go over all the contexts mentioned in Want and try to build a test to each one of them
488             #
489             #
490             # split up the input stream and have more than one tails
491             #
492              
493             # A tube might need to be able to terminate itself (or the whole pipe ?) without calling exit or die.
494             # We might allow any tube to tell the pipe to skip any further call to it.
495             # Or it can just decide it will keep calling return; on every call except in finish() ?
496             #
497             #
498              
499             # Trim
500              
501             # TODO: add 3rd parameter of split
502            
503             1;
504