File Coverage

blib/lib/Fsdb/Filter/yaml_to_db.pm
Criterion Covered Total %
statement 18 77 23.3
branch 0 12 0.0
condition n/a
subroutine 6 15 40.0
pod 5 5 100.0
total 29 109 26.6


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             #
4             # yaml_to_db.pm
5             # Copyright (C) 2011-2016 by John Heidemann
6             # $Id: 54d87bcf09ffd487550f0f7e05ab0a77cf2a3670 $
7             #
8             # This program is distributed under terms of the GNU general
9             # public license, version 2. See the file COPYING
10             # in $dblib for details.
11             #
12              
13             package Fsdb::Filter::yaml_to_db;
14              
15             =head1 NAME
16              
17             yaml_to_db - convert a subset of YAML into fsdb
18              
19             =head1 SYNOPSIS
20              
21             yaml_to_db
22              
23             =head1 DESCRIPTION
24              
25             Converts a I subset of YAML into Fsdb format.
26              
27             The input is YAML-format (I fsdb).
28             The input is parsed as YAML,
29             assuming the file is an array of dictionary entries.
30             We extract the dictionary names and output this as an fsdb table.
31              
32             The output is tab-separated fsdb.
33             (Someday more general field separators should be supported.)
34              
35             =head1 OPTIONS
36              
37              
38             =for comment
39             begin_standard_fsdb_options
40              
41             This module also supports the standard fsdb options:
42              
43             =over 4
44              
45             =item B<-d>
46              
47             Enable debugging output.
48              
49             =item B<-i> or B<--input> InputSource
50              
51             Read from InputSource, typically a file name, or C<-> for standard input,
52             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
53              
54             =item B<-o> or B<--output> OutputDestination
55              
56             Write to OutputDestination, typically a file name, or C<-> for standard output,
57             or (if in Perl) a IO::Handle, Fsdb::IO or Fsdb::BoundedQueue objects.
58              
59             =item B<--autorun> or B<--noautorun>
60              
61             By default, programs process automatically,
62             but Fsdb::Filter objects in Perl do not run until you invoke
63             the run() method.
64             The C<--(no)autorun> option controls that behavior within Perl.
65              
66             =item B<--help>
67              
68             Show help.
69              
70             =item B<--man>
71              
72             Show full manual.
73              
74             =back
75              
76             =for comment
77             end_standard_fsdb_options
78              
79              
80             =head1 SAMPLE USAGE
81              
82             =head2 Input:
83              
84             - name: ACM
85             role: sponsor
86             alttext: ACM, the Association for Computing Machinery
87             image: logos/acm-small.jpg
88             link: https://www.acm.org/
89             date: 2016-01-01
90            
91             - name: SIGCOMM
92             role: sponsor
93             alttext: SIGCOMM, ACM'S Special Interest Group on Communication
94             image: logos/sigcommlogo.png
95             link: http://sigcomm.org
96             date: 2016-01-02
97            
98             - name: SIGMETRICS
99             role: sponsor
100             alttext: SIGMETRICS, ACM'S Special Interest Group on Performance Evaluation
101             image: logos/sigmetrics-small.png
102             link: http://www.sigmetrics.org
103             date: 2016-01-03
104              
105              
106             =head2 Command:
107              
108             yaml_to_db
109              
110             =head2 Output:
111              
112             #fsdb -F t alttext date image link name role
113             ACM, the Association for Computing Machinery 2016-01-01 logos/acm-small.jpg https://www.acm.org/ ACM sponsor
114             SIGCOMM, ACM'S Special Interest Group on Communication 2016-01-02 logos/sigcommlogo.png http://sigcomm.org SIGCOMM sponsor
115             SIGMETRICS, ACM'S Special Interest Group on Performance Evaluation 2016-01-03 logos/sigmetrics-small.png http://www.sigmetrics.org SIGMETRICS sponsor
116             # | yaml_to_db
117              
118             =head1 SEE ALSO
119              
120             L.
121              
122              
123             =head1 CLASS FUNCTIONS
124              
125             =cut
126              
127             @ISA = qw(Fsdb::Filter);
128             $VERSION = 2.0;
129              
130 1     1   5418 use strict;
  1         2  
  1         36  
131 1     1   4 use Pod::Usage;
  1         2  
  1         128  
132 1     1   5 use Carp;
  1         2  
  1         58  
133              
134 1     1   593 use YAML::XS;
  1         2593  
  1         144  
135              
136 1     1   63 use Fsdb::Filter;
  1         3  
  1         37  
137 1     1   5 use Fsdb::IO::Writer;
  1         1  
  1         727  
138              
139              
140             =head2 new
141              
142             $filter = new Fsdb::Filter::yaml_to_db(@arguments);
143              
144             Create a new yaml_to_db object, taking command-line arguments.
145              
146             =cut
147              
148             sub new ($@) {
149 0     0 1   my $class = shift @_;
150 0           my $self = $class->SUPER::new(@_);
151 0           bless $self, $class;
152 0           $self->set_defaults;
153 0           $self->parse_options(@_);
154 0           $self->SUPER::post_new();
155 0           return $self;
156             }
157              
158              
159             =head2 set_defaults
160              
161             $filter->set_defaults();
162              
163             Internal: set up defaults.
164              
165             =cut
166              
167             sub set_defaults ($) {
168 0     0 1   my($self) = @_;
169 0           $self->SUPER::set_defaults();
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             'd|debug+' => \$self->{_debug},
190             'e|empty=s' => \$self->{_empty},
191 0     0     'i|input=s' => sub { $self->parse_io_option('input', @_); },
192             'log!' => \$self->{_logprog},
193 0     0     'o|output=s' => sub { $self->parse_io_option('output', @_); },
194 0 0         ) or pod2usage(2);
195 0 0         pod2usage(2) if ($#argv >= 0);
196             }
197              
198             =head2 setup
199              
200             $filter->setup();
201              
202             Internal: setup, parse headers.
203              
204             =cut
205              
206             sub setup($) {
207 0     0 1   my($self) = @_;
208              
209             # xxx: have to read and parse the whole input, a no-no for setup() :-(
210 0           $self->finish_fh_io_option('input');
211 0           my $yaml_str = join('', $self->{_in}->getlines);
212 0           my $yaml = $self->{_yaml} = Load($yaml_str);
213              
214 0 0         croak $self->{_prog} . ": yaml is not in expected format (toplevel list)\n"
215             if (ref $yaml ne 'ARRAY');
216              
217             #
218             # allocate columns
219             #
220 0           $self->finish_fh_io_option('input');
221 0           my $ncols = -1;
222 0           my @cols;
223             my %cols_hash;
224 0           my $record_no = 0;
225 0           foreach my $href (@$yaml) {
226 0 0         croak $self->{_prog} . ": yaml is not in expected format, record $record_no is not a dictionary\n"
227             if (ref $href ne 'HASH');
228 0           foreach (sort keys %$href) {
229 0 0         next if (defined($cols_hash{$_}));
230 0           $ncols++;
231 0           $cols[$ncols] = $_;
232 0           $cols_hash{$_} = $ncols;
233             };
234 0           $record_no++;
235             };
236 0           $self->{_ncols} = $ncols;
237 0           $self->{_cols} = \@cols;
238 0           $self->{_cols_hash} = \%cols_hash;
239              
240 0           $self->finish_io_option('output', -fscode => 't', -cols => \@cols);
241            
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 $write_fastpath_sub = $self->{_out}->fastpath_sub();
256              
257 0           my $ncols = $self->{_ncols};
258 0           my $cols_href = $self->{_cols_hash};
259            
260 0           my @empty_row = ($self->{_empty}) x $ncols;
261 0           my $record_no = 0;
262 0           foreach my $href (@{$self->{_yaml}}) {
  0            
263 0           my(@row) = @empty_row;
264 0           $record_no++;
265 0           foreach (keys %$href) {
266 0           my $i = $cols_href->{$_}; # $out->col_to_i($_);
267 0 0         if (!defined($i)) {
268 0           warn $self->{_prog} . ": unknown field $_ in record $record_no.\n";
269             } else {
270 0           $row[$i] = $href->{$_};
271             };
272             };
273 0           grep { s/\t/ /g; } @row; # clean up for fsdb double-space separator
  0            
274 0           grep { s/^ *$/$self->{_empty}/g; } @row; # add null values for fields
  0            
275 0           &{$write_fastpath_sub}(\@row);
  0            
276             };
277             }
278              
279              
280              
281             =head1 AUTHOR and COPYRIGHT
282              
283             Copyright (C) 2011-2016 by John Heidemann
284              
285             This program is distributed under terms of the GNU general
286             public license, version 2. See the file COPYING
287             with the distribution for details.
288              
289             =cut
290              
291             1;