line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/env perl |
2
|
|
|
|
|
|
|
package ypick; |
3
|
|
|
|
|
|
|
# ABSTRACT: pick a data structure to display only the desired fields |
4
|
|
|
|
|
|
|
$ypick::VERSION = '0.013'; |
5
|
1
|
|
|
1
|
|
357
|
use App::YAML::Filter::Base; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
12
|
|
6
|
1
|
|
|
1
|
|
557
|
use Pod::Usage::Return qw( pod2usage ); |
|
1
|
|
|
|
|
35667
|
|
|
1
|
|
|
|
|
70
|
|
7
|
1
|
|
|
1
|
|
847
|
use Getopt::Long qw( GetOptionsFromArray ); |
|
1
|
|
|
|
|
8469
|
|
|
1
|
|
|
|
|
5
|
|
8
|
1
|
|
|
1
|
|
165
|
use YAML; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
47
|
|
9
|
1
|
|
|
1
|
|
507
|
use Data::Partial::Google; |
|
1
|
|
|
|
|
265155
|
|
|
1
|
|
|
|
|
406
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
$|++; # no buffering |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
sub main { |
14
|
3
|
|
|
3
|
|
37003
|
my ( $class, @argv ) = @_; |
15
|
3
|
|
|
|
|
4
|
my %opt; |
16
|
3
|
|
|
|
|
21
|
GetOptionsFromArray( \@argv, \%opt, |
17
|
|
|
|
|
|
|
'help|h', |
18
|
|
|
|
|
|
|
'version', |
19
|
|
|
|
|
|
|
); |
20
|
3
|
50
|
|
|
|
605
|
return pod2usage(0) if $opt{help}; |
21
|
3
|
50
|
|
|
|
11
|
if ( $opt{version} ) { |
22
|
0
|
|
|
|
|
0
|
print "ypick version $ypick::VERSION (Perl $^V)\n"; |
23
|
0
|
|
|
|
|
0
|
return 0; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
3
|
|
|
|
|
7
|
my $pick = shift @argv; |
27
|
3
|
100
|
|
|
|
13
|
return pod2usage("ERROR: Must give a pick") unless $pick; |
28
|
|
|
|
|
|
|
|
29
|
2
|
|
|
|
|
38
|
my $filter = Data::Partial::Google->new( $pick ); |
30
|
|
|
|
|
|
|
|
31
|
2
|
100
|
|
|
|
7074
|
push @argv, "-" unless @argv; |
32
|
2
|
|
|
|
|
7
|
for $ARGV ( @argv ) { |
33
|
|
|
|
|
|
|
# We're doing a similar behavior to <>, but manually for easier testing. |
34
|
2
|
|
|
|
|
3
|
my $fh; |
35
|
2
|
100
|
|
|
|
7
|
if ( $ARGV eq '-' ) { |
36
|
|
|
|
|
|
|
# Use the existing STDIN so tests can fake it |
37
|
1
|
|
|
|
|
2
|
$fh = \*STDIN; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
else { |
40
|
1
|
50
|
|
|
|
57
|
unless ( open $fh, '<', $ARGV ) { |
41
|
0
|
|
|
|
|
0
|
warn "Could not open file '$ARGV' for reading: $!\n"; |
42
|
0
|
|
|
|
|
0
|
next; |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
2
|
|
|
|
|
4
|
my $buffer; |
47
|
2
|
|
|
|
|
2
|
my $scope = {}; |
48
|
2
|
|
|
|
|
27
|
while ( my $line = <$fh> ) { |
49
|
|
|
|
|
|
|
# --- is the start of a new document |
50
|
16
|
100
|
100
|
|
|
58
|
if ( $buffer && $line =~ /^---/ ) { |
51
|
|
|
|
|
|
|
# Flush the previous document |
52
|
2
|
|
|
|
|
10
|
print YAML::Dump( $filter->mask( YAML::Load( $buffer ) ) ); |
53
|
2
|
|
|
|
|
10883
|
$buffer = ''; |
54
|
|
|
|
|
|
|
} |
55
|
16
|
|
|
|
|
49
|
$buffer .= $line; |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
# Flush the buffer in the case of a single document with no --- |
58
|
2
|
50
|
|
|
|
11
|
if ( $buffer =~ /\S/ ) { |
59
|
|
|
|
|
|
|
#print STDERR "Buffer is: $buffer\n"; |
60
|
2
|
|
|
|
|
9
|
print YAML::Dump( $filter->mask( YAML::Load( $buffer ) ) ); |
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
2
|
|
|
|
|
6921
|
return 0; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
exit __PACKAGE__->main( @ARGV ) unless caller(0); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
__END__ |