File Coverage

blib/lib/App/YG.pm
Criterion Covered Total %
statement 30 209 14.3
branch 0 68 0.0
condition 0 28 0.0
subroutine 10 31 32.2
pod 3 3 100.0
total 43 339 12.6


line stmt bran cond sub pod time code
1             package App::YG;
2 1     1   14431 use strict;
  1         2  
  1         35  
3 1     1   3 use warnings;
  1         0  
  1         25  
4 1     1   4 use Carp qw/croak/;
  1         3  
  1         56  
5 1     1   642 use Getopt::Long qw/GetOptionsFromArray/;
  1         10329  
  1         4  
6 1     1   626 use Pod::Usage;
  1         36527  
  1         131  
7 1     1   506 use IO::Interactive qw/is_interactive/;
  1         7974  
  1         5  
8 1     1   665 use Term::ANSIColor qw/colored/;
  1         5485  
  1         400  
9              
10             our $VERSION = '0.063';
11              
12             our $CONFIG_FILE = '.ygconfig';
13             our $DEFAULT_PARSER = 'apache-combined';
14             our $DIGEST_LENGTH = 6;
15             our $DEFAULT_COLOR = +{
16             label => 'blue',
17             colon => 'cyan',
18             value => 'green',
19             hr => 'yellow',
20             count => 'red',
21             digest => 'magenta',
22             };
23              
24             use Class::Accessor::Lite (
25 1         6 new => 1,
26             rw => [qw/
27             config
28             parse_class
29             parse_func
30             labels
31             label_format
32             count
33             hr
34             /],
35 1     1   459 );
  1         720  
36              
37             sub run {
38 0     0 1   my $self = shift;
39 0           $self->pre(\@_)->loop;
40             }
41              
42             sub loop {
43 0     0 1   my $self = shift;
44              
45 0           $self->count(1);
46 0 0         if ( !is_interactive() ) {
  0 0          
47 0           while ( my $line = ) {
48 0           $self->_out_put(\$line);
49             }
50             }
51             elsif ( scalar @{ $self->config->{file} } ) {
52 0           for my $file (@{$self->config->{file}}) {
  0            
53 0 0         open my $fh, '<', $file or croak $!;
54 0           while ( my $line = <$fh> ) {
55 0           $self->_out_put(\$line);
56             }
57 0           close $fh;
58             }
59             }
60              
61 0           return 1;
62             }
63              
64             sub _out_put {
65 0     0     my ($self, $line_ref) = @_;
66              
67 0           chomp ${$line_ref};
  0            
68              
69 0 0 0       if ( ( !$self->config->{match} && !$self->config->{regexp} )
      0        
      0        
      0        
      0        
70             || ( $self->config->{match} && $self->_match($line_ref) )
71             || ( $self->config->{regexp} && $self->_regexp($line_ref) )
72             ) {
73 0           $self->__out($line_ref);
74             }
75             else {
76 0           return;
77             }
78             }
79              
80             sub __out {
81 0     0     my ($self, $line_ref) = @_;
82              
83 0 0         if ($self->config->{through}) {
84 0           print "${$line_ref}\n";
  0            
85 0           return;
86             }
87              
88 0 0         if (!$self->config->{nohr}) {
89 0           my $digest = '';
90 0 0         if ($self->config->{digest}) {
91 0           $digest = substr(Digest::SHA1::sha1_hex(${$line_ref}), 0, $DIGEST_LENGTH);
  0            
92             }
93 0           $self->_output_head($self->count, $digest);
94             }
95              
96 0 0         $self->_output_raw($line_ref) if $self->config->{raw};
97              
98 0 0 0       if ($self->config->{ltsv}) {
    0          
99 0           $self->_output_ltsv_line($line_ref);
100             }
101             elsif ( $self->config->{tab} || $self->config->{space} ) {
102 0           $self->_output_splited_line($line_ref);
103             }
104             else {
105 0           $self->_output_parsed_line($line_ref);
106             }
107              
108 0           $self->count( $self->count() + 1 );
109 0           return;
110             }
111              
112             sub _match {
113 0     0     my ($self, $line_ref) = @_;
114              
115 0 0         return 1 if index(${$line_ref}, $self->{config}->{match}) > -1;
  0            
116             }
117              
118             sub _regexp {
119 0     0     my ($self, $line_ref) = @_;
120              
121 0 0         if ($self->config->{ignore_case}) {
122 0 0         return 1 if ${$line_ref} =~ m!$self->{config}->{regexp}!i;
  0            
123             }
124             else {
125 0 0         return 1 if ${$line_ref} =~ m!$self->{config}->{regexp}!;
  0            
126             }
127             }
128              
129             sub _output_head {
130 0     0     my ($self, $count, $digest) = @_;
131              
132 0 0         my $colon = $digest ? ': ' : '';
133              
134 0 0         if ($self->config->{color}) {
135 0           print colored($self->hr.' ', $self->config->{_color}{hr});
136 0           print colored($count, $self->config->{_color}{count});
137 0           print colored($colon, $self->config->{_color}{colon});
138 0           print colored($digest, $self->config->{_color}{digest});
139 0           print colored(' '.$self->hr, $self->config->{_color}{hr});
140 0           print "\n";
141             }
142             else {
143 0           print $self->hr. " $count$colon$digest ". $self->hr. "\n";
144             }
145             }
146              
147             sub _output_raw {
148 0     0     print "${$_[1]}\n";
  0            
149             }
150              
151             sub _output_ltsv_line {
152 0     0     my ($self, $line_ref) = @_;
153              
154 0           my $delimiter = "\t";
155              
156 0           my @cols = split $delimiter, ${$line_ref};
  0            
157 0           my @labels;
158 0           for my $col (@cols) {
159 0           my ($label, $value) = split ':', $col;
160 0           push @labels, $label;
161             }
162 0           my $lablel_width = _max_label_len(\@labels);
163              
164 0           for my $col (@cols) {
165 0           my ($label, $value) = split ':', $col;
166 0           $self->__output_line( sprintf("%${lablel_width}s", $label), $value );
167             }
168 0           print "\n";
169             }
170              
171             sub _output_parsed_line {
172 0     0     my ($self, $line_ref) = @_;
173              
174 0           my $logs;
175             {
176 1     1   711 no strict 'refs'; ## no critic
  1         1  
  1         309  
  0            
177 0           $logs = &{ $self->parse_func }(${$line_ref});
  0            
  0            
178             }
179 0 0         if (@{$logs}) {
  0            
180 0           my $i = 0;
181 0           for my $label (@{$self->labels}) {
  0            
182 0           $self->__output_line( sprintf($self->label_format, $label), $logs->[$i] );
183 0           $i++;
184             }
185             }
186             else {
187 0           print ${$line_ref};
  0            
188             }
189 0           print "\n";
190             }
191              
192             sub _output_splited_line {
193 0     0     my ($self, $line_ref) = @_;
194              
195 0 0         my $delimiter = $self->config->{space} ? ' ' : "\t";
196 0           my $i = 1;
197 0           my @cols = split $delimiter, ${$line_ref};
  0            
198              
199 0 0         if ($self->config->{number}) {
200 0           my $j = length(scalar @cols);
201 0           for my $col (@cols) {
202 0           $self->__output_line( sprintf("%${j}d", $i), $col );
203 0           $i++;
204             }
205             }
206             else {
207 0           for my $col (@cols) {
208 0           $self->__output_line( '', $col );
209 0           $i++;
210             }
211             }
212 0           print "\n";
213             }
214              
215             sub __output_line {
216 0     0     my ($self, $label, $value) = @_;
217              
218 0 0         if ($self->config->{color}) {
219 0           print colored($label, $self->config->{_color}{label});
220 0 0         print colored(': ', $self->config->{_color}{colon}) if $label;
221 0           print colored("$value\n", $self->config->{_color}{value});
222             }
223             else {
224 0 0         print "$label: " if $label;
225 0           print "$value\n";
226             }
227             }
228              
229             sub pre {
230 0     0 1   my ($self, $argv) = @_;
231              
232 0           my $config = $self->_set_config;
233 0           $self->_merge_opt($config, $argv);
234 0           $self->config($config);
235 0   0       $self->parse_class(
236             $self->_load_parser($config->{parser} || $DEFAULT_PARSER)
237             );
238 0           $self->parse_func( $self->parse_class. '::parse');
239             {
240 1     1   4 no strict 'refs'; ## no critic
  1         1  
  1         659  
  0            
241 0           $self->labels( &{ $self->parse_class. '::labels' }() );
  0            
242             }
243             $self->label_format(
244 0           '%'. _max_label_len($self->labels). 's'
245             );
246              
247 0 0         if ($self->config->{digest}) {
248 0           eval { require Digest::SHA1; };
  0            
249 0 0         croak $@ if $@;
250             }
251              
252 0 0         if ($self->config->{color}) {
253 0           for my $k (keys %{$DEFAULT_COLOR}) {
  0            
254 0   0       $self->config->{_color}{$k}
255             = $self->config->{"color-$k"} || $DEFAULT_COLOR->{$k};
256             }
257             }
258              
259 0           $self->hr($self->_hr);
260              
261 0           $self;
262             }
263              
264             sub _hr {
265 0     0     my $self = shift;
266              
267 0   0       my $hr = $self->config->{hr} || '*';
268 0   0       my $hr_num = $self->config->{'hr-count'} || 20;
269 0           return scalar($hr x $hr_num);
270             }
271              
272             sub _set_config {
273 0     0     my $self = shift;
274              
275 0           my %config;
276 0           for my $dir ($ENV{YG_DIR}, $ENV{HOME}) {
277 0 0         next unless $dir;
278 0 0         next unless -e "$dir/$CONFIG_FILE";
279 0           $self->__read_config("$dir/$CONFIG_FILE" => \%config);
280             }
281              
282 0           return \%config;
283             }
284              
285             sub __read_config {
286 0     0     my ($self, $file, $config) = @_;
287              
288 0 0         open my $fh, '<', $file or croak $!;
289 0           while (<$fh>) {
290 0           chomp;
291 0 0         next if /\A\s*\Z/sm;
292 0 0         if (/\A(\w+):\s*(.+)\Z/sm) {
293 0           my ($key, $value) = ($1, $2);
294 0 0         if ($key eq 'file') {
295 0           push @{$config->{$key}}, $value;
  0            
296             }
297             else {
298 0           $config->{$key} = $value;
299             }
300             }
301             }
302 0           close $fh;
303             }
304              
305             sub _merge_opt {
306 0     0     my ($self, $config, $argv) = @_;
307              
308 0           Getopt::Long::Configure('bundling');
309             GetOptionsFromArray(
310             $argv,
311             'f|file=s@' => \$config->{file},
312             'p|parser=s' => \$config->{parser},
313             'tab' => \$config->{tab},
314             'space' => \$config->{space},
315             'n|number!' => \$config->{number},
316             'm|match=s' => \$config->{match},
317             're|regexp=s' => \$config->{regexp},
318             'i|ignore-case!' => \$config->{ignore_case},
319             'r|raw' => \$config->{raw},
320             't|through' => \$config->{through},
321             'digest!' => \$config->{digest},
322             'ltsv' => \$config->{ltsv},
323             'c|color!' => \$config->{color},
324             'color-label=s' => \$config->{color_label},
325             'color-colon=s' => \$config->{color_colon},
326             'color-value=s' => \$config->{color_value},
327             'color-hr=s' => \$config->{color_hr},
328             'color-count=s' => \$config->{color_count},
329             'color-digest=s' => \$config->{color_digest},
330             'hr=s' => \$config->{hr},
331             'hr-count=i' => \$config->{'hr-count'},
332             'nohr' => \$config->{'nohr'},
333             'h|help' => sub {
334 0     0     pod2usage(1);
335             },
336             'v|version' => sub {
337 0     0     print "yg v$App::YG::VERSION\n";
338 0           exit 1;
339             },
340 0 0         ) or pod2usage(2);
341              
342 0           push @{$config->{file}}, @{$argv};
  0            
  0            
343             }
344              
345             sub _load_parser {
346 0     0     my ($self, $parser) = @_;
347              
348 0           my $class = __PACKAGE__. join('', map { '::'.ucfirst($_) } split('-', $parser));
  0            
349 0           my $file = $class;
350 0           $file =~ s!::!/!g;
351 0           eval {
352 0           require "$file.pm"; ## no critic
353             };
354 0 0         if ($@) {
355 0           croak "wrong parser: $parser, $@";
356             }
357 0           return $class;
358             }
359              
360             sub _max_label_len {
361 0     0     my $labels = shift;
362              
363 0           my $max = 0;
364 0           for my $label (@{$labels}) {
  0            
365 0           my $len = length($label);
366 0 0         $max = $len if $max < $len;
367             }
368 0           return $max;
369             }
370              
371             1;
372              
373             __END__