File Coverage

blib/lib/Fsdb/Filter/dbfilestripcomments.pm
Criterion Covered Total %
statement 18 47 38.3
branch 0 4 0.0
condition n/a
subroutine 6 16 37.5
pod 6 6 100.0
total 30 73 41.1


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             #
4             # dbfilestripcomments.pm
5             # Copyright (C) 1991-2008 by John Heidemann
6             # $Id: 56971acf3abd4c1f7583a5113206c08a3a920f81 $
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              
14             package Fsdb::Filter::dbfilestripcomments;
15              
16             =head1 NAME
17              
18             dbfilestripcomments - remove comments from a fsdb file
19              
20             =head1 SYNOPSIS
21              
22             dbfilestripcomments [-h]
23              
24             =head1 DESCRIPTION
25              
26             Remove any comments in a file, including the header. This makes the
27             file unreadable by other Fsdb utilities, but perhaps more readable by
28             humans.
29              
30             With the -h option, leave the header.
31              
32             =head1 OPTIONS
33              
34             =over 4
35              
36             =item B<-h> or B<--header>
37              
38             Retain the header.
39              
40             =back
41              
42             =for comment
43             begin_standard_fsdb_options
44              
45             This module also supports the standard fsdb options:
46              
47             =over 4
48              
49             =item B<-d>
50              
51             Enable debugging output.
52              
53             =item B<-i> or B<--input> InputSource
54              
55             Read from InputSource, typically a file name, or C<-> for standard input,
56             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
57              
58             =item B<-o> or B<--output> OutputDestination
59              
60             Write to OutputDestination, typically a file name, or C<-> for standard output,
61             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
62              
63             =item B<--autorun> or B<--noautorun>
64              
65             By default, programs process automatically,
66             but Fsdb::Filter objects in Perl do not run until you invoke
67             the run() method.
68             The C<--(no)autorun> option controls that behavior within Perl.
69              
70             =item B<--help>
71              
72             Show help.
73              
74             =item B<--man>
75              
76             Show full manual.
77              
78             =back
79              
80             =for comment
81             end_standard_fsdb_options
82              
83              
84             =head1 SAMPLE USAGE
85              
86             =head2 Input:
87              
88             #fsdb -R C experiment mean stddev pct_rsd conf_range conf_low conf_high conf_pct sum sum_squared min max n
89             experiment: ufs_mab_sys
90             mean: 37.25
91             stddev: 0.070711
92             pct_rsd: 0.18983
93             conf_range: 0.6353
94             conf_low: 36.615
95             conf_high: 37.885
96             conf_pct: 0.95
97             sum: 74.5
98             sum_squared: 2775.1
99             min: 37.2
100             max: 37.3
101             n: 2
102            
103             # | /home/johnh/BIN/DB/dbmultistats experiment duration
104             # | /home/johnh/BIN/DB/dblistize
105              
106             =head2 Command:
107              
108             cat data.fsdb | dbfilestripcomments
109              
110             =head2 Output:
111              
112             experiment: ufs_mab_sys
113             mean: 37.25
114             stddev: 0.070711
115             pct_rsd: 0.18983
116             conf_range: 0.6353
117             conf_low: 36.615
118             conf_high: 37.885
119             conf_pct: 0.95
120             sum: 74.5
121             sum_squared: 2775.1
122             min: 37.2
123             max: 37.3
124             n: 2
125              
126             =head1 SEE ALSO
127              
128             L.
129             L.
130              
131              
132             =head1 CLASS FUNCTIONS
133              
134             =cut
135              
136             @ISA = qw(Fsdb::Filter);
137             $VERSION = 2.0;
138              
139 1     1   6733 use strict;
  1         3  
  1         57  
140 1     1   11 use Pod::Usage;
  1         2  
  1         196  
141 1     1   8 use Carp;
  1         2  
  1         100  
142              
143 1     1   8 use Fsdb::Filter;
  1         4  
  1         49  
144 1     1   10 use Fsdb::IO::Reader;
  1         2  
  1         53  
145 1     1   7 use Fsdb::IO::Writer;
  1         2  
  1         823  
146              
147              
148             =head2 new
149              
150             $filter = new Fsdb::Filter::dbfilestripcomments(@arguments);
151              
152             Create a new dbfilestripcomments object, taking command-line arguments.
153              
154             =cut
155              
156             sub new ($@) {
157 0     0 1   my $class = shift @_;
158 0           my $self = $class->SUPER::new(@_);
159 0           bless $self, $class;
160 0           $self->set_defaults;
161 0           $self->parse_options(@_);
162 0           $self->SUPER::post_new();
163 0           return $self;
164             }
165              
166              
167             =head2 set_defaults
168              
169             $filter->set_defaults();
170              
171             Internal: set up defaults.
172              
173             =cut
174              
175             sub set_defaults ($) {
176 0     0 1   my($self) = @_;
177 0           $self->SUPER::set_defaults();
178 0           $self->{_keep_header} = undef;
179             }
180              
181             =head2 parse_options
182              
183             $filter->parse_options(@ARGV);
184              
185             Internal: parse command-line arguments.
186              
187             =cut
188              
189             sub parse_options ($@) {
190 0     0 1   my $self = shift @_;
191              
192 0           my(@argv) = @_;
193             $self->get_options(
194             \@argv,
195 0     0     'help|?' => sub { pod2usage(1); },
196 0     0     'man' => sub { pod2usage(-verbose => 2); },
197             'autorun!' => \$self->{_autorun},
198             'close!' => \$self->{_close},
199             'd|debug+' => \$self->{_debug},
200             'h|header!' => \$self->{_keep_header},
201 0     0     'i|input=s' => sub { $self->parse_io_option('input', @_); },
202             'log!' => \$self->{_logprog},
203 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
204 0 0         ) or pod2usage(2);
205 0           push (@{$self->{_argv}}, @argv);
  0            
206             }
207              
208             =head2 setup
209              
210             $filter->setup();
211              
212             Internal: setup, parse headers.
213              
214             =cut
215              
216             sub setup ($) {
217 0     0 1   my($self) = @_;
218              
219 0           $self->finish_io_option('input');
220              
221 0 0         $self->finish_io_option('output', -clone => $self->{_in}, -outputheader => ($self->{_keep_header} ? 'now' : 'never'));
222             }
223              
224             =head2 run
225              
226             $filter->run();
227              
228             Internal: run over each rows.
229              
230             =cut
231             sub run ($) {
232 0     0 1   my($self) = @_;
233              
234 0           my $read_fastpath_sub = $self->{_in}->fastpath_sub();
235 0           my $write_fastpath_sub = $self->{_out}->fastpath_sub();
236 0           my $fref;
237              
238 0           while ($fref = &$read_fastpath_sub()) {
239 0           &$write_fastpath_sub($fref);
240             };
241             }
242              
243              
244              
245             =head2 finish
246              
247             $filter->finish();
248              
249             Internal: write trailer.
250             Or in our case, don't.
251              
252             =cut
253             sub finish ($) {
254 0     0 1   my($self) = @_;
255             # do nothing instead of calling parent
256             # $self->SUPER::finish();
257             }
258              
259             =head1 AUTHOR and COPYRIGHT
260              
261             Copyright (C) 1991-2008 by John Heidemann
262              
263             This program is distributed under terms of the GNU general
264             public license, version 2. See the file COPYING
265             with the distribution for details.
266              
267             =cut
268              
269             1;