← Index
NYTProf Performance Profile   « line view »
For nd2: #2 manager: init
  Run on Thu May 2 17:38:58 2019
Reported on Thu May 2 17:40:49 2019

Filename/appl/netdisco/perl5/lib/perl5/Dancer/App.pm
StatementsExecuted 467 statements in 693µs
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
46711488µs488µsDancer::App::::applicationsDancer::App::applications
0000s0sDancer::App::::BEGINDancer::App::BEGIN
0000s0sDancer::App::::_set_settingsDancer::App::_set_settings
0000s0sDancer::App::::app_existsDancer::App::app_exists
0000s0sDancer::App::::currentDancer::App::current
0000s0sDancer::App::::dec_lexical_prefixDancer::App::dec_lexical_prefix
0000s0sDancer::App::::find_routeDancer::App::find_route
0000s0sDancer::App::::find_route_through_appsDancer::App::find_route_through_apps
0000s0sDancer::App::::getDancer::App::get
0000s0sDancer::App::::get_prefixDancer::App::get_prefix
0000s0sDancer::App::::incr_lexical_prefixDancer::App::incr_lexical_prefix
0000s0sDancer::App::::initDancer::App::init
0000s0sDancer::App::::init_registryDancer::App::init_registry
0000s0sDancer::App::::reload_appsDancer::App::reload_apps
0000s0sDancer::App::::routesDancer::App::routes
0000s0sDancer::App::::set_app_prefixDancer::App::set_app_prefix
0000s0sDancer::App::::set_prefixDancer::App::set_prefix
0000s0sDancer::App::::set_running_appDancer::App::set_running_app
0000s0sDancer::App::::settingDancer::App::setting
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package Dancer::App;
2our $AUTHORITY = 'cpan:SUKRIA';
3# ABSTRACT: Base application class for Dancer.
4$Dancer::App::VERSION = '1.3512';
5use strict;
6use warnings;
7use Carp;
8use base 'Dancer::Object';
9
10use Dancer::Config;
11use Dancer::ModuleLoader;
12use Dancer::Route::Registry;
13use Dancer::Logger;
14use Dancer::Exception qw(:all);
15use Dancer::Deprecation;
16
17Dancer::App->attributes(qw(name app_prefix prefix registry settings on_lexical_prefix));
18
19# singleton that saves any app created, we want unicity for app names
20my $_apps = {};
21467693µs
# spent 488µs within Dancer::App::applications which was called 467 times, avg 1µs/call: # 467 times (488µs+0s) by Dancer::setting at line 215 of Dancer.pm, avg 1µs/call
sub applications { values %$_apps }
22
23sub app_exists {
24 my ( $self, $name ) = @_;
25 grep { $_ eq $name } keys %$_apps;
26}
27
28sub set_running_app {
29 my ($self, $name) = @_;
30 my $app = Dancer::App->get($name);
31 $app = Dancer::App->new(name => $name) unless defined $app;
32 Dancer::App->current($app);
33}
34
35sub set_app_prefix {
36 my ($self, $prefix) = @_;
37 $self->app_prefix($prefix);
38 $self->prefix($prefix);
39}
40
41sub get_prefix {
42 # return the current prefix (if undefined, return an empty string)
43 return Dancer::App->current->prefix || '';
44}
45
46sub incr_lexical_prefix {
47 no warnings; # for undefined
48 $_[0]->on_lexical_prefix( $_[0]->on_lexical_prefix + 1 );
49}
50
51sub dec_lexical_prefix {
52 $_[0]->on_lexical_prefix( $_[0]->on_lexical_prefix - 1 );
53}
54
55sub set_prefix {
56 my ($self, $prefix, $cb) = @_;
57
58 undef $prefix if defined($prefix) and $prefix eq "/";
59
60 raise core_app => "not a valid prefix: `$prefix', must start with a /"
61 if defined($prefix) && $prefix !~ /^\//;
62
63 my $app_prefix = defined $self->app_prefix ? $self->app_prefix : "";
64 my $previous = Dancer::App->current->prefix;
65
66 $prefix ||= "";
67
68 if (Dancer::App->current->on_lexical_prefix) {
69 Dancer::App->current->prefix($previous.$prefix);
70 } else {
71 Dancer::App->current->prefix($app_prefix.$prefix);
72 }
73
74 if (ref($cb) eq 'CODE') {
75 Dancer::App->current->incr_lexical_prefix;
76 eval { $cb->() };
77 my $e = $@;
78 Dancer::App->current->dec_lexical_prefix;
79 Dancer::App->current->prefix($previous);
80 die $e if $e;
81 }
82 return 1; # prefix may have been set to undef
83}
84
85sub routes {
86 my ($self, $method) = @_;
87 map { $_->pattern } @{$self->registry->{'routes'}{$method}};
88}
89
90sub reload_apps {
91 my ($class) = @_;
92
93 Dancer::Deprecation->deprecated(
94 feature => 'auto_reload',
95 reason => 'use plackup -r instead',
96 );
97
98 my @missing_modules = grep { not Dancer::ModuleLoader->load($_) }
99 qw(Module::Refresh Clone);
100
101 if (not @missing_modules) {
102
103 # saving apps & purging app registries
104 my $orig_apps = {};
105 while (my ($name, $app) = each %$_apps) {
106 $orig_apps->{$name} = $app->clone;
107 $app->registry->init();
108 }
109
110 # reloading changed modules, getting apps reloaded
111 Module::Refresh->refresh;
112
113 # make sure old apps that didn't get reloaded are kept
114 while (my ($name, $app) = each %$orig_apps) {
115 $_apps->{$name} = $app unless defined $_apps->{$name};
116 $_apps->{$name} = $app if $_apps->{$name}->registry->is_empty;
117 }
118
119 }
120 else {
121 carp "Modules required for auto_reload are missing. Install modules"
122 . " [@missing_modules] or unset 'auto_reload' in your config file.";
123 }
124}
125
126sub find_route_through_apps {
127 my ($class, $request) = @_;
128 for my $app (Dancer::App->current, Dancer::App->applications) {
129 my $route = $app->find_route($request);
130 if ($route) {
131 Dancer::App->current($route->app);
132 return $route;
133 }
134 return $route if $route;
135 }
136 return;
137}
138
139# instance
140
141sub find_route {
142 my ($self, $request) = @_;
143 my $method = lc($request->method);
144
145 # if route cache is enabled, we check if we handled this path before
146 if (Dancer::Config::setting('route_cache')) {
147 my $route = Dancer::Route::Cache->get->route_from_path($method,
148 $request->path_info, $self->name);
149
150 # NOTE maybe we should cache the match data as well
151 if ($route) {
152 $route->match($request);
153 return $route;
154 }
155 }
156
157 my @routes = @{$self->registry->routes($method)};
158
159 for my $r (@routes) {
160 my $match = $r->match($request);
161
162 if ($match) {
163 next if $r->has_options && (not $r->validate_options($request));
164
165 # if we have a route cache, store the result
166 if (Dancer::Config::setting('route_cache')) {
167 Dancer::Route::Cache->get->store_path($method,
168 $request->path_info => $r, $self->name);
169 }
170
171 return $r;
172 }
173 }
174 return;
175}
176
177sub init {
178 my ($self) = @_;
179 $self->name('main') unless defined $self->name;
180
181 raise core_app => "an app named '" . $self->name . "' already exists"
182 if exists $_apps->{$self->name};
183
184 # default values for properties
185 $self->settings({});
186 $self->init_registry();
187
188 $_apps->{$self->name} = $self;
189}
190
191sub init_registry {
192 my ($self, $reg) = @_;
193 $self->registry($reg || Dancer::Route::Registry->new);
194
195}
196
197# singleton that saves the current active Dancer::App object
198my $_current;
199
200sub current {
201 my ($class, $app) = @_;
202 return $_current = $app if defined $app;
203
204 if (not defined $_current) {
205 $_current = Dancer::App->get('main') || Dancer::App->new();
206 }
207
208 return $_current;
209}
210
211sub get {
212 my ($class, $name) = @_;
213 $_apps->{$name};
214}
215
216sub setting {
217 my $self = shift;
218
219 if ($self->name eq 'main') {
220 return (@_ > 1)
221 ? Dancer::Config::setting( @_ )
222 : Dancer::Config::setting( $_[0] );
223 }
224
225 if (@_ > 1) {
226 $self->_set_settings(@_)
227 } else {
228 my $name = shift;
229 exists($self->settings->{$name}) ? $self->settings->{$name}
230 : Dancer::Config::setting($name);
231 }
232}
233
234sub _set_settings {
235 my $self = shift;
236 die "Odd number of elements in set" unless @_ % 2 == 0;
237 while (@_) {
238 my $name = shift;
239 my $value = shift;
240 $self->settings->{$name} =
241 Dancer::Config->normalize_setting($name => $value);
242 }
243}
244
245
2461;
247
248__END__
Report produced by the NYTProf 6.06 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.