File Coverage

blib/lib/Ark/Test.pm
Criterion Covered Total %
statement 103 104 99.0
branch 32 36 88.8
condition 3 6 50.0
subroutine 19 19 100.0
pod 0 1 0.0
total 157 166 94.5


line stmt bran cond sub pod time code
1             package Ark::Test;
2 57     61   988935 use Mouse;
  57         259462  
  57         310  
3              
4 57     57   48402 use HTTP::Request;
  57         748538  
  57         1893  
5 57     57   28945 use HTTP::Cookies;
  57         629048  
  57         2013  
6 57     57   23745 use Plack 0.9910; # only for declare dep version
  57         9170  
  57         1565  
7 57     57   23967 use Plack::Test;
  57         31591  
  57         2982  
8              
9 57     57   19187 use FindBin;
  57         45911  
  57         2978  
10 57     57   4729 use Path::Class qw/dir/;
  57         338171  
  57         2708  
11              
12 57     57   23863 use Ark::Test::Context;
  57         146  
  57         4726  
13              
14             sub import {
15 77     77   12731 my ($class, $app_class, @rest) = @_;
16 77         210 my $caller = caller;
17 77         246 my %option = @rest;
18              
19 77 50       297 return unless $app_class;
20              
21 77 100       716 Mouse::load_class($app_class) unless Mouse::is_class_loaded($app_class);
22              
23 77         725 my $persist_app = undef;
24 77         120 my $cookie;
25              
26             {
27 57     57   375 no strict 'refs';
  57         103  
  57         1695  
  77         139  
28 57     57   353 no warnings 'redefine';
  57         113  
  57         42398  
29              
30 77         773 *{ $caller . '::request'} = sub {
31 289     289   104995 my $app;
        221      
32 289 100       831 unless ($persist_app) {
33 230         2988 $app = $app_class->new;
34              
35 307         1143 my @components = map { "${app_class}::${_}" }
36 230 100       645 @{ $option{components} || [] };
  230         1046  
37 230         1187 $app->load_component($_) for @components;
38              
39 230 100       1021 if ($option{minimal_setup}) {
40 54         216 $app->setup_home;
41              
42 54         1028 $app->path_to('action.cache')->remove;
43              
44 54         83224 my $child = fork;
45 54 100       4560 if ($child == 0) {
    50          
46 14         2550 $app->setup_minimal;
47 14         6263 exit;
48             }
49             elsif (!defined($child)) {
50 0         0 die $!;
51             }
52              
53 40         31187271 waitpid $child, 0;
54              
55 40         3780 $app->setup_minimal;
56             }
57             else {
58 176         815 $app->setup;
59             }
60 216   66     1235 $app->config->{home} ||= dir($FindBin::Bin);
61             }
62              
63 275 100       8440 if ($option{reuse_connection}) {
64 69 100       146 if ($persist_app) {
65 59         73 $app = $persist_app;
66             }
67             else {
68 10         23 $persist_app = $app;
69 10         108 $cookie = HTTP::Cookies->new;
70             }
71             }
72              
73 275 100       3564 my $req = ref($_[0]) eq 'HTTP::Request' ? $_[0] : HTTP::Request->new(@_);
74 275 100       269239 if ($cookie) {
75 69 50 33     148 unless ($req->uri->can('host') and $req->uri->host) {
76 69         651 $req->uri( URI->new('http://localhost' . $req->uri->path_query ) );
77 69         28410 $req->header( Host => 'localhost' );
78             }
79 69 100       3688 $cookie->add_cookie_header($req) unless $req->header('Cookie');
80             }
81              
82 275         21756 my $res;
83             test_psgi(
84             app => $app->handler,
85             client => sub {
86 275     275   778427 my $cb = shift;
87 275         767 $res = $cb->($req);
88             },
89 275         2336 );
90              
91 275 100       83265 if ($cookie) {
92 69         112 $res->{_request} = $req;
93 69 50       246 $cookie && $cookie->extract_cookies($res);
94             }
95              
96 275 100       29414 $app->path_to('action.cache')->remove if $option{minimal_setup};
97              
98 275         13544 $res;
99 77         556 };
100              
101 77         330 *{ $caller . '::get' } = sub {
102 131     131   92510 &{$caller . '::request'}(GET => @_)->content;
  131         672  
103 77         327 };
104              
105 77         351 *{ $caller . '::reset_app' } = sub() {
106 2     2   1022 undef $persist_app;
107 2         7 undef $cookie;
108 77         259 };
109              
110 77         362 *{ $caller . '::ctx_request'} = sub {
111 62 100   62   48783 unless (Ark::Context->meta->does_role('Ark::Test::Context')) {
112 9         497 Ark::Context->meta->make_mutable;
113 9         235 Ark::Test::Context->meta->apply( Ark::Context->meta );
114 9         14546 Ark::Context->meta->make_immutable;
115             }
116              
117 62         2729 my $res = &{$caller . '::request'}(@_);
  62         196  
118 62         115 return $res, context();
119 77         322 };
120              
121 77         81603 *{ $caller . '::ctx_get' } = sub {
122 22     22   42805 my ($res, $c) = &{$caller . '::ctx_request'}(GET => @_);
  22         114  
123 22         78 return $res->content, $c;
124 77         270 };
125             }
126             }
127              
128             do {
129             my $context;
130             sub context {
131 136 100   136 0 328 if ($_[0]) {
132 74         333 $context = $_[0];
133             }
134 136         1290 $context;
135             }
136             };
137              
138             1;
139