File Coverage

blib/lib/Fsdb/Filter/dbfilecat.pm
Criterion Covered Total %
statement 20 86 23.2
branch 0 36 0.0
condition 0 6 0.0
subroutine 7 17 41.1
pod 5 5 100.0
total 32 150 21.3


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2              
3             #
4             # dbfilecat.pm
5             # Copyright (C) 2013-2015 by John Heidemann
6             # $Id: b5d7e701dd3144b94bc1eda278c8f221f9593eb7 $
7             #
8             # This program is distributed under terms of the GNU general
9             # public license, version 2. See the file COPYING
10             # in $dblibdir for details.
11             #
12              
13             package Fsdb::Filter::dbfilecat;
14              
15             =head1 NAME
16              
17             dbfilecat - concatenate two files with identical schema
18              
19             =head1 SYNOPSIS
20              
21             dbfilecat --input A.fsdb [--input B.fsdb...]
22              
23             or
24              
25             echo A.fsdb | dbfilecat --xargs
26              
27              
28             =head1 DESCRIPTION
29              
30             Concatenate all provided input files,
31             producing one result.
32             We remove extra header lines.
33              
34             Inputs can both be specified with C<--input>, or one can come
35             from standard input and the other from C<--input>.
36             With C<--xargs>, each line of standard input is a filename for input.
37              
38             Inputs must have identical schemas (columns, column order,
39             and field separators).
40              
41             Like L, but no worries about sorting,
42             and with no arguments we read standard input
43             (although that's not very useful).
44              
45              
46             =head1 OPTIONS
47              
48             General option:
49              
50             =over 4
51              
52             =item B<--xargs>
53              
54             Expect that input filenames are given, one-per-line, on standard input.
55             (In this case, merging can start incrementally.
56              
57             =item B<--removeinputs>
58              
59             Delete the source files after they have been consumed.
60             (Defaults off, leaving the inputs in place.)
61              
62             =for comment
63             begin_standard_fsdb_options
64              
65             This module also supports the standard fsdb options:
66              
67             =item B<-d>
68              
69             Enable debugging output.
70              
71             =item B<-i> or B<--input> InputSource
72              
73             Read from InputSource, typically a file name, or C<-> for standard input,
74             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
75              
76             =item B<-o> or B<--output> OutputDestination
77              
78             Write to OutputDestination, typically a file name, or C<-> for standard output,
79             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
80              
81             =item B<--autorun> or B<--noautorun>
82              
83             By default, programs process automatically,
84             but Fsdb::Filter objects in Perl do not run until you invoke
85             the run() method.
86             The C<--(no)autorun> option controls that behavior within Perl.
87              
88             =item B<--help>
89              
90             Show help.
91              
92             =item B<--man>
93              
94             Show full manual.
95              
96             =back
97              
98             =for comment
99             end_standard_fsdb_options
100              
101              
102             =head1 SAMPLE USAGE
103              
104             =head2 Input:
105              
106             File F:
107              
108             #fsdb cid cname
109             11 numanal
110             10 pascal
111              
112             File F:
113              
114             #fsdb cid cname
115             12 os
116             13 statistics
117              
118             =head2 Command:
119              
120             dbfilecat --input a.fsdb --input b.fsdb
121              
122              
123             =head2 Output:
124              
125             #fsdb cid cname
126             11 numanal
127             10 pascal
128             12 os
129             13 statistics
130             # | dbmerge --input a.fsdb --input b.fsdb
131              
132             =head1 SEE ALSO
133              
134             L,
135             L
136              
137             =head1 CLASS FUNCTIONS
138              
139             =cut
140              
141              
142             @ISA = qw(Fsdb::Filter);
143             ($VERSION) = 2.0;
144              
145 1     1   6000 use 5.010;
  1         3  
146 1     1   5 use strict;
  1         1  
  1         31  
147 1     1   4 use Carp qw(croak carp);
  1         1  
  1         77  
148 1     1   6 use Pod::Usage;
  1         2  
  1         126  
149              
150 1     1   6 use Fsdb::Filter;
  1         6  
  1         20  
151 1     1   5 use Fsdb::IO::Reader;
  1         1  
  1         24  
152 1     1   4 use Fsdb::IO::Writer;
  1         2  
  1         1059  
153              
154              
155             =head2 new
156              
157             $filter = new Fsdb::Filter::dbmerge(@arguments);
158              
159             Create a new object, taking command-line arguments.
160              
161             =cut
162              
163             sub new($@) {
164 0     0 1   my $class = shift @_;
165 0           my $self = $class->SUPER::new(@_);
166 0           bless $self, $class;
167 0           $self->set_defaults;
168 0           $self->parse_options(@_);
169 0           $self->SUPER::post_new();
170 0           return $self;
171             }
172              
173              
174             =head2 set_defaults
175              
176             $filter->set_defaults();
177              
178             Internal: set up defaults.
179              
180             =cut
181              
182             sub set_defaults($) {
183 0     0 1   my $self = shift @_;
184 0           $self->SUPER::set_defaults();
185 0           $self->{_remove_inputs} = undef;
186 0           $self->{_xargs} = undef;
187             }
188              
189             =head2 parse_options
190              
191             $filter->parse_options(@ARGV);
192              
193             Internal: parse command-line arguments.
194              
195             =cut
196              
197             sub parse_options($@) {
198 0     0 1   my $self = shift @_;
199              
200 0           my(@argv) = @_;
201 0           my $past_sort_options = undef;
202             $self->get_options(
203             \@argv,
204 0     0     'help|?' => sub { pod2usage(1); },
205 0     0     'man' => sub { pod2usage(-verbose => 2); },
206             'autorun!' => \$self->{_autorun},
207             'close!' => \$self->{_close},
208             'd|debug+' => \$self->{_debug},
209 0     0     'i|input=s@' => sub { $self->parse_io_option('inputs', @_); },
210             'log!' => \$self->{_logprog},
211 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
212             'removeinputs!' => \$self->{_remove_inputs},
213             'xargs!' => \$self->{_xargs},
214 0 0         ) or pod2usage(2);
215             }
216              
217             =head2 setup
218              
219             $filter->setup();
220              
221             Internal: setup, parse headers.
222              
223             =cut
224              
225             sub setup($) {
226 0     0 1   my($self) = @_;
227              
228 0 0         if ($#{$self->{_inputs}} == -1) {
  0            
229             # default to stdin
230 0           push(@{$self->{_inputs}}, '-');
  0            
231             };
232 0 0 0       if ($self->{_xargs} && $#{$self->{_inputs}} > 0) {
  0            
233 0           croak $self->{_prog} . ": --xargs and multiple inputs (perhaps you meant NOT --xargs?).\n";
234             };
235 0 0 0       if (!$self->{_xargs} && $self->{_remove_inputs}) {
236 0           croak $self->{_prog} . ": --remove_inputs only works with --xargs.\n";
237             };
238              
239 0 0         if ($self->{_xargs}) {
240             croak $self->{_prog} . ": --xargs and internal error, no input.\n"
241 0 0         if ($#{$self->{_inputs}} != 0);
  0            
242             # have to delay comments in next line because otherwise _out is not yet open
243 0           $self->finish_io_option('inputs', -header => '#fsdb filename', -comment_handler => $self->create_delay_comments_sub);
244             croak $self->{_prog} . ": xargs setup input stream failed " . $self->{_ins}[0]->error() . "\n"
245 0 0         if ($self->{_ins}[0]->error());
246             } else {
247 0           $self->finish_io_option('inputs', -comment_handler => $self->create_pass_comments_sub);
248 0           foreach (@{$self->{_ins}}) {
  0            
249             croak $self->{_prog} . ": input streams have different schemas; cannot concatenate\n"
250 0 0         if ($self->{_ins}[0]->compare($_) ne 'identical');
251             };
252 0           $self->finish_io_option('output', -clone => $self->{_ins}[0]);
253             };
254             }
255              
256             =head2 _run_one
257              
258             $filter->_run_one();
259              
260             Internal: stream out one input stream.
261              
262             =cut
263             sub _run_one($) {
264 0     0     my($self, $in) = @_;
265 0           my $read_fastpath_sub = $in->fastpath_sub();
266 0           my $write_fastpath_sub = $self->{_out}->fastpath_sub();
267 0           my $fref;
268 0 0         print STDERR "# dbfilecat: _run_one start\n" if ($self->{_debug});
269 0           while ($fref = &$read_fastpath_sub()) {
270 0           &$write_fastpath_sub($fref);
271             };
272 0 0         print STDERR "# dbfilecat: _run_one end\n" if ($self->{_debug});
273             }
274              
275             =head2 run
276              
277             $filter->run();
278              
279             Internal: run over each rows.
280              
281             =cut
282             sub run($) {
283 0     0 1   my($self) = @_;
284              
285 0 0         if ($self->{_xargs}) {
286 0           my $inputs = 0;
287 0           my $read_fastpath_sub = $self->{_ins}[0]->fastpath_sub();
288 0           while (my $fref = &$read_fastpath_sub()) {
289 0           $inputs++;
290 0 0         print STDERR "# dbfilecat: xargs got $fref->[0]\n" if ($self->{_debug});
291 0           my $this_in = new Fsdb::IO::Reader(-file => $fref->[0], -comment_handler => $self->create_tolerant_pass_comments_sub());
292 0 0         if (!$self->{_out}) {
293 0           $self->finish_io_option('output', -clone => $this_in);
294             } else {
295             croak $self->{_prog} . ": input streams have different schemas; cannot concatenate\n"
296 0 0         if ($self->{_out}->compare($this_in) ne 'identical');
297             };
298 0           $self->_run_one($this_in);
299 0 0         if ($self->{_remove_inputs}) {
300             unlink($fref->[0]) or
301 0 0         carp $self->{_prog} . ": --remove-inputs, but cannot remove " . $fref->[0] . "\n";
302             };
303             };
304 0 0         croak $self->{_prog} . ": no input with --xargs\n"
305             if ($inputs == 0);
306             } else {
307 0           foreach my $in (@{$self->{_ins}}) {
  0            
308 0           $self->_run_one($in);
309             };
310 0 0         print STDERR "# dbfilecat: _ins end\n" if ($self->{_debug});
311             };
312             };
313              
314              
315              
316             =head1 AUTHOR and COPYRIGHT
317              
318             Copyright (C) 2013-2015 by John Heidemann
319              
320             This program is distributed under terms of the GNU general
321             public license, version 2. See the file COPYING
322             with the distribution for details.
323              
324             =cut
325              
326             1;