File Coverage

blib/lib/Fsdb/Filter/dbrowuniq.pm
Criterion Covered Total %
statement 18 96 18.7
branch 0 36 0.0
condition 0 3 0.0
subroutine 6 18 33.3
pod 5 5 100.0
total 29 158 18.3


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2              
3             #
4             # dbrowuniq.pm
5             # Copyright (C) 1997-2016 by John Heidemann
6             #
7             # This program is distributed under terms of the GNU general
8             # public license, version 2. See the file COPYING
9             # in $dblibdir for details.
10             #
11              
12             package Fsdb::Filter::dbrowuniq;
13              
14             =head1 NAME
15              
16             dbrowuniq - eliminate adjacent rows with duplicate fields, maybe counting
17              
18             =head1 SYNOPSIS
19              
20             dbrowuniq [-cFLB] [uniquifying fields...]
21              
22             =head1 DESCRIPTION
23              
24             Eliminate adjacent rows with duplicate fields, perhaps counting them.
25             Roughly equivalent to the Unix L command,
26             but optionally only operating on the specified fields.
27              
28             By default, I columns must be unique.
29             If column names are specified, only those columns must be unique
30             and the first row with those columns is returned.
31              
32             Dbrowuniq eliminates only identical rows that I.
33             If you want to eliminate identical rows across the entirefile,
34             you must make them adajcent, perhaps by using dbsort on your
35             uniquifying field.
36             (That is, the input with three lines a/b/a will produce
37             three lines of output with both a's, but if you dbsort it,
38             it will become a/a/b and dbrowuniq will output a/b.
39              
40             By default, L outputs the I unique row.
41             Optionally, with C<-L>, it will output the I unique row,
42             or with C<-B> it outputs both first and last.
43             (This choice only matters when uniqueness is determined by specific fields.)
44              
45             L can also count how many unique, adjacent lines it finds
46             with C<-c>, with the count going to a new column (defaulting to C).
47             Incremental counting, when the C column already exists,
48             is possible with C<-I>.
49              
50             =head1 OPTIONS
51              
52             =over 4
53              
54             =item B<-c> or B<--count>
55              
56             Create a new column (count) which counts the number of times
57             each line occurred.
58              
59             The new column is named by the C<-N> argument, defaulting to C.
60              
61             =item B<-N> on B<--new-name>
62              
63             Specify the name of the count column, if any.
64             (Default is C.)
65              
66             =item B<-I> on B<--incremental>
67              
68             Incremental counting.
69             If the count column exists, it is assumed to have a partial count
70             and the count accumulates.
71             If the count column doesn't exist, it is created.
72              
73             =item B<-L> or B<--last>
74              
75             Output the last unique row.
76             By default, it outputs the first unique row.
77              
78             =item B<-F> or B<--first>
79              
80             Output the first unique row.
81             (This is the default.)
82              
83             =item B<-B> or B<--both>
84              
85             Output both the first and last unique rows.
86              
87             =back
88              
89             =for comment
90             begin_standard_fsdb_options
91              
92             This module also supports the standard fsdb options:
93              
94             =over 4
95              
96             =item B<-d>
97              
98             Enable debugging output.
99              
100             =item B<-i> or B<--input> InputSource
101              
102             Read from InputSource, typically a file name, or C<-> for standard input,
103             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
104              
105             =item B<-o> or B<--output> OutputDestination
106              
107             Write to OutputDestination, typically a file name, or C<-> for standard output,
108             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
109              
110             =item B<--autorun> or B<--noautorun>
111              
112             By default, programs process automatically,
113             but Fsdb::Filter objects in Perl do not run until you invoke
114             the run() method.
115             The C<--(no)autorun> option controls that behavior within Perl.
116              
117             =item B<--header> H
118              
119             Use H as the full Fsdb header, rather than reading a header from
120             then input.
121              
122             =item B<--help>
123              
124             Show help.
125              
126             =item B<--man>
127              
128             Show full manual.
129              
130             =back
131              
132             =for comment
133             end_standard_fsdb_options
134              
135              
136             =head1 SAMPLE USAGE
137              
138             =head2 Input:
139              
140             #fsdb event
141             _null_getpage+128
142             _null_getpage+128
143             _null_getpage+128
144             _null_getpage+128
145             _null_getpage+128
146             _null_getpage+128
147             _null_getpage+4
148             _null_getpage+4
149             _null_getpage+4
150             _null_getpage+4
151             _null_getpage+4
152             _null_getpage+4
153             # | /home/johnh/BIN/DB/dbcol event
154             # | /home/johnh/BIN/DB/dbsort event
155              
156             =head2 Command:
157              
158             cat data.fsdb | dbrowuniq -c
159              
160             =head2 Output:
161              
162             #fsdb event count
163             _null_getpage+128 6
164             _null_getpage+4 6
165             # 2 /home/johnh/BIN/DB/dbcol event
166             # | /home/johnh/BIN/DB/dbrowuniq -c
167              
168             =head1 SAMPLE USAGE 2
169              
170             Retaining the last unique row as an example.
171              
172             =head2 Input:
173              
174             #fsdb event i
175             _null_getpage+128 10
176             _null_getpage+128 11
177             _null_getpage+128 12
178             _null_getpage+128 13
179             _null_getpage+128 14
180             _null_getpage+128 15
181             _null_getpage+4 16
182             _null_getpage+4 17
183             _null_getpage+4 18
184             _null_getpage+4 19
185             _null_getpage+4 20
186             _null_getpage+4 21
187             # | /home/johnh/BIN/DB/dbcol event
188             # | /home/johnh/BIN/DB/dbsort event
189              
190             =head2 Command:
191              
192             cat data.fsdb | dbrowuniq -c -L event
193              
194             =head2 Output:
195              
196             #fsdb event i count
197             _null_getpage+128 15 6
198             # | /home/johnh/BIN/DB/dbcol event
199             # | /home/johnh/BIN/DB/dbsort event
200             _null_getpage+4 21 6
201             # | dbrowuniq -c
202              
203             =head1 SAMPLE USAGE 3
204              
205             Incremental counting.
206              
207             =head2 Input:
208              
209             #fsdb event count
210             _null_getpage+128 6
211             _null_getpage+128 6
212             _null_getpage+4 6
213             _null_getpage+4 6
214             # /home/johnh/BIN/DB/dbcol event
215             # | /home/johnh/BIN/DB/dbrowuniq -c
216              
217             =head2 Command:
218              
219             cat data.fsdb | dbrowuniq -I -c event
220              
221             =head2 Output:
222              
223             #fsdb event count
224             _null_getpage+128 12
225             _null_getpage+4 12
226             # /home/johnh/BIN/DB/dbcol event
227             # | /home/johnh/BIN/DB/dbrowuniq -c
228             # | dbrowuniq -I -c event
229              
230             =head1 SEE ALSO
231              
232             L.
233              
234              
235             =head1 CLASS FUNCTIONS
236              
237             =cut
238              
239             @ISA = qw(Fsdb::Filter);
240             $VERSION = 2.0;
241              
242 1     1   5412 use strict;
  1         2  
  1         30  
243 1     1   5 use Pod::Usage;
  1         2  
  1         92  
244 1     1   7 use Carp;
  1         2  
  1         45  
245              
246 1     1   5 use Fsdb::Filter;
  1         2  
  1         21  
247 1     1   5 use Fsdb::IO::Reader;
  1         2  
  1         19  
248 1     1   4 use Fsdb::IO::Writer;
  1         1  
  1         859  
249              
250              
251             =head2 new
252              
253             $filter = new Fsdb::Filter::dbrowuniq(@arguments);
254              
255             Create a new dbrowuniq object, taking command-line arguments.
256              
257             =cut
258              
259             sub new ($@) {
260 0     0 1   my $class = shift @_;
261 0           my $self = $class->SUPER::new(@_);
262 0           bless $self, $class;
263 0           $self->set_defaults;
264 0           $self->parse_options(@_);
265 0           $self->SUPER::post_new();
266 0           return $self;
267             }
268              
269              
270             =head2 set_defaults
271              
272             $filter->set_defaults();
273              
274             Internal: set up defaults.
275              
276             =cut
277              
278             sub set_defaults ($) {
279 0     0 1   my($self) = @_;
280 0           $self->SUPER::set_defaults();
281 0           $self->{_count} = undef;
282 0           $self->{_which} = 'F';
283 0           $self->{_incremental} = undef;
284 0           $self->{_uniquifying_cols} = [];
285 0           $self->{_destination_column} = 'count';
286 0           $self->{_header} = undef;
287             }
288              
289             =head2 parse_options
290              
291             $filter->parse_options(@ARGV);
292              
293             Internal: parse command-line arguments.
294              
295             =cut
296              
297             sub parse_options ($@) {
298 0     0 1   my $self = shift @_;
299              
300 0           my(@argv) = @_;
301             $self->get_options(
302             \@argv,
303 0     0     'help|?' => sub { pod2usage(1); },
304 0     0     'man' => sub { pod2usage(-verbose => 2); },
305             'autorun!' => \$self->{_autorun},
306 0     0     'B|both' => sub { $self->{_which} = 'B' },
307             'c|count!' => \$self->{_count},
308 0     0     'F|first|nolast' => sub { $self->{_which} = 'F' },
309             'header=s' => \$self->{_header},
310             'I|incremental!' => \$self->{_incremental},
311 0     0     'L|last' => sub { $self->{_which} = 'L' },
312             'close!' => \$self->{_close},
313             'd|debug+' => \$self->{_debug},
314 0     0     'i|input=s' => sub { $self->parse_io_option('input', @_); },
315             'log!' => \$self->{_logprog},
316             'N|new-name=s' => \$self->{_destination_column},
317 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
318 0 0         ) or pod2usage(2);
319 0           push (@{$self->{_uniquifying_cols}}, @argv);
  0            
320             }
321              
322             =head2 setup
323              
324             $filter->setup();
325              
326             Internal: setup, parse headers.
327              
328             =cut
329              
330             sub setup ($) {
331 0     0 1   my($self) = @_;
332              
333 0           my(@finish_args) = (-comment_handler => $self->create_pass_comments_sub);
334 0 0         push (@finish_args, -header => $self->{_header}) if (defined($self->{_header}));
335 0           $self->finish_io_option('input', @finish_args);
336              
337 0 0         if ($#{$self->{_uniquifying_cols}} == -1) {
  0            
338 0           foreach (@{$self->{_in}->cols}) {
  0            
339 0           push (@{$self->{_uniquifying_cols}}, $_)
340 0 0         if ($_ ne $self->{_destination_column});
341             };
342             } else {
343 0           foreach (@{$self->{_uniquifying_cols}}) {
  0            
344             croak $self->{_prog} . ": unknown column ``$_''.\n"
345 0 0         if (!defined($self->{_in}->col_to_i($_)));
346             };
347             };
348              
349 0           $self->finish_io_option('output', -clone => $self->{_in}, -outputheader => 'delay');
350 0 0         if ($self->{_count}) {
351 0 0         if ($self->{_out}->col_to_i($self->{_destination_column})) {
352 0 0         if (!$self->{_incremental}) {
353 0           croak $self->{_prog} . ": cannot create column " . $self->{_destination_column} . " (it already exists)\n";
354             };
355             } else {
356             $self->{_out}->col_create($self->{_destination_column})
357 0 0         or croak $self->{_prog} . ": cannot create column " . $self->{_destination_column} . " (maybe it already existed?)\n";
358 0           $self->{_incremental} = undef;
359             };
360             };
361             }
362              
363             =head2 run
364              
365             $filter->run();
366              
367             Internal: run over each rows.
368              
369             =cut
370             sub run ($) {
371 0     0 1   my($self) = @_;
372              
373 0           my $read_fastpath_sub = $self->{_in}->fastpath_sub();
374 0           my $write_fastpath_sub = $self->{_out}->fastpath_sub();
375 0           my $count_coli = $self->{_out}->col_to_i($self->{_destination_column});
376              
377 0           my $first_prev_fref = [];
378 0           my $last_prev_fref = [];
379 0           my $output_fref = [];
380 0           my $this_fref;
381 0           my $count = 0;
382              
383 0           my $check_code = '1';
384 0           foreach (@{$self->{_uniquifying_cols}}) {
  0            
385 0           my $coli = $self->{_in}->col_to_i($_);
386 0 0         croak $self->{_prog} . ": internal error, cannot find column $_ even after checking already.\n"
387             if (!defined($coli));
388 0           $check_code .= " && (\$first_prev_fref->[$coli] eq \$this_fref->[$coli])";
389             };
390 0 0         print $check_code if ($self->{_debug});
391              
392 0 0         my $count_increment_code = ($self->{_incremental} ? '$this_fref->[' . $count_coli . ']' : '1');
393 0           my $handle_new_key_code = q'
394             @{$first_prev_fref} = @{$this_fref};
395             $count = ' . $count_increment_code . ';';
396 0           my $remember_prev_row_code = q'
397             @{$last_prev_fref} = @{$this_fref};
398             ';
399 0 0         $remember_prev_row_code = '' if ($self->{_which} eq 'F'); # optimize
400              
401 0 0         my $remember_count_code = (defined($self->{_count}) ? '$output_fref->[' . $count_coli . '] = $count;' . "\n" : '');
402              
403 0           my $handle_end_of_prev_code = '';
404 0 0 0       if ($self->{_which} eq 'F' || $self->{_which} eq 'B') {
405 0           $handle_end_of_prev_code .= '
406             @{$output_fref} = @{$first_prev_fref};
407             ' . $remember_count_code .
408             '&$write_fastpath_sub($output_fref) if ($count > 0);' . "\n";
409             };
410 0 0         if ($self->{_which} eq 'L') {
411 0           $handle_end_of_prev_code .= '
412             @{$output_fref} = @{$last_prev_fref};
413             ' . $remember_count_code .
414             '&$write_fastpath_sub($output_fref) if ($count > 0);' . "\n";
415             };
416 0 0         if ($self->{_which} eq 'B') {
417 0           $handle_end_of_prev_code .= '
418             @{$output_fref} = @{$last_prev_fref};
419             ' . $remember_count_code .
420             '&$write_fastpath_sub($output_fref) if ($count > 1);' . "\n";
421             };
422              
423 0           my $loop_code = q'
424             while ($this_fref = &$read_fastpath_sub()) {
425             if ($count > 0) {
426             if (' . $check_code . q') {
427             # identical, so just update prev
428             ' . $remember_prev_row_code .
429             '$count += ' . $count_increment_code . q';
430             next;
431             } else {
432             # not identical
433             ' . $handle_end_of_prev_code
434             . $handle_new_key_code
435             . $remember_prev_row_code . q'
436             };
437             } else {
438             # first row ever
439             ' . $handle_new_key_code
440             . $remember_prev_row_code . q'
441             };
442             };
443             # handle last row
444             ' . $handle_end_of_prev_code . "\n";
445 0           eval $loop_code;
446 0 0         $@ && croak $self->{_prog} . ": internal eval error: $@\n";
447             };
448              
449              
450             =head1 AUTHOR and COPYRIGHT
451              
452             Copyright (C) 1997-2016 by John Heidemann
453              
454             This program is distributed under terms of the GNU general
455             public license, version 2. See the file COPYING
456             with the distribution for details.
457              
458             =cut
459              
460             1;