File Coverage

blib/lib/App/PAIA/Tester.pm
Criterion Covered Total %
statement 69 79 87.3
branch 6 10 60.0
condition 6 11 54.5
subroutine 25 30 83.3
pod 14 17 82.3
total 120 147 81.6


line stmt bran cond sub pod time code
1             package App::PAIA::Tester;
2 4     4   50273 use strict;
  4         4  
  4         122  
3 4     4   34 use v5.10;
  4         9  
  4         153  
4              
5             our $VERSION = '0.30';
6              
7 4     4   1602 use parent 'Exporter';
  4         841  
  4         13  
8             our @EXPORT = (qw(
9             new_paia_test done_paia_test paia_response paia_live
10             paia PAIA debug
11             stdout stderr output error exit_code
12             stdout_json stderr_json output_json error exit_code
13             ));
14              
15 4     4   202 use Test::More;
  4         5  
  4         18  
16 4     4   2048 use App::Cmd::Tester;
  4         44080  
  4         21  
17 4     4   3472 use File::Temp qw(tempdir);
  4         51575  
  4         199  
18 4     4   24 use Cwd;
  4         4  
  4         165  
19 4     4   1060 use App::PAIA;
  4         11  
  4         39  
20 4     4   685 use JSON::PP qw(encode_json);
  4         6  
  4         245  
21 4     4   18 use Scalar::Util qw(reftype);
  4         4  
  4         161  
22 4     4   16 use HTTP::Tiny;
  4         5  
  4         1147  
23              
24             our $CWD = getcwd();
25             our $RESULT;
26              
27             sub decode_json {
28 2     2 0 9 my $json = shift;
29 2         4 $json =~ s/^#.*$//mg;
30 2         6 JSON::PP::decode_json($json)
31             }
32              
33 2     2 1 547 sub stdout_json() { decode_json($RESULT->stdout) }
34 0     0 1 0 sub stderr_json() { decode_json($RESULT->stderr) }
35 0     0 1 0 sub output_json() { decode_json($RESULT->output) }
36              
37             ## no critic
38 7     7 1 2708 eval "sub $_() { \$RESULT->$_ }" for qw(stdout stderr output error exit_code);
  7     7 1 3117  
  12     12 0 1952  
  0     0 1 0  
  3     3 1 512  
39              
40             our $HTTP_TINY_REQUEST = \&HTTP::Tiny::request;
41              
42             our $DEFAULT_PSGI = [ 500, [], ["no response faked yet"] ];
43             our $PSGI_RESPONSE = $DEFAULT_PSGI;
44             our $HTTP_REQUEST = sub { $PSGI_RESPONSE };
45              
46             sub mock_http {
47 6     6 0 8 my ($self, $method, $url, $opts) = @_;
48 6         17 my $psgi = $HTTP_REQUEST->(
49             $method, $url, $opts->{headers}, $opts->{content}
50             );
51             return {
52 6         14 protocol => 'HTTP/1.1',
53             status => $psgi->[0],
54 6         29 headers => { @{$psgi->[1]} },
55 6         12 content => join "", @{$psgi->[2]},
56             };
57             };
58              
59             sub paia_live() {
60 4     4   19 no warnings;
  4         6  
  4         948  
61 5     5 1 17 *HTTP::Tiny::request = $HTTP_TINY_REQUEST;
62             }
63              
64             sub new_paia_test(@) { ## no critic
65 5     5 1 279 chdir tempdir;
66 5         1972 paia_live;
67             }
68              
69             sub paia_response(@) { ## no critic
70 4     4 1 1120 $PSGI_RESPONSE = $DEFAULT_PSGI;
71 4 50 66     23 if (ref $_[0] and reftype $_[0] eq 'ARRAY') {
72 0         0 $PSGI_RESPONSE = shift;
73             } else {
74 4         6 $PSGI_RESPONSE = $DEFAULT_PSGI;
75 4 100       20 $PSGI_RESPONSE->[0] = $_[0] =~ /^\d+/ ? shift : 200;
76 4 100 66     36 $PSGI_RESPONSE->[1] = shift if ref $_[0] and reftype $_[0] eq 'ARRAY' and @_ > 1;
      66        
77 4         6 my $content = shift;
78 4 50       11 if (reftype $content eq 'HASH') {
    0          
79 4         4 push @{$PSGI_RESPONSE->[1]}, 'Content-type', 'application/json; charset=UTF-8';
  4         11  
80 4         16 $PSGI_RESPONSE->[2] = [ encode_json($content) ];
81             } elsif (reftype $_[1] eq 'ARRAY') {
82 0         0 $PSGI_RESPONSE->[2] = $content;
83             } else {
84 0         0 $PSGI_RESPONSE->[2] = [$content];
85             }
86             }
87              
88 4     4   18 no warnings;
  4         7  
  4         946  
89 4         517 *HTTP::Tiny::request = \&mock_http;
90             }
91              
92             sub paia(@) { ## no critic
93 25     25 1 7909 $RESULT = test_app('App::PAIA' => [@_]);
94             }
95              
96             sub PAIA($) { ## no critic
97 0     0 1 0 my @args = split /\s+/, shift;
98 0         0 say join ' ', '# paia', @args;
99 0         0 paia(@args);
100             }
101              
102             sub done_paia_test() {
103 4     4 1 1909 chdir $CWD;
104 4         15 done_testing;
105             }
106              
107             sub debug {
108 0   0 0 1   say "# $_" for split "\n", join "\n", (
109             "stdout: ".$RESULT->stdout,
110             "stderr: ".$RESULT->stderr,
111             "error: ".$RESULT->error // 'undef',
112             "exit_code: ".$RESULT->exit_code
113             );
114             }
115              
116             1;
117             __END__