File Coverage

blib/lib/App/RecordStream/Operation/toprettyprint.pm
Criterion Covered Total %
statement 76 88 86.3
branch 15 26 57.6
condition 3 3 100.0
subroutine 12 15 80.0
pod 0 7 0.0
total 106 139 76.2


line stmt bran cond sub pod time code
1             package App::RecordStream::Operation::toprettyprint;
2              
3             our $VERSION = "4.0.23";
4              
5 2     2   829 use strict;
  2         5  
  2         53  
6              
7 2     2   9 use base qw(App::RecordStream::Operation);
  2         3  
  2         111  
8              
9 2     2   12 use App::RecordStream::OutputStream;
  2         4  
  2         31  
10 2     2   8 use App::RecordStream::Record;
  2         8  
  2         1285  
11              
12             sub init {
13 5     5 0 10 my $this = shift;
14 5         9 my $args = shift;
15              
16 5         8 my $limit = undef;
17 5         25 my $key_groups = App::RecordStream::KeyGroups->new();
18 5         9 my $do_not_nest = 0;
19             my $spec = {
20 0     0   0 "1" => sub { $limit = 1; },
21 4     4   3212 "one" => sub { $limit = 1; },
22             "n=i" => \$limit,
23 0     0   0 'keys|k=s' => sub { $key_groups->add_groups($_[1]); },
24 5         37 'nonested' => \$do_not_nest,
25             'aligned:s' => \(my $aligned),
26             };
27              
28 5         21 $this->parse_options($args, $spec);
29              
30 5 50       18 if ( ! $key_groups->has_any_group() ) {
31 5         15 $key_groups->add_groups('!.!returnrefs');
32             }
33              
34 5         11 $this->{'LIMIT'} = $limit;
35 5         10 $this->{'KEY_GROUPS'} = $key_groups;
36 5         11 $this->{'NESTED_OUTPUT'} = not $do_not_nest;
37 5 0       56 $this->{'ALIGNED'} = $aligned =~ /^l(eft)?$/i ? 'left' : 'right'
    50          
38             if defined $aligned;
39             };
40              
41             sub accept_record {
42 10     10 0 18 my $this = shift;
43 10         14 my $record = shift;
44              
45 10         17 my $limit = $this->{'LIMIT'};
46 10 100       24 if ( defined($limit) ) {
47 5 100       15 if ( $limit == 0 ) {
48 1         3 return 0;
49             }
50 4         6 $this->{'LIMIT'}--;
51             }
52              
53 9         27 my $specs = $this->{'KEY_GROUPS'}->get_keyspecs_for_record($record);
54              
55 9 50       22 if ($this->{'ALIGNED'}) {
56 0         0 for my $key (@$specs) {
57 0         0 my $width = length $key;
58             $this->{'FORMAT_KEY_WIDTH'} = $width
59 0 0       0 if $width > $this->{'FORMAT_KEY_WIDTH'};
60             }
61             $this->{'FORMAT_KEY_WIDTH'} *= -1
62 0 0       0 if $this->{'ALIGNED'} eq 'left';
63             }
64              
65 9         37 $this->push_line('-' x 70);
66 9         31 foreach my $key (sort @$specs) {
67 21         30 my $value = ${$record->guess_key_from_spec($key)};
  21         55  
68 21         51 $this->output_value('', $key, $value);
69             }
70              
71 9         56 return 1;
72             }
73              
74             sub _format_key {
75 25     25   33 my $this = shift;
76 25         71 my $key = shift;
77 25 50       73 return $key unless $this->{'FORMAT_KEY_WIDTH'};
78 0         0 return sprintf '%*s', $this->{'FORMAT_KEY_WIDTH'}, $key;
79             }
80              
81             sub output_value {
82 25     25 0 36 my $this = shift;
83 25         43 my $prefix = shift;
84 25         35 my $key = shift;
85 25         42 my $value = shift;
86              
87 25         50 $key = $this->_format_key($key);
88              
89 25 100 100     94 if ( (ref($value) eq 'HASH') && $this->{'NESTED_OUTPUT'} ) {
    100          
90 3 100       10 if ( scalar keys %$value > 0 ) {
91 2         10 $this->push_line($prefix . "$key = HASH:");
92 2         6 $this->output_hash($prefix . ' ', $value);
93             }
94             else {
95 1         6 $this->push_line($prefix . "$key = EMPTY HASH");
96             }
97             }
98             elsif ( ref($value) eq 'ARRAY' ) {
99 1 50       3 if ( scalar @$value > 0 ) {
100 1         6 $this->push_line($prefix . "$key = ARRAY:");
101 1         4 $this->output_array($prefix . ' ', $value);
102             }
103             else {
104 0         0 $this->push_line($prefix . "$key = EMPTY ARAY");
105             }
106             }
107             else {
108 21         54 my $value_string = App::RecordStream::OutputStream::hashref_string($value);
109 21         82 $this->push_line($prefix . "$key = $value_string");
110             }
111             }
112              
113             sub output_array {
114 1     1 0 2 my $this = shift;
115 1         2 my $prefix = shift;
116 1         2 my $array = shift;
117              
118 1         2 my $index = 0;
119 1         4 foreach my $value (sort @$array) {
120 2         7 $this->output_value($prefix, $index, $value);
121 2         5 $index++;
122             }
123             }
124              
125             sub output_hash {
126 2     2 0 4 my $this = shift;
127 2         3 my $prefix = shift;
128 2         4 my $hash = shift;
129              
130 2         6 foreach my $key (sort keys %$hash) {
131 2         5 my $value = $hash->{$key};
132 2         9 $this->output_value($prefix, $key, $value);
133             }
134             }
135              
136             sub add_help_types {
137 5     5 0 8 my $this = shift;
138 5         20 $this->use_help_type('keyspecs');
139 5         14 $this->use_help_type('keygroups');
140 5         12 $this->use_help_type('keys');
141             }
142              
143             sub usage {
144 0     0 0   my $this = shift;
145              
146 0           my $options = [
147             ['1|one', 'Only print the first record'],
148             ['keys', 'Only print out specified keys, Maybe keyspecs may be keygroups, see --help-keys for more information'],
149             ['nonested', 'Do not nest the output of hashes, keep each value on one line'],
150             ['n ', 'Only print n records'],
151             ['aligned [r|l|right|left]', 'Format keys to the same width so values are aligned. Keys are right aligned by default, but you may pass a value of "left" to left align keys within the width.'],
152             ];
153              
154 0           my $args_string = $this->options_string($options);
155              
156 0           return <
157             Usage: recs-toprettyprint [files]
158             __FORMAT_TEXT__
159             Pretty print records, one key to a line, with a line of dashes (---)
160             separating records. Especially useful for records with very large amounts of
161             keys
162             __FORMAT_TEXT__
163              
164             Arguments:
165             $args_string
166              
167             Examples
168             # Pretty print records
169             recs-toprettyprint
170              
171             # Find all keys with 'time' in the name or value
172             ... | recs-toprettyprint --one | grep time
173             USAGE
174             }
175              
176             1;