File Coverage

blib/lib/Fsdb/Filter/dbfilealter.pm
Criterion Covered Total %
statement 15 53 28.3
branch 0 12 0.0
condition n/a
subroutine 5 14 35.7
pod 5 5 100.0
total 25 84 29.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2              
3             #
4             # dbfilealter.pm
5             # Copyright (C) 2008-2015 by John Heidemann
6             # $Id: 452833c6982aef27189f6f944be088d26f6413e2 $
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::dbfilealter;
14              
15             =head1 NAME
16              
17             dbfilealter - alter the format of an Fsdb file, changing the row/column separator
18              
19             =head1 SYNOPSIS
20              
21             dbfilealter [-c] [-F fs] [-R rs] [-Z compression] [column...]
22              
23             =head1 DESCRIPTION
24              
25             This program reformats a Fsdb file,
26             altering the row (C<-R rs>) or column (C<-F fs>) separator.
27             It verifies that this action does not violate the
28             file constraints (for example, if spaces appear in data and
29             the new format has space as a separator),
30             and optionally corrects things.
31              
32             With C<-Z compression> it controls compression on the file
33              
34             =head1 OPTIONS
35              
36             =over 4
37              
38             =item B<-F> or B<--fs> or B<--fieldseparator> S
39              
40             Specify the field (column) separator as C.
41             See below for valid field separators.
42              
43             =item B<-R> or B<--rs> or B<--rowseparator> S
44              
45             Specify the row separator as C.
46             See below for valid row separators.
47              
48             =item B<-Z> or B<--compression> S
49              
50             Specify file compression as given by file extension C.
51             Supported compressions are F for gzip,
52             F for bzip2,
53             F for xz,
54             or "none" or undef to disable compression.
55             Default is none.
56              
57             =item B<-c> or B<--correct>
58              
59             Correct any inconsistency caused by the new separators,
60             if possible.
61              
62             =back
63              
64             =for comment
65             begin_standard_fsdb_options
66              
67             This module also supports the standard fsdb options:
68              
69             =over 4
70              
71             =item B<-d>
72              
73             Enable debugging output.
74              
75             =item B<-i> or B<--input> InputSource
76              
77             Read from InputSource, typically a file name, or C<-> for standard input,
78             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
79              
80             =item B<-o> or B<--output> OutputDestination
81              
82             Write to OutputDestination, typically a file name, or C<-> for standard output,
83             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
84              
85             =item B<--autorun> or B<--noautorun>
86              
87             By default, programs process automatically,
88             but Fsdb::Filter objects in Perl do not run until you invoke
89             the run() method.
90             The C<--(no)autorun> option controls that behavior within Perl.
91              
92             =item B<--help>
93              
94             Show help.
95              
96             =item B<--man>
97              
98             Show full manual.
99              
100             =back
101              
102             =for comment
103             end_standard_fsdb_options
104              
105             =head2 Valid Field Separators
106              
107              
108             =over 4
109              
110             =item B
111             default: any amount of whitespace on input, tabs on output.
112              
113             =item B
114             single space (exactly one space for input and output).
115              
116             =item B
117             double space on output; two or more spaces on input.
118              
119             =item B
120             single tab character (exactly one tab for input and output).
121              
122             =item B
123             take I as one or more hex digits that specify a unicode character.
124             Accept one or more of those characters on input,
125             output exactly one of those characters.
126              
127             =item B
128             take I as a one (unicode) literal character.
129             Accept one or more of those characters on input,
130             output exactly one of those characters.
131              
132             =back
133              
134             Potentially in the future C and C will support
135             single-character-on-input equivalents of C and .
136              
137             =head2 Valid Row Seperators
138              
139             Three row separators are allowed:
140              
141             =over 4
142              
143             =item B
144             the default, one line per row
145              
146             =item B
147             complete rowized.
148             Each line is a field-labeled and its value,
149             and a blank line separates "rows".
150             All fields present in the output.
151              
152             =item B
153             incompletely rowized.
154             Like C, but
155             null fields are omitted from the output.
156              
157             =back
158              
159              
160             =head1 SAMPLE USAGE
161              
162             =head2 Input:
163              
164             #fsdb name id test1
165             a 1 80
166             b 2 70
167             c 3 65
168              
169             =head2 Command:
170              
171             cat data.fsdb | dbfilealter -F S
172              
173             =head2 Output:
174              
175             #fsdb -F S name id test1
176             a 1 80
177             b 2 70
178             c 3 65
179             # | dbfilealter -F S
180              
181             =head2 Command 2:
182              
183             cat data.fsdb | dbfilealter -R C
184              
185             =head2 Output:
186              
187             #fsdb -R C name id test1
188             name: a
189             id: 1
190             test1: 80
191            
192             name: b
193             id: 2
194             test1: 70
195            
196             name: c
197             id: 3
198             test1: 65
199            
200             # | dbfilealter -R C
201              
202             =head2 Correction mode input:
203              
204             #fsdb -F S name id test1
205             a student 1 80
206             b nice 2 70
207             c all 3 65
208              
209             =head2 Correction mode command:
210              
211             cat correction.fsdb | dbfilealter -c -F D
212              
213             =head2 Correction mode output:
214              
215             #fsdb name id test1
216             a_student 1 80
217             b_nice 2 70
218             c_all 3 65
219             # | dbfilealter -c -F D
220              
221             =head1 SEE ALSO
222              
223             L,
224             L.
225              
226              
227             =head1 CLASS FUNCTIONS
228              
229             =cut
230              
231             @ISA = qw(Fsdb::Filter);
232             ($VERSION) = 2.0;
233              
234 1     1   7361 use strict;
  1         2  
  1         36  
235 1     1   4 use Pod::Usage;
  1         3  
  1         148  
236 1     1   5 use Carp;
  1         2  
  1         59  
237              
238 1     1   4 use Fsdb::Filter;
  1         2  
  1         26  
239 1     1   3 use Fsdb::IO::Writer;
  1         2  
  1         567  
240              
241              
242             =head2 new
243              
244             $filter = new Fsdb::Filter::dbfilealter(@arguments);
245              
246             Create a new dbfilealter object, taking command-line arguments.
247              
248             =cut
249              
250             sub new ($@) {
251 0     0 1   my $class = shift @_;
252 0           my $self = $class->SUPER::new(@_);
253 0           bless $self, $class;
254 0           $self->set_defaults;
255 0           $self->parse_options(@_);
256 0           $self->SUPER::post_new();
257 0           return $self;
258             }
259              
260              
261             =head2 set_defaults
262              
263             $filter->set_defaults();
264              
265             Internal: set up defaults.
266              
267             =cut
268              
269             sub set_defaults ($) {
270 0     0 1   my($self) = @_;
271 0           $self->SUPER::set_defaults();
272 0           $self->{_fscode} = undef;
273 0           $self->{_rscode} = undef;
274 0           $self->{_compression} = undef;
275 0           $self->{_correct} = undef;
276             }
277              
278             =head2 parse_options
279              
280             $filter->parse_options(@ARGV);
281              
282             Internal: parse command-line arguments.
283              
284             =cut
285              
286             sub parse_options ($@) {
287 0     0 1   my $self = shift @_;
288              
289 0           my(@argv) = @_;
290             $self->get_options(
291             \@argv,
292 0     0     'help|?' => sub { pod2usage(1); },
293 0     0     'man' => sub { pod2usage(-verbose => 2); },
294             'autorun!' => \$self->{_autorun},
295             'close!' => \$self->{_close},
296             'c|correct!' => \$self->{_correct},
297             'd|debug+' => \$self->{_debug},
298             'F|fs|cs|fieldseparator|columnseparator=s' => \$self->{_fscode},
299 0     0     'i|input=s' => sub { $self->parse_io_option('input', @_); },
300             'log!' => \$self->{_logprog},
301 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
302             'R|rs|rowseparator=s' => \$self->{_rscode},
303             'Z|compression=s' => \$self->{_compression},
304 0 0         ) or pod2usage(2);
305 0           push (@{$self->{_cols}}, @argv);
  0            
306             }
307              
308             =head2 setup
309              
310             $filter->setup();
311              
312             Internal: setup, parse headers.
313              
314             =cut
315              
316             sub setup ($) {
317 0     0 1   my($self) = @_;
318              
319 0           $self->finish_io_option('input', -comment_handler => $self->create_pass_comments_sub);
320              
321             # all the hard work is on the next line where we force the right codes
322 0           my @out_args = ();
323             push (@out_args, -fscode => $self->{_fscode})
324 0 0         if (defined($self->{_fscode}));
325             push (@out_args, -rscode => $self->{_rscode})
326 0 0         if (defined($self->{_rscode}));
327             push (@out_args, -compression => $self->{_compression})
328 0 0         if (defined($self->{_compression}));
329 0           $self->finish_io_option('output', -clone => $self->{_in}, @out_args);
330             }
331              
332             =head2 run
333              
334             $filter->run();
335              
336             Internal: run over each rows.
337              
338             =cut
339             sub run ($) {
340 0     0 1   my($self) = @_;
341             # can't get any easier than this
342 0           my $read_fastpath_sub = $self->{_in}->fastpath_sub();
343 0           my $out = $self->{_out};
344 0           my $write_fastpath_sub = $self->{_out}->fastpath_sub();
345 0           my $loop_sub;
346             my $loop_sub_code = q'
347             $loop_sub = sub {
348             my $fref;
349             while ($fref = &$read_fastpath_sub()) {
350             ' .
351 0 0         ($self->{_correct} ? '$out->correct_fref_containing_fs($fref);' : '') .
352             '
353             &$write_fastpath_sub($fref);
354             };
355             }';
356 0           eval $loop_sub_code;
357 0 0         $@ && die $self->{_prog} . ": internal eval error: $@.\n";
358              
359 0           &$loop_sub();
360             }
361              
362             =head1 AUTHOR and COPYRIGHT
363              
364             Copyright (C) 2008-2015 by John Heidemann
365              
366             This program is distributed under terms of the GNU general
367             public license, version 2. See the file COPYING
368             with the distribution for details.
369              
370             =cut
371              
372             1;