File Coverage

blib/lib/Dancer2/Core/App.pm
Criterion Covered Total %
statement 619 649 95.3
branch 193 230 83.9
condition 68 112 60.7
subroutine 99 104 95.1
pod 15 45 33.3
total 994 1140 87.1


line stmt bran cond sub pod time code
1             # ABSTRACT: encapsulation of Dancer2 packages
2             package Dancer2::Core::App;
3             $Dancer2::Core::App::VERSION = '0.400001';
4 144     144   292678 use Moo;
  144         804434  
  144         742  
5 144     144   173879 use Carp qw<croak carp>;
  144         391  
  144         7256  
6 144     144   902 use Scalar::Util 'blessed';
  144         371  
  144         5952  
7 144     144   2318 use Module::Runtime 'is_module_name';
  144         5628  
  144         871  
8 144     144   57523 use Safe::Isa;
  144         56256  
  144         19802  
9 144     144   58889 use Sub::Quote;
  144         727305  
  144         8970  
10 144     144   1080 use File::Spec;
  144         310  
  144         5052  
11 144     144   762 use Module::Runtime qw< require_module use_module >;
  144         311  
  144         954  
12 144     144   7009 use List::Util ();
  144         319  
  144         2657  
13 144     144   43679 use Ref::Util qw< is_ref is_globref is_scalarref >;
  144         145500  
  144         9253  
14              
15 144     144   61923 use Plack::App::File;
  144         2280831  
  144         5986  
16 144     144   60290 use Plack::Middleware::FixMissingBodyInRedirect;
  144         1054242  
  144         6025  
17 144     144   57285 use Plack::Middleware::Head;
  144         37043  
  144         4351  
18 144     144   55885 use Plack::Middleware::Conditional;
  144         35437  
  144         4531  
19 144     144   57500 use Plack::Middleware::ConditionalGET;
  144         82204  
  144         5149  
20              
21 144     144   54818 use Dancer2::FileUtils 'path';
  144         386  
  144         8573  
22 144     144   2074 use Dancer2::Core;
  144         303  
  144         2640  
23 144     144   57004 use Dancer2::Core::Cookie;
  144         565  
  144         5839  
24 144     144   74107 use Dancer2::Core::Error;
  144         540  
  144         5621  
25 144     144   1131 use Dancer2::Core::Types;
  144         304  
  144         1236  
26 144     144   1723839 use Dancer2::Core::Route;
  144         492  
  144         5112  
27 144     144   58364 use Dancer2::Core::Hook;
  144         523  
  144         4639  
28 144     144   73493 use Dancer2::Core::Request;
  144         535  
  144         6074  
29 144     144   56734 use Dancer2::Core::Factory;
  144         426  
  144         4180  
30              
31 144     144   59727 use Dancer2::Handler::File;
  144         575  
  144         1109802  
32              
33             our $EVAL_SHIM; $EVAL_SHIM ||= sub {
34             my $code = shift;
35             $code->(@_);
36             };
37              
38              
39             # we have hooks here
40             with qw<
41             Dancer2::Core::Role::Hookable
42             Dancer2::Core::Role::ConfigReader
43             >;
44              
45 264     264 0 1979 sub supported_engines { [ qw<logger serializer session template> ] }
46              
47             sub with_plugins {
48 37     37 1 126 my ( $self, @plugins ) = @_;
49 37         161 return map $self->_with_plugin($_), @plugins;
50              
51             }
52              
53             sub _with_plugin {
54 37     37   94 my( $self, $plugin ) = @_;
55              
56 37 100       126 if ( is_ref($plugin) ) {
57             # passing the plugin as an already-created object
58              
59             # already loaded?
60 1 50       2 if( my ( $already ) = grep { ref($plugin) eq ref $_; } @{ $self->plugins } ) {
  2         14  
  1         16  
61 0 0       0 die "trying to load two different objects for plugin ". ref $plugin
62             if refaddr($plugin) != refaddr $already ;
63              
64             }
65             else {
66 1         3 push @{ $self->plugins }, $plugin;
  1         14  
67             }
68              
69 1         8 return $plugin;
70             }
71              
72             # short plugin names get Dancer2::Plugin:: prefix
73             # plugin names starting with a '+' are full package names
74 36 100       207 if ( $plugin !~ s/^\+// ) {
75 7         33 $plugin =~ s/^(?!Dancer2::Plugin::)/Dancer2::Plugin::/;
76             }
77              
78             # check if it's already there
79 36 100       82 if( my ( $already ) = grep { $plugin eq ref $_ } @{ $self->plugins } ) {
  12         114  
  36         777  
80 2         12 return $already;
81             }
82              
83 34         324 push @{ $self->plugins },
  34         519  
84             $plugin = use_module($plugin)->new( app => $self );
85              
86 34         497 return $plugin;
87             }
88              
89             sub with_plugin {
90 37     37 1 5834 my( $self, $plugin ) = @_;
91              
92 37 50       132 croak "expected a single argument"
93             unless @_ == 2;
94              
95 37         158 ( $self->with_plugins($plugin) )[0];
96             }
97              
98             has _factory => (
99             is => 'ro',
100             isa => InstanceOf['Dancer2::Core::Factory'],
101             lazy => 1,
102             default => sub { Dancer2::Core::Factory->new },
103             );
104              
105             has logger_engine => (
106             is => 'ro',
107             isa => ConsumerOf['Dancer2::Core::Role::Logger'],
108             lazy => 1,
109             builder => '_build_logger_engine',
110             writer => 'set_logger_engine',
111             );
112              
113             has session_engine => (
114             is => 'ro',
115             isa => ConsumerOf['Dancer2::Core::Role::SessionFactory'],
116             lazy => 1,
117             builder => '_build_session_engine',
118             writer => 'set_session_engine',
119             );
120              
121             has template_engine => (
122             is => 'ro',
123             isa => ConsumerOf['Dancer2::Core::Role::Template'],
124             lazy => 1,
125             builder => '_build_template_engine',
126             writer => 'set_template_engine',
127             );
128              
129             has serializer_engine => (
130             is => 'ro',
131             isa => ConsumerOf['Dancer2::Core::Role::Serializer'],
132             lazy => 1,
133             builder => '_build_serializer_engine',
134             writer => 'set_serializer_engine',
135             predicate => 'has_serializer_engine',
136             );
137              
138             has '+local_triggers' => (
139             default => sub {
140             my $self = shift;
141             my $triggers = {
142             # general triggers we want to allow, besides engines
143             views => sub {
144             my $self = shift;
145             my $value = shift;
146             $self->template_engine->views($value);
147             },
148              
149             layout => sub {
150             my $self = shift;
151             my $value = shift;
152             $self->template_engine->layout($value);
153             },
154              
155             layout_dir => sub {
156             my $self = shift;
157             my $value = shift;
158             $self->template_engine->layout_dir($value);
159             },
160              
161             log => sub {
162             my ( $self, $value, $config ) = @_;
163              
164             # This will allow to set the log level
165             # using: set log => warning
166             $self->logger_engine->log_level($value);
167             },
168             };
169              
170             foreach my $engine ( @{ $self->supported_engines } ) {
171             $triggers->{$engine} = sub {
172             my $self = shift;
173             my $value = shift;
174             my $config = shift;
175              
176             is_ref($value) and return $value;
177              
178             my $build_method = "_build_${engine}_engine";
179             my $setter_method = "set_${engine}_engine";
180             my $engine_instance = $self->$build_method( $value, $config );
181              
182             # set the engine with the new value from the builder
183             $self->$setter_method($engine_instance);
184              
185             return $engine_instance;
186             };
187             }
188              
189             return $triggers;
190             },
191             );
192              
193             sub _build_logger_engine {
194 253     253   5238 my $self = shift;
195 253         587 my $value = shift;
196 253         588 my $config = shift;
197              
198 253 100       5589 defined $config or $config = $self->config;
199 253 100       3000 defined $value or $value = $config->{logger};
200              
201 253 50       1172 is_ref($value) and return $value;
202              
203             # XXX This is needed for the tests that create an app without
204             # a runner.
205 253 50       892 defined $value or $value = 'console';
206              
207 253 100       1299 is_module_name($value)
208             or croak "Cannot load logger engine '$value': illegal module name";
209              
210 252         5405 my $engine_options =
211             $self->_get_config_for_engine( logger => $value, $config );
212              
213             my $logger = $self->_factory->create(
214             logger => $value,
215 252         5676 %{$engine_options},
  252         6797  
216             location => $self->config_location,
217             environment => $self->environment,
218             app_name => $self->name,
219             postponed_hooks => $self->postponed_hooks
220             );
221              
222 252 100       5340 exists $config->{log} and $logger->log_level($config->{log});
223              
224 252         7008 return $logger;
225             }
226              
227             sub _build_session_engine {
228 175     175   28498 my $self = shift;
229 175         423 my $value = shift;
230 175         389 my $config = shift;
231              
232 175 100       3319 defined $config or $config = $self->config;
233 175 100 100     2715 defined $value or $value = $config->{'session'} || 'simple';
234              
235 175 100       820 is_ref($value) and return $value;
236              
237 172 100       1102 is_module_name($value)
238             or croak "Cannot load session engine '$value': illegal module name";
239              
240 171         4159 my $engine_options =
241             $self->_get_config_for_engine( session => $value, $config );
242              
243 171         962 Scalar::Util::weaken( my $weak_self = $self );
244              
245             # Note that engine options will replace the default session_dir (if provided).
246             return $self->_factory->create(
247             session => $value,
248             session_dir => path( $self->config->{appdir}, 'sessions' ),
249 171         2601 %{$engine_options},
250             postponed_hooks => $self->postponed_hooks,
251              
252 3     3   33 log_cb => sub { $weak_self->log(@_) },
253 171         3654 );
254             }
255              
256             sub _build_template_engine {
257 164     164   4984 my $self = shift;
258 164         414 my $value = shift;
259 164         394 my $config = shift;
260              
261 164 100       3466 defined $config or $config = $self->config;
262 164 100       1992 defined $value or $value = $config->{'template'};
263              
264 164 50       829 defined $value or return;
265 164 50       666 is_ref($value) and return $value;
266              
267 164 100       926 is_module_name($value)
268             or croak "Cannot load template engine '$value': illegal module name";
269              
270 163         3244 my $engine_options =
271             $self->_get_config_for_engine( template => $value, $config );
272              
273             my $engine_attrs = {
274             config => $engine_options,
275             layout => $config->{layout},
276             layout_dir => ( $config->{layout_dir} || 'layouts' ),
277             views => $config->{views},
278 163   50     2101 };
279              
280 163         989 Scalar::Util::weaken( my $weak_self = $self );
281              
282             return $self->_factory->create(
283             template => $value,
284 163         3977 %{$engine_attrs},
285             postponed_hooks => $self->postponed_hooks,
286              
287 7     7   44 log_cb => sub { $weak_self->log(@_) },
288 163         3835 );
289             }
290              
291             sub _build_serializer_engine {
292 19     19   53 my $self = shift;
293 19         47 my $value = shift;
294 19         44 my $config = shift;
295              
296 19 50       70 defined $config or $config = $self->config;
297 19 50       76 defined $value or $value = $config->{serializer};
298              
299 19 50       66 defined $value or return;
300 19 50       74 is_ref($value) and return $value;
301              
302 19         99 my $engine_options =
303             $self->_get_config_for_engine( serializer => $value, $config );
304              
305 19         118 Scalar::Util::weaken( my $weak_self = $self );
306              
307             return $self->_factory->create(
308             serializer => $value,
309             config => $engine_options,
310             postponed_hooks => $self->postponed_hooks,
311              
312 5     5   46 log_cb => sub { $weak_self->log(@_) },
313 19         459 );
314             }
315              
316             sub _get_config_for_engine {
317 610     610   2347 my $self = shift;
318 610         1352 my $engine = shift;
319 610         1207 my $name = shift;
320 610         1171 my $config = shift;
321              
322 610 100 100     3806 defined $config->{'engines'} && defined $config->{'engines'}{$engine}
323             or return {};
324              
325             # try both camelized name and regular name
326 23         72 my $engine_config = {};
327 23         129 foreach my $engine_name ( $name, Dancer2::Core::camelize($name) ) {
328 30 100       128 if ( defined $config->{'engines'}{$engine}{$engine_name} ) {
329 19         60 $engine_config = $config->{'engines'}{$engine}{$engine_name};
330 19         51 last;
331             }
332             }
333              
334 23         80 return $engine_config;
335             }
336              
337             has postponed_hooks => (
338             is => 'ro',
339             isa => HashRef,
340             default => sub { {} },
341             );
342              
343             # TODO I'd be happier with a HashRef, really
344             has plugins => (
345             is => 'rw',
346             isa => ArrayRef,
347             default => sub { [] },
348             );
349              
350             has route_handlers => (
351             is => 'rw',
352             isa => ArrayRef,
353             default => sub { [] },
354             );
355              
356             has name => (
357             is => 'ro',
358             isa => Str,
359             default => sub { (caller(1))[0] },
360             );
361              
362             has request => (
363             is => 'ro',
364             isa => InstanceOf['Dancer2::Core::Request'],
365             writer => '_set_request',
366             clearer => 'clear_request',
367             predicate => 'has_request',
368             );
369              
370             sub set_request {
371 671     671 0 1690 my ($self, $request, $defined_engines) = @_;
372             # typically this is passed in as an optimization within the
373             # dispatch loop but may be called elsewhere
374 671   66     1966 $defined_engines ||= $self->defined_engines;
375             # populate request in app and all engines
376 671         16495 $self->_set_request($request);
377 671         21825 Scalar::Util::weaken( my $weak_request = $request );
378 671         1123 $_->set_request( $weak_request ) for @{$defined_engines};
  671         12869  
379             }
380              
381             has response => (
382             is => 'ro',
383             isa => InstanceOf['Dancer2::Core::Response'],
384             lazy => 1,
385             writer => 'set_response',
386             clearer => 'clear_response',
387             builder => '_build_response',
388             predicate => 'has_response',
389             );
390              
391             has with_return => (
392             is => 'ro',
393             predicate => 1,
394             writer => 'set_with_return',
395             clearer => 'clear_with_return',
396             );
397              
398             has session => (
399             is => 'ro',
400             isa => InstanceOf['Dancer2::Core::Session'],
401             lazy => 1,
402             builder => '_build_session',
403             writer => 'set_session',
404             clearer => 'clear_session',
405             predicate => '_has_session',
406             );
407              
408             around _build_config => sub {
409             my ( $orig, $self ) = @_;
410             my $config = $self->$orig;
411              
412             if ( $config && $config->{'engines'} ) {
413             $self->_validate_engine($_) for keys %{ $config->{'engines'} };
414             }
415              
416             return $config;
417             };
418              
419             sub _build_response {
420 641     641   6487 my $self = shift;
421             return Dancer2::Core::Response->new(
422 641 100       10168 server_tokens => !$self->config->{'no_server_tokens'},
423             $self->has_serializer_engine
424             ? ( serializer => $self->serializer_engine )
425             : (),
426             );
427             }
428              
429             sub _build_session {
430 93     93   1052 my $self = shift;
431 93         171 my $session;
432              
433             # Find the session engine
434 93         1459 my $engine = $self->session_engine;
435              
436             # find the session cookie if any
437 93 100       873 if ( !$self->has_destroyed_session ) {
438 88         161 my $session_id;
439 88         373 my $session_cookie = $self->cookie( $engine->cookie_name );
440 88 100       1275 defined $session_cookie and
441             $session_id = $session_cookie->value;
442              
443             # if we have a session cookie, try to retrieve the session
444 88 100       282 if ( defined $session_id ) {
445             eval {
446             $EVAL_SHIM->(sub {
447 53     53   309 $session = $engine->retrieve( id => $session_id );
448 53         386 });
449 50         314 1;
450             }
451 53 100       107 or do {
452 3   50     144 my $err = $@ || "Zombie Error";
453 3 50       17 if ( $err !~ /Unable to retrieve session/ ) {
454 0         0 croak "Failed to retrieve session: $err"
455             } else {
456             # XXX we throw away the error entirely? Why?
457             }
458             };
459             }
460             }
461              
462             # create the session if none retrieved
463 93   66     1262 return $session ||= $engine->create();
464             }
465              
466             sub has_session {
467 904     904 1 1501 my $self = shift;
468              
469 904         13783 my $engine = $self->session_engine;
470              
471 904   66     14695 return $self->_has_session
472             || ( $self->cookie( $engine->cookie_name )
473             && !$self->has_destroyed_session );
474             }
475              
476             has destroyed_session => (
477             is => 'ro',
478             isa => InstanceOf ['Dancer2::Core::Session'],
479             predicate => 1,
480             writer => 'set_destroyed_session',
481             clearer => 'clear_destroyed_session',
482             );
483              
484             has 'prep_apps' => (
485             'is' => 'ro',
486             'isa' => ArrayRef,
487             'default' => sub { [] },
488             );
489              
490             sub find_plugin {
491 2     2 0 6 my ( $self, $name ) = @_;
492 2     2   9 my $plugin = List::Util::first { ref($_) eq $name } @{ $self->plugins };
  2         18  
  2         40  
493 2 100       20 $plugin or return;
494 1         3 return $plugin;
495             }
496              
497             sub destroy_session {
498 17     17 1 47 my $self = shift;
499              
500             # Find the session engine
501 17         298 my $engine = $self->session_engine;
502              
503             # Expire session, set the expired cookie and destroy the session
504             # Setting the cookie ensures client gets an expired cookie unless
505             # a new session is created and supercedes it
506 17         376 my $session = $self->session;
507 17         636 $session->expires(-86400); # yesterday
508 17         1984 $engine->destroy( id => $session->id );
509              
510             # Invalidate session cookie in request
511             # and clear session in app and engines
512 17         374 $self->set_destroyed_session($session);
513 17         852 $self->clear_session;
514 17         110 $_->clear_session for @{ $self->defined_engines };
  17         49  
515              
516 17         1838 return;
517             }
518              
519             sub setup_session {
520 118     118 0 218 my $self = shift;
521              
522 118         203 for my $engine ( @{ $self->defined_engines } ) {
  118         282  
523 354 50       18188 $self->has_session ?
524             $engine->set_session( $self->session ) :
525             $engine->clear_session;
526             }
527             }
528              
529             sub change_session_id {
530 5     5 1 20 my $self = shift;
531              
532 5         104 my $session = $self->session;
533              
534             # Find the session engine
535 5         241 my $engine = $self->session_engine;
536              
537 5 100       89 if ($engine->can('_change_id')) {
538              
539             # session engine can change session ID
540 3         15 $engine->change_id( session => $session );
541             }
542             else {
543              
544             # Method order is important in here...
545             #
546             # On session build if there is no destroyed session then the session
547             # builder tries to recreate the session using the existing session
548             # cookie. We really don't want to do that in this case so it is
549             # important to create the new session before the
550             # clear_destroyed_session method is called.
551             #
552             # This sucks.
553             #
554             # Sawyer suggested:
555             #
556             # What if you take the session cookie logic out of that attribute into
557             # another attribute and clear that attribute?
558             # That would force the session rebuilt to rebuilt the attribute and
559             # get a different cookie value, no?
560             #
561             # TODO: think about this some more.
562              
563             # grab data, destroy session and store data again
564 2         6 my %data = %{$session->data};
  2         39  
565              
566             # destroy existing session
567 2         31 $self->destroy_session;
568              
569             # get new session
570 2         34 $session = $self->session;
571              
572             # write data from old session into new
573             # Some engines add session id to data so skip id.
574 2         60 while (my ($key, $value) = each %data ) {
575 2 50       274 $session->write($key => $value) unless $key eq 'id';
576             }
577              
578             # clear out destroyed session - no longer relevant
579 2         56 $self->clear_destroyed_session;
580             }
581              
582 5         122 return $session->id;
583             }
584              
585             has prefix => (
586             is => 'rw',
587             isa => Maybe [Dancer2Prefix],
588             predicate => 1,
589             coerce => sub {
590             my $prefix = shift;
591             defined($prefix) and $prefix eq "/" and return;
592             return $prefix;
593             },
594             );
595              
596             # routes registry, stored by method:
597             has routes => (
598             is => 'rw',
599             isa => HashRef,
600             default => sub {
601             { get => [],
602             head => [],
603             post => [],
604             put => [],
605             del => [],
606             options => [],
607             };
608             },
609             );
610              
611             # add_hook will add the hook to the first "hook candidate" it finds that support
612             # it. If none, then it will try to add the hook to the current application.
613             around add_hook => sub {
614             my $orig = shift;
615             my $self = shift;
616              
617             # saving caller information
618             my ( $package, $file, $line ) = caller(4); # deep to 4 : user's app code
619             my $add_hook_caller = [ $package, $file, $line ];
620              
621             my ($hook) = @_;
622             my $name = $hook->name;
623             my $hook_aliases = $self->all_hook_aliases;
624              
625             # look for an alias
626             defined $hook_aliases->{$name} and $name = $hook_aliases->{$name};
627             $hook->name($name);
628              
629             # if that hook belongs to the app, register it now and return
630             $self->has_hook($name) and return $self->$orig(@_);
631              
632             # at this point the hook name must be formatted like:
633             # '$type.$candidate.$name', eg: 'engine.template.before_render' or
634             # 'plugin.database.before_dbi_connect'
635             my ( $hookable_type, $hookable_name, $hook_name ) = split( /\./, $name );
636              
637             ( defined $hookable_name && defined $hook_name )
638             or croak "Invalid hook name `$name'";
639              
640             grep /^$hookable_type$/, qw(core engine handler plugin)
641             or croak "Unknown hook type `$hookable_type'";
642              
643             # register the hooks for existing hookable candidates
644             foreach my $hookable ( $self->hook_candidates ) {
645             $hookable->has_hook($name) and $hookable->add_hook(@_);
646             }
647              
648             # we register the hook for upcoming objects;
649             # that way, each components that can claim the hook will have a chance
650             # to register it.
651              
652             my $postponed_hooks = $self->postponed_hooks;
653              
654             # Hmm, so the hook was not claimed, at this point we'll cache it and
655             # register it when the owner is instantiated
656             $postponed_hooks->{$hookable_type}{$hookable_name} ||= {};
657             $postponed_hooks->{$hookable_type}{$hookable_name}{$name} ||= {};
658             $postponed_hooks->{$hookable_type}{$hookable_name}{$name}{hook} = $hook;
659             $postponed_hooks->{$hookable_type}{$hookable_name}{$name}{caller} =
660             $add_hook_caller;
661              
662             };
663              
664             around execute_hook => sub {
665             my $orig = shift;
666             my $self = shift;
667              
668             local $Dancer2::Core::Route::REQUEST = $self->request;
669             local $Dancer2::Core::Route::RESPONSE = $self->response;
670              
671             my ( $hook, @args ) = @_;
672             if ( !$self->has_hook($hook) ) {
673             foreach my $cand ( $self->hook_candidates ) {
674             $cand->has_hook($hook) and return $cand->execute_hook(@_);
675             }
676             }
677              
678             return $self->$orig(@_);
679             };
680              
681             sub _build_default_config {
682 236     236   3290 my $self = shift;
683              
684 236   33     2029 my $public = $ENV{DANCER_PUBLIC} || path( $self->location, 'public' );
685             return {
686             content_type => ( $ENV{DANCER_CONTENT_TYPE} || 'text/html' ),
687             charset => ( $ENV{DANCER_CHARSET} || '' ),
688             logger => ( $ENV{DANCER_LOGGER} || 'console' ),
689             views => ( $ENV{DANCER_VIEWS}
690 236   50     3888 || path( $self->location, 'views' ) ),
      50        
      50        
      33        
691             environment => $self->environment,
692             appdir => $self->location,
693             public_dir => $public,
694             template => 'Tiny',
695             route_handlers => [
696             [
697             AutoPage => 1
698             ],
699             ],
700             };
701             }
702              
703             sub _init_hooks {
704 235     235   624 my $self = shift;
705              
706             # Hook to flush the session at the end of the request,
707             # this way, we're sure we flush only once per request
708             #
709             # Note: we create a weakened copy $self
710             # before closing over the weakened copy
711             # to avoid circular memory refs.
712 235         944 Scalar::Util::weaken(my $app = $self);
713              
714             $self->add_hook(
715             Dancer2::Core::Hook->new(
716             name => 'core.app.after_request',
717             code => sub {
718 463     463   892 my $response = $Dancer2::Core::Route::RESPONSE;
719              
720             # make sure an engine is defined, if not, nothing to do
721 463         7711 my $engine = $app->session_engine;
722 463 50       4209 defined $engine or return;
723              
724             # if a session has been instantiated or we already had a
725             # session, first flush the session so cookie-based sessions can
726             # update the session ID if needed, then set the session cookie
727             # in the response
728             #
729             # if there is NO session object but the request has a cookie with
730             # a session key, create a dummy session with the same ID (without
731             # actually retrieving and flushing immediately) and generate the
732             # cookie header from the dummy session. Lazy Sessions FTW!
733              
734 463 100       1544 if ( $app->has_session ) {
    100          
735 76         201 my $session;
736 76 100       270 if ( $app->_has_session ) { # Session object exists
737 73         1292 $session = $app->session;
738 73 100       3559 $session->is_dirty and $engine->flush( session => $session );
739             }
740             else { # Cookie header exists. Create a dummy session object
741 3         13 my $cookie = $app->cookie( $engine->cookie_name );
742 3         62 my $session_id = $cookie->value;
743 3         63 $session = Dancer2::Core::Session->new( id => $session_id );
744             }
745 76         848 $engine->set_cookie_header(
746             response => $response,
747             session => $session
748             );
749             }
750             elsif ( $app->has_destroyed_session ) {
751 12         54 my $session = $app->destroyed_session;
752 12         65 $engine->set_cookie_header(
753             response => $response,
754             session => $session,
755             destroyed => 1
756             );
757             }
758             },
759             )
760 235         4611 );
761             }
762              
763             sub supported_hooks {
764 442     442 0 4960 qw/
765             core.app.before_request
766             core.app.after_request
767             core.app.route_exception
768             core.app.before_file_render
769             core.app.after_file_render
770             core.error.before
771             core.error.after
772             core.error.init
773             /;
774             }
775              
776             sub hook_aliases {
777 1758     1758 0 3191 my $self = shift;
778 1758   100     12417 $self->{'hook_aliases'} ||= {
779             before => 'core.app.before_request',
780             before_request => 'core.app.before_request',
781             after => 'core.app.after_request',
782             after_request => 'core.app.after_request',
783             init_error => 'core.error.init',
784             before_error => 'core.error.before',
785             after_error => 'core.error.after',
786             on_route_exception => 'core.app.route_exception',
787              
788             before_file_render => 'core.app.before_file_render',
789             after_file_render => 'core.app.after_file_render',
790             before_handler_file_render => 'handler.file.before_render',
791             after_handler_file_render => 'handler.file.after_render',
792              
793              
794             # compatibility from Dancer1
795             before_error_render => 'core.error.before',
796             after_error_render => 'core.error.after',
797             before_error_init => 'core.error.init',
798              
799             # TODO: call $engine->hook_aliases as needed
800             # But.. currently there are use cases where hook_aliases
801             # are needed before the engines are intiialized :(
802             before_template_render => 'engine.template.before_render',
803             after_template_render => 'engine.template.after_render',
804             before_layout_render => 'engine.template.before_layout_render',
805             after_layout_render => 'engine.template.after_layout_render',
806             before_serializer => 'engine.serializer.before',
807             after_serializer => 'engine.serializer.after',
808             };
809             }
810              
811             sub defined_engines {
812 1547     1547 0 2613 my $self = shift;
813             return [
814 1547 100       24821 $self->template_engine,
815             $self->session_engine,
816             $self->logger_engine,
817             $self->has_serializer_engine
818             ? $self->serializer_engine
819             : (),
820             ];
821             }
822              
823             # FIXME not needed anymore, I suppose...
824 0     0 0 0 sub api_version {2}
825              
826             sub register_plugin {
827 0     0 1 0 my $self = shift;
828 0         0 my $plugin = shift;
829              
830 0         0 $self->log( core => "Registered $plugin");
831              
832 0         0 push @{ $self->plugins }, $plugin;
  0         0  
833             }
834              
835             # This method overrides the default one from Role::ConfigReader
836             sub settings {
837 888     888 0 1710 my $self = shift;
838 888         1485 +{ %{ Dancer2::runner()->config }, %{ $self->config } };
  888         2397  
  888         23347  
839             }
840              
841             sub cleanup {
842 661     661 0 1258 my $self = shift;
843 661         16355 $self->clear_request;
844 661         13662 $self->clear_response;
845 661         12948 $self->clear_session;
846 661         12830 $self->clear_destroyed_session;
847             # Clear engine attributes
848 661         3296 for my $engine ( @{ $self->defined_engines } ) {
  661         1707  
849 2063         67187 $engine->clear_session;
850 2063         36175 $engine->clear_request;
851             }
852             }
853              
854             sub _validate_engine {
855 28     28   58 my $self = shift;
856 28         53 my $name = shift;
857              
858 28 100       51 grep +( $_ eq $name ), @{ $self->supported_engines }
  28         110  
859             or croak "Engine '$name' is not supported.";
860             }
861              
862             sub engine {
863 26     26 0 722 my $self = shift;
864 26         58 my $name = shift;
865              
866 26         97 $self->_validate_engine($name);
867              
868 25         84 my $attr_name = "${name}_engine";
869 25         519 return $self->$attr_name;
870             }
871              
872             sub template {
873 32     32 0 647 my $self = shift;
874              
875 32         540 my $template = $self->template_engine;
876 32         709 $template->set_settings( $self->config );
877              
878             # A session will not exist if there is no request (global keyword)
879             #
880             # A session may exist but the route code may not have instantiated
881             # the session object (sessions are lazy). If this is the case, do
882             # that now, so the templates have the session data for rendering.
883 32 100 100     1837 $self->has_request && $self->has_session && ! $template->has_session
      100        
884             and $self->setup_session;
885              
886             # return content
887 32 100       237 if ($self->has_with_return) {
888 28         100 my $old_with_return = $self->with_return;
889 28         53 my $local_response;
890             $self->set_with_return( sub {
891 1   33 1   17 $local_response ||= shift;
892 28         191 });
893 28         200 my $content = $template->process( @_ );
894 23         159 $self->set_with_return($old_with_return);
895 23 100       72 if ($local_response) {
896 1         6 $self->with_return->($local_response);
897             }
898 22         111 return $content;
899             }
900 4         19 return $template->process( @_ );
901             }
902              
903             sub hook_candidates {
904 45     45 0 87 my $self = shift;
905              
906 45         84 my @engines = @{ $self->defined_engines };
  45         128  
907              
908 45         3597 my @route_handlers;
909 45         97 for my $handler ( @{ $self->route_handlers } ) {
  45         770  
910 45         378 my $handler_code = $handler->{handler};
911 45 50 33     527 blessed $handler_code and $handler_code->can('supported_hooks')
912             and push @route_handlers, $handler_code;
913             }
914              
915             # TODO : get the list of all plugins registered
916 45         103 my @plugins = @{ $self->plugins };
  45         774  
917              
918 45         531 ( @route_handlers, @engines, @plugins );
919             }
920              
921             sub all_hook_aliases {
922 315     315 0 722 my $self = shift;
923              
924 315         1356 my $aliases = $self->hook_aliases;
925 315         859 for my $plugin ( grep { $_->can('hook_aliases') } @{ $self->plugins } ) {
  13         151  
  315         5932  
926 13         29 $aliases = { %{$aliases}, %{ $plugin->hook_aliases } };
  13         84  
  13         43  
927             }
928              
929 315         3193 return $aliases;
930             }
931              
932             sub mime_type {
933 10     10 0 25 my $self = shift;
934 10         46 my $runner = Dancer2::runner();
935              
936             exists $self->config->{default_mime_type}
937             ? $runner->mime_type->default( $self->config->{default_mime_type} )
938 10 100       225 : $runner->mime_type->reset_default;
939              
940 10         458 $runner->mime_type;
941             }
942              
943             sub log {
944 2323     2323 0 31194 my $self = shift;
945 2323         3795 my $level = shift;
946              
947 2323 50       38696 my $logger = $self->logger_engine
948             or croak "No logger defined";
949              
950 2323         41951 $logger->$level(@_);
951             }
952              
953             sub send_as {
954 8     8 0 18 my $self = shift;
955 8         22 my ( $type, $data, $options ) = @_;
956 8   100     42 $options ||= {};
957              
958 8 100       212 $type or croak "Can not send_as using an undefined type";
959              
960 7 100 100     43 if ( lc($type) eq 'html' || lc($type) eq 'plain' ) {
961 2 50       8 if ( $type ne lc $type ) {
962 0         0 local $Carp::CarpLevel = 2;
963 0         0 carp sprintf( "Please use %s as the type for 'send_as', not %s", lc($type), $type );
964             }
965              
966 2   50     36 $options->{charset} = $self->config->{charset} || 'UTF-8';
967 2         41 my $content = Encode::encode( $options->{charset}, $data );
968 2   33     105 $options->{content_type} ||= join '/', 'text', lc $type;
969 2         10 $self->send_file( \$content, %$options ); # returns from sub
970             }
971              
972             # Try and load the serializer class
973 5         20 my $serializer_class = "Dancer2::Serializer::$type";
974             eval {
975             $EVAL_SHIM->(sub {
976 5     5   23 require_module( $serializer_class );
977 5         30 });
978 3         87 1;
979 5 100       13 } or do {
980 2   50     484 my $err = $@ || "Zombie Error";
981 2         241 croak "Unable to load serializer class for $type: $err";
982             };
983              
984             # load any serializer engine config
985 3   50     70 my $engine_options =
986             $self->_get_config_for_engine( serializer => $type, $self->config ) || {};
987 3         96 my $serializer = $serializer_class->new( config => $engine_options );
988 3         78 my $content = $serializer->serialize( $data );
989 3   66     20 $options->{content_type} ||= $serializer->content_type;
990 3         20 $self->send_file( \$content, %$options );
991             }
992              
993             sub send_error {
994 8     8 0 21 my $self = shift;
995 8         25 my ( $message, $status ) = @_;
996              
997 8 100       156 my $err = Dancer2::Core::Error->new(
998             message => $message,
999             app => $self,
1000             ( status => $status )x!! $status,
1001              
1002             $self->has_serializer_engine
1003             ? ( serializer => $self->serializer_engine )
1004             : (),
1005             )->throw;
1006              
1007             # Immediately return to dispatch if with_return coderef exists
1008 8 50       178 $self->has_with_return && $self->with_return->($err);
1009 0         0 return $err;
1010             }
1011              
1012             sub send_file {
1013 16     16 0 37 my $self = shift;
1014 16         30 my $thing = shift;
1015 16         59 my %options = @_;
1016              
1017 16         39 my ($content_type, $charset, $file_path);
1018              
1019             # are we're given a filehandle? (based on what Plack::Middleware::Lint accepts)
1020             my $is_filehandle = Plack::Util::is_real_fh($thing)
1021 16   33     71 || ( is_globref($thing) && *{$thing}{IO} && *{$thing}{IO}->can('getline') )
1022             || ( Scalar::Util::blessed($thing) && $thing->can('getline') );
1023 16         815 my ($fh) = ($thing)x!! $is_filehandle;
1024              
1025             # if we're given an IO::Scalar object, DTRT (take the scalar ref from it)
1026 16 50 33     66 if (Scalar::Util::blessed($thing) && $thing->isa('IO::Scalar')) {
1027 0         0 $thing = $thing->sref;
1028             }
1029              
1030             # if we're given a SCALAR reference, build a filehandle to it
1031 16 100       54 if ( is_scalarref($thing) ) {
1032             ## no critic qw(InputOutput::RequireCheckedOpen)
1033 6         82 open $fh, "<", $thing;
1034             }
1035              
1036             # If we haven't got a filehandle, create one to the requested content
1037 16 100       52 if (! $fh) {
1038 9         18 my $path = $thing;
1039             # remove prefix from given path (if not a filehandle)
1040 9         225 my $prefix = $self->prefix;
1041 9 50 33     97 if ( $prefix && $prefix ne '/' ) {
1042 0         0 $path =~ s/^\Q$prefix\E//;
1043             }
1044             # static file dir - either system root or public_dir
1045             my $dir = $options{system_path}
1046             ? File::Spec->rootdir
1047             : $ENV{DANCER_PUBLIC}
1048             || $self->config->{public_dir}
1049 9 100 33     138 || path( $self->location, 'public' );
1050              
1051 9         124 $file_path = Dancer2::Handler::File->merge_paths( $path, $dir );
1052             my $err_response = sub {
1053 0     0   0 my $status = shift;
1054 0         0 $self->response->status($status);
1055 0         0 $self->response->header( 'Content-Type', 'text/plain' );
1056 0         0 $self->response->content( Dancer2::Core::HTTP->status_message($status) );
1057 0         0 $self->with_return->( $self->response );
1058 9         54 };
1059 9 50       31 $err_response->(403) if !defined $file_path;
1060 9 50       196 $err_response->(404) if !-f $file_path;
1061 9 50       135 $err_response->(403) if !-r $file_path;
1062              
1063             # Read file content as bytes
1064 9         48 $fh = Dancer2::FileUtils::open_file( "<", $file_path );
1065 9         56 binmode $fh;
1066 9   50     39 $content_type = Dancer2::runner()->mime_type->for_file($file_path) || 'text/plain';
1067 9 100       193 if ( $content_type =~ m!^text/! ) {
1068 5   50     112 $charset = $self->config->{charset} || "utf-8";
1069             }
1070             }
1071              
1072             # Now we are sure we can render the file...
1073 16         485 $self->execute_hook( 'core.app.before_file_render', $file_path );
1074              
1075             # response content type and charset
1076 16 100       190 ( exists $options{'content_type'} ) and $content_type = $options{'content_type'};
1077 16 100       54 ( exists $options{'charset'} ) and $charset = $options{'charset'};
1078 16 100 100     97 $content_type .= "; charset=$charset" if $content_type and $charset;
1079 16 100       308 ( defined $content_type )
1080             and $self->response->header('Content-Type' => $content_type );
1081              
1082             # content disposition
1083             ( exists $options{filename} )
1084             and $self->response->header( 'Content-Disposition' =>
1085 16 100 100     2170 ($options{content_disposition} || "attachment") . "; filename=\"$options{filename}\"" );
1086              
1087             # use a delayed response unless server does not support streaming
1088 16 100       285 my $use_streaming = exists $options{streaming} ? $options{streaming} : 1;
1089 16         27 my $response;
1090 16         83 my $env = $self->request->env;
1091 16 100 66     124 if ( $env->{'psgi.streaming'} && $use_streaming ) {
1092             my $cb = sub {
1093 15     15   37 my $responder = $Dancer2::Core::Route::RESPONDER;
1094 15         26 my $res = $Dancer2::Core::Route::RESPONSE;
1095 15         339 return $responder->(
1096             [ $res->status, $res->headers_to_array, $fh ]
1097             );
1098 15         187 };
1099              
1100 15         70 Scalar::Util::weaken( my $weak_self = $self );
1101              
1102             $response = Dancer2::Core::Response::Delayed->new(
1103 0     0   0 error_cb => sub { $weak_self->logger_engine->log( warning => @_ ) },
1104 15         364 cb => $cb,
1105             request => $Dancer2::Core::Route::REQUEST,
1106             response => $Dancer2::Core::Route::RESPONSE,
1107             );
1108             }
1109             else {
1110 1         20 $response = $self->response;
1111             # direct assignment to hash element, avoids around modifier
1112             # trying to serialise this this content.
1113 1         13 $response->{content} = Dancer2::FileUtils::read_glob_content($fh);
1114 1         30 $response->is_encoded(1); # bytes are already encoded
1115             }
1116              
1117 16         14200 $self->execute_hook( 'core.app.after_file_render', $response );
1118 16         207 $self->with_return->( $response );
1119             }
1120              
1121             sub BUILD {
1122             my $self = shift;
1123             $self->init_route_handlers();
1124             $self->_init_hooks();
1125              
1126             $self->log(core => 'Built config from files: ' . join(' ', @{$self->config_files}));
1127             }
1128              
1129             sub finish {
1130 204     204 0 508 my $self = shift;
1131              
1132             # normalize some values that require calculations
1133             defined $self->config->{'static_handler'}
1134 204 100       3294 or $self->config->{'static_handler'} = -d $self->config->{'public_dir'};
1135              
1136 204         12067 $self->register_route_handlers;
1137 204         4295 $self->compile_hooks;
1138              
1139 204 50 66     1730 @{$self->plugins}
  204         3669  
1140             && $self->plugins->[0]->can('_add_postponed_plugin_hooks')
1141             && $self->plugins->[0]->_add_postponed_plugin_hooks(
1142             $self->postponed_hooks
1143             );
1144              
1145 204         3026 foreach my $prep_cb ( @{ $self->prep_apps } ) {
  204         1162  
1146 4         16 $prep_cb->($self);
1147             }
1148             }
1149              
1150             sub init_route_handlers {
1151 236     236 0 543 my $self = shift;
1152              
1153 236         4293 my $handlers_config = $self->config->{route_handlers};
1154 235         7669 for my $handler_data ( @{$handlers_config} ) {
  235         908  
1155 234         490 my ($handler_name, $config) = @{$handler_data};
  234         705  
1156 234 50       1040 $config = {} if !is_ref($config);
1157              
1158 234         4926 my $handler = $self->_factory->create(
1159             Handler => $handler_name,
1160             app => $self,
1161             %$config,
1162             postponed_hooks => $self->postponed_hooks,
1163             );
1164              
1165 234         247790 push @{ $self->route_handlers }, {
  234         5129  
1166             name => $handler_name,
1167             handler => $handler,
1168             };
1169             }
1170             }
1171              
1172             sub register_route_handlers {
1173 204     204 0 526 my $self = shift;
1174 204         442 for my $handler ( @{$self->route_handlers} ) {
  204         4483  
1175 202         2151 my $handler_code = $handler->{handler};
1176 202         1155 $handler_code->register($self);
1177             }
1178             }
1179              
1180             sub compile_hooks {
1181 207     207 0 618 my ($self) = @_;
1182              
1183 207         947 for my $position ( $self->supported_hooks ) {
1184 1656         10524 my $compiled_hooks = [];
1185 1656         2309 for my $hook ( @{ $self->hooks->{$position} } ) {
  1656         24369  
1186 249         2820 Scalar::Util::weaken( my $app = $self );
1187             my $compiled = sub {
1188             # don't run the filter if halt has been used
1189 677 100 66 677   2950 $Dancer2::Core::Route::RESPONSE &&
1190             $Dancer2::Core::Route::RESPONSE->is_halted
1191             and return;
1192              
1193 676         2176 eval { $EVAL_SHIM->($hook,@_); 1; }
  667         3279  
1194 676 100       5189 or do {
1195 4   50     185 my $err = $@ || "Zombie Error";
1196 4         22 $app->cleanup;
1197 4         48 $app->log('error', "Exception caught in '$position' filter: $err");
1198 4         458 croak "Exception caught in '$position' filter: $err";
1199             };
1200 249         1771 };
1201              
1202 249         535 push @{$compiled_hooks}, $compiled;
  249         760  
1203             }
1204 1656         12355 $self->replace_hook( $position, $compiled_hooks );
1205             }
1206             }
1207              
1208             sub lexical_prefix {
1209 5     5 1 1680 my $self = shift;
1210 5         12 my $prefix = shift;
1211 5         9 my $cb = shift;
1212              
1213 5 100       21 $prefix eq '/' and undef $prefix;
1214              
1215             # save the app prefix
1216 5         105 my $app_prefix = $self->prefix;
1217              
1218             # alter the prefix for the callback
1219 5 100       51 my $new_prefix =
    100          
1220             ( defined $app_prefix ? $app_prefix : '' )
1221             . ( defined $prefix ? $prefix : '' );
1222              
1223             # if the new prefix is empty, it's a meaningless prefix, just ignore it
1224 5 100       78 length $new_prefix and $self->prefix($new_prefix);
1225              
1226 5         119 my $err;
1227 5         92 my $ok= eval { $EVAL_SHIM->($cb); 1 }
  4         16  
1228 5 100 50     13 or do { $err = $@ || "Zombie Error"; };
  1         18  
1229              
1230             # restore app prefix
1231 5         88 $self->prefix($app_prefix);
1232              
1233 5 100       468 $ok or croak "Unable to run the callback for prefix '$prefix': $err";
1234             }
1235              
1236             sub add_route {
1237 613     613 1 1714 my $self = shift;
1238 613         2318 my %route_attrs = @_;
1239              
1240             my $route = Dancer2::Core::Route->new(
1241             type_library => $self->config->{type_library},
1242 613         12036 %route_attrs,
1243             prefix => $self->prefix,
1244             );
1245              
1246 613         52213 my $method = $route->method;
1247              
1248 613         1216 push @{ $self->routes->{$method} }, $route;
  613         11119  
1249              
1250 613         8483 return $route;
1251             }
1252              
1253             sub route_exists {
1254 0     0 1 0 my $self = shift;
1255 0         0 my $route = shift;
1256              
1257 0         0 my $routes = $self->routes->{ $route->method };
1258              
1259 0         0 foreach my $existing_route (@$routes) {
1260 0 0       0 $existing_route->spec_route eq $route->spec_route
1261             and return 1;
1262             }
1263              
1264 0         0 return 0;
1265             }
1266              
1267             sub routes_regexps_for {
1268 1     1 1 701 my $self = shift;
1269 1         3 my $method = shift;
1270              
1271 1         2 return [ map $_->regexp, @{ $self->routes->{$method} } ];
  1         26  
1272             }
1273              
1274             sub cookie {
1275 543     543 0 1093 my $self = shift;
1276              
1277 543 50       3300 @_ == 1 and return $self->request->cookies->{ $_[0] };
1278              
1279             # writer
1280 0         0 my ( $name, $value, %options ) = @_;
1281 0         0 my $c =
1282             Dancer2::Core::Cookie->new( name => $name, value => $value, %options );
1283 0         0 $self->response->push_header( 'Set-Cookie' => $c->to_header );
1284             }
1285              
1286             sub redirect {
1287 26     26 1 45 my $self = shift;
1288 26         56 my $destination = shift;
1289 26         43 my $status = shift;
1290              
1291 26 100       114 if ($destination =~ m{^/(?!/)}) {
1292             # If the app is mounted to something other than "/", we must
1293             # preserve its path.
1294 12         90 my $script_name = $self->request->script_name;
1295 12         79 $script_name =~ s{/$}{}; # Remove trailing slash (if present).
1296 12         35 $destination = $script_name . $destination;
1297             }
1298              
1299 26         424 $self->response->redirect( $destination, $status );
1300              
1301             # Short circuit any remaining before hook / route code
1302             # ('pass' and after hooks are still processed)
1303 26 50       3248 $self->has_with_return
1304             and $self->with_return->($self->response);
1305             }
1306              
1307             sub halt {
1308 7     7 1 17 my $self = shift;
1309 7         141 $self->response->halt( @_ );
1310              
1311             # Short citcuit any remaining hook/route code
1312 7 50       348 $self->has_with_return
1313             and $self->with_return->($self->response);
1314             }
1315              
1316             sub pass {
1317 2     2 1 5 my $self = shift;
1318 2         39 $self->response->pass;
1319              
1320             # Short citcuit any remaining hook/route code
1321 2 50       99 $self->has_with_return
1322             and $self->with_return->($self->response);
1323             }
1324              
1325             sub forward {
1326 44     44 1 92 my $self = shift;
1327 44         83 my $url = shift;
1328 44         69 my $params = shift;
1329 44         68 my $options = shift;
1330              
1331 44         148 my $new_request = $self->make_forward_to( $url, $params, $options );
1332              
1333 44 50       311 $self->has_with_return
1334             and $self->with_return->($new_request);
1335              
1336             # nothing else will run after this
1337             }
1338              
1339             # Create a new request which is a clone of the current one, apart
1340             # from the path location, which points instead to the new location
1341             sub make_forward_to {
1342 53     53 0 191 my $self = shift;
1343 53         96 my $url = shift;
1344 53         86 my $params = shift;
1345 53         83 my $options = shift;
1346              
1347 53         150 my $overrides = { PATH_INFO => $url };
1348             exists $options->{method} and
1349 53 100       173 $overrides->{REQUEST_METHOD} = $options->{method};
1350              
1351             # "clone" the existing request
1352 53         265 my $new_request = $self->request->_shallow_clone( $params, $overrides );
1353              
1354             # If a session object was created during processing of the original request
1355             # i.e. a session object exists but no cookie existed
1356             # add a cookie so the dispatcher can assign the session to the appropriate app
1357 53         1196 my $engine = $self->session_engine;
1358 53 100 66     1917 $engine && $self->_has_session or return $new_request;
1359 11         34 my $name = $engine->cookie_name;
1360 11 100       28 exists $new_request->cookies->{$name} and return $new_request;
1361 10         200 $new_request->cookies->{$name} =
1362             Dancer2::Core::Cookie->new( name => $name, value => $self->session->id );
1363              
1364 10         36 return $new_request;
1365             }
1366              
1367 1     1 1 2350 sub app { shift }
1368              
1369             # DISPATCHER
1370             sub to_app {
1371 202     202 0 978 my $self = shift;
1372              
1373             # build engines
1374             {
1375 202         443 for ( qw<logger session template> ) {
  202         699  
1376 606         17632 my $attr = "${_}_engine";
1377 606         12027 $self->$attr;
1378             }
1379              
1380             # the serializer engine does not have a default
1381             # and is the only engine that can actually not have a value
1382 202 100       17593 if ( $self->config->{'serializer'} ) {
1383 20         603 $self->serializer_engine;
1384             }
1385             }
1386              
1387 202         3067 $self->finish;
1388              
1389             my $psgi = sub {
1390 587     587   1262491 my $env = shift;
1391              
1392             # pre-request sanity check
1393 587         1828 my $method = uc $env->{'REQUEST_METHOD'};
1394 587 100       2830 $Dancer2::Core::Types::supported_http_methods{$method}
1395             or return [
1396             405,
1397             [ 'Content-Type' => 'text/plain' ],
1398             [ "Method Not Allowed\n\n$method is not supported." ]
1399             ];
1400              
1401 585         1016 my $response;
1402             eval {
1403 585         4146 $EVAL_SHIM->(sub{ $response = $self->dispatch($env)->to_psgi });
  585         2053  
1404 585         5194 1;
1405 585 50       1091 } or do {
1406 0   0     0 my $err = $@ || "Zombie Error";
1407             return [
1408 0         0 500,
1409             [ 'Content-Type' => 'text/plain' ],
1410             [ "Internal Server Error\n\n$err" ],
1411             ];
1412             };
1413              
1414 585         6417 return $response;
1415 202         1238 };
1416              
1417             # Only add static content handler if required
1418 202 100       3636 if ( $self->config->{'static_handler'} ) {
1419             # Use App::File to "serve" the static content
1420             my $static_app = Plack::App::File->new(
1421             root => $self->config->{public_dir},
1422 8     8   1700 content_type => sub { $self->mime_type->for_file( $_[0] ) },
1423 111         2943 )->to_app;
1424             # Conditionally use the static handler wrapped with ConditionalGET
1425             # when the file exists. Otherwise the request passes into our app.
1426             $psgi = Plack::Middleware::Conditional->wrap(
1427             $psgi,
1428 419     419   2036784 condition => sub { -f path( $self->config->{public_dir}, shift->{PATH_INFO} ) },
1429 111     111   8085 builder => sub { Plack::Middleware::ConditionalGET->wrap( $static_app ) },
1430 111         6531 );
1431             }
1432              
1433             # Wrap with common middleware
1434 202 100       8641 if ( ! $self->config->{'no_default_middleware'} ) {
1435             # FixMissingBodyInRedirect
1436 198         3571 $psgi = Plack::Middleware::FixMissingBodyInRedirect->wrap( $psgi );
1437             # Apply Head. After static so a HEAD request on static content DWIM.
1438 198         8783 $psgi = Plack::Middleware::Head->wrap( $psgi );
1439             }
1440              
1441 202         7384 return $psgi;
1442             }
1443              
1444             sub dispatch {
1445 585     585 0 1182 my $self = shift;
1446 585         1022 my $env = shift;
1447              
1448 585         2186 my $runner = Dancer2::runner();
1449 585         1017 my $request;
1450 585         1063 my $request_built_successfully = eval {
1451             $EVAL_SHIM->(sub {
1452 585   100 585   3786 $request = $runner->{'internal_request'} || $self->build_request($env);
1453 585         2998 });
1454 581         2625 1;
1455             };
1456             # Catch bad content causing deserialization to fail when building the request
1457 585 100       2680 if ( ! $request_built_successfully ) {
1458 4         12 my $err = $@;
1459 4         23 Scalar::Util::weaken(my $app = $self);
1460 4         41 return Dancer2::Core::Error->new(
1461             app => $app,
1462             message => $err,
1463             status => 400, # 400 Bad request (dont send again), rather than 500
1464             )->throw;
1465             }
1466              
1467 581         14647 my $cname = $self->session_engine->cookie_name;
1468 581         6906 my $defined_engines = $self->defined_engines;
1469              
1470             DISPATCH:
1471 581         28552 while (1) {
1472 608         2734 my $http_method = lc $request->method;
1473 608         5353 my $path_info = $request->path_info;
1474              
1475             # Add request to app and engines
1476 608         4623 $self->set_request($request, $defined_engines);
1477              
1478 608         63919 $self->log( core => "looking for $http_method $path_info" );
1479              
1480             ROUTE:
1481 608         1296 foreach my $route ( @{ $self->routes->{$http_method} } ) {
  608         10171  
1482             #warn "testing route " . $route->regexp . "\n";
1483             # TODO store in route cache
1484              
1485             # go to the next route if no match
1486 1163 100       7752 my $match = $route->match($request)
1487             or next ROUTE;
1488              
1489 550         18258 $request->_set_route_params($match);
1490 550         2271 $request->_set_route_parameters($match);
1491 550         20447 $request->_set_route($route);
1492              
1493             # Add session to app *if* we have a session and the request
1494             # has the appropriate cookie header for _this_ app.
1495 550 100       2096 if ( my $sess = $runner->{'internal_sessions'}{$cname} ) {
1496 6         137 $self->set_session($sess);
1497             }
1498              
1499             # calling the actual route
1500 550         1204 my $response;
1501              
1502             # this is very evil, but allows breaking out of multiple stack
1503             # frames without throwing an exception. Avoiding exceptions means
1504             # a naive eval won't swallow our flow control mechanisms, and
1505             # avoids __DIE__ handlers. It also prevents some cleanup routines
1506             # from working, since they are expecting control to return to them
1507             # after an eval.
1508             DANCER2_CORE_APP_ROUTE_RETURN: {
1509 550 50       970 if (!$self->has_with_return) {
  550         2448  
1510             $self->set_with_return(sub {
1511 103     103   467 $response = shift;
1512 144     144   1501 no warnings 'exiting';
  144         378  
  144         124404  
1513 103         665 last DANCER2_CORE_APP_ROUTE_RETURN;
1514 550         3469 });
1515             }
1516 550         1806 $response = $self->_dispatch_route($route);
1517             };
1518              
1519             # ensure we clear the with_return handler
1520 550         11105 $self->clear_with_return;
1521              
1522             # handle forward requests
1523 550 100       4950 if ( ref $response eq 'Dancer2::Core::Request' ) {
1524             # this is actually a request, not response
1525             # however, we need to clean up the request & response
1526 44         721 $self->clear_request;
1527 44         850 $self->clear_response;
1528              
1529             # this is in case we're asked for an old-style dispatching
1530 44 100       421 if ( $runner->{'internal_dispatch'} ) {
1531             # Get the session object from the app before we clean up
1532             # the request context, so we can propagate this to the
1533             # next dispatch cycle (if required).
1534             $self->_has_session
1535 17 100       185 and $runner->{'internal_sessions'}{$cname} =
1536             $self->session;
1537              
1538 17         91 $runner->{'internal_forward'} = 1;
1539 17         38 $runner->{'internal_request'} = $response;
1540 17         56 return $self->response_not_found($request);
1541             }
1542              
1543 27         45 $request = $response;
1544 27         78 next DISPATCH;
1545             }
1546              
1547             # from here we assume the response is a Dancer2::Core::Response
1548              
1549             # halted response, don't process further
1550 506 100       8126 if ( $response->is_halted ) {
1551 34         2219 $self->cleanup;
1552 34         231 delete $runner->{'internal_request'};
1553 34         719 return $response;
1554             }
1555              
1556             # pass the baton if the response says so...
1557 472 100       10090 if ( $response->has_passed ) {
1558             ## A previous route might have used splat, failed
1559             ## this needs to be cleaned from the request.
1560             exists $request->{_params}{splat}
1561 9 100       69 and delete $request->{_params}{splat};
1562              
1563 9         126 $response->has_passed(0); # clear for the next round
1564              
1565             # clear the content because if you pass it,
1566             # the next route is in charge of catching it
1567 9         345 $response->clear_content;
1568 9         57 next ROUTE;
1569             }
1570              
1571             # it's just a regular response
1572 463         13039 $self->execute_hook( 'core.app.after_request', $response );
1573 463         1784 $self->cleanup;
1574 463         2810 delete $runner->{'internal_request'};
1575              
1576 463         4996 return $response;
1577             }
1578              
1579             # we don't actually want to continue the loop
1580 67         201 last;
1581             }
1582              
1583             # No response! ensure Core::Dispatcher recognizes this failure
1584             # so it can try the next Core::App
1585             # and set the created request so we don't create it again
1586             # (this is important so we don't ignore the previous body)
1587 67 100       249 if ( $runner->{'internal_dispatch'} ) {
1588 51         128 $runner->{'internal_404'} = 1;
1589 51         2027 $runner->{'internal_request'} = $request;
1590             }
1591              
1592             # Render 404 response, cleanup, and return the response.
1593 67         2038 my $response = $self->response_not_found($request);
1594 67         212 $self->cleanup;
1595 67         640 return $response;
1596             }
1597              
1598             sub build_request {
1599 536     536 0 1443 my ( $self, $env ) = @_;
1600              
1601             # If we have an app, send the serialization engine
1602             my $request = Dancer2::Core::Request->new(
1603             env => $env,
1604 536 100 100     1899 is_behind_proxy => $self->settings->{'behind_proxy'} || 0,
1605              
1606             $self->has_serializer_engine
1607             ? ( serializer => $self->serializer_engine )
1608             : (),
1609             );
1610              
1611 532         3394 return $request;
1612             }
1613              
1614             # Call any before hooks then the matched route.
1615             sub _dispatch_route {
1616 550     550   1249 my ( $self, $route ) = @_;
1617              
1618 550         942 local $@;
1619             eval {
1620             $EVAL_SHIM->(sub {
1621 550     550   13625 $self->execute_hook( 'core.app.before_request', $self );
1622 550         2518 });
1623 541         7208 1;
1624 550 100       1105 } or do {
1625 4   50     212 my $err = $@ || "Zombie Error";
1626 4         26 return $self->response_internal_error($err);
1627             };
1628 541         8766 my $response = $self->response;
1629              
1630 541 100       11538 if ( $response->is_halted ) {
1631 2         19 return $self->_prep_response( $response );
1632             }
1633              
1634             eval {
1635 539     539   3138 $EVAL_SHIM->(sub{ $response = $route->execute($self) });
  539         2214  
1636 428         2300 1;
1637 539 100       3997 } or do {
1638 13   50     609 my $err = $@ || "Zombie Error";
1639 13         74 return $self->response_internal_error($err);
1640             };
1641              
1642 428         1212 return $response;
1643             }
1644              
1645             sub _prep_response {
1646 451     451   1217 my ( $self, $response, $content ) = @_;
1647              
1648             # The response object has no back references to the content or app
1649             # Update the default_content_type of the response if any value set in
1650             # config so it can be applied when the response is encoded/returned.
1651 451         9989 my $config = $self->config;
1652 451 50 33     5284 if ( exists $config->{content_type}
1653             and my $ct = $config->{content_type} ) {
1654 451         7701 $response->default_content_type($ct);
1655             }
1656              
1657             # if we were passed any content, set it in the response
1658 451 100       21632 defined $content && $response->content($content);
1659 451         45899 return $response;
1660             }
1661              
1662             sub response_internal_error {
1663 17     17 0 52 my ( $self, $error ) = @_;
1664              
1665 17         436 $self->execute_hook( 'core.app.route_exception', $self, $error );
1666 17         241 $self->log( error => "Route exception: $error" );
1667              
1668 17         231 local $Dancer2::Core::Route::REQUEST = $self->request;
1669 17         313 local $Dancer2::Core::Route::RESPONSE = $self->response;
1670              
1671 17         344 return Dancer2::Core::Error->new(
1672             app => $self,
1673             status => 500,
1674             exception => $error,
1675             )->throw;
1676             }
1677              
1678             sub response_not_found {
1679 93     93 0 210 my ( $self, $request ) = @_;
1680              
1681 93         281 $self->set_request($request);
1682              
1683 93         8510 local $Dancer2::Core::Route::REQUEST = $self->request;
1684 93         1572 local $Dancer2::Core::Route::RESPONSE = $self->response;
1685              
1686 93         6784 my $response = Dancer2::Core::Error->new(
1687             app => $self,
1688             status => 404,
1689             message => $request->path,
1690             )->throw;
1691              
1692 93         1119 $self->cleanup;
1693              
1694 93         860 return $response;
1695             }
1696              
1697             1;
1698              
1699             __END__
1700              
1701             =pod
1702              
1703             =encoding UTF-8
1704              
1705             =head1 NAME
1706              
1707             Dancer2::Core::App - encapsulation of Dancer2 packages
1708              
1709             =head1 VERSION
1710              
1711             version 0.400001
1712              
1713             =head1 DESCRIPTION
1714              
1715             Everything a package that uses Dancer2 does is encapsulated into a
1716             C<Dancer2::Core::App> instance. This class defines all that can be done in such
1717             objects.
1718              
1719             Mainly, it will contain all the route handlers, the configuration settings and
1720             the hooks that are defined in the calling package.
1721              
1722             Note that with Dancer2, everything that is done within a package is scoped to
1723             that package, thanks to that encapsulation.
1724              
1725             =head1 ATTRIBUTES
1726              
1727             =head2 plugins
1728              
1729             =head2 runner_config
1730              
1731             =head2 default_config
1732              
1733             =head2 with_return
1734              
1735             Used to cache the coderef that will return from back to the dispatcher, across
1736             an arbitrary number of stack frames.
1737              
1738             =head2 destroyed_session
1739              
1740             We cache a destroyed session here; once this is set we must not attempt to
1741             retrieve the session from the cookie in the request. If no new session is
1742             created, this is set (with expiration) as a cookie to force the browser to
1743             expire the cookie.
1744              
1745             =head1 METHODS
1746              
1747             =head2 has_session
1748              
1749             Returns true if session engine has been defined and if either a session
1750             object has been instantiated or if a session cookie was found and not
1751             subsequently invalidated.
1752              
1753             =head2 change_session_id
1754              
1755             Changes the session ID used by the current session. This should be used on
1756             any change of privilege level, for example on login. Returns the new session
1757             ID.
1758              
1759             =head2 destroy_session
1760              
1761             Destroys the current session and ensures any subsequent session is created
1762             from scratch and not from the request session cookie
1763              
1764             =head2 register_plugin
1765              
1766             =head2 with_plugins( @plugin_names )
1767              
1768             Creates instances of the given plugins and tie them to the app.
1769             The plugin classes are automatically loaded.
1770             Returns the newly created plugins.
1771              
1772             The plugin names are expected to be without the leading C<Dancer2::Plugin>.
1773             I.e., use C<Foo> to mean C<Dancer2::Plugin::Foo>.
1774              
1775             If a given plugin is already tied to the app, the already-existing
1776             instance will be used and returned by C<with_plugins> (think of it
1777             as using a role).
1778              
1779             my @plugins = $app->with_plugins( 'Foo', 'Bar' );
1780              
1781             # now $app uses the plugins Dancer2::Plugin::Foo
1782             # and Dancer2::Plugin::Bar
1783              
1784             =head2 with_plugin( $plugin_name )
1785              
1786             Just like C<with_plugin>, but for a single plugin.
1787              
1788             my $plugin = $app->with_plugin('Foo');
1789              
1790             =head2 add_route
1791              
1792             Register a new route handler.
1793              
1794             $app->add_route(
1795             method => 'get',
1796             regexp => '/somewhere',
1797             code => sub { ... },
1798             options => $conditions,
1799             );
1800              
1801             Returns a new L<< Dancer2::Core::Route >> object created with the passed
1802             arguments.
1803              
1804             =head2 route_exists
1805              
1806             Returns a true value if a route already exists, otherwise false.
1807              
1808             my $route = Dancer2::Core::Route->new(...);
1809             if ($app->route_exists($route)) {
1810             ...
1811             }
1812              
1813             =head2 routes_regexps_for
1814              
1815             Sugar for getting the ordered list of all registered route regexps by method.
1816              
1817             my $regexps = $app->routes_regexps_for( 'get' );
1818              
1819             Returns an ArrayRef with the results.
1820              
1821             =head2 redirect($destination, $status)
1822              
1823             Sets a redirect in the response object. If $destination is not an absolute URI, then it will
1824             be made into an absolute URI, relative to the URI in the request.
1825              
1826             =head2 halt
1827              
1828             Flag the response object as 'halted'.
1829              
1830             If called during request dispatch, immediately returns the response
1831             to the dispatcher and after hooks will not be run.
1832              
1833             =head2 pass
1834              
1835             Flag the response object as 'passed'.
1836              
1837             If called during request dispatch, immediately returns the response
1838             to the dispatcher.
1839              
1840             =head2 forward
1841              
1842             Create a new request which is a clone of the current one, apart
1843             from the path location, which points instead to the new location.
1844             This is used internally to chain requests using the forward keyword.
1845              
1846             This method takes 3 parameters: the url to forward to, followed by an
1847             optional hashref of parameters added to the current request parameters,
1848             followed by a hashref of options regarding the redirect, such as
1849             C<method> to change the request method.
1850              
1851             For example:
1852              
1853             forward '/login', { login_failed => 1 }, { method => 'GET' });
1854              
1855             =head2 app
1856              
1857             Returns itself. This is simply available as a shim to help transition from
1858             a previous version in which hooks were sent a context object (originally
1859             C<Dancer2::Core::Context>) which has since been removed.
1860              
1861             # before
1862             hook before => sub {
1863             my $ctx = shift;
1864             my $app = $ctx->app;
1865             };
1866              
1867             # after
1868             hook before => sub {
1869             my $app = shift;
1870             };
1871              
1872             This meant that C<< $app->app >> would fail, so this method has been provided
1873             to make it work.
1874              
1875             # now
1876             hook before => sub {
1877             my $WannaBeCtx = shift;
1878             my $app = $WannaBeContext->app; # works
1879             };
1880              
1881             =head2 lexical_prefix
1882              
1883             Allow for setting a lexical prefix
1884              
1885             $app->lexical_prefix('/blog', sub {
1886             ...
1887             });
1888              
1889             All the route defined within the callback will have a prefix appended to the
1890             current one.
1891              
1892             =head2 C< $SIG{__DIE__} > Compatibility via C< $Dancer2::Core::App::EVAL_SHIM >
1893              
1894             If an installation wishes to use C< $SIG{__DIE__} > hooks to enhance
1895             their error handling then it may be required to ensure that certain
1896             bookkeeping code is executed within every C<eval BLOCK> that Dancer2
1897             performs. This can be accomplished by overriding the global variable
1898             C<$Dancer2::Core::App::EVAL_SHIM> with a subroutine which does whatever
1899             logic is required.
1900              
1901             This routine must perform the equivalent of the following subroutine:
1902              
1903             our $EVAL_SHIM = sub {
1904             my $code = shift;
1905             return $code->(@_);
1906             };
1907              
1908             An example of overriding this sub might be as follows:
1909              
1910             $Dancer2::Core::App::EVAL_SHIM = sub {
1911             my $code = shift;
1912             local $IGNORE_EVAL_COUNTER = $IGNORE_EVAL_COUNTER + 1;
1913             return $code->(@_);
1914             };
1915              
1916             B<Note:> that this is a GLOBAL setting, which must be set up before
1917             any form of dispatch or use of Dancer2.
1918              
1919             =head1 AUTHOR
1920              
1921             Dancer Core Developers
1922              
1923             =head1 COPYRIGHT AND LICENSE
1924              
1925             This software is copyright (c) 2023 by Alexis Sukrieh.
1926              
1927             This is free software; you can redistribute it and/or modify it under
1928             the same terms as the Perl 5 programming language system itself.
1929              
1930             =cut