File Coverage

blib/lib/Ark/Context.pm
Criterion Covered Total %
statement 119 134 88.8
branch 37 52 71.1
condition 12 19 63.1
subroutine 27 28 96.4
pod 0 21 0.0
total 195 254 76.7


line stmt bran cond sub pod time code
1             package Ark::Context;
2 61     61   388 use Mouse;
  61         119  
  61         418  
3              
4 61     61   19736 use Scalar::Util ();
  61         126  
  61         2121  
5 61     61   29375 use Try::Tiny 0.02;
  61         124341  
  61         3331  
6 61     61   26593 use URI::WithBase;
  61         401775  
  61         13421  
7              
8             our $DETACH = 'ARK_DETACH';
9             our $DEFERRED = 'ARK_DEFERRED';
10             our $STREAMING = 'ARK_STREAMING';
11              
12             extends 'Ark::Component';
13              
14             has request => (
15             is => 'rw',
16             isa => 'Object',
17             required => 1,
18             );
19              
20             has response => (
21             is => 'rw',
22             isa => 'Ark::Response',
23             lazy => 1,
24             default => sub {
25             Ark::Response->new;
26             },
27             );
28              
29             has app => (
30             is => 'rw',
31             isa => 'Ark::Core',
32             required => 1,
33             weak_ref => 1,
34             handles => ['debug', 'log', 'get_actions', 'get_action', 'ensure_class_loaded',
35             'component', 'controller', 'view', 'model', 'path_to', 'config',
36             'router',],
37             );
38              
39             has stash => (
40             is => 'rw',
41             isa => 'HashRef',
42             lazy => 1,
43             default => sub { {} },
44             );
45              
46             has stack => (
47             is => 'rw',
48             isa => 'ArrayRef',
49             lazy => 1,
50             default => sub { [] },
51             );
52              
53             has state => (
54             is => 'rw',
55             default => 0,
56             );
57              
58             has error => (
59             is => 'rw',
60             isa => 'ArrayRef',
61             lazy => 1,
62             default => sub { [] },
63             );
64              
65             has [qw/detached finalized/] => (
66             is => 'rw',
67             isa => 'Bool',
68             default => 0,
69             );
70              
71             { # alias
72 61     61   511 no warnings 'once';
  61         119  
  61         101203  
73             *req = \&request;
74             *res = \&response;
75             }
76              
77             sub process {
78 281     281 0 6316 my $self = shift;
79              
80 281         1210 $self->prepare;
81 281         1033 $self->dispatch;
82 281 50       2279 $self->finalize unless $self->response->is_deferred;
83             }
84              
85             sub prepare {
86 281     281 0 541 my $self = shift;
87              
88 281         1420 $self->prepare_action;
89 281         73159 $self->prepare_encoding;
90 281         1089 $self->prepare_headers;
91 281         964 $self->prepare_body;
92             }
93              
94             sub prepare_action {
95 281     281 0 884 my $self = shift;
96 281         1079 my $req = $self->request;
97              
98 281         1506 $req->match( $self->router->match($req->path) );
99             }
100              
101       281 0   sub prepare_headers {}
102              
103       281 0   sub prepare_body {}
104              
105             sub forward {
106 142     142 0 9273 my ($self, $target, @args) = @_;
107 142 100       455 return 0 unless $target;
108              
109 136 100       373 unless (@args) {
110 121         810 @args = @{ $self->req->captures } ? @{ $self->req->captures }
  10         191  
111 121 100       164 : @{ $self->req->args };
  111         2392  
112             }
113              
114 136 100       1784 if (Scalar::Util::blessed($target)) {
115 25 50       322 if ($target->isa('Ark::Action')) {
    50          
116 0         0 $target->dispatch($self, @args);
117 0         0 return $self->state;
118             }
119             elsif ($target->can('process')) {
120 25         138 $self->execute($target, 'process', @args);
121 25         116 return $self->state;
122             }
123             }
124             else {
125 111 100       522 if ($target =~ m!^/.+!) {
126 18         160 my ($namespace, $name) = $target =~ m!^(.*/)([^/]+)$!;
127 18         116 $namespace =~ s!(^/|/$)!!g;
128 18 50 100     115 if (my $action = $self->get_action($name, $namespace || '')) {
129 18         822 $action->dispatch($self, @args);
130 18         124 return $self->state;
131             }
132             }
133             else {
134 93         282 my $last = $self->stack->[-1];
135              
136 93 50 33     1343 if ($last
      33        
137             and $last->{obj}->isa('Ark::Controller')
138             and my $action = $self->get_action($target, $last->{obj}->namespace)) {
139              
140 93         4749 $action->dispatch($self, @args);
141 91         474 return $self->state;
142             }
143             }
144             }
145              
146 0         0 my $error = qq/Couldn't forward to $target, Invalid action or component/;
147 0         0 $self->log( error => $error );
148 0         0 push @{ $self->error }, $error;
  0         0  
149              
150 0         0 return 0;
151             }
152              
153             sub detach {
154 10     10 0 229 shift->forward(@_);
155 10         86 die $DETACH;
156             }
157              
158             sub dispatch {
159 272     272 0 496 my $self = shift;
160              
161 272         928 my $match = $self->request->match;
162 272 100       915 if ($match) {
163 271 100 66     1135 $self->dispatch_private_action('begin')
164             and $self->dispatch_auto_action
165             and $match->dispatch($self);
166              
167 271         948 $self->detached(0);
168 271 50 33     3052 $self->dispatch_private_action('end')
169             unless $self->res->is_deferred or $self->res->is_streaming;
170             }
171             else {
172 1         9 $self->log( error => 'no action found' );
173             }
174             }
175              
176             sub dispatch_action {
177 0     0 0 0 my ($self, $name) = @_;
178              
179 0 0       0 my $action = ($self->router->get_actions($name, $self->req->action->namespace))[-1]
180             or return 1;
181 0         0 $action->dispatch($self);
182              
183 0         0 !@{ $self->error };
  0         0  
184             }
185              
186             sub dispatch_private_action {
187 542     542 0 2186 my ($self, $name) = @_;
188              
189 542         1558 my $action = ($self->router->get_actions($name, $self->req->action->namespace))[-1];
190 542 100 100     29029 return 1 unless ($action and $action->attributes->{Private});
191              
192 8         28 $action->dispatch($self);
193              
194 8         11 !@{ $self->error };
  8         34  
195             }
196              
197             sub dispatch_auto_action {
198 271     271 0 617 my $self = shift;
199              
200 271         776 for my $auto ($self->router->get_actions('auto', $self->req->action->namespace)) {
201 4 50       175 next unless $auto->attributes->{Private};
202 4         17 $auto->dispatch($self);
203 4 100       16 return 0 unless $self->state;
204             }
205              
206 270         12190 1;
207             }
208              
209             sub depth {
210 12     12 0 18 scalar @{ shift->stack };
  12         87  
211             }
212              
213             sub execute {
214 488     488 0 1302 my ($self, $obj, $method, @args) = @_;
215 488         961 my $class = ref $obj;
216              
217 488         1380 $self->state(0);
218 488         814 push @{ $self->stack }, {
  488         2932  
219             obj => $obj,
220             method => $method,
221             args => \@args,
222             as_string => "${class}->${method}"
223             };
224              
225 488         934 my $error;
226             try {
227 488     488   22269 $self->execute_action($obj, $method, @args);
228             } catch {
229 13     13   231 $error = $_;
230 488         3962 };
231              
232 488         6453 pop @{ $self->stack };
  488         1252  
233              
234 488 100       1519 if ($error) {
235 13 100       173 if ($error =~ /^${DETACH} at /) {
236 12 100       52 die $DETACH if ($self->depth >= 1);
237 10         37 $self->detached(1);
238             }
239             else {
240 1         2 push @{ $self->error }, $error;
  1         9  
241 1         4 $self->state(0);
242             }
243             }
244              
245 486         1837 $self->state;
246             }
247              
248             sub execute_action {
249 488     488 0 1224 my ($self, $obj, $method, @args) = @_;
250              
251 488         2749 my $state = $obj->$method($self, @args);
252 475 100       59090 $self->state( defined $state ? $state : undef );
253             }
254              
255             sub redirect {
256 2     2 0 5 my ($self, $uri, $status) = @_;
257              
258 2   100     7 $status ||= '302';
259              
260 2         11 $self->res->status($status);
261 2         84 $self->res->header( Location => $uri );
262             }
263              
264             sub redirect_and_detach {
265 2     2 0 701 my $self = shift;
266 2         7 $self->redirect(@_);
267 2         121 $self->detach;
268             }
269              
270             sub uri_for {
271 10     10 0 133 my ($self, @path) = @_;
272 10 50       31 my $params = ref $path[-1] eq 'HASH' ? pop @path : {};
273              
274 10         43 my $base = $self->req->base;
275 10         86 $base =~ s!/*$!!;
276              
277 10         189 (my $path = join '/', @path) =~ s!/{2,}!/!g;
278 10         30 $path =~ s!^/+!!;
279 10         65 my $uri = URI::WithBase->new($path, $base . '/');
280 10         861 $uri->query_form($params);
281              
282 10         642 $uri->abs;
283             }
284              
285             sub finalize {
286 281     281 0 917 my $self = shift;
287              
288 281         923 my $is_deferred = $self->response->is_deferred;
289              
290 281 50       742 if ($is_deferred) {
291 0         0 my $action = $self->request->action;
292 0 0       0 if ($action) {
293 0         0 $self->dispatch_private_action('end');
294             }
295             }
296              
297 281         986 $self->finalize_headers;
298 281         875 $self->finalize_body;
299 281         1146 $self->finalize_encoding;
300 281 50       1298 $self->response->finalize if $self->response->is_deferred;
301 281         1237 $self->finalized(1);
302             }
303              
304       281 0   sub finalize_headers {}
305       281 0   sub finalize_body {}
306              
307             sub DEMOLISH {
308 272     272 0 575 my $self = shift;
309 272 50       3593 $self->finalize unless $self->finalized;
310             }
311              
312             __PACKAGE__->meta->make_immutable;