File Coverage

blib/lib/Fsdb/Filter/dbrow.pm
Criterion Covered Total %
statement 15 58 25.8
branch 0 14 0.0
condition n/a
subroutine 5 14 35.7
pod 5 5 100.0
total 25 91 27.4


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             #
4             # dbrow.pm
5             # Copyright (C) 1991-2007 by John Heidemann
6             # $Id: 3fe478660267a8bb5a9f13c957e1169ae188226e $
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::dbrow;
14              
15             =head1 NAME
16              
17             dbrow - select rows from an Fsdb file based on arbitrary conditions
18              
19             =head1 SYNOPSIS
20              
21             dbrow [-vw] CONDITION [CONDITION...]
22              
23             =head1 DESCRIPTION
24              
25             Select rows for which all CONDITIONS are true.
26             Conditions are specified as Perl code,
27             in which column names are be embedded, preceded by underscores.
28              
29             =head1 OPTIONS
30              
31             =over 4
32              
33             =item B<-v>
34              
35             Invert the selection, picking rows where at least one condition does
36             I match.
37              
38             =back
39              
40             =for comment
41             begin_standard_fsdb_options
42              
43             This module also supports the standard fsdb options:
44              
45             =over 4
46              
47             =item B<-d>
48              
49             Enable debugging output.
50              
51             =item B<-w> or B<--warnings>
52              
53             Enable warnings in user supplied code.
54              
55             =item B<-i> or B<--input> InputSource
56              
57             Read from InputSource, typically a file name, or C<-> for standard input,
58             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
59              
60             =item B<-o> or B<--output> OutputDestination
61              
62             Write to OutputDestination, typically a file name, or C<-> for standard output,
63             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
64              
65             =item B<--autorun> or B<--noautorun>
66              
67             By default, programs process automatically,
68             but Fsdb::Filter objects in Perl do not run until you invoke
69             the run() method.
70             The C<--(no)autorun> option controls that behavior within Perl.
71              
72             =item B<--header> H
73              
74             Use H as the full Fsdb header, rather than reading a header from
75             then input.
76              
77             =item B<--help>
78              
79             Show help.
80              
81             =item B<--man>
82              
83             Show full manual.
84              
85             =back
86              
87             =for comment
88             end_standard_fsdb_options
89              
90              
91             =head1 SAMPLE USAGE
92              
93             =head2 Input:
94              
95             #fsdb account passwd uid gid fullname homedir shell
96             johnh * 2274 134 John_Heidemann /home/johnh /bin/bash
97             greg * 2275 134 Greg_Johnson /home/greg /bin/bash
98             root * 0 0 Root /root /bin/bash
99             # this is a simple database
100              
101             =head2 Command:
102              
103             cat DATA/passwd.fsdb | dbrow '_fullname =~ /John/'
104              
105             =head2 Output:
106              
107             #fsdb account passwd uid gid fullname homedir shell
108             johnh * 2274 134 John_Heidemann /home/johnh /bin/bash
109             greg * 2275 134 Greg_Johnson /home/greg /bin/bash
110             # this is a simple database
111             # | /home/johnh/BIN/DB/dbrow
112              
113              
114             =head1 BUGS
115              
116             Doesn't detect references to unknown columns in conditions.
117              
118             END
119             #' for font-lock mode.
120             exit 1;
121              
122             =head1 CLASS FUNCTIONS
123              
124             =cut
125              
126             @ISA = qw(Fsdb::Filter);
127             ($VERSION) = 2.0;
128              
129 1     1   6089 use strict;
  1         3  
  1         42  
130 1     1   426 use Pod::Usage;
  1         60450  
  1         168  
131              
132 1     1   12 use Fsdb::Filter;
  1         3  
  1         31  
133 1     1   7 use Fsdb::IO::Reader;
  1         3  
  1         29  
134 1     1   6 use Fsdb::IO::Writer;
  1         3  
  1         679  
135              
136              
137             =head2 new
138              
139             $filter = new Fsdb::Filter::dbrow(@arguments);
140              
141             Create a new dbrow object, taking command-line arguments.
142              
143             =cut
144              
145             sub new ($@) {
146 0     0 1   my $class = shift @_;
147 0           my $self = $class->SUPER::new(@_);
148 0           bless $self, $class;
149 0           $self->set_defaults;
150 0           $self->parse_options(@_);
151 0           $self->SUPER::post_new();
152 0           return $self;
153             }
154              
155              
156             =head2 set_defaults
157              
158             $filter->set_defaults();
159              
160             Internal: set up defaults.
161              
162             =cut
163              
164             sub set_defaults ($) {
165 0     0 1   my($self) = @_;
166 0           $self->SUPER::set_defaults();
167 0           $self->{_invert_match} = undef;
168 0           $self->{_warnings} = undef;
169 0           $self->{_header} = undef;
170             }
171              
172             =head2 parse_options
173              
174             $filter->parse_options(@ARGV);
175              
176             Internal: parse command-line arguments.
177              
178             =cut
179              
180             sub parse_options ($@) {
181 0     0 1   my $self = shift @_;
182              
183 0           my(@argv) = @_;
184             $self->get_options(
185             \@argv,
186 0     0     'help|?' => sub { pod2usage(1); },
187 0     0     'man' => sub { pod2usage(-verbose => 2); },
188             'autorun!' => \$self->{_autorun},
189             'close!' => \$self->{_close},
190             'd|debug+' => \$self->{_debug},
191             'header=s' => \$self->{_header},
192 0     0     'i|input=s' => sub { $self->parse_io_option('input', @_); },
193             'log!' => \$self->{_logprog},
194 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
195             'v|invert-match!' => \$self->{_invert_match},
196             'w|warnings!' => \$self->{_warnings},
197 0 0         ) or pod2usage(2);
198 0           push (@{$self->{_argv}}, @argv);
  0            
199             }
200              
201             =head2 setup
202              
203             $filter->setup();
204              
205             Internal: setup, parse headers.
206              
207             =cut
208              
209             sub setup ($) {
210 0     0 1   my($self) = @_;
211              
212 0           my(@in_options) = (-comment_handler => $self->create_pass_comments_sub);
213 0 0         push(@in_options, -header => $self->{_header}) if (defined($self->{_header}));
214 0           $self->finish_io_option('input', @in_options);
215 0           my $read_fastpath_sub = $self->{_in}->fastpath_sub();
216              
217 0           $self->finish_io_option('output', -clone => $self->{_in});
218 0           my $write_fastpath_sub = $self->{_out}->fastpath_sub();
219              
220             #
221             # convert code to perl
222             #
223 0           my($partial_code, $needs_lfref) = $self->{_in}->codify(join(") && (", @{$self->{_argv}}));
  0            
224              
225 0 0         my($negate_code) = $self->{_invert_match} ? "!" : "";
226              
227             {
228 0           my $loop_sub;
  0            
229             my $loop_code = q'
230             $loop_sub = sub {
231             my $fref;
232             my $lfref;
233             my $result;
234             while ($fref = &$read_fastpath_sub()) {
235             ' .
236 0 0         ($self->{_warnings} ? "use" : "no") . q' strict "vars";
    0          
237             # BEGIN USER PROVIDED CODE
238             $result = ' . $negate_code . '(' . $partial_code . q');
239              
240             # END USER PROVIDED CODE
241             ' . ($needs_lfref ? q'
242             $lfref = $fref; # save for next pass
243             ' : '') . q'
244             &$write_fastpath_sub($fref) if ($result);
245             };
246             };
247             ';
248 0 0         if ($self->{_debug}) {
249 0           print STDERR "DEBUG:\n$loop_code\n";
250 0           exit 1;
251             };
252 0           eval $loop_code;
253 0 0         $@ && die $self->{_prog} . ": eval error compiling user-provided code: $@.\n";
254 0           $self->{_loop_sub} = $loop_sub;
255             }
256             }
257              
258             =head2 run
259              
260             $filter->run();
261              
262             Internal: run over each rows.
263              
264             =cut
265             sub run ($) {
266 0     0 1   my($self) = @_;
267 0           &{$self->{_loop_sub}}();
  0            
268             }
269              
270              
271             =head1 AUTHOR and COPYRIGHT
272              
273             Copyright (C) 1991-2007 by John Heidemann
274              
275             This program is distributed under terms of the GNU general
276             public license, version 2. See the file COPYING
277             with the distribution for details.
278              
279             =cut
280              
281             1;