File Coverage

bin/ymask
Criterion Covered Total %
statement 39 43 90.7
branch 12 16 75.0
condition 3 3 100.0
subroutine 6 6 100.0
pod n/a
total 60 68 88.2


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.014';
5 1     1   420 use App::YAML::Filter::Base;
  1         2  
  1         14  
6 1     1   532 use Pod::Usage::Return qw( pod2usage );
  1         39350  
  1         110  
7 1     1   1126 use Getopt::Long qw( GetOptionsFromArray );
  1         12694  
  1         6  
8 1     1   179 use YAML;
  1         2  
  1         50  
9 1     1   610 use Data::Partial::Google;
  1         250569  
  1         401  
10              
11             $|++; # no buffering
12              
13             sub main {
14 3     3   36024 my ( $class, @argv ) = @_;
15 3         7 my %opt;
16 3         19 GetOptionsFromArray( \@argv, \%opt,
17             'help|h',
18             'version',
19             );
20 3 50       704 return pod2usage(0) if $opt{help};
21 3 50       10 if ( $opt{version} ) {
22 0         0 print "ymask version $ymask::VERSION (Perl $^V)\n";
23 0         0 return 0;
24             }
25              
26 3         5 my $mask = shift @argv;
27 3 100       12 return pod2usage("ERROR: Must give a mask") unless $mask;
28              
29 2         38 my $filter = Data::Partial::Google->new( $mask );
30              
31 2 100       7196 push @argv, "-" unless @argv;
32 2         8 for $ARGV ( @argv ) {
33             # We're doing a similar behavior to <>, but manually for easier testing.
34 2         24 my $fh;
35 2 100       6 if ( $ARGV eq '-' ) {
36             # Use the existing STDIN so tests can fake it
37 1         2 $fh = \*STDIN;
38             }
39             else {
40 1 50       41 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         3 my $buffer;
47 2         5 my $scope = {};
48 2         23 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         12 print YAML::Dump( $filter->mask( YAML::Load( $buffer ) ) );
53 2         10003 $buffer = '';
54             }
55 16         48 $buffer .= $line;
56             }
57             # Flush the buffer in the case of a single document with no ---
58 2 50       9 if ( $buffer =~ /\S/ ) {
59             #print STDERR "Buffer is: $buffer\n";
60 2         6 print YAML::Dump( $filter->mask( YAML::Load( $buffer ) ) );
61             }
62             }
63              
64 2         7060 return 0;
65             }
66              
67             exit __PACKAGE__->main( @ARGV ) unless caller(0);
68              
69             __END__