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
|
|
|
|
|
|
|
|