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__ |