File Coverage

bin/ymask
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


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__