File Coverage

blib/lib/Fsdb/Filter/dbcolrename.pm
Criterion Covered Total %
statement 18 64 28.1
branch 0 8 0.0
condition n/a
subroutine 6 15 40.0
pod 5 5 100.0
total 29 92 31.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             #
4             # dbcolrename.pm
5             # Copyright (C) 1991-2015 by John Heidemann
6             # $Id: ef5f2e367d568155d5b7c0131550d2e76635982c $
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::dbcolrename;
14              
15             =head1 NAME
16              
17             dbcolrename - change the names of columns in a fsdb schema
18              
19             =head1 SYNOPSIS
20              
21             dbcolrename OldName1 NewName1 [OldName2 NewName2] ...
22              
23             =head1 DESCRIPTION
24              
25             Dbcolrename changes the names of columns in a fsdb schema,
26             mapping OldName1 to NewName1, and so on for multiple pairs of column names.
27              
28             Note that it is valid to do "overlapping" renames
29             like C.
30              
31             =head1 OPTIONS
32              
33             No non-standard options.
34              
35             =for comment
36             begin_standard_fsdb_options
37              
38             This module also supports the standard fsdb options:
39              
40             =over 4
41              
42             =item B<-d>
43              
44             Enable debugging output.
45              
46             =item B<-i> or B<--input> InputSource
47              
48             Read from InputSource, typically a file name, or C<-> for standard input,
49             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
50              
51             =item B<-o> or B<--output> OutputDestination
52              
53             Write to OutputDestination, typically a file name, or C<-> for standard output,
54             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
55              
56             =item B<--autorun> or B<--noautorun>
57              
58             By default, programs process automatically,
59             but Fsdb::Filter objects in Perl do not run until you invoke
60             the run() method.
61             The C<--(no)autorun> option controls that behavior within Perl.
62              
63             =item B<--help>
64              
65             Show help.
66              
67             =item B<--man>
68              
69             Show full manual.
70              
71             =back
72              
73             =for comment
74             end_standard_fsdb_options
75              
76              
77             =head1 SAMPLE USAGE
78              
79             =head2 Input:
80              
81             #fsdb account passwd uid gid fullname homedir shell
82             johnh * 2274 134 John_Heidemann /home/johnh /bin/bash
83             greg * 2275 134 Greg_Johnson /home/greg /bin/bash
84             root * 0 0 Root /root /bin/bash
85             # this is a simple database
86              
87             =head2 Command:
88              
89             cat DATA/passwd.fsdb | dbcolrename fullname first_last
90              
91             =head2 Output:
92              
93             #fsdb account passwd uid gid first_last homedir shell
94             johnh * 2274 134 John_Heidemann /home/johnh /bin/bash
95             greg * 2275 134 Greg_Johnson /home/greg /bin/bash
96             root * 0 0 Root /root /bin/bash
97             # this is a simple database
98             # | dbcolrename fullname first_last
99              
100              
101             =head1 SEE ALSO
102              
103             L.
104              
105              
106             =head1 CLASS FUNCTIONS
107              
108             =cut
109              
110             @ISA = qw(Fsdb::Filter);
111             ($VERSION) = 2.0;
112              
113 1     1   3503 use strict;
  1         1  
  1         24  
114 1     1   4 use Carp;
  1         1  
  1         43  
115 1     1   4 use Pod::Usage;
  1         1  
  1         59  
116              
117 1     1   4 use Fsdb::Filter;
  1         1  
  1         20  
118 1     1   3 use Fsdb::IO::Reader;
  1         1  
  1         14  
119 1     1   3 use Fsdb::IO::Writer;
  1         1  
  1         475  
120              
121              
122             =head2 new
123              
124             $filter = new Fsdb::Filter::dbcolrename(@arguments);
125              
126             Create a new dbcolrename object, taking command-line arguments.
127              
128             =cut
129              
130             sub new ($@) {
131 0     0 1   my $class = shift @_;
132 0           my $self = $class->SUPER::new(@_);
133 0           bless $self, $class;
134 0           $self->set_defaults;
135 0           $self->parse_options(@_);
136 0           $self->SUPER::post_new();
137 0           return $self;
138             }
139              
140              
141             =head2 set_defaults
142              
143             $filter->set_defaults();
144              
145             Internal: set up defaults.
146              
147             =cut
148              
149             sub set_defaults ($) {
150 0     0 1   my($self) = @_;
151 0           $self->SUPER::set_defaults();
152             # $self->{_rename_old} = [];
153             # $self->{_rename_new} = [];
154 0           $self->{_rename_map} = {};
155             }
156              
157             =head2 parse_options
158              
159             $filter->parse_options(@ARGV);
160              
161             Internal: parse command-line arguments.
162              
163             =cut
164              
165             sub parse_options ($@) {
166 0     0 1   my $self = shift @_;
167              
168 0           my(@argv) = @_;
169             $self->get_options(
170             \@argv,
171 0     0     'help|?' => sub { pod2usage(1); },
172 0     0     'man' => sub { pod2usage(-verbose => 2); },
173             'autorun!' => \$self->{_autorun},
174             'close!' => \$self->{_close},
175             'd|debug+' => \$self->{_debug},
176 0     0     'i|input=s' => sub { $self->parse_io_option('input', @_); },
177             'log!' => \$self->{_logprog},
178 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
179 0 0         ) or pod2usage(2);
180 0 0         croak $self->{_prog} . ": dbcolrename requires an even number of arguments to do (old,new pairs)\n"
181             if ( ($#argv + 1) % 2 != 0);
182 0           while ($#argv >= 1) {
183 0           my($old) = shift @argv;
184 0           my($new) = shift @argv;
185             # # preserve ordering to allow concurrent a->b b->a renames
186             # push(@{$self->{_rename_old}}, $old);
187             # push(@{$self->{_rename_new}}, $new);
188 0           $self->{_rename_map}{$old} = $new;
189             # we do error checking in setup
190             };
191             }
192              
193             =head2 setup
194              
195             $filter->setup();
196              
197             Internal: setup, parse headers.
198              
199             =cut
200              
201             sub setup ($) {
202 0     0 1   my($self) = @_;
203              
204 0           $self->finish_io_option('input', -comment_handler => $self->create_pass_comments_sub);
205              
206 0           my @old_cols = @{$self->{_in}->cols};
  0            
207 0           my @new_cols = @old_cols;
208 0           my %cur_cols; # just for double naming
209 0           foreach (0..$#old_cols) {
210 0           $cur_cols{$old_cols[$_]} = $_;
211             };
212              
213 0           foreach (keys %{$self->{_rename_map}}) {
  0            
214 0           my ($old) = $_;
215 0           my ($new) = $self->{_rename_map}{$old};
216 0           my $old_i = $self->{_in}->col_to_i($old);
217 0 0         croak $self->{_prog} . ": column `$old' is not in input stream.\n"
218             if (!defined($old_i));
219             croak $self->{_prog} . ": column `$new' already exists in the output stream.\n"
220 0 0         if (defined($cur_cols{$new}));
221 0           $new_cols[$old_i] = $new;
222 0           $cur_cols{$new} = $old_i;
223             };
224              
225 0           $self->finish_io_option('output', -clone => $self->{_in}, -cols => \@new_cols);
226             }
227              
228             =head2 run
229              
230             $filter->run();
231              
232             Internal: run over each rows.
233              
234             =cut
235             sub run ($) {
236 0     0 1   my($self) = @_;
237              
238 0           my $read_fastpath_sub = $self->{_in}->fastpath_sub();
239 0           my $write_fastpath_sub = $self->{_out}->fastpath_sub();
240 0           my $fref;
241 0           while ($fref = &$read_fastpath_sub()) {
242 0           &$write_fastpath_sub($fref);
243             };
244              
245             }
246              
247              
248             =head1 AUTHOR and COPYRIGHT
249              
250             Copyright (C) 1991-2015 by John Heidemann
251              
252             This program is distributed under terms of the GNU general
253             public license, version 2. See the file COPYING
254             with the distribution for details.
255              
256             =cut
257              
258             1;