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