File Coverage

bin/ypick
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 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__