File Coverage

blib/lib/Fsdb/Filter/dbrowdiff.pm
Criterion Covered Total %
statement 18 70 25.7
branch 0 16 0.0
condition n/a
subroutine 6 17 35.2
pod 5 5 100.0
total 29 108 26.8


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             #
4             # dbrowdiff.pm
5             # Copyright (C) 1991-2008 by John Heidemann
6             # $Id: 17b7079e396a9ac89246edb3bd38b8b7e8d021c4 $
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::dbrowdiff;
14              
15             =head1 NAME
16              
17             dbrowdiff - compute row-by-row differences of some column
18              
19             =head1 SYNOPSIS
20              
21             dbrowdiff [-B|-I] column
22              
23             =head1 DESCRIPTION
24              
25             For a given column, compute the differences between each row
26             of the table. Differences are output to two new columns,
27             C and C.
28              
29             Differences are either relative to the previous column
30             (I mode), or relative to the first row
31             (I mode), the default.
32              
33             =head1 OPTIONS
34              
35             =over 4
36              
37             =item B<-B> or B<--baseline>
38              
39             Select baseline mode (the default), where differences are relative to the first row.
40              
41             =item B<-I> or B<--incremental>
42              
43             Select incremental mode, where differences are relative to the previous row.
44              
45             =item B<-f FORMAT> or B<--format FORMAT>
46              
47             Specify a L-style format for output statistics.
48             Defaults to C<%.5g>.
49              
50             =back
51              
52              
53             =for comment
54             begin_standard_fsdb_options
55              
56             This module also supports the standard fsdb options:
57              
58             =over 4
59              
60             =item B<-d>
61              
62             Enable debugging output.
63              
64             =item B<-i> or B<--input> InputSource
65              
66             Read from InputSource, typically a file name, or C<-> for standard input,
67             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
68              
69             =item B<-o> or B<--output> OutputDestination
70              
71             Write to OutputDestination, typically a file name, or C<-> for standard output,
72             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
73              
74             =item B<--autorun> or B<--noautorun>
75              
76             By default, programs process automatically,
77             but Fsdb::Filter objects in Perl do not run until you invoke
78             the run() method.
79             The C<--(no)autorun> option controls that behavior within Perl.
80              
81             =item B<--help>
82              
83             Show help.
84              
85             =item B<--man>
86              
87             Show full manual.
88              
89             =back
90              
91             =for comment
92             end_standard_fsdb_options
93              
94              
95             =head1 SAMPLE USAGE
96              
97             =head2 Input:
98              
99             #fsdb event clock
100             _null_getpage+128 815812813.281756
101             _null_getpage+128 815812813.328709
102             _null_getpage+128 815812813.353830
103             _null_getpage+128 815812813.357169
104             _null_getpage+128 815812813.375844
105             _null_getpage+128 815812813.378358
106             # | /home/johnh/BIN/DB/dbrow
107             # | /home/johnh/BIN/DB/dbcol event clock
108              
109             =head2 Command:
110              
111             cat DATA/kitrace.fsdb | dbrowdiff clock
112              
113             =head2 Output:
114              
115             #fsdb event clock absdiff pctdiff
116             _null_getpage+128 815812813.281756 0 0
117             _null_getpage+128 815812813.328709 0.046953 5.7554e-09
118             _null_getpage+128 815812813.353830 0.072074 8.8346e-09
119             _null_getpage+128 815812813.357169 0.075413 9.2439e-09
120             _null_getpage+128 815812813.375844 0.094088 1.1533e-08
121             _null_getpage+128 815812813.378358 0.096602 1.1841e-08
122             # | /home/johnh/BIN/DB/dbrow
123             # | /home/johnh/BIN/DB/dbcol event clock
124             # | dbrowdiff clock
125              
126              
127             =head1 SEE ALSO
128              
129             L.
130             L.
131             L.
132             L.
133              
134             L, L, and L are similar but different.
135             L computes row-by-row differences for a column,
136             L eliminates rows that have no differences,
137             and L compares fields of two files.
138              
139              
140             =head1 CLASS FUNCTIONS
141              
142             =cut
143              
144             @ISA = qw(Fsdb::Filter);
145             $VERSION = 2.0;
146              
147 1     1   4173 use strict;
  1         3  
  1         27  
148 1     1   6 use Pod::Usage;
  1         1  
  1         86  
149 1     1   6 use Carp;
  1         2  
  1         43  
150              
151 1     1   6 use Fsdb::Filter;
  1         1  
  1         15  
152 1     1   4 use Fsdb::IO::Reader;
  1         2  
  1         19  
153 1     1   5 use Fsdb::IO::Writer;
  1         1  
  1         577  
154              
155              
156             =head2 new
157              
158             $filter = new Fsdb::Filter::dbrowdiff(@arguments);
159              
160             Create a new dbrowdiff object, taking command-line arguments.
161              
162             =cut
163              
164             sub new ($@) {
165 0     0 1   my $class = shift @_;
166 0           my $self = $class->SUPER::new(@_);
167 0           bless $self, $class;
168 0           $self->set_defaults;
169 0           $self->parse_options(@_);
170 0           $self->SUPER::post_new();
171 0           return $self;
172             }
173              
174              
175             =head2 set_defaults
176              
177             $filter->set_defaults();
178              
179             Internal: set up defaults.
180              
181             =cut
182              
183             sub set_defaults ($) {
184 0     0 1   my($self) = @_;
185 0           $self->SUPER::set_defaults();
186 0           $self->{_format} = "%.5g";
187 0           $self->{_mode} = 'B';
188             }
189              
190             =head2 parse_options
191              
192             $filter->parse_options(@ARGV);
193              
194             Internal: parse command-line arguments.
195              
196             =cut
197              
198             sub parse_options ($@) {
199 0     0 1   my $self = shift @_;
200              
201 0           my(@argv) = @_;
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 0     0     'B|baseline' => sub { $self->{_mode} = 'B'; },
208             'close!' => \$self->{_close},
209             'd|debug+' => \$self->{_debug},
210             'f|format=s' => \$self->{_format},
211 0     0     'i|input=s' => sub { $self->parse_io_option('input', @_); },
212 0     0     'I|incremental' => sub { $self->{_mode} = 'I'; },
213             'log!' => \$self->{_logprog},
214 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
215 0 0         ) or pod2usage(2);
216 0           $self->parse_target_column(\@argv);
217             }
218              
219             =head2 setup
220              
221             $filter->setup();
222              
223             Internal: setup, parse headers.
224              
225             =cut
226              
227             sub setup ($) {
228 0     0 1   my($self) = @_;
229              
230 0 0         pod2usage(2) if (!defined($self->{_target_column}));
231              
232 0           $self->finish_io_option('input', -comment_handler => $self->create_pass_comments_sub);
233              
234 0           $self->{_target_coli} = $self->{_in}->col_to_i($self->{_target_column});
235             croak $self->{_prog} . ": target column " . $self->{_target_column} . " is not in input stream.\n"
236 0 0         if (!defined($self->{_target_coli}));
237              
238 0           $self->finish_io_option('output', -clone => $self->{_in}, -outputheader => 'delay');
239 0           foreach (qw(absdiff pctdiff)) {
240             $self->{_out}->col_create($_)
241 0 0         or croak $self->{_prog} . ": cannot create column $_ (maybe it already existed?)\n";
242             };
243             }
244              
245             =head2 run
246              
247             $filter->run();
248              
249             Internal: run over each rows.
250              
251             =cut
252             sub run ($) {
253 0     0 1   my($self) = @_;
254              
255 0           my $read_fastpath_sub = $self->{_in}->fastpath_sub();
256 0           my $write_fastpath_sub = $self->{_out}->fastpath_sub();
257              
258 0           my $target_coli = $self->{_target_coli};
259 0           my $absdiff_coli = $self->{_out}->col_to_i('absdiff');
260 0           my $pctdiff_coli = $self->{_out}->col_to_i('pctdiff');
261 0           my $format = $self->{_format};
262 0           my $incremental_mode = ($self->{_mode} eq 'I');
263              
264 0           my $base;
265             my $absdiff;
266 0           my $pctdiff;
267 0           my $fref;
268              
269 0           while ($fref = &$read_fastpath_sub()) {
270 0 0         if (!defined($base)) {
271 0           $absdiff = $pctdiff = 0.0;
272 0           $base = $fref->[$target_coli];
273             } else {
274 0           $absdiff = $fref->[$target_coli] - $base;
275 0 0         $pctdiff = ($absdiff / $base) * 100.0 if ($base != 0);
276             };
277 0           $fref->[$absdiff_coli] = sprintf("$format", $absdiff);
278 0 0         if ($base == 0) {
279 0           $fref->[$pctdiff_coli] = $self->{_empty};
280             } else {
281 0           $fref->[$pctdiff_coli] = sprintf("$format", $pctdiff);
282             };
283 0 0         $base = $fref->[$target_coli] if ($incremental_mode);
284 0           &$write_fastpath_sub($fref);
285             };
286             }
287              
288             =head1 AUTHOR and COPYRIGHT
289              
290             Copyright (C) 1991-2008 by John Heidemann
291              
292             This program is distributed under terms of the GNU general
293             public license, version 2. See the file COPYING
294             with the distribution for details.
295              
296             =cut
297              
298             1;