File Coverage

blib/lib/App/Presto/ArgProcessor.pm
Criterion Covered Total %
statement 54 65 83.0
branch 20 32 62.5
condition 3 5 60.0
subroutine 10 14 71.4
pod 0 1 0.0
total 87 117 74.3


line stmt bran cond sub pod time code
1             package App::Presto::ArgProcessor;
2             BEGIN {
3 1     1   26409 $App::Presto::ArgProcessor::AUTHORITY = 'cpan:BPHILLIPS';
4             }
5             {
6             $App::Presto::ArgProcessor::VERSION = '0.009';
7             }
8              
9             # ABSTRACT: Term::ShellUI sub-class
10              
11 1     1   12 use strict;
  1         2  
  1         35  
12 1     1   5 use warnings;
  1         2  
  1         34  
13 1     1   153133 use Regexp::Common qw(balanced);
  1         7218  
  1         5  
14 1     1   3878 use Moo;
  1         22172  
  1         9  
15 1     1   3928 use File::Slurp qw(read_file);
  1         23536  
  1         1455  
16              
17             has _stash => (
18             is => 'lazy',
19             handles => ['stash'],
20             );
21             sub _build__stash {
22 0     0   0 return App::Presto->instance->_stash;
23             }
24              
25             has client => (
26             is => 'lazy',
27             );
28              
29             sub _build_client {
30 0     0   0 return App::Presto->instance->client;
31             }
32              
33             has config => (
34             is => 'lazy',
35             );
36              
37             sub _build_config {
38 0     0   0 return App::Presto->instance->config;
39             }
40              
41             has term => (
42             is => 'lazy',
43             );
44              
45             sub _build_term {
46 0     0   0 return App::Presto->instance->term;
47             }
48              
49             sub process {
50 14     14 0 11469 my $self = shift;
51 14         26 my $args = shift;
52 14         25 foreach my $i ( 0 .. $#{$args} ) {
  14         47  
53 39         2481 my $arg = $args->[$i];
54 39 50       299 if ( $arg =~ m{^#} ) { # comments
    100          
55 0         0 splice( @$args, $i ); # everything else is a comment
56 0         0 last;
57             } elsif ( $arg =~ m[^(\$$RE{balanced}{-keep})$] ) { # full substitutions
58 8         1311 $args->[$i] = $self->_expand_param( substr( $2, 1, -1 ), $1 );
59             } else { # this one gets interpolated
60 31 100       5559 $args->[$i] =~ s[(\$$RE{balanced}{-keep})][my $result = $self->_expand_param(substr($2,1,-1),$1); ref($result) eq 'ARRAY' ? join(',', @$result) : $result]eg;
  4         640  
  4         79  
61             }
62             }
63 14         2881 return $args;
64             }
65              
66             sub _expand_param {
67 12     12   26 my $self = shift;
68 12         42 my $param = shift;
69 12         23 my $orig = shift;
70 12         19 my $replacement = '';
71 12 100       85 if($param =~ m/^(BODY|HEADER)\b(.*)/){
    50          
    0          
    0          
72 6         24 $replacement = $self->_expand_response_param($1,$2);
73             } elsif($param =~ m/^STASH($RE{balanced}{-parens => '[]'})(\/.*)?/){
74 6         899 my ($key, $dpath) = ($1, $2);
75 6         183 $replacement = $self->stash(substr($key,1,-1));
76 6 50       24 if($dpath){
77 6         19 $replacement = _apply_dpath($replacement, $dpath)
78             }
79             } elsif($param =~ m/^FILE($RE{balanced}{-parens => '[]'})($RE{balanced}{-parens => '[]'})?/){
80 0         0 my $file = substr($1, 1, -1);
81 0 0 0     0 my $encoding = $2 ? substr($2, 1, -1) : $self->config->get('binmode') || 'utf8';
82 0         0 $replacement = read_file( $file, { binmode => ":encoding($encoding)" } );
83             } elsif($param =~ m/^PROMPT($RE{balanced}{-parens => '[]'})($RE{balanced}{-parens => '[]'})?/){
84 0         0 my($prompt,$default) = ($1, $2);
85 0 0       0 $replacement = $self->term->readline( substr( $prompt, 1, -1 ) . ' ', ($default ? substr( $default, 1, -1 ) : () ) );
86             }
87 12 100       698 return defined $replacement ? $replacement : $orig;
88             }
89              
90             sub _expand_response_param {
91 6     6   10 my $self = shift;
92 6         14 my $section = shift;
93 6         13 my $sub_section = shift;
94 6         177 my $client = $self->client;
95 6 100 100     722 if($section eq 'HEADER' && $sub_section =~ m/($RE{balanced}{-parens => '[]'})/){
    100          
96 1         209 return $client->response->header(substr($1,1,-1));
97             } elsif($section eq 'BODY'){
98 4 100       24 if(!$sub_section){
    50          
99 1         19 return $client->response_data;
100             } elsif( $sub_section =~ m{^/} ){
101 3         32 return _apply_dpath($client->response_data, $sub_section);
102             }
103             }
104 1         134 return undef;
105             }
106              
107             sub _apply_dpath {
108 9     9   236 my $data = shift;
109 9         16 my $path = shift;
110 9         1249 require Data::DPath;
111 9         221049 my $dpath = Data::DPath::Path->new(path => $path);
112 9         2052 my @matches = $dpath->match($data);
113 9 100       1709 return @matches > 1 ? \@matches : $matches[0];
114             }
115              
116             1;
117              
118             __END__