line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Catalyst; |
2
|
|
|
|
|
|
|
|
3
|
165
|
|
|
168
|
|
6033087
|
use Moose; |
|
165
|
|
|
|
|
15803866
|
|
|
165
|
|
|
|
|
1594
|
|
4
|
165
|
|
|
165
|
|
1236230
|
use Moose::Meta::Class (); |
|
165
|
|
|
|
|
444
|
|
|
165
|
|
|
|
|
6675
|
|
5
|
|
|
|
|
|
|
extends 'Catalyst::Component'; |
6
|
165
|
|
|
165
|
|
1181
|
use Moose::Util qw/find_meta/; |
|
165
|
|
|
|
|
405
|
|
|
165
|
|
|
|
|
1437
|
|
7
|
165
|
|
|
165
|
|
64284
|
use namespace::clean -except => 'meta'; |
|
165
|
|
|
|
|
226869
|
|
|
165
|
|
|
|
|
1526
|
|
8
|
165
|
|
|
165
|
|
85153
|
use Catalyst::Exception; |
|
165
|
|
|
|
|
517
|
|
|
165
|
|
|
|
|
5748
|
|
9
|
165
|
|
|
165
|
|
82852
|
use Catalyst::Exception::Detach; |
|
165
|
|
|
|
|
569
|
|
|
165
|
|
|
|
|
6348
|
|
10
|
165
|
|
|
165
|
|
83575
|
use Catalyst::Exception::Go; |
|
165
|
|
|
|
|
575
|
|
|
165
|
|
|
|
|
6070
|
|
11
|
165
|
|
|
165
|
|
86512
|
use Catalyst::Log; |
|
165
|
|
|
|
|
732
|
|
|
165
|
|
|
|
|
7026
|
|
12
|
165
|
|
|
165
|
|
109169
|
use Catalyst::Request; |
|
165
|
|
|
|
|
895
|
|
|
165
|
|
|
|
|
8636
|
|
13
|
165
|
|
|
165
|
|
103577
|
use Catalyst::Request::Upload; |
|
165
|
|
|
|
|
2334
|
|
|
165
|
|
|
|
|
7428
|
|
14
|
165
|
|
|
165
|
|
104287
|
use Catalyst::Response; |
|
165
|
|
|
|
|
873
|
|
|
165
|
|
|
|
|
7978
|
|
15
|
165
|
|
|
165
|
|
1557
|
use Catalyst::Utils; |
|
165
|
|
|
|
|
426
|
|
|
165
|
|
|
|
|
4560
|
|
16
|
165
|
|
|
165
|
|
88537
|
use Catalyst::Controller; |
|
165
|
|
|
|
|
966
|
|
|
165
|
|
|
|
|
10089
|
|
17
|
165
|
|
|
165
|
|
1638
|
use Data::OptList; |
|
165
|
|
|
|
|
436
|
|
|
165
|
|
|
|
|
2003
|
|
18
|
165
|
|
|
165
|
|
5433
|
use Devel::InnerPackage (); |
|
165
|
|
|
|
|
458
|
|
|
165
|
|
|
|
|
2804
|
|
19
|
165
|
|
|
165
|
|
113869
|
use Module::Pluggable::Object (); |
|
165
|
|
|
|
|
854261
|
|
|
165
|
|
|
|
|
4265
|
|
20
|
165
|
|
|
165
|
|
83536
|
use Text::SimpleTable (); |
|
165
|
|
|
|
|
443315
|
|
|
165
|
|
|
|
|
4466
|
|
21
|
165
|
|
|
165
|
|
1575
|
use Path::Class::Dir (); |
|
165
|
|
|
|
|
585
|
|
|
165
|
|
|
|
|
3661
|
|
22
|
165
|
|
|
165
|
|
1195
|
use Path::Class::File (); |
|
165
|
|
|
|
|
552
|
|
|
165
|
|
|
|
|
3072
|
|
23
|
165
|
|
|
165
|
|
1121
|
use URI (); |
|
165
|
|
|
|
|
471
|
|
|
165
|
|
|
|
|
3034
|
|
24
|
165
|
|
|
165
|
|
1016
|
use URI::http; |
|
165
|
|
|
|
|
465
|
|
|
165
|
|
|
|
|
6248
|
|
25
|
165
|
|
|
165
|
|
1100
|
use URI::https; |
|
165
|
|
|
|
|
469
|
|
|
165
|
|
|
|
|
5526
|
|
26
|
165
|
|
|
165
|
|
91135
|
use HTML::Entities; |
|
165
|
|
|
|
|
1048494
|
|
|
165
|
|
|
|
|
13382
|
|
27
|
165
|
|
|
165
|
|
105376
|
use Tree::Simple qw/use_weak_refs/; |
|
165
|
|
|
|
|
606045
|
|
|
165
|
|
|
|
|
1068
|
|
28
|
165
|
|
|
165
|
|
88594
|
use Tree::Simple::Visitor::FindByUID; |
|
165
|
|
|
|
|
388262
|
|
|
165
|
|
|
|
|
5796
|
|
29
|
165
|
|
|
165
|
|
1548
|
use Class::C3::Adopt::NEXT; |
|
165
|
|
|
|
|
543
|
|
|
165
|
|
|
|
|
2433
|
|
30
|
165
|
|
|
165
|
|
6474
|
use List::Util qw/uniq/; |
|
165
|
|
|
|
|
517
|
|
|
165
|
|
|
|
|
12219
|
|
31
|
165
|
|
|
165
|
|
1533
|
use attributes; |
|
165
|
|
|
|
|
544
|
|
|
165
|
|
|
|
|
1884
|
|
32
|
165
|
|
|
165
|
|
8420
|
use String::RewritePrefix; |
|
165
|
|
|
|
|
518
|
|
|
165
|
|
|
|
|
2172
|
|
33
|
165
|
|
|
165
|
|
133767
|
use Catalyst::EngineLoader; |
|
165
|
|
|
|
|
689
|
|
|
165
|
|
|
|
|
6818
|
|
34
|
165
|
|
|
165
|
|
1604
|
use utf8; |
|
165
|
|
|
|
|
444
|
|
|
165
|
|
|
|
|
1657
|
|
35
|
165
|
|
|
165
|
|
5487
|
use Carp qw/croak carp shortmess/; |
|
165
|
|
|
|
|
565
|
|
|
165
|
|
|
|
|
11500
|
|
36
|
165
|
|
|
165
|
|
1306
|
use Try::Tiny; |
|
165
|
|
|
|
|
646
|
|
|
165
|
|
|
|
|
7709
|
|
37
|
165
|
|
|
165
|
|
88371
|
use Safe::Isa; |
|
165
|
|
|
|
|
89589
|
|
|
165
|
|
|
|
|
24520
|
|
38
|
165
|
|
|
165
|
|
1614
|
use Moose::Util 'find_meta'; |
|
165
|
|
|
|
|
511
|
|
|
165
|
|
|
|
|
1928
|
|
39
|
165
|
|
|
165
|
|
125546
|
use Plack::Middleware::Conditional; |
|
165
|
|
|
|
|
452689
|
|
|
165
|
|
|
|
|
6264
|
|
40
|
165
|
|
|
165
|
|
72331
|
use Plack::Middleware::ReverseProxy; |
|
165
|
|
|
|
|
123821
|
|
|
165
|
|
|
|
|
6277
|
|
41
|
165
|
|
|
165
|
|
72367
|
use Plack::Middleware::IIS6ScriptNameFix; |
|
165
|
|
|
|
|
69404
|
|
|
165
|
|
|
|
|
6009
|
|
42
|
165
|
|
|
165
|
|
73245
|
use Plack::Middleware::IIS7KeepAliveFix; |
|
165
|
|
|
|
|
51170
|
|
|
165
|
|
|
|
|
5721
|
|
43
|
165
|
|
|
165
|
|
73216
|
use Plack::Middleware::LighttpdScriptNameFix; |
|
165
|
|
|
|
|
61900
|
|
|
165
|
|
|
|
|
5958
|
|
44
|
165
|
|
|
165
|
|
72335
|
use Plack::Middleware::ContentLength; |
|
165
|
|
|
|
|
55679
|
|
|
165
|
|
|
|
|
5710
|
|
45
|
165
|
|
|
165
|
|
71210
|
use Plack::Middleware::Head; |
|
165
|
|
|
|
|
46690
|
|
|
165
|
|
|
|
|
6052
|
|
46
|
165
|
|
|
165
|
|
75262
|
use Plack::Middleware::HTTPExceptions; |
|
165
|
|
|
|
|
1050046
|
|
|
165
|
|
|
|
|
6963
|
|
47
|
165
|
|
|
165
|
|
73394
|
use Plack::Middleware::FixMissingBodyInRedirect; |
|
165
|
|
|
|
|
107814
|
|
|
165
|
|
|
|
|
8548
|
|
48
|
165
|
|
|
165
|
|
69237
|
use Plack::Middleware::MethodOverride; |
|
165
|
|
|
|
|
5481037
|
|
|
165
|
|
|
|
|
6978
|
|
49
|
165
|
|
|
165
|
|
77116
|
use Plack::Middleware::RemoveRedundantBody; |
|
165
|
|
|
|
|
68086
|
|
|
165
|
|
|
|
|
6396
|
|
50
|
165
|
|
|
165
|
|
79416
|
use Catalyst::Middleware::Stash; |
|
165
|
|
|
|
|
596
|
|
|
165
|
|
|
|
|
7506
|
|
51
|
165
|
|
|
165
|
|
2033
|
use Plack::Util; |
|
165
|
|
|
|
|
490
|
|
|
165
|
|
|
|
|
4087
|
|
52
|
165
|
|
|
165
|
|
2563
|
use Class::Load 'load_class'; |
|
165
|
|
|
|
|
527
|
|
|
165
|
|
|
|
|
9829
|
|
53
|
165
|
|
|
165
|
|
1216
|
use Encode 2.21 'decode_utf8', 'encode_utf8'; |
|
165
|
|
|
|
|
4478
|
|
|
165
|
|
|
|
|
7641
|
|
54
|
165
|
|
|
165
|
|
1785
|
use Scalar::Util; |
|
165
|
|
|
|
|
532
|
|
|
165
|
|
|
|
|
11328
|
|
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
our $VERSION = '5.90131'; |
57
|
|
|
|
|
|
|
$VERSION =~ tr/_//d; |
58
|
|
|
|
|
|
|
|
59
|
165
|
|
|
165
|
|
323638
|
BEGIN { require 5.008003; } |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
has stack => (is => 'ro', default => sub { [] }); |
62
|
|
|
|
|
|
|
has state => (is => 'rw', default => 0); |
63
|
|
|
|
|
|
|
has stats => (is => 'rw'); |
64
|
|
|
|
|
|
|
has action => (is => 'rw'); |
65
|
|
|
|
|
|
|
has counter => (is => 'rw', default => sub { {} }); |
66
|
|
|
|
|
|
|
has request => ( |
67
|
|
|
|
|
|
|
is => 'rw', |
68
|
|
|
|
|
|
|
default => sub { |
69
|
|
|
|
|
|
|
my $self = shift; |
70
|
|
|
|
|
|
|
my $class = ref $self; |
71
|
|
|
|
|
|
|
my $composed_request_class = $class->composed_request_class; |
72
|
|
|
|
|
|
|
return $composed_request_class->new( $self->_build_request_constructor_args); |
73
|
|
|
|
|
|
|
}, |
74
|
|
|
|
|
|
|
predicate => 'has_request', |
75
|
|
|
|
|
|
|
lazy => 1, |
76
|
|
|
|
|
|
|
); |
77
|
|
|
|
|
|
|
sub _build_request_constructor_args { |
78
|
939
|
|
|
939
|
|
2087
|
my $self = shift; |
79
|
939
|
|
|
|
|
3008
|
my %p = ( _log => $self->log ); |
80
|
939
|
100
|
|
|
|
33956
|
$p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp; |
81
|
939
|
|
|
|
|
4614
|
$p{data_handlers} = {$self->registered_data_handlers}; |
82
|
|
|
|
|
|
|
$p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request} |
83
|
939
|
100
|
|
|
|
4035
|
if $self->config->{use_hash_multivalue_in_request}; |
84
|
939
|
|
|
|
|
37354
|
\%p; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub composed_request_class { |
88
|
1104
|
|
|
1104
|
1
|
2594
|
my $class = shift; |
89
|
1104
|
100
|
|
|
|
4864
|
return $class->_composed_request_class if $class->_composed_request_class; |
90
|
|
|
|
|
|
|
|
91
|
163
|
100
|
|
|
|
642
|
my @traits = (@{$class->request_class_traits||[]}, @{$class->config->{request_class_traits}||[]}); |
|
163
|
50
|
|
|
|
2072
|
|
|
163
|
|
|
|
|
966
|
|
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# For each trait listed, figure out what the namespace is. First we try the $trait |
94
|
|
|
|
|
|
|
# as it is in the config. Then try $MyApp::TraitFor::Request:$trait. Last we try |
95
|
|
|
|
|
|
|
# Catalyst::TraitFor::Request::$trait. If none load, throw error. |
96
|
|
|
|
|
|
|
|
97
|
163
|
|
|
|
|
671
|
my $trait_ns = 'TraitFor::Request'; |
98
|
|
|
|
|
|
|
my @normalized_traits = map { |
99
|
163
|
|
|
|
|
660
|
Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_) |
|
6
|
|
|
|
|
1825
|
|
100
|
|
|
|
|
|
|
} @traits; |
101
|
|
|
|
|
|
|
|
102
|
163
|
50
|
100
|
|
|
1422
|
if ($class->debug && scalar(@normalized_traits)) { |
103
|
0
|
|
|
|
|
0
|
my $column_width = Catalyst::Utils::term_width() - 6; |
104
|
0
|
|
|
|
|
0
|
my $t = Text::SimpleTable->new($column_width); |
105
|
0
|
|
|
|
|
0
|
$t->row($_) for @normalized_traits; |
106
|
0
|
|
|
|
|
0
|
$class->log->debug( "Composed Request Class Traits:\n" . $t->draw . "\n" ); |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
163
|
|
|
|
|
2197
|
return $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @normalized_traits)); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
has response => ( |
113
|
|
|
|
|
|
|
is => 'rw', |
114
|
|
|
|
|
|
|
default => sub { |
115
|
|
|
|
|
|
|
my $self = shift; |
116
|
|
|
|
|
|
|
my $class = ref $self; |
117
|
|
|
|
|
|
|
my $composed_response_class = $class->composed_response_class; |
118
|
|
|
|
|
|
|
return $composed_response_class->new( $self->_build_response_constructor_args); |
119
|
|
|
|
|
|
|
}, |
120
|
|
|
|
|
|
|
predicate=>'has_response', |
121
|
|
|
|
|
|
|
lazy => 1, |
122
|
|
|
|
|
|
|
); |
123
|
|
|
|
|
|
|
sub _build_response_constructor_args { |
124
|
|
|
|
|
|
|
return +{ |
125
|
939
|
|
|
939
|
|
3886
|
_log => $_[0]->log, |
126
|
|
|
|
|
|
|
encoding => $_[0]->encoding, |
127
|
|
|
|
|
|
|
}; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub composed_response_class { |
131
|
1103
|
|
|
1103
|
1
|
3338
|
my $class = shift; |
132
|
1103
|
100
|
|
|
|
4850
|
return $class->_composed_response_class if $class->_composed_response_class; |
133
|
|
|
|
|
|
|
|
134
|
163
|
100
|
|
|
|
676
|
my @traits = (@{$class->response_class_traits||[]}, @{$class->config->{response_class_traits}||[]}); |
|
163
|
50
|
|
|
|
1851
|
|
|
163
|
|
|
|
|
1030
|
|
135
|
|
|
|
|
|
|
|
136
|
163
|
|
|
|
|
677
|
my $trait_ns = 'TraitFor::Response'; |
137
|
|
|
|
|
|
|
my @normalized_traits = map { |
138
|
163
|
|
|
|
|
693
|
Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_) |
|
3
|
|
|
|
|
839
|
|
139
|
|
|
|
|
|
|
} @traits; |
140
|
|
|
|
|
|
|
|
141
|
163
|
50
|
100
|
|
|
1146
|
if ($class->debug && scalar(@normalized_traits)) { |
142
|
0
|
|
|
|
|
0
|
my $column_width = Catalyst::Utils::term_width() - 6; |
143
|
0
|
|
|
|
|
0
|
my $t = Text::SimpleTable->new($column_width); |
144
|
0
|
|
|
|
|
0
|
$t->row($_) for @normalized_traits; |
145
|
0
|
|
|
|
|
0
|
$class->log->debug( "Composed Response Class Traits:\n" . $t->draw . "\n" ); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
163
|
|
|
|
|
1964
|
return $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @normalized_traits)); |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
has namespace => (is => 'rw'); |
152
|
|
|
|
|
|
|
|
153
|
9258
|
50
|
|
9258
|
1
|
13226
|
sub depth { scalar @{ shift->stack || [] }; } |
|
9258
|
|
|
|
|
259117
|
|
154
|
15
|
|
|
15
|
1
|
1150
|
sub comp { shift->component(@_) } |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub req { |
157
|
23979
|
|
|
23979
|
1
|
86945
|
my $self = shift; return $self->request(@_); |
|
23979
|
|
|
|
|
585087
|
|
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
sub res { |
160
|
5503
|
|
|
5503
|
1
|
83328
|
my $self = shift; return $self->response(@_); |
|
5503
|
|
|
|
|
141038
|
|
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# For backwards compatibility |
164
|
0
|
|
|
0
|
1
|
0
|
sub finalize_output { shift->finalize_body(@_) }; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# For statistics |
167
|
|
|
|
|
|
|
our $COUNT = 1; |
168
|
|
|
|
|
|
|
our $START = time; |
169
|
|
|
|
|
|
|
our $RECURSION = 1000; |
170
|
|
|
|
|
|
|
our $DETACH = Catalyst::Exception::Detach->new; |
171
|
|
|
|
|
|
|
our $GO = Catalyst::Exception::Go->new; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
#I imagine that very few of these really |
174
|
|
|
|
|
|
|
#need to be class variables. if any. |
175
|
|
|
|
|
|
|
#maybe we should just make them attributes with a default? |
176
|
|
|
|
|
|
|
__PACKAGE__->mk_classdata($_) |
177
|
|
|
|
|
|
|
for qw/components arguments dispatcher engine log dispatcher_class |
178
|
|
|
|
|
|
|
engine_loader context_class request_class response_class stats_class |
179
|
|
|
|
|
|
|
setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware |
180
|
|
|
|
|
|
|
_data_handlers _encoding _encode_check finalized_default_middleware |
181
|
|
|
|
|
|
|
request_class_traits response_class_traits stats_class_traits |
182
|
|
|
|
|
|
|
_composed_request_class _composed_response_class _composed_stats_class/; |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
__PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); |
185
|
|
|
|
|
|
|
__PACKAGE__->request_class('Catalyst::Request'); |
186
|
|
|
|
|
|
|
__PACKAGE__->response_class('Catalyst::Response'); |
187
|
|
|
|
|
|
|
__PACKAGE__->stats_class('Catalyst::Stats'); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub composed_stats_class { |
190
|
164
|
|
|
164
|
1
|
1097
|
my $class = shift; |
191
|
164
|
100
|
|
|
|
1426
|
return $class->_composed_stats_class if $class->_composed_stats_class; |
192
|
|
|
|
|
|
|
|
193
|
163
|
100
|
|
|
|
920
|
my @traits = (@{$class->stats_class_traits||[]}, @{$class->config->{stats_class_traits}||[]}); |
|
163
|
50
|
|
|
|
1656
|
|
|
163
|
|
|
|
|
1040
|
|
194
|
|
|
|
|
|
|
|
195
|
163
|
|
|
|
|
704
|
my $trait_ns = 'TraitFor::Stats'; |
196
|
|
|
|
|
|
|
my @normalized_traits = map { |
197
|
163
|
|
|
|
|
686
|
Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_) |
|
1
|
|
|
|
|
7
|
|
198
|
|
|
|
|
|
|
} @traits; |
199
|
|
|
|
|
|
|
|
200
|
163
|
50
|
100
|
|
|
920
|
if ($class->debug && scalar(@normalized_traits)) { |
201
|
0
|
|
|
|
|
0
|
my $column_width = Catalyst::Utils::term_width() - 6; |
202
|
0
|
|
|
|
|
0
|
my $t = Text::SimpleTable->new($column_width); |
203
|
0
|
|
|
|
|
0
|
$t->row($_) for @normalized_traits; |
204
|
0
|
|
|
|
|
0
|
$class->log->debug( "Composed Stats Class Traits:\n" . $t->draw . "\n" ); |
205
|
|
|
|
|
|
|
} |
206
|
|
|
|
|
|
|
|
207
|
163
|
|
|
|
|
1747
|
return $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @normalized_traits)); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
__PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC); |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub import { |
213
|
317
|
|
|
317
|
|
107752
|
my ( $class, @arguments ) = @_; |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
# We have to limit $class to Catalyst to avoid pushing Catalyst upon every |
216
|
|
|
|
|
|
|
# callers @ISA. |
217
|
317
|
100
|
|
|
|
21006
|
return unless $class eq 'Catalyst'; |
218
|
|
|
|
|
|
|
|
219
|
167
|
|
|
|
|
659
|
my $caller = caller(); |
220
|
167
|
100
|
|
|
|
4780
|
return if $caller eq 'main'; |
221
|
|
|
|
|
|
|
|
222
|
159
|
|
|
|
|
1060
|
my $meta = Moose::Meta::Class->initialize($caller); |
223
|
159
|
100
|
|
|
|
137148
|
unless ( $caller->isa('Catalyst') ) { |
224
|
150
|
|
|
|
|
786
|
my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller'); |
225
|
150
|
|
|
|
|
8045
|
$meta->superclasses(@superclasses); |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
# Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp |
228
|
159
|
|
|
|
|
1155624
|
$meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses); |
|
317
|
|
|
|
|
8320
|
|
229
|
|
|
|
|
|
|
|
230
|
159
|
100
|
|
|
|
307116
|
unless( $meta->has_method('meta') ){ |
231
|
151
|
50
|
|
|
|
6722
|
if ($Moose::VERSION >= 1.15) { |
232
|
151
|
|
|
|
|
1178
|
$meta->_add_meta_method('meta'); |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
else { |
235
|
0
|
|
|
0
|
|
0
|
$meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } ); |
|
0
|
|
|
|
|
0
|
|
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
159
|
|
|
|
|
48108
|
$caller->arguments( [@arguments] ); |
240
|
159
|
|
|
|
|
1445
|
$caller->setup_home; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
892
|
|
|
892
|
|
2459
|
sub _application { $_[0] } |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=encoding UTF-8 |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=head1 NAME |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Catalyst - The Elegant MVC Web Application Framework |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=head1 SYNOPSIS |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
See the L<Catalyst::Manual> distribution for comprehensive |
254
|
|
|
|
|
|
|
documentation and tutorials. |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
# Install Catalyst::Devel for helpers and other development tools |
257
|
|
|
|
|
|
|
# use the helper to create a new application |
258
|
|
|
|
|
|
|
catalyst.pl MyApp |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
# add models, views, controllers |
261
|
|
|
|
|
|
|
script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db |
262
|
|
|
|
|
|
|
script/myapp_create.pl view MyTemplate TT |
263
|
|
|
|
|
|
|
script/myapp_create.pl controller Search |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
# built in testserver -- use -r to restart automatically on changes |
266
|
|
|
|
|
|
|
# --help to see all available options |
267
|
|
|
|
|
|
|
script/myapp_server.pl |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
# command line testing interface |
270
|
|
|
|
|
|
|
script/myapp_test.pl /yada |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
### in lib/MyApp.pm |
273
|
|
|
|
|
|
|
use Catalyst qw/-Debug/; # include plugins here as well |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
### In lib/MyApp/Controller/Root.pm (autocreated) |
276
|
|
|
|
|
|
|
sub foo : Chained('/') Args() { # called for /foo, /foo/1, /foo/1/2, etc. |
277
|
|
|
|
|
|
|
my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2 |
278
|
|
|
|
|
|
|
$c->stash->{template} = 'foo.tt'; # set the template |
279
|
|
|
|
|
|
|
# lookup something from db -- stash vars are passed to TT |
280
|
|
|
|
|
|
|
$c->stash->{data} = |
281
|
|
|
|
|
|
|
$c->model('Database::Foo')->search( { country => $args[0] } ); |
282
|
|
|
|
|
|
|
if ( $c->req->params->{bar} ) { # access GET or POST parameters |
283
|
|
|
|
|
|
|
$c->forward( 'bar' ); # process another action |
284
|
|
|
|
|
|
|
# do something else after forward returns |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# The foo.tt TT template can use the stash data from the database |
289
|
|
|
|
|
|
|
[% WHILE (item = data.next) %] |
290
|
|
|
|
|
|
|
[% item.foo %] |
291
|
|
|
|
|
|
|
[% END %] |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# called for /bar/of/soap, /bar/of/soap/10, etc. |
294
|
|
|
|
|
|
|
sub bar : Chained('/') PathPart('/bar/of/soap') Args() { ... } |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# called after all actions are finished |
297
|
|
|
|
|
|
|
sub end : Action { |
298
|
|
|
|
|
|
|
my ( $self, $c ) = @_; |
299
|
|
|
|
|
|
|
if ( scalar @{ $c->error } ) { ... } # handle errors |
300
|
|
|
|
|
|
|
return if $c->res->body; # already have a response |
301
|
|
|
|
|
|
|
$c->forward( 'MyApp::View::TT' ); # render template |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
See L<Catalyst::Manual::Intro> for additional information. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=head1 DESCRIPTION |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
Catalyst is a modern framework for making web applications without the |
309
|
|
|
|
|
|
|
pain usually associated with this process. This document is a reference |
310
|
|
|
|
|
|
|
to the main Catalyst application. If you are a new user, we suggest you |
311
|
|
|
|
|
|
|
start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>. |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
See L<Catalyst::Manual> for more documentation. |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
Catalyst plugins can be loaded by naming them as arguments to the "use |
316
|
|
|
|
|
|
|
Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the |
317
|
|
|
|
|
|
|
plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes |
318
|
|
|
|
|
|
|
C<My::Module>. |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
use Catalyst qw/My::Module/; |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
If your plugin starts with a name other than C<Catalyst::Plugin::>, you can |
323
|
|
|
|
|
|
|
fully qualify the name by using a unary plus: |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
use Catalyst qw/ |
326
|
|
|
|
|
|
|
My::Module |
327
|
|
|
|
|
|
|
+Fully::Qualified::Plugin::Name |
328
|
|
|
|
|
|
|
/; |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
Special flags like C<-Debug> can also be specified as |
331
|
|
|
|
|
|
|
arguments when Catalyst is loaded: |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
use Catalyst qw/-Debug My::Module/; |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
The position of plugins and flags in the chain is important, because |
336
|
|
|
|
|
|
|
they are loaded in the order in which they appear. |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
The following flags are supported: |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
=head2 -Debug |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
Enables debug output. You can also force this setting from the system |
343
|
|
|
|
|
|
|
environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment |
344
|
|
|
|
|
|
|
settings override the application, with <MYAPP>_DEBUG having the highest |
345
|
|
|
|
|
|
|
priority. |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
This sets the log level to 'debug' and enables full debug output on the |
348
|
|
|
|
|
|
|
error screen. If you only want the latter, see L<< $c->debug >>. |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
=head2 -Home |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
Forces Catalyst to use a specific home directory, e.g.: |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
use Catalyst qw[-Home=/usr/mst]; |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
This can also be done in the shell environment by setting either the |
357
|
|
|
|
|
|
|
C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP> |
358
|
|
|
|
|
|
|
is replaced with the uppercased name of your application, any "::" in |
359
|
|
|
|
|
|
|
the name will be replaced with underscores, e.g. MyApp::Web should use |
360
|
|
|
|
|
|
|
MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used. |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
If none of these are set, Catalyst will attempt to automatically detect the |
363
|
|
|
|
|
|
|
home directory. If you are working in a development environment, Catalyst |
364
|
|
|
|
|
|
|
will try and find the directory containing either Makefile.PL, Build.PL, |
365
|
|
|
|
|
|
|
dist.ini, or cpanfile. If the application has been installed into the system |
366
|
|
|
|
|
|
|
(i.e. you have done C<make install>), then Catalyst will use the path to your |
367
|
|
|
|
|
|
|
application module, without the .pm extension (e.g., /foo/MyApp if your |
368
|
|
|
|
|
|
|
application was installed at /foo/MyApp.pm) |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=head2 -Log |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
use Catalyst '-Log=warn,fatal,error'; |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
Specifies a comma-delimited list of log levels. |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=head2 -Stats |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
Enables statistics collection and reporting. |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
use Catalyst qw/-Stats=1/; |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
You can also force this setting from the system environment with CATALYST_STATS |
383
|
|
|
|
|
|
|
or <MYAPP>_STATS. The environment settings override the application, with |
384
|
|
|
|
|
|
|
<MYAPP>_STATS having the highest priority. |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
Stats are also enabled if L<< debugging |/"-Debug" >> is enabled. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=head1 METHODS |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=head2 INFORMATION ABOUT THE CURRENT REQUEST |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=head2 $c->action |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
Returns a L<Catalyst::Action> object for the current action, which |
395
|
|
|
|
|
|
|
stringifies to the action name. See L<Catalyst::Action>. |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
=head2 $c->namespace |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
Returns the namespace of the current action, i.e., the URI prefix |
400
|
|
|
|
|
|
|
corresponding to the controller of the current action. For example: |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
# in Controller::Foo::Bar |
403
|
|
|
|
|
|
|
$c->namespace; # returns 'foo/bar'; |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=head2 $c->request |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
=head2 $c->req |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
Returns the current L<Catalyst::Request> object, giving access to |
410
|
|
|
|
|
|
|
information about the current client request (including parameters, |
411
|
|
|
|
|
|
|
cookies, HTTP headers, etc.). See L<Catalyst::Request>. |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
There is a predicate method C<has_request> that returns true if the |
414
|
|
|
|
|
|
|
request object has been created. This is something you might need to |
415
|
|
|
|
|
|
|
check if you are writing plugins that run before a request is finalized. |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
=head2 REQUEST FLOW HANDLING |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
=head2 $c->forward( $action [, \@arguments ] ) |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
=head2 $c->forward( $class, $method, [, \@arguments ] ) |
422
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=head2 $c->forward( $component_instance, $method, [, \@arguments ] ) |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
This is one way of calling another action (method) in the same or |
427
|
|
|
|
|
|
|
a different controller. You can also use C<< $self->my_method($c, @args) >> |
428
|
|
|
|
|
|
|
in the same controller or C<< $c->controller('MyController')->my_method($c, @args) >> |
429
|
|
|
|
|
|
|
in a different controller. |
430
|
|
|
|
|
|
|
The main difference is that 'forward' uses some of the Catalyst request |
431
|
|
|
|
|
|
|
cycle overhead, including debugging, which may be useful to you. On the |
432
|
|
|
|
|
|
|
other hand, there are some complications to using 'forward', restrictions |
433
|
|
|
|
|
|
|
on values returned from 'forward', and it may not handle errors as you prefer. |
434
|
|
|
|
|
|
|
Whether you use 'forward' or not is up to you; it is not considered superior to |
435
|
|
|
|
|
|
|
the other ways to call a method. |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
'forward' calls another action, by its private name. If you give a |
438
|
|
|
|
|
|
|
class name but no method, C<process()> is called. You may also optionally |
439
|
|
|
|
|
|
|
pass arguments in an arrayref. The action will receive the arguments in |
440
|
|
|
|
|
|
|
C<@_> and C<< $c->req->args >>. Upon returning from the function, |
441
|
|
|
|
|
|
|
C<< $c->req->args >> will be restored to the previous values. |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
Any data C<return>ed from the action forwarded to, will be returned by the |
444
|
|
|
|
|
|
|
call to forward. |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
my $foodata = $c->forward('/foo'); |
447
|
|
|
|
|
|
|
$c->forward('index'); |
448
|
|
|
|
|
|
|
$c->forward(qw/Model::DBIC::Foo do_stuff/); |
449
|
|
|
|
|
|
|
$c->forward('View::TT'); |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies |
452
|
|
|
|
|
|
|
an C<< eval { } >> around the call (actually |
453
|
|
|
|
|
|
|
L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all |
454
|
|
|
|
|
|
|
exceptions thrown by the called action non-fatal and pushing them onto |
455
|
|
|
|
|
|
|
$c->error instead. If you want C<die> to propagate you need to do something |
456
|
|
|
|
|
|
|
like: |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
$c->forward('foo'); |
459
|
|
|
|
|
|
|
die join "\n", @{ $c->error } if @{ $c->error }; |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Or make sure to always return true values from your actions and write |
462
|
|
|
|
|
|
|
your code like this: |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
$c->forward('foo') || return; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
Another note is that C<< $c->forward >> always returns a scalar because it |
467
|
|
|
|
|
|
|
actually returns $c->state which operates in a scalar context. |
468
|
|
|
|
|
|
|
Thus, something like: |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
return @array; |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
in an action that is forwarded to is going to return a scalar, |
473
|
|
|
|
|
|
|
i.e. how many items are in that array, which is probably not what you want. |
474
|
|
|
|
|
|
|
If you need to return an array then return a reference to it, |
475
|
|
|
|
|
|
|
or stash it like so: |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
$c->stash->{array} = \@array; |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
and access it from the stash. |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
Keep in mind that the C<end> method used is that of the caller action. So a C<< $c->detach >> inside a forwarded action would run the C<end> method from the original action requested. |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
If you call c<forward> with the name of a component class or instance, rather than an action name |
484
|
|
|
|
|
|
|
or instance, we invoke the C<process> action on that class or instance, or whatever action you |
485
|
|
|
|
|
|
|
specific via the second argument $method. |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
=cut |
488
|
|
|
|
|
|
|
|
489
|
165
|
|
|
165
|
1
|
1368
|
sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) } |
|
165
|
|
|
6919
|
|
617
|
|
|
165
|
|
|
|
|
725351
|
|
|
6919
|
|
|
|
|
22730
|
|
|
6919
|
|
|
|
|
20083
|
|
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=head2 $c->detach( $action [, \@arguments ] ) |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=head2 $c->detach( $class, $method, [, \@arguments ] ) |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
=head2 $c->detach() |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but |
498
|
|
|
|
|
|
|
doesn't return to the previous action when processing is finished. |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
When called with no arguments it escapes the processing chain entirely. |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
=cut |
503
|
|
|
|
|
|
|
|
504
|
16
|
|
|
16
|
1
|
168
|
sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) } |
|
16
|
|
|
|
|
69
|
|
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=head2 $c->visit( $action [, \@arguments ] ) |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
=head2 $c->visit( $action [, \@captures, \@arguments ] ) |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
=head2 $c->visit( $class, $method, [, \@arguments ] ) |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
=head2 $c->visit( $class, $method, [, \@captures, \@arguments ] ) |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, |
515
|
|
|
|
|
|
|
but does a full dispatch, instead of just calling the new C<$action> / |
516
|
|
|
|
|
|
|
C<< $class->$method >>. This means that C<begin>, C<auto> and the method |
517
|
|
|
|
|
|
|
you go to are called, just like a new request. |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
In addition both C<< $c->action >> and C<< $c->namespace >> are localized. |
520
|
|
|
|
|
|
|
This means, for example, that C<< $c->action >> methods such as |
521
|
|
|
|
|
|
|
L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and |
522
|
|
|
|
|
|
|
L<reverse|Catalyst::Action/reverse> return information for the visited action |
523
|
|
|
|
|
|
|
when they are invoked within the visited action. This is different from the |
524
|
|
|
|
|
|
|
behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which |
525
|
|
|
|
|
|
|
continues to use the $c->action object from the caller action even when |
526
|
|
|
|
|
|
|
invoked from the called action. |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
C<< $c->stash >> is kept unchanged. |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> |
531
|
|
|
|
|
|
|
allows you to "wrap" another action, just as it would have been called by |
532
|
|
|
|
|
|
|
dispatching from a URL, while the analogous |
533
|
|
|
|
|
|
|
L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to |
534
|
|
|
|
|
|
|
transfer control to another action as if it had been reached directly from a URL. |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
=cut |
537
|
|
|
|
|
|
|
|
538
|
26
|
|
|
26
|
1
|
321
|
sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) } |
|
26
|
|
|
|
|
89
|
|
539
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
=head2 $c->go( $action [, \@arguments ] ) |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
=head2 $c->go( $action [, \@captures, \@arguments ] ) |
543
|
|
|
|
|
|
|
|
544
|
|
|
|
|
|
|
=head2 $c->go( $class, $method, [, \@arguments ] ) |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=head2 $c->go( $class, $method, [, \@captures, \@arguments ] ) |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
The relationship between C<go> and |
549
|
|
|
|
|
|
|
L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as |
550
|
|
|
|
|
|
|
the relationship between |
551
|
|
|
|
|
|
|
L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and |
552
|
|
|
|
|
|
|
L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>, |
553
|
|
|
|
|
|
|
C<< $c->go >> will perform a full dispatch on the specified action or method, |
554
|
|
|
|
|
|
|
with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>, |
555
|
|
|
|
|
|
|
C<go> escapes the processing of the current request chain on completion, and |
556
|
|
|
|
|
|
|
does not return to its caller. |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
@arguments are arguments to the final destination of $action. @captures are |
559
|
|
|
|
|
|
|
arguments to the intermediate steps, if any, on the way to the final sub of |
560
|
|
|
|
|
|
|
$action. |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
=cut |
563
|
|
|
|
|
|
|
|
564
|
24
|
|
|
24
|
1
|
285
|
sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) } |
|
24
|
|
|
|
|
72
|
|
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
=head2 $c->response |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=head2 $c->res |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
Returns the current L<Catalyst::Response> object, see there for details. |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
There is a predicate method C<has_response> that returns true if the |
573
|
|
|
|
|
|
|
request object has been created. This is something you might need to |
574
|
|
|
|
|
|
|
check if you are writing plugins that run before a request is finalized. |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
=head2 $c->stash |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
Returns a hashref to the stash, which may be used to store data and pass |
579
|
|
|
|
|
|
|
it between components during a request. You can also set hash keys by |
580
|
|
|
|
|
|
|
passing arguments. The stash is automatically sent to the view. The |
581
|
|
|
|
|
|
|
stash is cleared at the end of a request; it cannot be used for |
582
|
|
|
|
|
|
|
persistent storage (for this you must use a session; see |
583
|
|
|
|
|
|
|
L<Catalyst::Plugin::Session> for a complete system integrated with |
584
|
|
|
|
|
|
|
Catalyst). |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
$c->stash->{foo} = $bar; |
587
|
|
|
|
|
|
|
$c->stash( { moose => 'majestic', qux => 0 } ); |
588
|
|
|
|
|
|
|
$c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
# stash is automatically passed to the view for use in a template |
591
|
|
|
|
|
|
|
$c->forward( 'MyApp::View::TT' ); |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
The stash hash is currently stored in the PSGI C<$env> and is managed by |
594
|
|
|
|
|
|
|
L<Catalyst::Middleware::Stash>. Since it's part of the C<$env> items in |
595
|
|
|
|
|
|
|
the stash can be accessed in sub applications mounted under your main |
596
|
|
|
|
|
|
|
L<Catalyst> application. For example if you delegate the response of an |
597
|
|
|
|
|
|
|
action to another L<Catalyst> application, that sub application will have |
598
|
|
|
|
|
|
|
access to all the stash keys of the main one, and if can of course add |
599
|
|
|
|
|
|
|
more keys of its own. However those new keys will not 'bubble' back up |
600
|
|
|
|
|
|
|
to the main application. |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
For more information the best thing to do is to review the test case: |
603
|
|
|
|
|
|
|
t/middleware-stash.t in the distribution /t directory. |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
=cut |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
sub stash { |
608
|
2425
|
|
|
2425
|
1
|
8900
|
my $c = shift; |
609
|
2425
|
50
|
|
|
|
9124
|
$c->log->error("You are requesting the stash but you don't have a context") unless blessed $c; |
610
|
2425
|
|
|
|
|
7281
|
return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_); |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
=head2 $c->error |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=head2 $c->error($error, ...) |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
=head2 $c->error($arrayref) |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
Returns an arrayref containing error messages. If Catalyst encounters an |
620
|
|
|
|
|
|
|
error while processing a request, it stores the error in $c->error. This |
621
|
|
|
|
|
|
|
method should only be used to store fatal error messages. |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
my @error = @{ $c->error }; |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
Add a new error. |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
$c->error('Something bad happened'); |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
Calling this will always return an arrayref (if there are no errors it |
630
|
|
|
|
|
|
|
will be an empty arrayref. |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
=cut |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
sub error { |
635
|
11087
|
|
|
11087
|
1
|
129583
|
my $c = shift; |
636
|
11087
|
100
|
|
|
|
30889
|
if ( $_[0] ) { |
|
|
100
|
|
|
|
|
|
637
|
39
|
50
|
|
|
|
247
|
my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_]; |
638
|
39
|
50
|
|
|
|
180
|
croak @$error unless ref $c; |
639
|
39
|
|
|
|
|
103
|
push @{ $c->{error} }, @$error; |
|
39
|
|
|
|
|
215
|
|
640
|
|
|
|
|
|
|
} |
641
|
10
|
|
|
|
|
24
|
elsif ( defined $_[0] ) { $c->{error} = undef } |
642
|
11087
|
|
100
|
|
|
61932
|
return $c->{error} || []; |
643
|
|
|
|
|
|
|
} |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
=head2 $c->state |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
Contains the return value of the last executed action. |
648
|
|
|
|
|
|
|
Note that << $c->state >> operates in a scalar context which means that all |
649
|
|
|
|
|
|
|
values it returns are scalar. |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
Please note that if an action throws an exception, the value of state |
652
|
|
|
|
|
|
|
should no longer be considered the return if the last action. It is generally |
653
|
|
|
|
|
|
|
going to be 0, which indicates an error state. Examine $c->error for error |
654
|
|
|
|
|
|
|
details. |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
=head2 $c->clear_errors |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
Clear errors. You probably don't want to clear the errors unless you are |
659
|
|
|
|
|
|
|
implementing a custom error screen. |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
This is equivalent to running |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
$c->error(0); |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
=cut |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
sub clear_errors { |
668
|
10
|
|
|
10
|
1
|
16
|
my $c = shift; |
669
|
10
|
|
|
|
|
26
|
$c->error(0); |
670
|
|
|
|
|
|
|
} |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
=head2 $c->has_errors |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
Returns true if you have errors |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=cut |
677
|
|
|
|
|
|
|
|
678
|
301
|
100
|
|
301
|
1
|
574
|
sub has_errors { scalar(@{shift->error}) ? 1:0 } |
|
301
|
|
|
|
|
1024
|
|
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
=head2 $c->last_error |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
Returns the most recent error in the stack (the one most recently added...) |
683
|
|
|
|
|
|
|
or nothing if there are no errors. This does not modify the contents of the |
684
|
|
|
|
|
|
|
error stack. |
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=cut |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
sub last_error { |
689
|
0
|
|
|
0
|
1
|
0
|
my (@errs) = @{shift->error}; |
|
0
|
|
|
|
|
0
|
|
690
|
0
|
0
|
|
|
|
0
|
return scalar(@errs) ? $errs[-1]: undef; |
691
|
|
|
|
|
|
|
} |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
=head2 shift_errors |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
shifts the most recently added error off the error stack and returns it. Returns |
696
|
|
|
|
|
|
|
nothing if there are no more errors. |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
=cut |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
sub shift_errors { |
701
|
3
|
|
|
3
|
1
|
31
|
my ($self) = @_; |
702
|
3
|
|
|
|
|
5
|
my @errors = @{$self->error}; |
|
3
|
|
|
|
|
8
|
|
703
|
3
|
|
|
|
|
12
|
my $err = shift(@errors); |
704
|
3
|
|
|
|
|
10
|
$self->{error} = \@errors; |
705
|
3
|
|
|
|
|
7
|
return $err; |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=head2 pop_errors |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
pops the most recently added error off the error stack and returns it. Returns |
711
|
|
|
|
|
|
|
nothing if there are no more errors. |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=cut |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
sub pop_errors { |
716
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
717
|
0
|
|
|
|
|
0
|
my @errors = @{$self->error}; |
|
0
|
|
|
|
|
0
|
|
718
|
0
|
|
|
|
|
0
|
my $err = pop(@errors); |
719
|
0
|
|
|
|
|
0
|
$self->{error} = \@errors; |
720
|
0
|
|
|
|
|
0
|
return $err; |
721
|
|
|
|
|
|
|
} |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
sub _comp_search_prefixes { |
724
|
64
|
|
|
64
|
|
124
|
my $c = shift; |
725
|
64
|
|
|
|
|
211
|
return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_); |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
# search components given a name and some prefixes |
729
|
|
|
|
|
|
|
sub _comp_names_search_prefixes { |
730
|
67
|
|
|
67
|
|
201
|
my ( $c, $name, @prefixes ) = @_; |
731
|
67
|
|
66
|
|
|
220
|
my $appclass = ref $c || $c; |
732
|
67
|
|
|
|
|
261
|
my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; |
733
|
67
|
|
|
|
|
1462
|
$filter = qr/$filter/; # Compile regex now rather than once per loop |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
# map the original component name to the sub part that we will search against |
736
|
574
|
|
|
|
|
799
|
my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; } |
|
574
|
|
|
|
|
2168
|
|
|
574
|
|
|
|
|
1606
|
|
737
|
67
|
|
|
|
|
221
|
grep { /$filter/ } keys %{ $c->components }; |
|
1139
|
|
|
|
|
3542
|
|
|
67
|
|
|
|
|
218
|
|
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
# undef for a name will return all |
740
|
67
|
100
|
|
|
|
291
|
return keys %eligible if !defined $name; |
741
|
|
|
|
|
|
|
|
742
|
61
|
100
|
|
|
|
205
|
my $query = $name->$_isa('Regexp') ? $name : qr/^$name$/i; |
743
|
61
|
|
|
|
|
1201
|
my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible; |
|
558
|
|
|
|
|
1611
|
|
744
|
|
|
|
|
|
|
|
745
|
61
|
100
|
|
|
|
426
|
return @result if @result; |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
# if we were given a regexp to search against, we're done. |
748
|
20
|
100
|
|
|
|
60
|
return if $name->$_isa('Regexp'); |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
# skip regexp fallback if configured |
751
|
|
|
|
|
|
|
return |
752
|
19
|
100
|
|
|
|
237
|
if $appclass->config->{disable_component_resolution_regex_fallback}; |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
# regexp fallback |
755
|
18
|
|
|
|
|
169
|
$query = qr/$name/i; |
756
|
18
|
|
|
|
|
78
|
@result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible; |
|
139
|
|
|
|
|
367
|
|
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
# no results? try against full names |
759
|
18
|
100
|
|
|
|
62
|
if( !@result ) { |
760
|
14
|
|
|
|
|
39
|
@result = grep { m{$query} } keys %eligible; |
|
125
|
|
|
|
|
336
|
|
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
# don't warn if we didn't find any results, it just might not exist |
764
|
18
|
100
|
|
|
|
68
|
if( @result ) { |
765
|
|
|
|
|
|
|
# Disgusting hack to work out correct method name |
766
|
14
|
|
|
|
|
34
|
my $warn_for = lc $prefixes[0]; |
767
|
14
|
|
|
|
|
60
|
my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" . |
768
|
|
|
|
|
|
|
(join '", "', @result) . "'. Relying on regexp fallback behavior for " . |
769
|
|
|
|
|
|
|
"component resolution is unreliable and unsafe."; |
770
|
14
|
|
|
|
|
30
|
my $short = $result[0]; |
771
|
|
|
|
|
|
|
# remove the component namespace prefix |
772
|
14
|
|
|
|
|
83
|
$short =~ s/.*?(Model|Controller|View):://; |
773
|
14
|
|
|
|
|
1982
|
my $shortmess = Carp::shortmess(''); |
774
|
14
|
50
|
|
|
|
230
|
if ($shortmess =~ m#Catalyst/Plugin#) { |
|
|
50
|
|
|
|
|
|
775
|
0
|
|
|
|
|
0
|
$msg .= " You probably need to set '$short' instead of '${name}' in this " . |
776
|
|
|
|
|
|
|
"plugin's config"; |
777
|
|
|
|
|
|
|
} elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) { |
778
|
0
|
|
|
|
|
0
|
$msg .= " You probably need to set '$short' instead of '${name}' in this " . |
779
|
|
|
|
|
|
|
"component's config"; |
780
|
|
|
|
|
|
|
} else { |
781
|
14
|
|
|
|
|
87
|
$msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " . |
782
|
|
|
|
|
|
|
"but if you really wanted to search, pass in a regexp as the argument " . |
783
|
|
|
|
|
|
|
"like so: \$c->${warn_for}(qr/${name}/)"; |
784
|
|
|
|
|
|
|
} |
785
|
14
|
|
|
|
|
66
|
$c->log->warn( "${msg}$shortmess" ); |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
|
788
|
18
|
|
|
|
|
149
|
return @result; |
789
|
|
|
|
|
|
|
} |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
# Find possible names for a prefix |
792
|
|
|
|
|
|
|
sub _comp_names { |
793
|
3
|
|
|
3
|
|
10
|
my ( $c, @prefixes ) = @_; |
794
|
3
|
|
33
|
|
|
14
|
my $appclass = ref $c || $c; |
795
|
|
|
|
|
|
|
|
796
|
3
|
|
|
|
|
14
|
my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; |
797
|
|
|
|
|
|
|
|
798
|
3
|
|
|
|
|
7
|
my @names = map { s{$filter}{}; $_; } |
|
9
|
|
|
|
|
147
|
|
|
9
|
|
|
|
|
28
|
|
799
|
|
|
|
|
|
|
$c->_comp_names_search_prefixes( undef, @prefixes ); |
800
|
|
|
|
|
|
|
|
801
|
3
|
|
|
|
|
50
|
return @names; |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
# Filter a component before returning by calling ACCEPT_CONTEXT if available |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
sub _filter_component { |
807
|
16604
|
|
|
16604
|
|
32477
|
my ( $c, $comp, @args ) = @_; |
808
|
|
|
|
|
|
|
|
809
|
16604
|
100
|
|
|
|
39669
|
if(ref $comp eq 'CODE') { |
810
|
9
|
|
|
|
|
21
|
$comp = $comp->(); |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
|
813
|
16604
|
100
|
|
|
|
26721
|
if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) { |
|
16604
|
|
|
|
|
63711
|
|
814
|
11
|
|
|
|
|
49
|
return $comp->ACCEPT_CONTEXT( $c, @args ); |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
|
817
|
16593
|
50
|
33
|
|
|
41843
|
$c->log->warn("You called component '${\$comp->catalyst_component_name}' with arguments [@args], but this component does not ACCEPT_CONTEXT, so args are ignored.") if scalar(@args) && $c->debug; |
|
0
|
|
|
|
|
0
|
|
818
|
|
|
|
|
|
|
|
819
|
16593
|
|
|
|
|
51188
|
return $comp; |
820
|
|
|
|
|
|
|
} |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=head2 COMPONENT ACCESSORS |
823
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
=head2 $c->controller($name) |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
Gets a L<Catalyst::Controller> instance by name. |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
$c->controller('Foo')->do_stuff; |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
If the name is omitted, will return the controller for the dispatched |
831
|
|
|
|
|
|
|
action. |
832
|
|
|
|
|
|
|
|
833
|
|
|
|
|
|
|
If you want to search for controllers, pass in a regexp as the argument. |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
# find all controllers that start with Foo |
836
|
|
|
|
|
|
|
my @foo_controllers = $c->controller(qr{^Foo}); |
837
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
=cut |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
sub controller { |
842
|
71
|
|
|
71
|
1
|
14417
|
my ( $c, $name, @args ) = @_; |
843
|
|
|
|
|
|
|
|
844
|
71
|
|
66
|
|
|
323
|
my $appclass = ref($c) || $c; |
845
|
71
|
100
|
|
|
|
195
|
if( $name ) { |
846
|
61
|
100
|
|
|
|
238
|
unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps |
847
|
58
|
|
|
|
|
793
|
my $comps = $c->components; |
848
|
58
|
|
|
|
|
200
|
my $check = $appclass."::Controller::".$name; |
849
|
58
|
100
|
|
|
|
311
|
return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; |
850
|
13
|
|
|
|
|
21
|
foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) { |
|
13
|
|
|
|
|
43
|
|
851
|
2
|
100
|
|
|
|
14
|
next unless $path =~ /.*::Controller/; |
852
|
1
|
|
|
|
|
7
|
$check = $path."::".$name; |
853
|
1
|
50
|
|
|
|
13
|
return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; |
854
|
|
|
|
|
|
|
} |
855
|
|
|
|
|
|
|
} |
856
|
15
|
|
|
|
|
94
|
my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ ); |
857
|
15
|
100
|
|
|
|
78
|
return map { $c->_filter_component( $_, @args ) } @result if ref $name; |
|
3
|
|
|
|
|
9
|
|
858
|
12
|
|
|
|
|
36
|
return $c->_filter_component( $result[ 0 ], @args ); |
859
|
|
|
|
|
|
|
} |
860
|
|
|
|
|
|
|
|
861
|
10
|
|
|
|
|
276
|
return $c->component( $c->action->class ); |
862
|
|
|
|
|
|
|
} |
863
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=head2 $c->model($name) |
865
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
Gets a L<Catalyst::Model> instance by name. |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
$c->model('Foo')->do_stuff; |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
Any extra arguments are directly passed to ACCEPT_CONTEXT, if the model |
871
|
|
|
|
|
|
|
defines ACCEPT_CONTEXT. If it does not, the args are discarded. |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
If the name is omitted, it will look for |
874
|
|
|
|
|
|
|
- a model object in $c->stash->{current_model_instance}, then |
875
|
|
|
|
|
|
|
- a model name in $c->stash->{current_model}, then |
876
|
|
|
|
|
|
|
- a config setting 'default_model', or |
877
|
|
|
|
|
|
|
- check if there is only one model, and return it if that's the case. |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
If you want to search for models, pass in a regexp as the argument. |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
# find all models that start with Foo |
882
|
|
|
|
|
|
|
my @foo_models = $c->model(qr{^Foo}); |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
=cut |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
sub model { |
887
|
51
|
|
|
51
|
1
|
9131
|
my ( $c, $name, @args ) = @_; |
888
|
51
|
|
66
|
|
|
223
|
my $appclass = ref($c) || $c; |
889
|
51
|
100
|
|
|
|
170
|
if( $name ) { |
890
|
49
|
100
|
|
|
|
181
|
unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps |
891
|
46
|
|
|
|
|
596
|
my $comps = $c->components; |
892
|
46
|
|
|
|
|
139
|
my $check = $appclass."::Model::".$name; |
893
|
46
|
100
|
|
|
|
242
|
return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; |
894
|
16
|
|
|
|
|
32
|
foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) { |
|
16
|
|
|
|
|
58
|
|
895
|
0
|
0
|
|
|
|
0
|
next unless $path =~ /.*::Model/; |
896
|
0
|
|
|
|
|
0
|
$check = $path."::".$name; |
897
|
0
|
0
|
|
|
|
0
|
return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
} |
900
|
19
|
|
|
|
|
105
|
my @result = $c->_comp_search_prefixes( $name, qw/Model M/ ); |
901
|
19
|
100
|
|
|
|
71
|
return map { $c->_filter_component( $_, @args ) } @result if ref $name; |
|
6
|
|
|
|
|
13
|
|
902
|
14
|
|
|
|
|
47
|
return $c->_filter_component( $result[ 0 ], @args ); |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
|
905
|
2
|
50
|
|
|
|
8
|
if (ref $c) { |
906
|
|
|
|
|
|
|
return $c->stash->{current_model_instance} |
907
|
0
|
0
|
|
|
|
0
|
if $c->stash->{current_model_instance}; |
908
|
|
|
|
|
|
|
return $c->model( $c->stash->{current_model} ) |
909
|
0
|
0
|
|
|
|
0
|
if $c->stash->{current_model}; |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
return $c->model( $appclass->config->{default_model} ) |
912
|
2
|
100
|
|
|
|
10
|
if $appclass->config->{default_model}; |
913
|
|
|
|
|
|
|
|
914
|
1
|
|
|
|
|
5
|
my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/); |
915
|
|
|
|
|
|
|
|
916
|
1
|
50
|
|
|
|
4
|
if( $rest ) { |
917
|
1
|
|
|
|
|
5
|
$c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') ); |
918
|
1
|
|
|
|
|
8
|
$c->log->warn( '* $c->config(default_model => "the name of the default model to use")' ); |
919
|
1
|
|
|
|
|
8
|
$c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' ); |
920
|
1
|
|
|
|
|
8
|
$c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' ); |
921
|
1
|
|
|
|
|
12
|
$c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' ); |
922
|
|
|
|
|
|
|
} |
923
|
|
|
|
|
|
|
|
924
|
1
|
|
|
|
|
8
|
return $c->_filter_component( $comp ); |
925
|
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
=head2 $c->view($name) |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
Gets a L<Catalyst::View> instance by name. |
931
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
$c->view('Foo')->do_stuff; |
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
Any extra arguments are directly passed to ACCEPT_CONTEXT. |
935
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
If the name is omitted, it will look for |
937
|
|
|
|
|
|
|
- a view object in $c->stash->{current_view_instance}, then |
938
|
|
|
|
|
|
|
- a view name in $c->stash->{current_view}, then |
939
|
|
|
|
|
|
|
- a config setting 'default_view', or |
940
|
|
|
|
|
|
|
- check if there is only one view, and return it if that's the case. |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
If you want to search for views, pass in a regexp as the argument. |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
# find all views that start with Foo |
945
|
|
|
|
|
|
|
my @foo_views = $c->view(qr{^Foo}); |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=cut |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
sub view { |
950
|
33
|
|
|
33
|
1
|
2177
|
my ( $c, $name, @args ) = @_; |
951
|
|
|
|
|
|
|
|
952
|
33
|
|
66
|
|
|
134
|
my $appclass = ref($c) || $c; |
953
|
33
|
100
|
|
|
|
103
|
if( $name ) { |
954
|
29
|
100
|
|
|
|
116
|
unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps |
955
|
26
|
|
|
|
|
358
|
my $comps = $c->components; |
956
|
26
|
|
|
|
|
92
|
my $check = $appclass."::View::".$name; |
957
|
26
|
100
|
|
|
|
77
|
if( exists $comps->{$check} ) { |
958
|
14
|
|
|
|
|
51
|
return $c->_filter_component( $comps->{$check}, @args ); |
959
|
|
|
|
|
|
|
} |
960
|
|
|
|
|
|
|
else { |
961
|
12
|
|
|
|
|
46
|
$c->log->warn( "Attempted to use view '$check', but does not exist" ); |
962
|
|
|
|
|
|
|
} |
963
|
12
|
|
|
|
|
39
|
foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) { |
|
12
|
|
|
|
|
48
|
|
964
|
0
|
0
|
|
|
|
0
|
next unless $path =~ /.*::View/; |
965
|
0
|
|
|
|
|
0
|
$check = $path."::".$name; |
966
|
0
|
0
|
|
|
|
0
|
return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; |
967
|
|
|
|
|
|
|
} |
968
|
|
|
|
|
|
|
} |
969
|
15
|
|
|
|
|
127
|
my @result = $c->_comp_search_prefixes( $name, qw/View V/ ); |
970
|
15
|
100
|
|
|
|
62
|
return map { $c->_filter_component( $_, @args ) } @result if ref $name; |
|
4
|
|
|
|
|
11
|
|
971
|
12
|
|
|
|
|
49
|
return $c->_filter_component( $result[ 0 ], @args ); |
972
|
|
|
|
|
|
|
} |
973
|
|
|
|
|
|
|
|
974
|
4
|
100
|
|
|
|
19
|
if (ref $c) { |
975
|
|
|
|
|
|
|
return $c->stash->{current_view_instance} |
976
|
2
|
50
|
|
|
|
10
|
if $c->stash->{current_view_instance}; |
977
|
|
|
|
|
|
|
return $c->view( $c->stash->{current_view} ) |
978
|
2
|
50
|
|
|
|
14
|
if $c->stash->{current_view}; |
979
|
|
|
|
|
|
|
} |
980
|
|
|
|
|
|
|
return $c->view( $appclass->config->{default_view} ) |
981
|
4
|
100
|
|
|
|
19
|
if $appclass->config->{default_view}; |
982
|
|
|
|
|
|
|
|
983
|
2
|
|
|
|
|
9
|
my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/); |
984
|
|
|
|
|
|
|
|
985
|
2
|
100
|
|
|
|
43
|
if( $rest ) { |
986
|
1
|
|
|
|
|
6
|
$c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' ); |
987
|
1
|
|
|
|
|
20
|
$c->log->warn( '* $c->config(default_view => "the name of the default view to use")' ); |
988
|
1
|
|
|
|
|
8
|
$c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' ); |
989
|
1
|
|
|
|
|
5
|
$c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' ); |
990
|
1
|
|
|
|
|
6
|
$c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' ); |
991
|
|
|
|
|
|
|
} |
992
|
|
|
|
|
|
|
|
993
|
2
|
|
|
|
|
17
|
return $c->_filter_component( $comp ); |
994
|
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
=head2 $c->controllers |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
Returns the available names which can be passed to $c->controller |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
=cut |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
sub controllers { |
1003
|
1
|
|
|
1
|
1
|
7
|
my ( $c ) = @_; |
1004
|
1
|
|
|
|
|
4
|
return $c->_comp_names(qw/Controller C/); |
1005
|
|
|
|
|
|
|
} |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
=head2 $c->models |
1008
|
|
|
|
|
|
|
|
1009
|
|
|
|
|
|
|
Returns the available names which can be passed to $c->model |
1010
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
=cut |
1012
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
sub models { |
1014
|
1
|
|
|
1
|
1
|
3
|
my ( $c ) = @_; |
1015
|
1
|
|
|
|
|
3
|
return $c->_comp_names(qw/Model M/); |
1016
|
|
|
|
|
|
|
} |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
|
1019
|
|
|
|
|
|
|
=head2 $c->views |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
Returns the available names which can be passed to $c->view |
1022
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=cut |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
sub views { |
1026
|
1
|
|
|
1
|
1
|
387
|
my ( $c ) = @_; |
1027
|
1
|
|
|
|
|
7
|
return $c->_comp_names(qw/View V/); |
1028
|
|
|
|
|
|
|
} |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
=head2 $c->comp($name) |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
=head2 $c->component($name) |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
Gets a component object by name. This method is not recommended, |
1035
|
|
|
|
|
|
|
unless you want to get a specific component by full |
1036
|
|
|
|
|
|
|
class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >> |
1037
|
|
|
|
|
|
|
should be used instead. |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
If C<$name> is a regexp, a list of components matched against the full |
1040
|
|
|
|
|
|
|
component name will be returned. |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
If Catalyst can't find a component by name, it will fallback to regex |
1043
|
|
|
|
|
|
|
matching by default. To disable this behaviour set |
1044
|
|
|
|
|
|
|
disable_component_resolution_regex_fallback to a true value. |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
__PACKAGE__->config( disable_component_resolution_regex_fallback => 1 ); |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
=cut |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
sub component { |
1051
|
16465
|
|
|
16465
|
1
|
79101
|
my ( $c, $name, @args ) = @_; |
1052
|
|
|
|
|
|
|
|
1053
|
16465
|
100
|
|
|
|
33012
|
if( $name ) { |
1054
|
16464
|
|
|
|
|
46806
|
my $comps = $c->components; |
1055
|
|
|
|
|
|
|
|
1056
|
16464
|
100
|
|
|
|
35678
|
if( !ref $name ) { |
1057
|
|
|
|
|
|
|
# is it the exact name? |
1058
|
|
|
|
|
|
|
return $c->_filter_component( $comps->{ $name }, @args ) |
1059
|
16459
|
100
|
|
|
|
57556
|
if exists $comps->{ $name }; |
1060
|
|
|
|
|
|
|
|
1061
|
|
|
|
|
|
|
# perhaps we just omitted "MyApp"? |
1062
|
30
|
|
66
|
|
|
209
|
my $composed = ( ref $c || $c ) . "::${name}"; |
1063
|
|
|
|
|
|
|
return $c->_filter_component( $comps->{ $composed }, @args ) |
1064
|
30
|
100
|
|
|
|
138
|
if exists $comps->{ $composed }; |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
# search all of the models, views and controllers |
1067
|
12
|
|
|
|
|
73
|
my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ ); |
1068
|
12
|
100
|
|
|
|
69
|
return $c->_filter_component( $comp, @args ) if $comp; |
1069
|
|
|
|
|
|
|
} |
1070
|
|
|
|
|
|
|
|
1071
|
|
|
|
|
|
|
return |
1072
|
7
|
50
|
|
|
|
26
|
if $c->config->{disable_component_resolution_regex_fallback}; |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
# This is here so $c->comp( '::M::' ) works |
1075
|
7
|
100
|
|
|
|
44
|
my $query = ref $name ? $name : qr{$name}i; |
1076
|
|
|
|
|
|
|
|
1077
|
7
|
|
|
|
|
15
|
my @result = grep { m{$query} } keys %{ $c->components }; |
|
108
|
|
|
|
|
307
|
|
|
7
|
|
|
|
|
34
|
|
1078
|
7
|
100
|
|
|
|
51
|
return map { $c->_filter_component( $_, @args ) } @result if ref $name; |
|
3
|
|
|
|
|
8
|
|
1079
|
|
|
|
|
|
|
|
1080
|
2
|
50
|
|
|
|
9
|
if( $result[ 0 ] ) { |
1081
|
0
|
|
|
|
|
0
|
$c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) ); |
1082
|
0
|
|
|
|
|
0
|
$c->log->warn( 'Relying on the regexp fallback behavior for component resolution' ); |
1083
|
0
|
|
|
|
|
0
|
$c->log->warn( 'is unreliable and unsafe. You have been warned' ); |
1084
|
0
|
|
|
|
|
0
|
return $c->_filter_component( $result[ 0 ], @args ); |
1085
|
|
|
|
|
|
|
} |
1086
|
|
|
|
|
|
|
|
1087
|
|
|
|
|
|
|
# I would expect to return an empty list here, but that breaks back-compat |
1088
|
|
|
|
|
|
|
} |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
# fallback |
1091
|
3
|
|
|
|
|
7
|
return sort keys %{ $c->components }; |
|
3
|
|
|
|
|
11
|
|
1092
|
|
|
|
|
|
|
} |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
=head2 CLASS DATA AND HELPER CLASSES |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
=head2 $c->config |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
Returns or takes a hashref containing the application's configuration. |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
__PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } ); |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
You can also use a C<YAML>, C<XML> or L<Config::General> config file |
1103
|
|
|
|
|
|
|
like C<myapp.conf> in your applications home directory. See |
1104
|
|
|
|
|
|
|
L<Catalyst::Plugin::ConfigLoader>. |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
=head3 Cascading configuration |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
The config method is present on all Catalyst components, and configuration |
1109
|
|
|
|
|
|
|
will be merged when an application is started. Configuration loaded with |
1110
|
|
|
|
|
|
|
L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration, |
1111
|
|
|
|
|
|
|
followed by configuration in your top level C<MyApp> class. These two |
1112
|
|
|
|
|
|
|
configurations are merged, and then configuration data whose hash key matches a |
1113
|
|
|
|
|
|
|
component name is merged with configuration for that component. |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
The configuration for a component is then passed to the C<new> method when a |
1116
|
|
|
|
|
|
|
component is constructed. |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
For example: |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } }); |
1121
|
|
|
|
|
|
|
MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' }); |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
will mean that C<MyApp::Model::Foo> receives the following data when |
1124
|
|
|
|
|
|
|
constructed: |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
MyApp::Model::Foo->new({ |
1127
|
|
|
|
|
|
|
bar => 'baz', |
1128
|
|
|
|
|
|
|
quux => 'frob', |
1129
|
|
|
|
|
|
|
overrides => 'me', |
1130
|
|
|
|
|
|
|
}); |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
It's common practice to use a Moose attribute |
1133
|
|
|
|
|
|
|
on the receiving component to access the config value. |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
package MyApp::Model::Foo; |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
use Moose; |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
# this attr will receive 'baz' at construction time |
1140
|
|
|
|
|
|
|
has 'bar' => ( |
1141
|
|
|
|
|
|
|
is => 'rw', |
1142
|
|
|
|
|
|
|
isa => 'Str', |
1143
|
|
|
|
|
|
|
); |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
You can then get the value 'baz' by calling $c->model('Foo')->bar |
1146
|
|
|
|
|
|
|
(or $self->bar inside code in the model). |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >> |
1149
|
|
|
|
|
|
|
as a way of reading config within your code, as this B<will not> give you the |
1150
|
|
|
|
|
|
|
correctly merged config back. You B<MUST> take the config values supplied to |
1151
|
|
|
|
|
|
|
the constructor and use those instead. |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
=cut |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
around config => sub { |
1156
|
|
|
|
|
|
|
my $orig = shift; |
1157
|
|
|
|
|
|
|
my $c = shift; |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
croak('Setting config after setup has been run is not allowed.') |
1160
|
|
|
|
|
|
|
if ( @_ and $c->setup_finished ); |
1161
|
|
|
|
|
|
|
|
1162
|
|
|
|
|
|
|
$c->$orig(@_); |
1163
|
|
|
|
|
|
|
}; |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
=head2 $c->log |
1166
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
Returns the logging object instance. Unless it is already set, Catalyst |
1168
|
|
|
|
|
|
|
sets this up with a L<Catalyst::Log> object. To use your own log class, |
1169
|
|
|
|
|
|
|
set the logger with the C<< __PACKAGE__->log >> method prior to calling |
1170
|
|
|
|
|
|
|
C<< __PACKAGE__->setup >>. |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
__PACKAGE__->log( MyLogger->new ); |
1173
|
|
|
|
|
|
|
__PACKAGE__->setup; |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
And later: |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
$c->log->info( 'Now logging with my own logger!' ); |
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
Your log class should implement the methods described in |
1180
|
|
|
|
|
|
|
L<Catalyst::Log>. |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
=head2 has_encoding |
1183
|
|
|
|
|
|
|
|
1184
|
|
|
|
|
|
|
Returned True if there's a valid encoding |
1185
|
|
|
|
|
|
|
|
1186
|
|
|
|
|
|
|
=head2 clear_encoding |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
Clears the encoding for the current context |
1189
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
=head2 encoding |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
Sets or gets the application encoding. Setting encoding takes either an |
1193
|
|
|
|
|
|
|
Encoding object or a string that we try to resolve via L<Encode::find_encoding>. |
1194
|
|
|
|
|
|
|
|
1195
|
|
|
|
|
|
|
You would expect to get the encoding object back if you attempt to set it. If |
1196
|
|
|
|
|
|
|
there is a failure you will get undef returned and an error message in the log. |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
=cut |
1199
|
|
|
|
|
|
|
|
1200
|
0
|
0
|
|
0
|
1
|
0
|
sub has_encoding { shift->encoding ? 1:0 } |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
sub clear_encoding { |
1203
|
2
|
|
|
2
|
1
|
23
|
my $c = shift; |
1204
|
2
|
50
|
|
|
|
15
|
if(blessed $c) { |
1205
|
2
|
|
|
|
|
8
|
$c->encoding(undef); |
1206
|
|
|
|
|
|
|
} else { |
1207
|
0
|
|
|
|
|
0
|
$c->log->error("You can't clear encoding on the application"); |
1208
|
|
|
|
|
|
|
} |
1209
|
|
|
|
|
|
|
} |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
sub encoding { |
1212
|
4938
|
|
|
4938
|
1
|
54162
|
my $c = shift; |
1213
|
4938
|
|
|
|
|
8077
|
my $encoding; |
1214
|
|
|
|
|
|
|
|
1215
|
4938
|
100
|
|
|
|
10994
|
if ( scalar @_ ) { |
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
# Don't let one change this once we are too far into the response |
1218
|
174
|
100
|
100
|
|
|
1309
|
if(blessed $c && $c->res->finalized_headers) { |
1219
|
1
|
|
|
|
|
281
|
Carp::croak("You may not change the encoding once the headers are finalized"); |
1220
|
0
|
|
|
|
|
0
|
return; |
1221
|
|
|
|
|
|
|
} |
1222
|
|
|
|
|
|
|
|
1223
|
|
|
|
|
|
|
# Let it be set to undef |
1224
|
173
|
100
|
|
|
|
828
|
if (my $wanted = shift) { |
1225
|
169
|
50
|
|
|
|
1374
|
$encoding = Encode::find_encoding($wanted) |
1226
|
|
|
|
|
|
|
or Carp::croak( qq/Unknown encoding '$wanted'/ ); |
1227
|
169
|
|
|
185
|
|
44189
|
binmode(STDERR, ':encoding(' . $encoding->name . ')'); |
|
152
|
|
|
|
|
7945
|
|
|
152
|
|
|
|
|
439
|
|
|
152
|
|
|
|
|
1565
|
|
1228
|
|
|
|
|
|
|
} |
1229
|
|
|
|
|
|
|
else { |
1230
|
4
|
|
|
|
|
32
|
binmode(STDERR); |
1231
|
|
|
|
|
|
|
} |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
$encoding = ref $c |
1234
|
173
|
100
|
|
|
|
173778
|
? $c->{encoding} = $encoding |
1235
|
|
|
|
|
|
|
: $c->_encoding($encoding); |
1236
|
|
|
|
|
|
|
} else { |
1237
|
|
|
|
|
|
|
$encoding = ref $c && exists $c->{encoding} |
1238
|
|
|
|
|
|
|
? $c->{encoding} |
1239
|
4764
|
100
|
66
|
|
|
28972
|
: $c->_encoding; |
1240
|
|
|
|
|
|
|
} |
1241
|
|
|
|
|
|
|
|
1242
|
4937
|
|
|
|
|
55213
|
return $encoding; |
1243
|
|
|
|
|
|
|
} |
1244
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
=head2 $c->debug |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
Returns 1 if debug mode is enabled, 0 otherwise. |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
You can enable debug mode in several ways: |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
=over |
1252
|
|
|
|
|
|
|
|
1253
|
|
|
|
|
|
|
=item By calling myapp_server.pl with the -d flag |
1254
|
|
|
|
|
|
|
|
1255
|
|
|
|
|
|
|
=item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
=item The -Debug option in your MyApp.pm |
1258
|
|
|
|
|
|
|
|
1259
|
|
|
|
|
|
|
=item By declaring C<sub debug { 1 }> in your MyApp.pm. |
1260
|
|
|
|
|
|
|
|
1261
|
|
|
|
|
|
|
=back |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
The first three also set the log level to 'debug'. |
1264
|
|
|
|
|
|
|
|
1265
|
|
|
|
|
|
|
Calling C<< $c->debug(1) >> has no effect. |
1266
|
|
|
|
|
|
|
|
1267
|
|
|
|
|
|
|
=cut |
1268
|
|
|
|
|
|
|
|
1269
|
7259
|
|
|
7259
|
1
|
131426
|
sub debug { 0 } |
1270
|
|
|
|
|
|
|
|
1271
|
|
|
|
|
|
|
=head2 $c->dispatcher |
1272
|
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
Returns the dispatcher instance. See L<Catalyst::Dispatcher>. |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
=head2 $c->engine |
1276
|
|
|
|
|
|
|
|
1277
|
|
|
|
|
|
|
Returns the engine instance. See L<Catalyst::Engine>. |
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
=head2 UTILITY METHODS |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
=head2 $c->path_to(@path) |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
Merges C<@path> with C<< $c->config->{home} >> and returns a |
1285
|
|
|
|
|
|
|
L<Path::Class::Dir> object. Note you can usually use this object as |
1286
|
|
|
|
|
|
|
a filename, but sometimes you will have to explicitly stringify it |
1287
|
|
|
|
|
|
|
yourself by calling the C<< ->stringify >> method. |
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
For example: |
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
$c->path_to( 'db', 'sqlite.db' ); |
1292
|
|
|
|
|
|
|
|
1293
|
|
|
|
|
|
|
=cut |
1294
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
sub path_to { |
1296
|
18
|
|
|
18
|
1
|
16853
|
my ( $c, @path ) = @_; |
1297
|
18
|
|
|
|
|
118
|
my $path = Path::Class::Dir->new( $c->config->{home}, @path ); |
1298
|
18
|
100
|
|
|
|
1446
|
if ( -d $path ) { return $path } |
|
7
|
|
|
|
|
397
|
|
1299
|
11
|
|
|
|
|
674
|
else { return Path::Class::File->new( $c->config->{home}, @path ) } |
1300
|
|
|
|
|
|
|
} |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
sub plugin { |
1303
|
1
|
|
|
1
|
0
|
386
|
my ( $class, $name, $plugin, @args ) = @_; |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
# See block comment in t/unit_core_plugin.t |
1306
|
1
|
|
|
|
|
5
|
$class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in a future release/); |
1307
|
|
|
|
|
|
|
|
1308
|
1
|
|
|
|
|
14
|
$class->_register_plugin( $plugin, 1 ); |
1309
|
|
|
|
|
|
|
|
1310
|
1
|
|
|
|
|
3
|
eval { $plugin->import }; |
|
1
|
|
|
|
|
7
|
|
1311
|
1
|
|
|
|
|
7
|
$class->mk_classdata($name); |
1312
|
1
|
|
|
|
|
2
|
my $obj; |
1313
|
1
|
|
|
|
|
2
|
eval { $obj = $plugin->new(@args) }; |
|
1
|
|
|
|
|
5
|
|
1314
|
|
|
|
|
|
|
|
1315
|
1
|
50
|
|
|
|
18
|
if ($@) { |
1316
|
0
|
|
|
|
|
0
|
Catalyst::Exception->throw( message => |
1317
|
|
|
|
|
|
|
qq/Couldn't instantiate instant plugin "$plugin", "$@"/ ); |
1318
|
|
|
|
|
|
|
} |
1319
|
|
|
|
|
|
|
|
1320
|
1
|
|
|
|
|
6
|
$class->$name($obj); |
1321
|
1
|
50
|
|
|
|
3
|
$class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/) |
1322
|
|
|
|
|
|
|
if $class->debug; |
1323
|
|
|
|
|
|
|
} |
1324
|
|
|
|
|
|
|
|
1325
|
|
|
|
|
|
|
=head2 MyApp->setup |
1326
|
|
|
|
|
|
|
|
1327
|
|
|
|
|
|
|
Initializes the dispatcher and engine, loads any plugins, and loads the |
1328
|
|
|
|
|
|
|
model, view, and controller components. You may also specify an array |
1329
|
|
|
|
|
|
|
of plugins to load here, if you choose to not load them in the C<use |
1330
|
|
|
|
|
|
|
Catalyst> line. |
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
MyApp->setup; |
1333
|
|
|
|
|
|
|
MyApp->setup( qw/-Debug/ ); |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
B<Note:> You B<should not> wrap this method with method modifiers |
1336
|
|
|
|
|
|
|
or bad things will happen - wrap the C<setup_finalize> method instead. |
1337
|
|
|
|
|
|
|
|
1338
|
|
|
|
|
|
|
B<Note:> You can create a custom setup stage that will execute when the |
1339
|
|
|
|
|
|
|
application is starting. Use this to customize setup. |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
MyApp->setup(-Custom=value); |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
sub setup_custom { |
1344
|
|
|
|
|
|
|
my ($class, $value) = @_; |
1345
|
|
|
|
|
|
|
} |
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
Can be handy if you want to hook into the setup phase. |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
=cut |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
sub setup { |
1352
|
164
|
|
|
164
|
1
|
241919
|
my ( $class, @arguments ) = @_; |
1353
|
164
|
50
|
|
|
|
1074
|
croak('Running setup more than once') |
1354
|
|
|
|
|
|
|
if ( $class->setup_finished ); |
1355
|
|
|
|
|
|
|
|
1356
|
164
|
50
|
|
|
|
1806
|
unless ( $class->isa('Catalyst') ) { |
1357
|
|
|
|
|
|
|
|
1358
|
0
|
|
|
|
|
0
|
Catalyst::Exception->throw( |
1359
|
|
|
|
|
|
|
message => qq/'$class' does not inherit from Catalyst/ ); |
1360
|
|
|
|
|
|
|
} |
1361
|
|
|
|
|
|
|
|
1362
|
164
|
100
|
|
|
|
1024
|
if ( $class->arguments ) { |
1363
|
158
|
|
|
|
|
770
|
@arguments = ( @arguments, @{ $class->arguments } ); |
|
158
|
|
|
|
|
762
|
|
1364
|
|
|
|
|
|
|
} |
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
# Process options |
1367
|
164
|
|
|
|
|
784
|
my $flags = {}; |
1368
|
|
|
|
|
|
|
|
1369
|
164
|
|
|
|
|
756
|
foreach (@arguments) { |
1370
|
|
|
|
|
|
|
|
1371
|
655
|
100
|
|
|
|
1832
|
if (/^-Debug$/) { |
|
|
100
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
$flags->{log} = |
1373
|
3
|
50
|
|
|
|
21
|
( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug'; |
1374
|
|
|
|
|
|
|
} |
1375
|
|
|
|
|
|
|
elsif (/^-(\w+)=?(.*)$/) { |
1376
|
9
|
|
|
|
|
78
|
$flags->{ lc $1 } = $2; |
1377
|
|
|
|
|
|
|
} |
1378
|
|
|
|
|
|
|
else { |
1379
|
643
|
|
|
|
|
957
|
push @{ $flags->{plugins} }, $_; |
|
643
|
|
|
|
|
1538
|
|
1380
|
|
|
|
|
|
|
} |
1381
|
|
|
|
|
|
|
} |
1382
|
|
|
|
|
|
|
|
1383
|
164
|
|
|
|
|
1392
|
$class->setup_home( delete $flags->{home} ); |
1384
|
|
|
|
|
|
|
|
1385
|
164
|
|
|
|
|
2450
|
$class->setup_log( delete $flags->{log} ); |
1386
|
164
|
|
|
|
|
1928
|
$class->setup_plugins( delete $flags->{plugins} ); |
1387
|
|
|
|
|
|
|
|
1388
|
164
|
|
|
|
|
518456
|
$class->setup_data_handlers(); |
1389
|
164
|
|
|
|
|
1611
|
$class->setup_dispatcher( delete $flags->{dispatcher} ); |
1390
|
164
|
50
|
|
|
|
51794
|
if (my $engine = delete $flags->{engine}) { |
1391
|
0
|
|
|
|
|
0
|
$class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading"); |
1392
|
|
|
|
|
|
|
} |
1393
|
164
|
|
|
|
|
1967
|
$class->setup_engine(); |
1394
|
164
|
|
|
|
|
1983
|
$class->setup_stats( delete $flags->{stats} ); |
1395
|
|
|
|
|
|
|
|
1396
|
164
|
|
|
|
|
551
|
for my $flag ( sort keys %{$flags} ) { |
|
164
|
|
|
|
|
1072
|
|
1397
|
|
|
|
|
|
|
|
1398
|
0
|
0
|
|
|
|
0
|
if ( my $code = $class->can( 'setup_' . $flag ) ) { |
1399
|
0
|
|
|
|
|
0
|
&$code( $class, delete $flags->{$flag} ); |
1400
|
|
|
|
|
|
|
} |
1401
|
|
|
|
|
|
|
else { |
1402
|
0
|
|
|
|
|
0
|
$class->log->warn(qq/Unknown flag "$flag"/); |
1403
|
|
|
|
|
|
|
} |
1404
|
|
|
|
|
|
|
} |
1405
|
|
|
|
|
|
|
|
1406
|
164
|
|
|
|
|
542
|
eval { require Catalyst::Devel; }; |
|
164
|
|
|
|
|
28362
|
|
1407
|
164
|
0
|
33
|
|
|
6637
|
if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) { |
|
|
|
0
|
|
|
|
|
1408
|
0
|
|
|
|
|
0
|
$class->log->warn(<<"EOF"); |
1409
|
|
|
|
|
|
|
You are running an old script! |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
Please update by running (this will overwrite existing files): |
1412
|
|
|
|
|
|
|
catalyst.pl -force -scripts $class |
1413
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
or (this will not overwrite existing files): |
1415
|
|
|
|
|
|
|
catalyst.pl -scripts $class |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
EOF |
1418
|
|
|
|
|
|
|
} |
1419
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
# Call plugins setup, this is stupid and evil. |
1421
|
|
|
|
|
|
|
# Also screws C3 badly on 5.10, hack to avoid. |
1422
|
|
|
|
|
|
|
{ |
1423
|
165
|
|
|
165
|
|
1689
|
no warnings qw/redefine/; |
|
165
|
|
|
|
|
634
|
|
|
165
|
|
|
|
|
505926
|
|
|
164
|
|
|
|
|
579
|
|
1424
|
164
|
|
|
164
|
|
2277
|
local *setup = sub { }; |
1425
|
164
|
50
|
|
|
|
2000
|
$class->setup unless $Catalyst::__AM_RESTARTING; |
1426
|
|
|
|
|
|
|
} |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
# If you are expecting configuration info as part of your setup, it needs |
1429
|
|
|
|
|
|
|
# to get called here and below, since we need the above line to support |
1430
|
|
|
|
|
|
|
# ConfigLoader based configs. |
1431
|
|
|
|
|
|
|
|
1432
|
164
|
|
|
|
|
1789
|
$class->setup_encoding(); |
1433
|
164
|
|
|
|
|
1877
|
$class->setup_middleware(); |
1434
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
# Initialize our data structure |
1436
|
164
|
|
|
|
|
2293
|
$class->components( {} ); |
1437
|
|
|
|
|
|
|
|
1438
|
164
|
|
|
|
|
1810
|
$class->setup_components; |
1439
|
|
|
|
|
|
|
|
1440
|
164
|
100
|
|
|
|
3112
|
if ( $class->debug ) { |
1441
|
7
|
|
0
|
|
|
81
|
my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins; |
|
0
|
|
|
|
|
0
|
|
1442
|
|
|
|
|
|
|
|
1443
|
7
|
50
|
|
|
|
42
|
if (@plugins) { |
1444
|
0
|
|
|
|
|
0
|
my $column_width = Catalyst::Utils::term_width() - 6; |
1445
|
0
|
|
|
|
|
0
|
my $t = Text::SimpleTable->new($column_width); |
1446
|
0
|
|
|
|
|
0
|
$t->row($_) for @plugins; |
1447
|
0
|
|
|
|
|
0
|
$class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" ); |
1448
|
|
|
|
|
|
|
} |
1449
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
my @middleware = map { |
1451
|
7
|
50
|
50
|
|
|
78
|
ref $_ eq 'CODE' ? |
|
49
|
|
|
|
|
786
|
|
1452
|
|
|
|
|
|
|
"Inline Coderef" : |
1453
|
|
|
|
|
|
|
(ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '') |
1454
|
|
|
|
|
|
|
|| '') } $class->registered_middlewares; |
1455
|
|
|
|
|
|
|
|
1456
|
7
|
50
|
|
|
|
217
|
if (@middleware) { |
1457
|
7
|
|
|
|
|
62
|
my $column_width = Catalyst::Utils::term_width() - 6; |
1458
|
7
|
|
|
|
|
100
|
my $t = Text::SimpleTable->new($column_width); |
1459
|
7
|
|
|
|
|
414
|
$t->row($_) for @middleware; |
1460
|
7
|
|
|
|
|
2712
|
$class->log->debug( "Loaded PSGI Middleware:\n" . $t->draw . "\n" ); |
1461
|
|
|
|
|
|
|
} |
1462
|
|
|
|
|
|
|
|
1463
|
7
|
|
|
|
|
285
|
my %dh = $class->registered_data_handlers; |
1464
|
7
|
50
|
|
|
|
55
|
if (my @data_handlers = keys %dh) { |
1465
|
7
|
|
|
|
|
35
|
my $column_width = Catalyst::Utils::term_width() - 6; |
1466
|
7
|
|
|
|
|
51
|
my $t = Text::SimpleTable->new($column_width); |
1467
|
7
|
|
|
|
|
295
|
$t->row($_) for @data_handlers; |
1468
|
7
|
|
|
|
|
788
|
$class->log->debug( "Loaded Request Data Handlers:\n" . $t->draw . "\n" ); |
1469
|
|
|
|
|
|
|
} |
1470
|
|
|
|
|
|
|
|
1471
|
7
|
|
|
|
|
149
|
my $dispatcher = $class->dispatcher; |
1472
|
7
|
|
|
|
|
64
|
my $engine = $class->engine; |
1473
|
7
|
|
|
|
|
53
|
my $home = $class->config->{home}; |
1474
|
|
|
|
|
|
|
|
1475
|
7
|
|
|
|
|
42
|
$class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher))); |
1476
|
7
|
|
|
|
|
56
|
$class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine))); |
1477
|
|
|
|
|
|
|
|
1478
|
7
|
50
|
|
|
|
125
|
$home |
|
|
100
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
? ( -d $home ) |
1480
|
|
|
|
|
|
|
? $class->log->debug(qq/Found home "$home"/) |
1481
|
|
|
|
|
|
|
: $class->log->debug(qq/Home "$home" doesn't exist/) |
1482
|
|
|
|
|
|
|
: $class->log->debug(q/Couldn't find home/); |
1483
|
|
|
|
|
|
|
|
1484
|
7
|
|
|
|
|
36
|
my $column_width = Catalyst::Utils::term_width() - 8 - 9; |
1485
|
|
|
|
|
|
|
|
1486
|
7
|
|
|
|
|
68
|
my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] ); |
1487
|
7
|
|
|
|
|
725
|
for my $comp ( sort keys %{ $class->components } ) { |
|
7
|
|
|
|
|
36
|
|
1488
|
5
|
50
|
|
|
|
28
|
my $type = ref $class->components->{$comp} ? 'instance' : 'class'; |
1489
|
5
|
|
|
|
|
30
|
$t->row( $comp, $type ); |
1490
|
|
|
|
|
|
|
} |
1491
|
|
|
|
|
|
|
$class->log->debug( "Loaded components:\n" . $t->draw . "\n" ) |
1492
|
7
|
100
|
|
|
|
516
|
if ( keys %{ $class->components } ); |
|
7
|
|
|
|
|
31
|
|
1493
|
|
|
|
|
|
|
} |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
# Add our self to components, since we are also a component |
1496
|
164
|
100
|
|
|
|
1415
|
if( $class->isa('Catalyst::Controller') ){ |
1497
|
144
|
|
|
|
|
852
|
$class->components->{$class} = $class; |
1498
|
|
|
|
|
|
|
} |
1499
|
|
|
|
|
|
|
|
1500
|
164
|
|
|
|
|
2394
|
$class->setup_actions; |
1501
|
|
|
|
|
|
|
|
1502
|
163
|
100
|
|
|
|
842
|
if ( $class->debug ) { |
1503
|
7
|
|
100
|
|
|
55
|
my $name = $class->config->{name} || 'Application'; |
1504
|
7
|
|
|
|
|
36
|
$class->log->info("$name powered by Catalyst $Catalyst::VERSION"); |
1505
|
|
|
|
|
|
|
} |
1506
|
|
|
|
|
|
|
|
1507
|
163
|
50
|
|
|
|
1099
|
if ($class->config->{case_sensitive}) { |
1508
|
0
|
|
|
|
|
0
|
$class->log->warn($class . "->config->{case_sensitive} is set."); |
1509
|
0
|
|
|
|
|
0
|
$class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81."); |
1510
|
|
|
|
|
|
|
} |
1511
|
|
|
|
|
|
|
|
1512
|
|
|
|
|
|
|
# call these so we pre setup the composed classes |
1513
|
163
|
|
|
|
|
3690
|
$class->composed_request_class; |
1514
|
163
|
|
|
|
|
1910
|
$class->composed_response_class; |
1515
|
163
|
|
|
|
|
2326
|
$class->composed_stats_class; |
1516
|
|
|
|
|
|
|
|
1517
|
163
|
|
|
|
|
2016
|
$class->setup_finalize; |
1518
|
|
|
|
|
|
|
|
1519
|
|
|
|
|
|
|
# Flush the log for good measure (in case something turned off 'autoflush' early) |
1520
|
163
|
100
|
|
|
|
1640
|
$class->log->_flush() if $class->log->can('_flush'); |
1521
|
|
|
|
|
|
|
|
1522
|
163
|
|
50
|
|
|
2007
|
return $class || 1; # Just in case someone named their Application 0... |
1523
|
|
|
|
|
|
|
} |
1524
|
|
|
|
|
|
|
|
1525
|
|
|
|
|
|
|
=head2 $app->setup_finalize |
1526
|
|
|
|
|
|
|
|
1527
|
|
|
|
|
|
|
A hook to attach modifiers to. This method does not do anything except set the |
1528
|
|
|
|
|
|
|
C<setup_finished> accessor. |
1529
|
|
|
|
|
|
|
|
1530
|
|
|
|
|
|
|
Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup. |
1531
|
|
|
|
|
|
|
|
1532
|
|
|
|
|
|
|
Example: |
1533
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
after setup_finalize => sub { |
1535
|
|
|
|
|
|
|
my $app = shift; |
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
## do stuff here.. |
1538
|
|
|
|
|
|
|
}; |
1539
|
|
|
|
|
|
|
|
1540
|
|
|
|
|
|
|
=cut |
1541
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
sub setup_finalize { |
1543
|
163
|
|
|
163
|
1
|
3360
|
my ($class) = @_; |
1544
|
163
|
|
|
|
|
1555
|
$class->setup_finished(1); |
1545
|
|
|
|
|
|
|
} |
1546
|
|
|
|
|
|
|
|
1547
|
|
|
|
|
|
|
=head2 $c->uri_for( $path?, @args?, \%query_values?, \$fragment? ) |
1548
|
|
|
|
|
|
|
|
1549
|
|
|
|
|
|
|
=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values?, \$fragment? ) |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
=head2 $c->uri_for( $action, [@captures, @args], \%query_values?, \$fragment? ) |
1552
|
|
|
|
|
|
|
|
1553
|
|
|
|
|
|
|
Constructs an absolute L<URI> object based on the application root, the |
1554
|
|
|
|
|
|
|
provided path, and the additional arguments and query parameters provided. |
1555
|
|
|
|
|
|
|
When used as a string, provides a textual URI. If you need more flexibility |
1556
|
|
|
|
|
|
|
than this (i.e. the option to provide relative URIs etc.) see |
1557
|
|
|
|
|
|
|
L<Catalyst::Plugin::SmartURI>. |
1558
|
|
|
|
|
|
|
|
1559
|
|
|
|
|
|
|
If no arguments are provided, the URI for the current action is returned. |
1560
|
|
|
|
|
|
|
To return the current action and also provide @args, use |
1561
|
|
|
|
|
|
|
C<< $c->uri_for( $c->action, @args ) >>. |
1562
|
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
If the first argument is a string, it is taken as a public URI path relative |
1564
|
|
|
|
|
|
|
to C<< $c->namespace >> (if it doesn't begin with a forward slash) or |
1565
|
|
|
|
|
|
|
relative to the application root (if it does). It is then merged with |
1566
|
|
|
|
|
|
|
C<< $c->request->base >>; any C<@args> are appended as additional path |
1567
|
|
|
|
|
|
|
components; and any C<%query_values> are appended as C<?foo=bar> parameters. |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
B<NOTE> If you are using this 'stringy' first argument, we skip encoding and |
1570
|
|
|
|
|
|
|
allow you to declare something like: |
1571
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
$c->uri_for('/foo/bar#baz') |
1573
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
Where 'baz' is a URI fragment. We consider this first argument string to be |
1575
|
|
|
|
|
|
|
'expert' mode where you are expected to create a valid URL and we for the most |
1576
|
|
|
|
|
|
|
part just pass it through without a lot of internal effort to escape and encode. |
1577
|
|
|
|
|
|
|
|
1578
|
|
|
|
|
|
|
If the first argument is a L<Catalyst::Action> it represents an action which |
1579
|
|
|
|
|
|
|
will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The |
1580
|
|
|
|
|
|
|
optional C<\@captures> argument (an arrayref) allows passing the captured |
1581
|
|
|
|
|
|
|
variables that are needed to fill in the paths of Chained and Regex actions; |
1582
|
|
|
|
|
|
|
once the path is resolved, C<uri_for> continues as though a path was |
1583
|
|
|
|
|
|
|
provided, appending any arguments or parameters and creating an absolute |
1584
|
|
|
|
|
|
|
URI. |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
The captures for the current request can be found in |
1587
|
|
|
|
|
|
|
C<< $c->request->captures >>, and actions can be resolved using |
1588
|
|
|
|
|
|
|
C<< Catalyst::Controller->action_for($name) >>. If you have a private action |
1589
|
|
|
|
|
|
|
path, use C<< $c->uri_for_action >> instead. |
1590
|
|
|
|
|
|
|
|
1591
|
|
|
|
|
|
|
# Equivalent to $c->req->uri |
1592
|
|
|
|
|
|
|
$c->uri_for($c->action, $c->req->captures, |
1593
|
|
|
|
|
|
|
@{ $c->req->args }, $c->req->params); |
1594
|
|
|
|
|
|
|
|
1595
|
|
|
|
|
|
|
# For the Foo action in the Bar controller |
1596
|
|
|
|
|
|
|
$c->uri_for($c->controller('Bar')->action_for('Foo')); |
1597
|
|
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
# Path to a static resource |
1599
|
|
|
|
|
|
|
$c->uri_for('/static/images/logo.png'); |
1600
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
In general the scheme of the generated URI object will follow the incoming request |
1602
|
|
|
|
|
|
|
however if your targeted action or action chain has the Scheme attribute it will |
1603
|
|
|
|
|
|
|
use that instead. |
1604
|
|
|
|
|
|
|
|
1605
|
|
|
|
|
|
|
Also, if the targeted Action or Action chain declares Args/CaptureArgs that have |
1606
|
|
|
|
|
|
|
type constraints, we will require that your proposed URL verify on those declared |
1607
|
|
|
|
|
|
|
constraints. |
1608
|
|
|
|
|
|
|
|
1609
|
|
|
|
|
|
|
=cut |
1610
|
|
|
|
|
|
|
|
1611
|
|
|
|
|
|
|
sub uri_for { |
1612
|
122
|
|
|
122
|
1
|
27404
|
my ( $c, $path, @args ) = @_; |
1613
|
|
|
|
|
|
|
|
1614
|
122
|
100
|
|
|
|
459
|
if ( $path->$_isa('Catalyst::Controller') ) { |
1615
|
1
|
|
|
|
|
42
|
$path = $path->path_prefix; |
1616
|
1
|
|
|
|
|
4
|
$path =~ s{/+\z}{}; |
1617
|
1
|
|
|
|
|
3
|
$path .= '/'; |
1618
|
|
|
|
|
|
|
} |
1619
|
|
|
|
|
|
|
|
1620
|
122
|
100
|
100
|
|
|
2588
|
my $fragment = ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? ${pop @args} : undef ); |
|
2
|
|
|
|
|
8
|
|
1621
|
|
|
|
|
|
|
|
1622
|
122
|
100
|
|
|
|
467
|
unless(blessed $path) { |
1623
|
47
|
100
|
100
|
|
|
274
|
if (defined($path) and $path =~ s/#(.+)$//) { |
1624
|
5
|
50
|
33
|
|
|
34
|
if(defined($1) and defined $fragment) { |
1625
|
0
|
|
|
|
|
0
|
carp "Abiguious fragment declaration: You cannot define a fragment in '$path' and as an argument '$fragment'"; |
1626
|
|
|
|
|
|
|
} |
1627
|
5
|
50
|
|
|
|
12
|
if(defined($1)) { |
1628
|
5
|
|
|
|
|
10
|
$fragment = $1; |
1629
|
|
|
|
|
|
|
} |
1630
|
|
|
|
|
|
|
} |
1631
|
|
|
|
|
|
|
} |
1632
|
|
|
|
|
|
|
|
1633
|
122
|
100
|
100
|
|
|
620
|
my $params = |
1634
|
|
|
|
|
|
|
( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); |
1635
|
|
|
|
|
|
|
|
1636
|
122
|
100
|
100
|
|
|
683
|
undef($path) if (defined $path && $path eq ''); |
1637
|
|
|
|
|
|
|
|
1638
|
122
|
50
|
|
|
|
345
|
carp "uri_for called with undef argument" if grep { ! defined $_ } @args; |
|
127
|
|
|
|
|
339
|
|
1639
|
|
|
|
|
|
|
|
1640
|
122
|
100
|
|
|
|
346
|
my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef; |
1641
|
122
|
100
|
|
|
|
1517
|
if ( $path->$_isa('Catalyst::Action') ) { # action object |
1642
|
73
|
|
|
|
|
1082
|
s|/|%2F|g for @args; |
1643
|
123
|
|
|
|
|
234
|
my $captures = [ map { s|/|%2F|g; $_; } |
|
123
|
|
|
|
|
279
|
|
1644
|
|
|
|
|
|
|
( scalar @args && ref $args[0] eq 'ARRAY' |
1645
|
73
|
100
|
100
|
|
|
364
|
? @{ shift(@args) } |
|
53
|
|
|
|
|
130
|
|
1646
|
|
|
|
|
|
|
: ()) ]; |
1647
|
|
|
|
|
|
|
|
1648
|
73
|
|
|
|
|
162
|
my $action = $path; |
1649
|
73
|
|
|
|
|
279
|
my $expanded_action = $c->dispatcher->expand_action( $action ); |
1650
|
73
|
|
|
|
|
905
|
my $num_captures = $expanded_action->number_of_captures; |
1651
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
# ->uri_for( $action, \@captures_and_args, \%query_values? ) |
1653
|
73
|
100
|
100
|
|
|
1467
|
if( !@args && $action->number_of_args && @$captures > $num_captures ) { |
|
|
|
100
|
|
|
|
|
1654
|
22
|
|
|
|
|
75
|
unshift @args, splice @$captures, $num_captures; |
1655
|
|
|
|
|
|
|
} |
1656
|
|
|
|
|
|
|
|
1657
|
73
|
100
|
|
|
|
226
|
if($num_captures) { |
1658
|
47
|
100
|
|
|
|
154
|
unless($expanded_action->match_captures_constraints($c, $captures)) { |
1659
|
3
|
50
|
|
|
|
113
|
$c->log->debug("captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'") |
|
0
|
|
|
|
|
0
|
|
1660
|
|
|
|
|
|
|
if $c->debug; |
1661
|
3
|
|
|
|
|
101
|
return undef; |
1662
|
|
|
|
|
|
|
} |
1663
|
|
|
|
|
|
|
} |
1664
|
|
|
|
|
|
|
|
1665
|
70
|
|
|
|
|
282
|
$path = $c->dispatcher->uri_for_action($action, $captures); |
1666
|
70
|
100
|
|
|
|
378
|
if (not defined $path) { |
1667
|
3
|
50
|
|
|
|
16
|
$c->log->debug(qq/Can't find uri_for action '$action' @$captures/) |
1668
|
|
|
|
|
|
|
if $c->debug; |
1669
|
3
|
|
|
|
|
71
|
return undef; |
1670
|
|
|
|
|
|
|
} |
1671
|
67
|
50
|
|
|
|
232
|
$path = '/' if $path eq ''; |
1672
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
# At this point @encoded_args is the remaining Args (all captures removed). |
1674
|
67
|
100
|
|
|
|
2916
|
if($expanded_action->has_args_constraints) { |
1675
|
10
|
100
|
|
|
|
42
|
unless($expanded_action->match_args($c,\@args)) { |
1676
|
3
|
50
|
|
|
|
72
|
$c->log->debug("args [@args] do not match the type constraints in action '$expanded_action'") |
1677
|
|
|
|
|
|
|
if $c->debug; |
1678
|
3
|
|
|
|
|
50
|
return undef; |
1679
|
|
|
|
|
|
|
} |
1680
|
|
|
|
|
|
|
} |
1681
|
|
|
|
|
|
|
} |
1682
|
|
|
|
|
|
|
|
1683
|
113
|
|
|
|
|
633
|
unshift(@args, $path); |
1684
|
|
|
|
|
|
|
|
1685
|
113
|
100
|
100
|
|
|
781
|
unless (defined $path && $path =~ s!^/!!) { # in-place strip |
1686
|
18
|
|
|
|
|
595
|
my $namespace = $c->namespace; |
1687
|
18
|
100
|
|
|
|
43
|
if (defined $path) { # cheesy hack to handle path '../foo' |
1688
|
16
|
|
|
|
|
60
|
$namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{}; |
1689
|
|
|
|
|
|
|
} |
1690
|
18
|
|
100
|
|
|
85
|
unshift(@args, $namespace || ''); |
1691
|
|
|
|
|
|
|
} |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
# join args with '/', or a blank string |
1694
|
113
|
|
|
|
|
576
|
my $args = join('/', grep { defined($_) } @args); |
|
226
|
|
|
|
|
628
|
|
1695
|
113
|
|
|
|
|
369
|
$args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE |
1696
|
113
|
|
|
|
|
448
|
$args =~ s!^/+!!; |
1697
|
|
|
|
|
|
|
|
1698
|
113
|
|
|
|
|
315
|
my ($base, $class) = ('/', 'URI::_generic'); |
1699
|
113
|
100
|
|
|
|
460
|
if(blessed($c)) { |
1700
|
104
|
|
|
|
|
349
|
$base = $c->req->base; |
1701
|
104
|
100
|
|
|
|
385
|
if($target_action) { |
1702
|
61
|
|
|
|
|
241
|
$target_action = $c->dispatcher->expand_action($target_action); |
1703
|
61
|
100
|
|
|
|
365
|
if(my $s = $target_action->scheme) { |
1704
|
3
|
|
|
|
|
9
|
$s = lc($s); |
1705
|
3
|
|
|
|
|
8
|
$class = "URI::$s"; |
1706
|
3
|
|
|
|
|
10
|
$base->scheme($s); |
1707
|
|
|
|
|
|
|
} else { |
1708
|
58
|
|
|
|
|
192
|
$class = ref($base); |
1709
|
|
|
|
|
|
|
} |
1710
|
|
|
|
|
|
|
} else { |
1711
|
43
|
|
|
|
|
97
|
$class = ref($base); |
1712
|
|
|
|
|
|
|
} |
1713
|
|
|
|
|
|
|
|
1714
|
104
|
|
|
|
|
996
|
$base =~ s{(?<!/)$}{/}; |
1715
|
|
|
|
|
|
|
} |
1716
|
|
|
|
|
|
|
|
1717
|
113
|
|
|
|
|
1073
|
my $query = ''; |
1718
|
113
|
100
|
|
|
|
472
|
if (my @keys = keys %$params) { |
1719
|
|
|
|
|
|
|
# somewhat lifted from URI::_query's query_form |
1720
|
|
|
|
|
|
|
$query = '?'.join('&', map { |
1721
|
34
|
|
|
|
|
92
|
my $val = $params->{$_}; |
|
37
|
|
|
|
|
81
|
|
1722
|
37
|
|
|
|
|
135
|
my $key = encode_utf8($_); |
1723
|
|
|
|
|
|
|
# using the URI::Escape pattern here so utf8 chars survive |
1724
|
37
|
|
|
|
|
143
|
$key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; |
1725
|
37
|
|
|
|
|
76
|
$key =~ s/ /+/g; |
1726
|
|
|
|
|
|
|
|
1727
|
37
|
100
|
|
|
|
89
|
$val = '' unless defined $val; |
1728
|
|
|
|
|
|
|
(map { |
1729
|
37
|
100
|
|
|
|
116
|
my $param = encode_utf8($_); |
|
38
|
|
|
|
|
99
|
|
1730
|
|
|
|
|
|
|
# using the URI::Escape pattern here so utf8 chars survive |
1731
|
38
|
|
|
|
|
203
|
$param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; |
1732
|
38
|
|
|
|
|
84
|
$param =~ s/ /+/g; |
1733
|
|
|
|
|
|
|
|
1734
|
38
|
|
|
|
|
174
|
"${key}=$param"; |
1735
|
|
|
|
|
|
|
} ( ref $val eq 'ARRAY' ? @$val : $val )); |
1736
|
|
|
|
|
|
|
} @keys); |
1737
|
|
|
|
|
|
|
} |
1738
|
|
|
|
|
|
|
|
1739
|
113
|
|
|
|
|
454
|
$base = encode_utf8 $base; |
1740
|
113
|
|
|
|
|
922
|
$base =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; |
1741
|
113
|
|
|
|
|
352
|
$args = encode_utf8 $args; |
1742
|
113
|
|
|
|
|
579
|
$args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; |
1743
|
|
|
|
|
|
|
|
1744
|
113
|
100
|
|
|
|
315
|
if(defined $fragment) { |
1745
|
7
|
100
|
|
|
|
45
|
if(blessed $path) { |
1746
|
1
|
|
|
|
|
6
|
$fragment = encode_utf8($fragment); |
1747
|
1
|
|
|
|
|
4
|
$fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; |
1748
|
1
|
|
|
|
|
4
|
$fragment =~ s/ /+/g; |
1749
|
|
|
|
|
|
|
} |
1750
|
7
|
|
|
|
|
15
|
$query .= "#$fragment"; |
1751
|
|
|
|
|
|
|
} |
1752
|
|
|
|
|
|
|
|
1753
|
113
|
|
|
|
|
442
|
my $res = bless(\"${base}${args}${query}", $class); |
1754
|
113
|
|
|
|
|
1972
|
$res; |
1755
|
|
|
|
|
|
|
} |
1756
|
|
|
|
|
|
|
|
1757
|
|
|
|
|
|
|
=head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? ) |
1758
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
=head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? ) |
1760
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
=over |
1762
|
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
|
=item $path |
1764
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
A private path to the Catalyst action you want to create a URI for. |
1766
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path) |
1768
|
|
|
|
|
|
|
>> and passing the resulting C<$action> and the remaining arguments to C<< |
1769
|
|
|
|
|
|
|
$c->uri_for >>. |
1770
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
You can also pass in a Catalyst::Action object, in which case it is passed to |
1772
|
|
|
|
|
|
|
C<< $c->uri_for >>. |
1773
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
Note that although the path looks like a URI that dispatches to the wanted action, it is not a URI, but an internal path to that action. |
1775
|
|
|
|
|
|
|
|
1776
|
|
|
|
|
|
|
For example, if the action looks like: |
1777
|
|
|
|
|
|
|
|
1778
|
|
|
|
|
|
|
package MyApp::Controller::Users; |
1779
|
|
|
|
|
|
|
|
1780
|
|
|
|
|
|
|
sub lst : Path('the-list') {} |
1781
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
You can use: |
1783
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
$c->uri_for_action('/users/lst') |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
and it will create the URI /users/the-list. |
1787
|
|
|
|
|
|
|
|
1788
|
|
|
|
|
|
|
=item \@captures_and_args? |
1789
|
|
|
|
|
|
|
|
1790
|
|
|
|
|
|
|
Optional array reference of Captures (i.e. C<CaptureArgs> or C<< $c->req->captures >>) |
1791
|
|
|
|
|
|
|
and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained> |
1792
|
|
|
|
|
|
|
to interpolate all the parameters in the URI. |
1793
|
|
|
|
|
|
|
|
1794
|
|
|
|
|
|
|
=item @args? |
1795
|
|
|
|
|
|
|
|
1796
|
|
|
|
|
|
|
Optional list of extra arguments - can be supplied in the |
1797
|
|
|
|
|
|
|
C<< \@captures_and_args? >> array ref, or here - whichever is easier for your |
1798
|
|
|
|
|
|
|
code. |
1799
|
|
|
|
|
|
|
|
1800
|
|
|
|
|
|
|
Your action can have zero, a fixed or a variable number of args (e.g. |
1801
|
|
|
|
|
|
|
C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number).. |
1802
|
|
|
|
|
|
|
|
1803
|
|
|
|
|
|
|
=item \%query_values? |
1804
|
|
|
|
|
|
|
|
1805
|
|
|
|
|
|
|
Optional array reference of query parameters to append. E.g. |
1806
|
|
|
|
|
|
|
|
1807
|
|
|
|
|
|
|
{ foo => 'bar' } |
1808
|
|
|
|
|
|
|
|
1809
|
|
|
|
|
|
|
will generate |
1810
|
|
|
|
|
|
|
|
1811
|
|
|
|
|
|
|
/rest/of/your/uri?foo=bar |
1812
|
|
|
|
|
|
|
|
1813
|
|
|
|
|
|
|
=back |
1814
|
|
|
|
|
|
|
|
1815
|
|
|
|
|
|
|
=cut |
1816
|
|
|
|
|
|
|
|
1817
|
|
|
|
|
|
|
sub uri_for_action { |
1818
|
31
|
|
|
31
|
1
|
4298
|
my ( $c, $path, @args ) = @_; |
1819
|
31
|
100
|
|
|
|
174
|
my $action = blessed($path) |
1820
|
|
|
|
|
|
|
? $path |
1821
|
|
|
|
|
|
|
: $c->dispatcher->get_action_by_path($path); |
1822
|
31
|
100
|
|
|
|
99
|
unless (defined $action) { |
1823
|
1
|
|
|
|
|
218
|
croak "Can't find action for path '$path'"; |
1824
|
|
|
|
|
|
|
} |
1825
|
30
|
|
|
|
|
138
|
return $c->uri_for( $action, @args ); |
1826
|
|
|
|
|
|
|
} |
1827
|
|
|
|
|
|
|
|
1828
|
|
|
|
|
|
|
=head2 $c->welcome_message |
1829
|
|
|
|
|
|
|
|
1830
|
|
|
|
|
|
|
Returns the Catalyst welcome HTML page. |
1831
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
=cut |
1833
|
|
|
|
|
|
|
|
1834
|
|
|
|
|
|
|
sub welcome_message { |
1835
|
0
|
|
|
0
|
1
|
0
|
my $c = shift; |
1836
|
0
|
|
|
|
|
0
|
my $name = $c->config->{name}; |
1837
|
0
|
|
|
|
|
0
|
my $logo = $c->uri_for('/static/images/catalyst_logo.png'); |
1838
|
0
|
|
|
|
|
0
|
my $prefix = Catalyst::Utils::appprefix( ref $c ); |
1839
|
0
|
|
|
|
|
0
|
$c->response->content_type('text/html; charset=utf-8'); |
1840
|
0
|
|
|
|
|
0
|
return <<"EOF"; |
1841
|
|
|
|
|
|
|
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" |
1842
|
|
|
|
|
|
|
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> |
1843
|
|
|
|
|
|
|
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en"> |
1844
|
|
|
|
|
|
|
<head> |
1845
|
|
|
|
|
|
|
<meta http-equiv="Content-Language" content="en" /> |
1846
|
|
|
|
|
|
|
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> |
1847
|
|
|
|
|
|
|
<title>$name on Catalyst $VERSION</title> |
1848
|
|
|
|
|
|
|
<style type="text/css"> |
1849
|
|
|
|
|
|
|
body { |
1850
|
|
|
|
|
|
|
color: #000; |
1851
|
|
|
|
|
|
|
background-color: #eee; |
1852
|
|
|
|
|
|
|
} |
1853
|
|
|
|
|
|
|
div#content { |
1854
|
|
|
|
|
|
|
width: 640px; |
1855
|
|
|
|
|
|
|
margin-left: auto; |
1856
|
|
|
|
|
|
|
margin-right: auto; |
1857
|
|
|
|
|
|
|
margin-top: 10px; |
1858
|
|
|
|
|
|
|
margin-bottom: 10px; |
1859
|
|
|
|
|
|
|
text-align: left; |
1860
|
|
|
|
|
|
|
background-color: #ccc; |
1861
|
|
|
|
|
|
|
border: 1px solid #aaa; |
1862
|
|
|
|
|
|
|
} |
1863
|
|
|
|
|
|
|
p, h1, h2 { |
1864
|
|
|
|
|
|
|
margin-left: 20px; |
1865
|
|
|
|
|
|
|
margin-right: 20px; |
1866
|
|
|
|
|
|
|
font-family: verdana, tahoma, sans-serif; |
1867
|
|
|
|
|
|
|
} |
1868
|
|
|
|
|
|
|
a { |
1869
|
|
|
|
|
|
|
font-family: verdana, tahoma, sans-serif; |
1870
|
|
|
|
|
|
|
} |
1871
|
|
|
|
|
|
|
:link, :visited { |
1872
|
|
|
|
|
|
|
text-decoration: none; |
1873
|
|
|
|
|
|
|
color: #b00; |
1874
|
|
|
|
|
|
|
border-bottom: 1px dotted #bbb; |
1875
|
|
|
|
|
|
|
} |
1876
|
|
|
|
|
|
|
:link:hover, :visited:hover { |
1877
|
|
|
|
|
|
|
color: #555; |
1878
|
|
|
|
|
|
|
} |
1879
|
|
|
|
|
|
|
div#topbar { |
1880
|
|
|
|
|
|
|
margin: 0px; |
1881
|
|
|
|
|
|
|
} |
1882
|
|
|
|
|
|
|
pre { |
1883
|
|
|
|
|
|
|
margin: 10px; |
1884
|
|
|
|
|
|
|
padding: 8px; |
1885
|
|
|
|
|
|
|
} |
1886
|
|
|
|
|
|
|
div#answers { |
1887
|
|
|
|
|
|
|
padding: 8px; |
1888
|
|
|
|
|
|
|
margin: 10px; |
1889
|
|
|
|
|
|
|
background-color: #fff; |
1890
|
|
|
|
|
|
|
border: 1px solid #aaa; |
1891
|
|
|
|
|
|
|
} |
1892
|
|
|
|
|
|
|
h1 { |
1893
|
|
|
|
|
|
|
font-size: 0.9em; |
1894
|
|
|
|
|
|
|
font-weight: normal; |
1895
|
|
|
|
|
|
|
text-align: center; |
1896
|
|
|
|
|
|
|
} |
1897
|
|
|
|
|
|
|
h2 { |
1898
|
|
|
|
|
|
|
font-size: 1.0em; |
1899
|
|
|
|
|
|
|
} |
1900
|
|
|
|
|
|
|
p { |
1901
|
|
|
|
|
|
|
font-size: 0.9em; |
1902
|
|
|
|
|
|
|
} |
1903
|
|
|
|
|
|
|
p img { |
1904
|
|
|
|
|
|
|
float: right; |
1905
|
|
|
|
|
|
|
margin-left: 10px; |
1906
|
|
|
|
|
|
|
} |
1907
|
|
|
|
|
|
|
span#appname { |
1908
|
|
|
|
|
|
|
font-weight: bold; |
1909
|
|
|
|
|
|
|
font-size: 1.6em; |
1910
|
|
|
|
|
|
|
} |
1911
|
|
|
|
|
|
|
</style> |
1912
|
|
|
|
|
|
|
</head> |
1913
|
|
|
|
|
|
|
<body> |
1914
|
|
|
|
|
|
|
<div id="content"> |
1915
|
|
|
|
|
|
|
<div id="topbar"> |
1916
|
|
|
|
|
|
|
<h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a> |
1917
|
|
|
|
|
|
|
$VERSION</h1> |
1918
|
|
|
|
|
|
|
</div> |
1919
|
|
|
|
|
|
|
<div id="answers"> |
1920
|
|
|
|
|
|
|
<p> |
1921
|
|
|
|
|
|
|
<img src="$logo" alt="Catalyst Logo" /> |
1922
|
|
|
|
|
|
|
</p> |
1923
|
|
|
|
|
|
|
<p>Welcome to the world of Catalyst. |
1924
|
|
|
|
|
|
|
This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a> |
1925
|
|
|
|
|
|
|
framework will make web development something you had |
1926
|
|
|
|
|
|
|
never expected it to be: Fun, rewarding, and quick.</p> |
1927
|
|
|
|
|
|
|
<h2>What to do now?</h2> |
1928
|
|
|
|
|
|
|
<p>That really depends on what <b>you</b> want to do. |
1929
|
|
|
|
|
|
|
We do, however, provide you with a few starting points.</p> |
1930
|
|
|
|
|
|
|
<p>If you want to jump right into web development with Catalyst |
1931
|
|
|
|
|
|
|
you might want to start with a tutorial.</p> |
1932
|
|
|
|
|
|
|
<pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code> |
1933
|
|
|
|
|
|
|
</pre> |
1934
|
|
|
|
|
|
|
<p>Afterwards you can go on to check out a more complete look at our features.</p> |
1935
|
|
|
|
|
|
|
<pre> |
1936
|
|
|
|
|
|
|
<code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a> |
1937
|
|
|
|
|
|
|
<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful --> |
1938
|
|
|
|
|
|
|
</code></pre> |
1939
|
|
|
|
|
|
|
<h2>What to do next?</h2> |
1940
|
|
|
|
|
|
|
<p>Next it's time to write an actual application. Use the |
1941
|
|
|
|
|
|
|
helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>, |
1942
|
|
|
|
|
|
|
<a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and |
1943
|
|
|
|
|
|
|
<a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>; |
1944
|
|
|
|
|
|
|
they can save you a lot of work.</p> |
1945
|
|
|
|
|
|
|
<pre><code>script/${prefix}_create.pl --help</code></pre> |
1946
|
|
|
|
|
|
|
<p>Also, be sure to check out the vast and growing |
1947
|
|
|
|
|
|
|
collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>; |
1948
|
|
|
|
|
|
|
you are likely to find what you need there. |
1949
|
|
|
|
|
|
|
</p> |
1950
|
|
|
|
|
|
|
|
1951
|
|
|
|
|
|
|
<h2>Need help?</h2> |
1952
|
|
|
|
|
|
|
<p>Catalyst has a very active community. Here are the main places to |
1953
|
|
|
|
|
|
|
get in touch with us.</p> |
1954
|
|
|
|
|
|
|
<ul> |
1955
|
|
|
|
|
|
|
<li> |
1956
|
|
|
|
|
|
|
<a href="http://dev.catalyst.perl.org">Wiki</a> |
1957
|
|
|
|
|
|
|
</li> |
1958
|
|
|
|
|
|
|
<li> |
1959
|
|
|
|
|
|
|
<a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a> |
1960
|
|
|
|
|
|
|
</li> |
1961
|
|
|
|
|
|
|
<li> |
1962
|
|
|
|
|
|
|
<a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a> |
1963
|
|
|
|
|
|
|
</li> |
1964
|
|
|
|
|
|
|
</ul> |
1965
|
|
|
|
|
|
|
<h2>In conclusion</h2> |
1966
|
|
|
|
|
|
|
<p>The Catalyst team hopes you will enjoy using Catalyst as much |
1967
|
|
|
|
|
|
|
as we enjoyed making it. Please contact us if you have ideas |
1968
|
|
|
|
|
|
|
for improvement or other feedback.</p> |
1969
|
|
|
|
|
|
|
</div> |
1970
|
|
|
|
|
|
|
</div> |
1971
|
|
|
|
|
|
|
</body> |
1972
|
|
|
|
|
|
|
</html> |
1973
|
|
|
|
|
|
|
EOF |
1974
|
|
|
|
|
|
|
} |
1975
|
|
|
|
|
|
|
|
1976
|
|
|
|
|
|
|
=head2 run_options |
1977
|
|
|
|
|
|
|
|
1978
|
|
|
|
|
|
|
Contains a hash of options passed from the application script, including |
1979
|
|
|
|
|
|
|
the original ARGV the script received, the processed values from that |
1980
|
|
|
|
|
|
|
ARGV and any extra arguments to the script which were not processed. |
1981
|
|
|
|
|
|
|
|
1982
|
|
|
|
|
|
|
This can be used to add custom options to your application's scripts |
1983
|
|
|
|
|
|
|
and setup your application differently depending on the values of these |
1984
|
|
|
|
|
|
|
options. |
1985
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
=head1 INTERNAL METHODS |
1987
|
|
|
|
|
|
|
|
1988
|
|
|
|
|
|
|
These methods are not meant to be used by end users. |
1989
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
=head2 $c->components |
1991
|
|
|
|
|
|
|
|
1992
|
|
|
|
|
|
|
Returns a hash of components. |
1993
|
|
|
|
|
|
|
|
1994
|
|
|
|
|
|
|
=head2 $c->context_class |
1995
|
|
|
|
|
|
|
|
1996
|
|
|
|
|
|
|
Returns or sets the context class. |
1997
|
|
|
|
|
|
|
|
1998
|
|
|
|
|
|
|
=head2 $c->counter |
1999
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
Returns a hashref containing coderefs and execution counts (needed for |
2001
|
|
|
|
|
|
|
deep recursion detection). |
2002
|
|
|
|
|
|
|
|
2003
|
|
|
|
|
|
|
=head2 $c->depth |
2004
|
|
|
|
|
|
|
|
2005
|
|
|
|
|
|
|
Returns the number of actions on the current internal execution stack. |
2006
|
|
|
|
|
|
|
|
2007
|
|
|
|
|
|
|
=head2 $c->dispatch |
2008
|
|
|
|
|
|
|
|
2009
|
|
|
|
|
|
|
Dispatches a request to actions. |
2010
|
|
|
|
|
|
|
|
2011
|
|
|
|
|
|
|
=cut |
2012
|
|
|
|
|
|
|
|
2013
|
925
|
|
|
925
|
1
|
4194
|
sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) } |
|
925
|
|
|
|
|
3640
|
|
2014
|
|
|
|
|
|
|
|
2015
|
|
|
|
|
|
|
=head2 $c->dispatcher_class |
2016
|
|
|
|
|
|
|
|
2017
|
|
|
|
|
|
|
Returns or sets the dispatcher class. |
2018
|
|
|
|
|
|
|
|
2019
|
|
|
|
|
|
|
=head2 $c->dump_these |
2020
|
|
|
|
|
|
|
|
2021
|
|
|
|
|
|
|
Returns a list of 2-element array references (name, structure) pairs |
2022
|
|
|
|
|
|
|
that will be dumped on the error page in debug mode. |
2023
|
|
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
=cut |
2025
|
|
|
|
|
|
|
|
2026
|
|
|
|
|
|
|
sub dump_these { |
2027
|
36
|
|
|
36
|
1
|
73
|
my $c = shift; |
2028
|
36
|
|
|
|
|
110
|
[ Request => $c->req ], |
2029
|
|
|
|
|
|
|
[ Response => $c->res ], |
2030
|
|
|
|
|
|
|
[ Stash => $c->stash ], |
2031
|
|
|
|
|
|
|
[ Config => $c->config ]; |
2032
|
|
|
|
|
|
|
} |
2033
|
|
|
|
|
|
|
|
2034
|
|
|
|
|
|
|
=head2 $c->engine_class |
2035
|
|
|
|
|
|
|
|
2036
|
|
|
|
|
|
|
Returns or sets the engine class. |
2037
|
|
|
|
|
|
|
|
2038
|
|
|
|
|
|
|
=head2 $c->execute( $class, $coderef ) |
2039
|
|
|
|
|
|
|
|
2040
|
|
|
|
|
|
|
Execute a coderef in given class and catch exceptions. Errors are available |
2041
|
|
|
|
|
|
|
via $c->error. |
2042
|
|
|
|
|
|
|
|
2043
|
|
|
|
|
|
|
=cut |
2044
|
|
|
|
|
|
|
|
2045
|
|
|
|
|
|
|
sub execute { |
2046
|
9165
|
|
|
9165
|
1
|
264972
|
my ( $c, $class, $code ) = @_; |
2047
|
9165
|
|
66
|
|
|
23223
|
$class = $c->component($class) || $class; |
2048
|
|
|
|
|
|
|
#$c->state(0); |
2049
|
|
|
|
|
|
|
|
2050
|
9165
|
100
|
|
|
|
23559
|
if ( $c->depth >= $RECURSION ) { |
2051
|
1
|
|
|
|
|
34
|
my $action = $code->reverse(); |
2052
|
1
|
50
|
|
|
|
16
|
$action = "/$action" unless $action =~ /->/; |
2053
|
1
|
|
|
|
|
5
|
my $error = qq/Deep recursion detected calling "${action}"/; |
2054
|
1
|
|
|
|
|
9
|
$c->log->error($error); |
2055
|
1
|
|
|
|
|
9
|
$c->error($error); |
2056
|
1
|
|
|
|
|
42
|
$c->state(0); |
2057
|
1
|
|
|
|
|
27
|
return $c->state; |
2058
|
|
|
|
|
|
|
} |
2059
|
|
|
|
|
|
|
|
2060
|
9164
|
100
|
|
|
|
24555
|
my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats; |
2061
|
|
|
|
|
|
|
|
2062
|
9164
|
|
|
|
|
14027
|
push( @{ $c->stack }, $code ); |
|
9164
|
|
|
|
|
207233
|
|
2063
|
|
|
|
|
|
|
|
2064
|
165
|
|
|
165
|
|
1757
|
no warnings 'recursion'; |
|
165
|
|
|
|
|
541
|
|
|
165
|
|
|
|
|
46385
|
|
2065
|
|
|
|
|
|
|
# N.B. This used to be combined, but I have seen $c get clobbered if so, and |
2066
|
|
|
|
|
|
|
# I have no idea how, ergo $ret (which appears to fix the issue) |
2067
|
9164
|
|
100
|
|
|
16769
|
eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) }; |
|
9164
|
|
|
|
|
13720
|
|
|
9038
|
|
|
|
|
296721
|
|
2068
|
|
|
|
|
|
|
|
2069
|
9161
|
100
|
100
|
|
|
21293
|
$c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info; |
2070
|
|
|
|
|
|
|
|
2071
|
9161
|
|
|
|
|
13495
|
my $last = pop( @{ $c->stack } ); |
|
9161
|
|
|
|
|
209284
|
|
2072
|
|
|
|
|
|
|
|
2073
|
9161
|
100
|
|
|
|
24199
|
if ( my $error = $@ ) { |
2074
|
|
|
|
|
|
|
#rethow if this can be handled by middleware |
2075
|
123
|
100
|
|
|
|
510
|
if ( $c->_handle_http_exception($error) ) { |
2076
|
9
|
|
|
|
|
12
|
foreach my $err (@{$c->error}) { |
|
9
|
|
|
|
|
23
|
|
2077
|
0
|
|
|
|
|
0
|
$c->log->error($err); |
2078
|
|
|
|
|
|
|
} |
2079
|
9
|
|
|
|
|
30
|
$c->clear_errors; |
2080
|
9
|
50
|
|
|
|
25
|
$c->log->_flush if $c->log->can('_flush'); |
2081
|
|
|
|
|
|
|
|
2082
|
9
|
50
|
|
|
|
357
|
$error->can('rethrow') ? $error->rethrow : croak $error; |
2083
|
|
|
|
|
|
|
} |
2084
|
114
|
100
|
100
|
|
|
1315
|
if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) { |
|
|
100
|
100
|
|
|
|
|
2085
|
27
|
100
|
|
|
|
85
|
$error->rethrow if $c->depth > 1; |
2086
|
|
|
|
|
|
|
} |
2087
|
|
|
|
|
|
|
elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) { |
2088
|
66
|
100
|
|
|
|
173
|
$error->rethrow if $c->depth > 0; |
2089
|
|
|
|
|
|
|
} |
2090
|
|
|
|
|
|
|
else { |
2091
|
21
|
100
|
|
|
|
141
|
unless ( ref $error ) { |
2092
|
165
|
|
|
165
|
|
1523
|
no warnings 'uninitialized'; |
|
165
|
|
|
|
|
532
|
|
|
165
|
|
|
|
|
1710644
|
|
2093
|
13
|
|
|
|
|
68
|
chomp $error; |
2094
|
13
|
|
|
|
|
458
|
my $class = $last->class; |
2095
|
13
|
|
|
|
|
384
|
my $name = $last->name; |
2096
|
13
|
|
|
|
|
114
|
$error = qq/Caught exception in $class->$name "$error"/; |
2097
|
|
|
|
|
|
|
} |
2098
|
21
|
|
|
|
|
84
|
$c->error($error); |
2099
|
|
|
|
|
|
|
} |
2100
|
|
|
|
|
|
|
#$c->state(0); |
2101
|
|
|
|
|
|
|
} |
2102
|
9084
|
|
|
|
|
206499
|
return $c->state; |
2103
|
|
|
|
|
|
|
} |
2104
|
|
|
|
|
|
|
|
2105
|
|
|
|
|
|
|
sub _stats_start_execute { |
2106
|
111
|
|
|
111
|
|
227
|
my ( $c, $code ) = @_; |
2107
|
111
|
|
33
|
|
|
276
|
my $appclass = ref($c) || $c; |
2108
|
|
|
|
|
|
|
return if ( ( $code->name =~ /^_.*/ ) |
2109
|
111
|
100
|
100
|
|
|
2893
|
&& ( !$appclass->config->{show_internal_actions} ) ); |
2110
|
|
|
|
|
|
|
|
2111
|
29
|
|
|
|
|
829
|
my $action_name = $code->reverse(); |
2112
|
29
|
|
|
|
|
749
|
$c->counter->{$action_name}++; |
2113
|
|
|
|
|
|
|
|
2114
|
29
|
|
|
|
|
65
|
my $action = $action_name; |
2115
|
29
|
50
|
|
|
|
145
|
$action = "/$action" unless $action =~ /->/; |
2116
|
|
|
|
|
|
|
|
2117
|
|
|
|
|
|
|
# determine if the call was the result of a forward |
2118
|
|
|
|
|
|
|
# this is done by walking up the call stack and looking for a calling |
2119
|
|
|
|
|
|
|
# sub of Catalyst::forward before the eval |
2120
|
29
|
|
|
|
|
65
|
my $callsub = q{}; |
2121
|
29
|
|
|
|
|
84
|
for my $index ( 2 .. 11 ) { |
2122
|
|
|
|
|
|
|
last |
2123
|
119
|
100
|
100
|
|
|
819
|
if ( ( caller($index) )[0] eq 'Catalyst' |
2124
|
|
|
|
|
|
|
&& ( caller($index) )[3] eq '(eval)' ); |
2125
|
|
|
|
|
|
|
|
2126
|
95
|
100
|
|
|
|
461
|
if ( ( caller($index) )[3] =~ /forward$/ ) { |
2127
|
5
|
|
|
|
|
18
|
$callsub = ( caller($index) )[3]; |
2128
|
5
|
|
|
|
|
13
|
$action = "-> $action"; |
2129
|
5
|
|
|
|
|
8
|
last; |
2130
|
|
|
|
|
|
|
} |
2131
|
|
|
|
|
|
|
} |
2132
|
|
|
|
|
|
|
|
2133
|
29
|
|
|
|
|
792
|
my $uid = $action_name . $c->counter->{$action_name}; |
2134
|
|
|
|
|
|
|
|
2135
|
|
|
|
|
|
|
# is this a root-level call or a forwarded call? |
2136
|
29
|
100
|
|
|
|
105
|
if ( $callsub =~ /forward$/ ) { |
2137
|
5
|
|
|
|
|
112
|
my $parent = $c->stack->[-1]; |
2138
|
|
|
|
|
|
|
|
2139
|
|
|
|
|
|
|
# forward, locate the caller |
2140
|
5
|
100
|
66
|
|
|
102
|
if ( defined $parent && exists $c->counter->{"$parent"} ) { |
2141
|
|
|
|
|
|
|
$c->stats->profile( |
2142
|
|
|
|
|
|
|
begin => $action, |
2143
|
4
|
|
|
|
|
99
|
parent => "$parent" . $c->counter->{"$parent"}, |
2144
|
|
|
|
|
|
|
uid => $uid, |
2145
|
|
|
|
|
|
|
); |
2146
|
|
|
|
|
|
|
} |
2147
|
|
|
|
|
|
|
else { |
2148
|
|
|
|
|
|
|
|
2149
|
|
|
|
|
|
|
# forward with no caller may come from a plugin |
2150
|
1
|
|
|
|
|
40
|
$c->stats->profile( |
2151
|
|
|
|
|
|
|
begin => $action, |
2152
|
|
|
|
|
|
|
uid => $uid, |
2153
|
|
|
|
|
|
|
); |
2154
|
|
|
|
|
|
|
} |
2155
|
|
|
|
|
|
|
} |
2156
|
|
|
|
|
|
|
else { |
2157
|
|
|
|
|
|
|
|
2158
|
|
|
|
|
|
|
# root-level call |
2159
|
24
|
|
|
|
|
588
|
$c->stats->profile( |
2160
|
|
|
|
|
|
|
begin => $action, |
2161
|
|
|
|
|
|
|
uid => $uid, |
2162
|
|
|
|
|
|
|
); |
2163
|
|
|
|
|
|
|
} |
2164
|
29
|
|
|
|
|
193
|
return $action; |
2165
|
|
|
|
|
|
|
|
2166
|
|
|
|
|
|
|
} |
2167
|
|
|
|
|
|
|
|
2168
|
|
|
|
|
|
|
sub _stats_finish_execute { |
2169
|
29
|
|
|
29
|
|
77
|
my ( $c, $info ) = @_; |
2170
|
29
|
|
|
|
|
769
|
$c->stats->profile( end => $info ); |
2171
|
|
|
|
|
|
|
} |
2172
|
|
|
|
|
|
|
|
2173
|
|
|
|
|
|
|
=head2 $c->finalize |
2174
|
|
|
|
|
|
|
|
2175
|
|
|
|
|
|
|
Finalizes the request. |
2176
|
|
|
|
|
|
|
|
2177
|
|
|
|
|
|
|
=cut |
2178
|
|
|
|
|
|
|
|
2179
|
|
|
|
|
|
|
sub finalize { |
2180
|
925
|
|
|
925
|
1
|
2219
|
my $c = shift; |
2181
|
|
|
|
|
|
|
|
2182
|
925
|
|
|
|
|
1692
|
for my $error ( @{ $c->error } ) { |
|
925
|
|
|
|
|
2539
|
|
2183
|
37
|
|
|
|
|
187
|
$c->log->error($error); |
2184
|
|
|
|
|
|
|
} |
2185
|
|
|
|
|
|
|
|
2186
|
|
|
|
|
|
|
# Support skipping finalize for psgix.io style 'jailbreak'. Used to support |
2187
|
|
|
|
|
|
|
# stuff like cometd and websockets |
2188
|
|
|
|
|
|
|
|
2189
|
925
|
50
|
|
|
|
25094
|
if($c->request->_has_io_fh) { |
2190
|
0
|
|
|
|
|
0
|
$c->log_response; |
2191
|
0
|
|
|
|
|
0
|
return; |
2192
|
|
|
|
|
|
|
} |
2193
|
|
|
|
|
|
|
|
2194
|
|
|
|
|
|
|
# Allow engine to handle finalize flow (for POE) |
2195
|
925
|
|
|
|
|
4211
|
my $engine = $c->engine; |
2196
|
925
|
50
|
|
|
|
6596
|
if ( my $code = $engine->can('finalize') ) { |
2197
|
0
|
|
|
|
|
0
|
$engine->$code($c); |
2198
|
|
|
|
|
|
|
} |
2199
|
|
|
|
|
|
|
else { |
2200
|
|
|
|
|
|
|
|
2201
|
925
|
|
|
|
|
4349
|
$c->finalize_uploads; |
2202
|
|
|
|
|
|
|
|
2203
|
|
|
|
|
|
|
# Error |
2204
|
925
|
100
|
|
|
|
1859
|
if ( $#{ $c->error } >= 0 ) { |
|
925
|
|
|
|
|
3172
|
|
2205
|
34
|
|
|
|
|
226
|
$c->finalize_error; |
2206
|
|
|
|
|
|
|
} |
2207
|
|
|
|
|
|
|
|
2208
|
925
|
|
|
|
|
5145
|
$c->finalize_encoding; |
2209
|
925
|
100
|
|
|
|
34118
|
$c->finalize_headers unless $c->response->finalized_headers; |
2210
|
925
|
|
|
|
|
4623
|
$c->finalize_body; |
2211
|
|
|
|
|
|
|
} |
2212
|
|
|
|
|
|
|
|
2213
|
925
|
|
|
|
|
5158
|
$c->log_response; |
2214
|
|
|
|
|
|
|
|
2215
|
925
|
100
|
|
|
|
2984
|
$c->log_stats if $c->use_stats; |
2216
|
|
|
|
|
|
|
|
2217
|
925
|
|
|
|
|
25383
|
return $c->response->status; |
2218
|
|
|
|
|
|
|
} |
2219
|
|
|
|
|
|
|
|
2220
|
|
|
|
|
|
|
=head2 $c->log_stats |
2221
|
|
|
|
|
|
|
|
2222
|
|
|
|
|
|
|
Logs statistics. |
2223
|
|
|
|
|
|
|
|
2224
|
|
|
|
|
|
|
=cut |
2225
|
|
|
|
|
|
|
|
2226
|
|
|
|
|
|
|
sub log_stats { |
2227
|
15
|
|
|
15
|
1
|
36
|
my $c = shift; |
2228
|
|
|
|
|
|
|
|
2229
|
15
|
|
|
|
|
407
|
my $elapsed = $c->stats->elapsed; |
2230
|
15
|
50
|
|
|
|
589
|
my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed; |
2231
|
15
|
|
|
|
|
69
|
$c->log->info( |
2232
|
|
|
|
|
|
|
"Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" ); |
2233
|
|
|
|
|
|
|
} |
2234
|
|
|
|
|
|
|
|
2235
|
|
|
|
|
|
|
|
2236
|
|
|
|
|
|
|
=head2 $c->finalize_body |
2237
|
|
|
|
|
|
|
|
2238
|
|
|
|
|
|
|
Finalizes body. |
2239
|
|
|
|
|
|
|
|
2240
|
|
|
|
|
|
|
=cut |
2241
|
|
|
|
|
|
|
|
2242
|
925
|
|
|
925
|
1
|
2116
|
sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) } |
|
925
|
|
|
|
|
2909
|
|
2243
|
|
|
|
|
|
|
|
2244
|
|
|
|
|
|
|
=head2 $c->finalize_cookies |
2245
|
|
|
|
|
|
|
|
2246
|
|
|
|
|
|
|
Finalizes cookies. |
2247
|
|
|
|
|
|
|
|
2248
|
|
|
|
|
|
|
=cut |
2249
|
|
|
|
|
|
|
|
2250
|
925
|
|
|
925
|
1
|
1835
|
sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) } |
|
925
|
|
|
|
|
3391
|
|
2251
|
|
|
|
|
|
|
|
2252
|
|
|
|
|
|
|
=head2 $c->finalize_error |
2253
|
|
|
|
|
|
|
|
2254
|
|
|
|
|
|
|
Finalizes error. If there is only one error in L</error> and it is an object that |
2255
|
|
|
|
|
|
|
does C<as_psgi> or C<code> we rethrow the error and presume it caught by middleware |
2256
|
|
|
|
|
|
|
up the ladder. Otherwise we return the debugging error page (in debug mode) or we |
2257
|
|
|
|
|
|
|
return the default error page (production mode). |
2258
|
|
|
|
|
|
|
|
2259
|
|
|
|
|
|
|
=cut |
2260
|
|
|
|
|
|
|
|
2261
|
|
|
|
|
|
|
sub finalize_error { |
2262
|
34
|
|
|
34
|
1
|
420
|
my $c = shift; |
2263
|
34
|
100
|
|
|
|
82
|
if($#{$c->error} > 0) { |
|
34
|
|
|
|
|
135
|
|
2264
|
3
|
|
|
|
|
12
|
$c->engine->finalize_error( $c, @_ ); |
2265
|
|
|
|
|
|
|
} else { |
2266
|
31
|
|
|
|
|
75
|
my ($error) = @{$c->error}; |
|
31
|
|
|
|
|
110
|
|
2267
|
31
|
50
|
|
|
|
236
|
if ( $c->_handle_http_exception($error) ) { |
2268
|
|
|
|
|
|
|
# In the case where the error 'knows what it wants', becauses its PSGI |
2269
|
|
|
|
|
|
|
# aware, just rethow and let middleware catch it |
2270
|
0
|
0
|
|
|
|
0
|
$error->can('rethrow') ? $error->rethrow : croak $error; |
2271
|
|
|
|
|
|
|
} else { |
2272
|
31
|
|
|
|
|
163
|
$c->engine->finalize_error( $c, @_ ) |
2273
|
|
|
|
|
|
|
} |
2274
|
|
|
|
|
|
|
} |
2275
|
|
|
|
|
|
|
} |
2276
|
|
|
|
|
|
|
|
2277
|
|
|
|
|
|
|
=head2 $c->finalize_headers |
2278
|
|
|
|
|
|
|
|
2279
|
|
|
|
|
|
|
Finalizes headers. |
2280
|
|
|
|
|
|
|
|
2281
|
|
|
|
|
|
|
=cut |
2282
|
|
|
|
|
|
|
|
2283
|
|
|
|
|
|
|
sub finalize_headers { |
2284
|
925
|
|
|
925
|
1
|
9890
|
my $c = shift; |
2285
|
|
|
|
|
|
|
|
2286
|
925
|
|
|
|
|
25372
|
my $response = $c->response; #accessor calls can add up? |
2287
|
|
|
|
|
|
|
|
2288
|
|
|
|
|
|
|
# Check if we already finalized headers |
2289
|
925
|
50
|
|
|
|
27353
|
return if $response->finalized_headers; |
2290
|
|
|
|
|
|
|
|
2291
|
|
|
|
|
|
|
# Handle redirects |
2292
|
925
|
100
|
|
|
|
4920
|
if ( my $location = $response->redirect ) { |
2293
|
14
|
50
|
|
|
|
69
|
$c->log->debug(qq/Redirecting to "$location"/) if $c->debug; |
2294
|
14
|
|
|
|
|
64
|
$response->header( Location => $location ); |
2295
|
|
|
|
|
|
|
} |
2296
|
|
|
|
|
|
|
|
2297
|
|
|
|
|
|
|
# Remove incorrectly added body and content related meta data when returning |
2298
|
|
|
|
|
|
|
# an information response, or a response the is required to not include a body |
2299
|
|
|
|
|
|
|
|
2300
|
925
|
|
|
|
|
5508
|
$c->finalize_cookies; |
2301
|
|
|
|
|
|
|
|
2302
|
|
|
|
|
|
|
# This currently is a NOOP but I don't want to remove it since I guess people |
2303
|
|
|
|
|
|
|
# might have Response subclasses that use it for something... (JNAP) |
2304
|
925
|
|
|
|
|
22924
|
$c->response->finalize_headers(); |
2305
|
|
|
|
|
|
|
|
2306
|
|
|
|
|
|
|
# Done |
2307
|
925
|
|
|
|
|
26871
|
$response->finalized_headers(1); |
2308
|
|
|
|
|
|
|
} |
2309
|
|
|
|
|
|
|
|
2310
|
|
|
|
|
|
|
=head2 $c->finalize_encoding |
2311
|
|
|
|
|
|
|
|
2312
|
|
|
|
|
|
|
Make sure your body is encoded properly IF you set an encoding. By |
2313
|
|
|
|
|
|
|
default the encoding is UTF-8 but you can disable it by explicitly setting the |
2314
|
|
|
|
|
|
|
encoding configuration value to undef. |
2315
|
|
|
|
|
|
|
|
2316
|
|
|
|
|
|
|
We can only encode when the body is a scalar. Methods for encoding via the |
2317
|
|
|
|
|
|
|
streaming interfaces (such as C<write> and C<write_fh> on L<Catalyst::Response> |
2318
|
|
|
|
|
|
|
are available). |
2319
|
|
|
|
|
|
|
|
2320
|
|
|
|
|
|
|
See L</ENCODING>. |
2321
|
|
|
|
|
|
|
|
2322
|
|
|
|
|
|
|
=cut |
2323
|
|
|
|
|
|
|
|
2324
|
|
|
|
|
|
|
sub finalize_encoding { |
2325
|
925
|
|
|
925
|
1
|
1835
|
my $c = shift; |
2326
|
925
|
|
50
|
|
|
2673
|
my $res = $c->res || return; |
2327
|
|
|
|
|
|
|
|
2328
|
|
|
|
|
|
|
# Warn if the set charset is different from the one you put into encoding. We need |
2329
|
|
|
|
|
|
|
# to do this early since encodable_response is false for this condition and we need |
2330
|
|
|
|
|
|
|
# to match the debug output for backcompat (there's a test for this...) -JNAP |
2331
|
925
|
100
|
100
|
|
|
6098
|
if( |
|
|
|
100
|
|
|
|
|
2332
|
|
|
|
|
|
|
$res->content_type_charset and $c->encoding and |
2333
|
|
|
|
|
|
|
(uc($c->encoding->mime_name) ne uc($res->content_type_charset)) |
2334
|
|
|
|
|
|
|
) { |
2335
|
2
|
|
|
|
|
233
|
my $ct = lc($res->content_type_charset); |
2336
|
2
|
|
|
|
|
228
|
$c->log->debug("Catalyst encoding config is set to encode in '" . |
2337
|
|
|
|
|
|
|
$c->encoding->mime_name . |
2338
|
|
|
|
|
|
|
"', content type is '$ct', not encoding "); |
2339
|
|
|
|
|
|
|
} |
2340
|
|
|
|
|
|
|
|
2341
|
925
|
100
|
100
|
|
|
237677
|
if( |
|
|
|
100
|
|
|
|
|
2342
|
|
|
|
|
|
|
($res->encodable_response) and |
2343
|
|
|
|
|
|
|
(defined($res->body)) and |
2344
|
|
|
|
|
|
|
(ref(\$res->body) eq 'SCALAR') |
2345
|
|
|
|
|
|
|
) { |
2346
|
|
|
|
|
|
|
# if you are finding yourself here and your body is already encoded correctly |
2347
|
|
|
|
|
|
|
# and you want to turn this off, use $c->clear_encoding to prevent encoding |
2348
|
|
|
|
|
|
|
# at this step, or set encoding to undef in the config to do so for the whole |
2349
|
|
|
|
|
|
|
# application. See the ENCODING documentaiton for better notes. |
2350
|
203
|
|
|
|
|
943
|
$c->res->body( $c->encoding->encode( $c->res->body, $c->_encode_check ) ); |
2351
|
|
|
|
|
|
|
|
2352
|
|
|
|
|
|
|
# Set the charset if necessary. This might be a bit bonkers since encodable response |
2353
|
|
|
|
|
|
|
# is false when the set charset is not the same as the encoding mimetype (maybe |
2354
|
|
|
|
|
|
|
# confusing action at a distance here.. |
2355
|
|
|
|
|
|
|
# Don't try to set the charset if one already exists or if headers are already finalized |
2356
|
203
|
100
|
66
|
|
|
1121
|
$c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name) |
|
|
|
66
|
|
|
|
|
|
|
|
100
|
|
|
|
|
2357
|
|
|
|
|
|
|
unless($c->res->content_type_charset || |
2358
|
|
|
|
|
|
|
($c->res->_context && $c->res->finalized_headers && !$c->res->_has_response_cb)); |
2359
|
|
|
|
|
|
|
} |
2360
|
|
|
|
|
|
|
} |
2361
|
|
|
|
|
|
|
|
2362
|
|
|
|
|
|
|
=head2 $c->finalize_output |
2363
|
|
|
|
|
|
|
|
2364
|
|
|
|
|
|
|
An alias for finalize_body. |
2365
|
|
|
|
|
|
|
|
2366
|
|
|
|
|
|
|
=head2 $c->finalize_read |
2367
|
|
|
|
|
|
|
|
2368
|
|
|
|
|
|
|
Finalizes the input after reading is complete. |
2369
|
|
|
|
|
|
|
|
2370
|
|
|
|
|
|
|
=cut |
2371
|
|
|
|
|
|
|
|
2372
|
0
|
|
|
0
|
1
|
0
|
sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) } |
|
0
|
|
|
|
|
0
|
|
2373
|
|
|
|
|
|
|
|
2374
|
|
|
|
|
|
|
=head2 $c->finalize_uploads |
2375
|
|
|
|
|
|
|
|
2376
|
|
|
|
|
|
|
Finalizes uploads. Cleans up any temporary files. |
2377
|
|
|
|
|
|
|
|
2378
|
|
|
|
|
|
|
=cut |
2379
|
|
|
|
|
|
|
|
2380
|
925
|
|
|
925
|
1
|
1991
|
sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) } |
|
925
|
|
|
|
|
2679
|
|
2381
|
|
|
|
|
|
|
|
2382
|
|
|
|
|
|
|
=head2 $c->get_action( $action, $namespace ) |
2383
|
|
|
|
|
|
|
|
2384
|
|
|
|
|
|
|
Gets an action in a given namespace. |
2385
|
|
|
|
|
|
|
|
2386
|
|
|
|
|
|
|
=cut |
2387
|
|
|
|
|
|
|
|
2388
|
7795
|
|
|
7795
|
1
|
13499
|
sub get_action { my $c = shift; $c->dispatcher->get_action(@_) } |
|
7795
|
|
|
|
|
21077
|
|
2389
|
|
|
|
|
|
|
|
2390
|
|
|
|
|
|
|
=head2 $c->get_actions( $action, $namespace ) |
2391
|
|
|
|
|
|
|
|
2392
|
|
|
|
|
|
|
Gets all actions of a given name in a namespace and all parent |
2393
|
|
|
|
|
|
|
namespaces. |
2394
|
|
|
|
|
|
|
|
2395
|
|
|
|
|
|
|
=cut |
2396
|
|
|
|
|
|
|
|
2397
|
2922
|
|
|
2922
|
1
|
5550
|
sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) } |
|
2922
|
|
|
|
|
8630
|
|
2398
|
|
|
|
|
|
|
|
2399
|
|
|
|
|
|
|
=head2 $app->handle_request( @arguments ) |
2400
|
|
|
|
|
|
|
|
2401
|
|
|
|
|
|
|
Called to handle each HTTP request. |
2402
|
|
|
|
|
|
|
|
2403
|
|
|
|
|
|
|
=cut |
2404
|
|
|
|
|
|
|
|
2405
|
|
|
|
|
|
|
sub handle_request { |
2406
|
930
|
|
|
930
|
1
|
3309
|
my ( $class, @arguments ) = @_; |
2407
|
|
|
|
|
|
|
|
2408
|
|
|
|
|
|
|
# Always expect worst case! |
2409
|
930
|
|
|
|
|
1985
|
my $status = -1; |
2410
|
|
|
|
|
|
|
try { |
2411
|
930
|
100
|
|
930
|
|
37200
|
if ($class->debug) { |
2412
|
16
|
|
100
|
|
|
131
|
my $secs = time - $START || 1; |
2413
|
16
|
|
|
|
|
179
|
my $av = sprintf '%.3f', $COUNT / $secs; |
2414
|
16
|
|
|
|
|
891
|
my $time = localtime time; |
2415
|
16
|
|
|
|
|
123
|
$class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***"); |
2416
|
|
|
|
|
|
|
} |
2417
|
|
|
|
|
|
|
|
2418
|
930
|
|
|
|
|
4646
|
my $c = $class->prepare(@arguments); |
2419
|
925
|
|
|
|
|
46295
|
$c->dispatch; |
2420
|
921
|
|
|
|
|
5965
|
$status = $c->finalize; |
2421
|
|
|
|
|
|
|
} catch { |
2422
|
|
|
|
|
|
|
#rethow if this can be handled by middleware |
2423
|
8
|
100
|
|
8
|
|
189
|
if ( $class->_handle_http_exception($_) ) { |
2424
|
4
|
50
|
|
|
|
105
|
$_->can('rethrow') ? $_->rethrow : croak $_; |
2425
|
|
|
|
|
|
|
} |
2426
|
4
|
|
|
|
|
30
|
chomp(my $error = $_); |
2427
|
4
|
|
|
|
|
16
|
$class->log->error(qq/Caught exception in engine "$error"/); |
2428
|
930
|
|
|
|
|
7660
|
}; |
2429
|
|
|
|
|
|
|
|
2430
|
925
|
|
|
|
|
19603
|
$COUNT++; |
2431
|
|
|
|
|
|
|
|
2432
|
925
|
100
|
|
|
|
4720
|
if(my $coderef = $class->log->can('_flush')){ |
2433
|
874
|
|
|
|
|
2860
|
$class->log->$coderef(); |
2434
|
|
|
|
|
|
|
} |
2435
|
925
|
|
|
|
|
4522
|
return $status; |
2436
|
|
|
|
|
|
|
} |
2437
|
|
|
|
|
|
|
|
2438
|
|
|
|
|
|
|
=head2 $class->prepare( @arguments ) |
2439
|
|
|
|
|
|
|
|
2440
|
|
|
|
|
|
|
Creates a Catalyst context from an engine-specific request (Apache, CGI, |
2441
|
|
|
|
|
|
|
etc.). |
2442
|
|
|
|
|
|
|
|
2443
|
|
|
|
|
|
|
=cut |
2444
|
|
|
|
|
|
|
|
2445
|
|
|
|
|
|
|
has _uploadtmp => ( |
2446
|
|
|
|
|
|
|
is => 'ro', |
2447
|
|
|
|
|
|
|
predicate => '_has_uploadtmp', |
2448
|
|
|
|
|
|
|
); |
2449
|
|
|
|
|
|
|
|
2450
|
|
|
|
|
|
|
sub prepare { |
2451
|
930
|
|
|
930
|
1
|
21830
|
my ( $class, @arguments ) = @_; |
2452
|
|
|
|
|
|
|
|
2453
|
|
|
|
|
|
|
# XXX |
2454
|
|
|
|
|
|
|
# After the app/ctxt split, this should become an attribute based on something passed |
2455
|
|
|
|
|
|
|
# into the application. |
2456
|
930
|
100
|
33
|
|
|
4812
|
$class->context_class( ref $class || $class ) unless $class->context_class; |
2457
|
|
|
|
|
|
|
|
2458
|
930
|
|
|
|
|
4550
|
my $uploadtmp = $class->config->{uploadtmp}; |
2459
|
930
|
100
|
|
|
|
3675
|
my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()}); |
2460
|
|
|
|
|
|
|
|
2461
|
930
|
|
|
|
|
121217
|
$c->response->_context($c); |
2462
|
930
|
|
|
|
|
5602
|
$c->stats($class->stats_class->new)->enable($c->use_stats); |
2463
|
|
|
|
|
|
|
|
2464
|
930
|
100
|
66
|
|
|
3936
|
if ( $c->debug || $c->config->{enable_catalyst_header} ) { |
2465
|
16
|
|
|
|
|
139
|
$c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); |
2466
|
|
|
|
|
|
|
} |
2467
|
|
|
|
|
|
|
|
2468
|
|
|
|
|
|
|
try { |
2469
|
|
|
|
|
|
|
# Allow engine to direct the prepare flow (for POE) |
2470
|
930
|
50
|
|
930
|
|
44752
|
if ( my $prepare = $c->engine->can('prepare') ) { |
2471
|
0
|
|
|
|
|
0
|
$c->engine->$prepare( $c, @arguments ); |
2472
|
|
|
|
|
|
|
} |
2473
|
|
|
|
|
|
|
else { |
2474
|
930
|
|
|
|
|
5021
|
$c->prepare_request(@arguments); |
2475
|
930
|
|
|
|
|
4501
|
$c->prepare_connection; |
2476
|
930
|
|
|
|
|
4380
|
$c->prepare_query_parameters; |
2477
|
929
|
|
|
|
|
17930
|
$c->prepare_headers; # Just hooks, no longer needed - they just |
2478
|
929
|
|
|
|
|
4250
|
$c->prepare_cookies; # cause the lazy attribute on req to build |
2479
|
929
|
|
|
|
|
4832
|
$c->prepare_path; |
2480
|
|
|
|
|
|
|
|
2481
|
|
|
|
|
|
|
# Prepare the body for reading, either by prepare_body |
2482
|
|
|
|
|
|
|
# or the user, if they are using $c->read |
2483
|
929
|
|
|
|
|
4594
|
$c->prepare_read; |
2484
|
|
|
|
|
|
|
|
2485
|
|
|
|
|
|
|
# Parse the body unless the user wants it on-demand |
2486
|
929
|
100
|
|
|
|
4834
|
unless ( ref($c)->config->{parse_on_demand} ) { |
2487
|
926
|
|
|
|
|
4522
|
$c->prepare_body; |
2488
|
|
|
|
|
|
|
} |
2489
|
|
|
|
|
|
|
} |
2490
|
927
|
|
|
|
|
5490
|
$c->prepare_action; |
2491
|
|
|
|
|
|
|
} |
2492
|
|
|
|
|
|
|
# VERY ugly and probably shouldn't rely on ->finalize actually working |
2493
|
|
|
|
|
|
|
catch { |
2494
|
|
|
|
|
|
|
# failed prepare is always due to an invalid request, right? |
2495
|
|
|
|
|
|
|
# Note we call finalize and then die here, which escapes |
2496
|
|
|
|
|
|
|
# finalize being called in the enclosing block.. |
2497
|
|
|
|
|
|
|
# It in fact couldn't be called, as we don't return $c.. |
2498
|
|
|
|
|
|
|
# This is a mess - but I'm unsure you can fix this without |
2499
|
|
|
|
|
|
|
# breaking compat for people doing crazy things (we should set |
2500
|
|
|
|
|
|
|
# the 400 and just return the ctx here IMO, letting finalize get called |
2501
|
|
|
|
|
|
|
# above... |
2502
|
5
|
100
|
|
5
|
|
182
|
if ( $c->_handle_http_exception($_) ) { |
2503
|
1
|
|
|
|
|
4
|
foreach my $err (@{$c->error}) { |
|
1
|
|
|
|
|
8
|
|
2504
|
0
|
|
|
|
|
0
|
$c->log->error($err); |
2505
|
|
|
|
|
|
|
} |
2506
|
1
|
|
|
|
|
13
|
$c->clear_errors; |
2507
|
1
|
50
|
|
|
|
3
|
$c->log->_flush if $c->log->can('_flush'); |
2508
|
1
|
50
|
|
|
|
56
|
$_->can('rethrow') ? $_->rethrow : croak $_; |
2509
|
|
|
|
|
|
|
} else { |
2510
|
4
|
|
|
|
|
132
|
$c->response->status(400); |
2511
|
4
|
|
|
|
|
104
|
$c->response->content_type('text/plain'); |
2512
|
4
|
|
|
|
|
167
|
$c->response->body('Bad Request'); |
2513
|
4
|
|
|
|
|
21
|
$c->finalize; |
2514
|
4
|
|
|
|
|
32
|
die $_; |
2515
|
|
|
|
|
|
|
} |
2516
|
930
|
|
|
|
|
12476
|
}; |
2517
|
|
|
|
|
|
|
|
2518
|
925
|
|
|
|
|
70039
|
$c->log_request; |
2519
|
925
|
|
|
|
|
3647
|
$c->{stash} = $c->stash; |
2520
|
925
|
|
|
|
|
3990
|
Scalar::Util::weaken($c->{stash}); |
2521
|
|
|
|
|
|
|
|
2522
|
925
|
|
|
|
|
3254
|
return $c; |
2523
|
|
|
|
|
|
|
} |
2524
|
|
|
|
|
|
|
|
2525
|
|
|
|
|
|
|
=head2 $c->prepare_action |
2526
|
|
|
|
|
|
|
|
2527
|
|
|
|
|
|
|
Prepares action. See L<Catalyst::Dispatcher>. |
2528
|
|
|
|
|
|
|
|
2529
|
|
|
|
|
|
|
=cut |
2530
|
|
|
|
|
|
|
|
2531
|
|
|
|
|
|
|
sub prepare_action { |
2532
|
927
|
|
|
927
|
1
|
7664
|
my $c = shift; |
2533
|
927
|
|
|
|
|
4316
|
my $ret = $c->dispatcher->prepare_action( $c, @_); |
2534
|
|
|
|
|
|
|
|
2535
|
927
|
100
|
|
|
|
2977
|
if($c->encoding) { |
2536
|
926
|
|
|
|
|
2053
|
foreach (@{$c->req->arguments}, @{$c->req->captures}) { |
|
926
|
|
|
|
|
3037
|
|
|
926
|
|
|
|
|
3006
|
|
2537
|
781
|
|
|
|
|
8107
|
$_ = $c->_handle_param_unicode_decoding($_); |
2538
|
|
|
|
|
|
|
} |
2539
|
|
|
|
|
|
|
} |
2540
|
|
|
|
|
|
|
|
2541
|
925
|
|
|
|
|
13733
|
return $ret; |
2542
|
|
|
|
|
|
|
} |
2543
|
|
|
|
|
|
|
|
2544
|
|
|
|
|
|
|
|
2545
|
|
|
|
|
|
|
=head2 $c->prepare_body |
2546
|
|
|
|
|
|
|
|
2547
|
|
|
|
|
|
|
Prepares message body. |
2548
|
|
|
|
|
|
|
|
2549
|
|
|
|
|
|
|
=cut |
2550
|
|
|
|
|
|
|
|
2551
|
|
|
|
|
|
|
sub prepare_body { |
2552
|
1028
|
|
|
1028
|
1
|
4104
|
my $c = shift; |
2553
|
|
|
|
|
|
|
|
2554
|
1028
|
100
|
|
|
|
29949
|
return if $c->request->_has_body; |
2555
|
|
|
|
|
|
|
|
2556
|
|
|
|
|
|
|
# Initialize on-demand data |
2557
|
927
|
|
|
|
|
4161
|
$c->engine->prepare_body( $c, @_ ); |
2558
|
926
|
|
|
|
|
4548
|
$c->prepare_parameters; |
2559
|
925
|
|
|
|
|
4167
|
$c->prepare_uploads; |
2560
|
|
|
|
|
|
|
} |
2561
|
|
|
|
|
|
|
|
2562
|
|
|
|
|
|
|
=head2 $c->prepare_body_chunk( $chunk ) |
2563
|
|
|
|
|
|
|
|
2564
|
|
|
|
|
|
|
Prepares a chunk of data before sending it to L<HTTP::Body>. |
2565
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
See L<Catalyst::Engine>. |
2567
|
|
|
|
|
|
|
|
2568
|
|
|
|
|
|
|
=cut |
2569
|
|
|
|
|
|
|
|
2570
|
|
|
|
|
|
|
sub prepare_body_chunk { |
2571
|
0
|
|
|
0
|
1
|
0
|
my $c = shift; |
2572
|
0
|
|
|
|
|
0
|
$c->engine->prepare_body_chunk( $c, @_ ); |
2573
|
|
|
|
|
|
|
} |
2574
|
|
|
|
|
|
|
|
2575
|
|
|
|
|
|
|
=head2 $c->prepare_body_parameters |
2576
|
|
|
|
|
|
|
|
2577
|
|
|
|
|
|
|
Prepares body parameters. |
2578
|
|
|
|
|
|
|
|
2579
|
|
|
|
|
|
|
=cut |
2580
|
|
|
|
|
|
|
|
2581
|
|
|
|
|
|
|
sub prepare_body_parameters { |
2582
|
927
|
|
|
927
|
1
|
1880
|
my $c = shift; |
2583
|
927
|
|
|
|
|
22726
|
$c->request->prepare_body_parameters( $c, @_ ); |
2584
|
|
|
|
|
|
|
} |
2585
|
|
|
|
|
|
|
|
2586
|
|
|
|
|
|
|
=head2 $c->prepare_connection |
2587
|
|
|
|
|
|
|
|
2588
|
|
|
|
|
|
|
Prepares connection. |
2589
|
|
|
|
|
|
|
|
2590
|
|
|
|
|
|
|
=cut |
2591
|
|
|
|
|
|
|
|
2592
|
|
|
|
|
|
|
sub prepare_connection { |
2593
|
930
|
|
|
930
|
1
|
1997
|
my $c = shift; |
2594
|
930
|
|
|
|
|
22806
|
$c->request->prepare_connection($c); |
2595
|
|
|
|
|
|
|
} |
2596
|
|
|
|
|
|
|
|
2597
|
|
|
|
|
|
|
=head2 $c->prepare_cookies |
2598
|
|
|
|
|
|
|
|
2599
|
|
|
|
|
|
|
Prepares cookies by ensuring that the attribute on the request |
2600
|
|
|
|
|
|
|
object has been built. |
2601
|
|
|
|
|
|
|
|
2602
|
|
|
|
|
|
|
=cut |
2603
|
|
|
|
|
|
|
|
2604
|
929
|
|
|
929
|
1
|
2078
|
sub prepare_cookies { my $c = shift; $c->request->cookies } |
|
929
|
|
|
|
|
24180
|
|
2605
|
|
|
|
|
|
|
|
2606
|
|
|
|
|
|
|
=head2 $c->prepare_headers |
2607
|
|
|
|
|
|
|
|
2608
|
|
|
|
|
|
|
Prepares request headers by ensuring that the attribute on the request |
2609
|
|
|
|
|
|
|
object has been built. |
2610
|
|
|
|
|
|
|
|
2611
|
|
|
|
|
|
|
=cut |
2612
|
|
|
|
|
|
|
|
2613
|
929
|
|
|
929
|
1
|
1981
|
sub prepare_headers { my $c = shift; $c->request->headers } |
|
929
|
|
|
|
|
24070
|
|
2614
|
|
|
|
|
|
|
|
2615
|
|
|
|
|
|
|
=head2 $c->prepare_parameters |
2616
|
|
|
|
|
|
|
|
2617
|
|
|
|
|
|
|
Prepares parameters. |
2618
|
|
|
|
|
|
|
|
2619
|
|
|
|
|
|
|
=cut |
2620
|
|
|
|
|
|
|
|
2621
|
|
|
|
|
|
|
sub prepare_parameters { |
2622
|
927
|
|
|
927
|
1
|
2095
|
my $c = shift; |
2623
|
927
|
|
|
|
|
3586
|
$c->prepare_body_parameters; |
2624
|
926
|
|
|
|
|
3599
|
$c->engine->prepare_parameters( $c, @_ ); |
2625
|
|
|
|
|
|
|
} |
2626
|
|
|
|
|
|
|
|
2627
|
|
|
|
|
|
|
=head2 $c->prepare_path |
2628
|
|
|
|
|
|
|
|
2629
|
|
|
|
|
|
|
Prepares path and base. |
2630
|
|
|
|
|
|
|
|
2631
|
|
|
|
|
|
|
=cut |
2632
|
|
|
|
|
|
|
|
2633
|
929
|
|
|
929
|
1
|
2068
|
sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) } |
|
929
|
|
|
|
|
3741
|
|
2634
|
|
|
|
|
|
|
|
2635
|
|
|
|
|
|
|
=head2 $c->prepare_query_parameters |
2636
|
|
|
|
|
|
|
|
2637
|
|
|
|
|
|
|
Prepares query parameters. |
2638
|
|
|
|
|
|
|
|
2639
|
|
|
|
|
|
|
=cut |
2640
|
|
|
|
|
|
|
|
2641
|
|
|
|
|
|
|
sub prepare_query_parameters { |
2642
|
930
|
|
|
930
|
1
|
1972
|
my $c = shift; |
2643
|
|
|
|
|
|
|
|
2644
|
930
|
|
|
|
|
3307
|
$c->engine->prepare_query_parameters( $c, @_ ); |
2645
|
|
|
|
|
|
|
} |
2646
|
|
|
|
|
|
|
|
2647
|
|
|
|
|
|
|
=head2 $c->log_request |
2648
|
|
|
|
|
|
|
|
2649
|
|
|
|
|
|
|
Writes information about the request to the debug logs. This includes: |
2650
|
|
|
|
|
|
|
|
2651
|
|
|
|
|
|
|
=over 4 |
2652
|
|
|
|
|
|
|
|
2653
|
|
|
|
|
|
|
=item * Request method, path, and remote IP address |
2654
|
|
|
|
|
|
|
|
2655
|
|
|
|
|
|
|
=item * Query keywords (see L<Catalyst::Request/query_keywords>) |
2656
|
|
|
|
|
|
|
|
2657
|
|
|
|
|
|
|
=item * Request parameters |
2658
|
|
|
|
|
|
|
|
2659
|
|
|
|
|
|
|
=item * File uploads |
2660
|
|
|
|
|
|
|
|
2661
|
|
|
|
|
|
|
=back |
2662
|
|
|
|
|
|
|
|
2663
|
|
|
|
|
|
|
=cut |
2664
|
|
|
|
|
|
|
|
2665
|
|
|
|
|
|
|
sub log_request { |
2666
|
925
|
|
|
925
|
1
|
2017
|
my $c = shift; |
2667
|
|
|
|
|
|
|
|
2668
|
925
|
100
|
|
|
|
2656
|
return unless $c->debug; |
2669
|
|
|
|
|
|
|
|
2670
|
16
|
|
|
|
|
113
|
my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these; |
|
64
|
|
|
|
|
190
|
|
2671
|
16
|
|
|
|
|
60
|
my $request = $dump->[1]; |
2672
|
|
|
|
|
|
|
|
2673
|
16
|
|
|
|
|
524
|
my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address ); |
2674
|
16
|
|
50
|
|
|
63
|
$method ||= ''; |
2675
|
16
|
100
|
|
|
|
56
|
$path = '/' unless length $path; |
2676
|
16
|
|
50
|
|
|
82
|
$address ||= ''; |
2677
|
|
|
|
|
|
|
|
2678
|
16
|
|
|
|
|
57
|
$path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; |
|
0
|
|
|
|
|
0
|
|
2679
|
16
|
|
|
|
|
160
|
$path = decode_utf8($path); |
2680
|
|
|
|
|
|
|
|
2681
|
16
|
|
|
|
|
160
|
$c->log->debug(qq/"$method" request for "$path" from "$address"/); |
2682
|
|
|
|
|
|
|
|
2683
|
16
|
|
|
|
|
484
|
$c->log_request_headers($request->headers); |
2684
|
|
|
|
|
|
|
|
2685
|
16
|
50
|
|
|
|
519
|
if ( my $keywords = $request->query_keywords ) { |
2686
|
0
|
|
|
|
|
0
|
$c->log->debug("Query keywords are: $keywords"); |
2687
|
|
|
|
|
|
|
} |
2688
|
|
|
|
|
|
|
|
2689
|
16
|
50
|
|
|
|
462
|
$c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () ); |
2690
|
|
|
|
|
|
|
|
2691
|
16
|
|
|
|
|
80
|
$c->log_request_uploads($request); |
2692
|
|
|
|
|
|
|
} |
2693
|
|
|
|
|
|
|
|
2694
|
|
|
|
|
|
|
=head2 $c->log_response |
2695
|
|
|
|
|
|
|
|
2696
|
|
|
|
|
|
|
Writes information about the response to the debug logs by calling |
2697
|
|
|
|
|
|
|
C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>. |
2698
|
|
|
|
|
|
|
|
2699
|
|
|
|
|
|
|
=cut |
2700
|
|
|
|
|
|
|
|
2701
|
|
|
|
|
|
|
sub log_response { |
2702
|
925
|
|
|
925
|
1
|
2032
|
my $c = shift; |
2703
|
|
|
|
|
|
|
|
2704
|
925
|
100
|
|
|
|
3015
|
return unless $c->debug; |
2705
|
|
|
|
|
|
|
|
2706
|
13
|
|
|
|
|
92
|
my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these; |
|
52
|
|
|
|
|
137
|
|
2707
|
13
|
|
|
|
|
60
|
my $response = $dump->[1]; |
2708
|
|
|
|
|
|
|
|
2709
|
13
|
|
|
|
|
80
|
$c->log_response_status_line($response); |
2710
|
13
|
|
|
|
|
78
|
$c->log_response_headers($response->headers); |
2711
|
|
|
|
|
|
|
} |
2712
|
|
|
|
|
|
|
|
2713
|
|
|
|
|
|
|
=head2 $c->log_response_status_line($response) |
2714
|
|
|
|
|
|
|
|
2715
|
|
|
|
|
|
|
Writes one line of information about the response to the debug logs. This includes: |
2716
|
|
|
|
|
|
|
|
2717
|
|
|
|
|
|
|
=over 4 |
2718
|
|
|
|
|
|
|
|
2719
|
|
|
|
|
|
|
=item * Response status code |
2720
|
|
|
|
|
|
|
|
2721
|
|
|
|
|
|
|
=item * Content-Type header (if present) |
2722
|
|
|
|
|
|
|
|
2723
|
|
|
|
|
|
|
=item * Content-Length header (if present) |
2724
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
=back |
2726
|
|
|
|
|
|
|
|
2727
|
|
|
|
|
|
|
=cut |
2728
|
|
|
|
|
|
|
|
2729
|
|
|
|
|
|
|
sub log_response_status_line { |
2730
|
13
|
|
|
13
|
1
|
40
|
my ($c, $response) = @_; |
2731
|
|
|
|
|
|
|
|
2732
|
13
|
|
50
|
|
|
49
|
$c->log->debug( |
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
2733
|
|
|
|
|
|
|
sprintf( |
2734
|
|
|
|
|
|
|
'Response Code: %s; Content-Type: %s; Content-Length: %s', |
2735
|
|
|
|
|
|
|
$response->status || 'unknown', |
2736
|
|
|
|
|
|
|
$response->headers->header('Content-Type') || 'unknown', |
2737
|
|
|
|
|
|
|
$response->headers->header('Content-Length') || 'unknown' |
2738
|
|
|
|
|
|
|
) |
2739
|
|
|
|
|
|
|
); |
2740
|
|
|
|
|
|
|
} |
2741
|
|
|
|
|
|
|
|
2742
|
|
|
|
|
|
|
=head2 $c->log_response_headers($headers); |
2743
|
|
|
|
|
|
|
|
2744
|
|
|
|
|
|
|
Hook method which can be wrapped by plugins to log the response headers. |
2745
|
|
|
|
|
|
|
No-op in the default implementation. |
2746
|
|
|
|
|
|
|
|
2747
|
|
|
|
|
|
|
=cut |
2748
|
|
|
|
|
|
|
|
2749
|
|
|
|
13
|
1
|
|
sub log_response_headers {} |
2750
|
|
|
|
|
|
|
|
2751
|
|
|
|
|
|
|
=head2 $c->log_request_parameters( query => {}, body => {} ) |
2752
|
|
|
|
|
|
|
|
2753
|
|
|
|
|
|
|
Logs request parameters to debug logs |
2754
|
|
|
|
|
|
|
|
2755
|
|
|
|
|
|
|
=cut |
2756
|
|
|
|
|
|
|
|
2757
|
|
|
|
|
|
|
sub log_request_parameters { |
2758
|
16
|
|
|
16
|
1
|
39
|
my $c = shift; |
2759
|
16
|
|
|
|
|
75
|
my %all_params = @_; |
2760
|
|
|
|
|
|
|
|
2761
|
16
|
50
|
|
|
|
76
|
return unless $c->debug; |
2762
|
|
|
|
|
|
|
|
2763
|
16
|
|
|
|
|
123
|
my $column_width = Catalyst::Utils::term_width() - 44; |
2764
|
16
|
|
|
|
|
51
|
foreach my $type (qw(query body)) { |
2765
|
32
|
|
|
|
|
73
|
my $params = $all_params{$type}; |
2766
|
32
|
50
|
|
|
|
129
|
next if ! keys %$params; |
2767
|
0
|
|
|
|
|
0
|
my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] ); |
2768
|
0
|
|
|
|
|
0
|
for my $key ( sort keys %$params ) { |
2769
|
0
|
|
|
|
|
0
|
my @values = (); |
2770
|
0
|
0
|
|
|
|
0
|
if(ref $params eq 'Hash::MultiValue') { |
2771
|
0
|
|
|
|
|
0
|
@values = $params->get_all($key); |
2772
|
|
|
|
|
|
|
} else { |
2773
|
0
|
|
|
|
|
0
|
my $param = $params->{$key}; |
2774
|
0
|
0
|
|
|
|
0
|
if( defined($param) ) { |
2775
|
0
|
0
|
|
|
|
0
|
@values = ref $param eq 'ARRAY' ? @$param : $param; |
2776
|
|
|
|
|
|
|
} |
2777
|
|
|
|
|
|
|
} |
2778
|
0
|
0
|
|
|
|
0
|
$t->row( $key.( scalar @values > 1 ? ' [multiple]' : ''), join(', ', @values) ); |
2779
|
|
|
|
|
|
|
} |
2780
|
0
|
|
|
|
|
0
|
$c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw ); |
2781
|
|
|
|
|
|
|
} |
2782
|
|
|
|
|
|
|
} |
2783
|
|
|
|
|
|
|
|
2784
|
|
|
|
|
|
|
=head2 $c->log_request_uploads |
2785
|
|
|
|
|
|
|
|
2786
|
|
|
|
|
|
|
Logs file uploads included in the request to the debug logs. |
2787
|
|
|
|
|
|
|
The parameter name, filename, file type, and file size are all included in |
2788
|
|
|
|
|
|
|
the debug logs. |
2789
|
|
|
|
|
|
|
|
2790
|
|
|
|
|
|
|
=cut |
2791
|
|
|
|
|
|
|
|
2792
|
|
|
|
|
|
|
sub log_request_uploads { |
2793
|
16
|
|
|
16
|
1
|
48
|
my $c = shift; |
2794
|
16
|
|
|
|
|
34
|
my $request = shift; |
2795
|
16
|
50
|
|
|
|
47
|
return unless $c->debug; |
2796
|
16
|
|
|
|
|
553
|
my $uploads = $request->uploads; |
2797
|
16
|
50
|
|
|
|
207
|
if ( keys %$uploads ) { |
2798
|
0
|
|
|
|
|
0
|
my $t = Text::SimpleTable->new( |
2799
|
|
|
|
|
|
|
[ 12, 'Parameter' ], |
2800
|
|
|
|
|
|
|
[ 26, 'Filename' ], |
2801
|
|
|
|
|
|
|
[ 18, 'Type' ], |
2802
|
|
|
|
|
|
|
[ 9, 'Size' ] |
2803
|
|
|
|
|
|
|
); |
2804
|
0
|
|
|
|
|
0
|
for my $key ( sort keys %$uploads ) { |
2805
|
0
|
|
|
|
|
0
|
my $upload = $uploads->{$key}; |
2806
|
0
|
0
|
|
|
|
0
|
for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) { |
|
0
|
|
|
|
|
0
|
|
2807
|
0
|
|
|
|
|
0
|
$t->row( $key, $u->filename, $u->type, $u->size ); |
2808
|
|
|
|
|
|
|
} |
2809
|
|
|
|
|
|
|
} |
2810
|
0
|
|
|
|
|
0
|
$c->log->debug( "File Uploads are:\n" . $t->draw ); |
2811
|
|
|
|
|
|
|
} |
2812
|
|
|
|
|
|
|
} |
2813
|
|
|
|
|
|
|
|
2814
|
|
|
|
|
|
|
=head2 $c->log_request_headers($headers); |
2815
|
|
|
|
|
|
|
|
2816
|
|
|
|
|
|
|
Hook method which can be wrapped by plugins to log the request headers. |
2817
|
|
|
|
|
|
|
No-op in the default implementation. |
2818
|
|
|
|
|
|
|
|
2819
|
|
|
|
|
|
|
=cut |
2820
|
|
|
|
|
|
|
|
2821
|
|
|
|
16
|
1
|
|
sub log_request_headers {} |
2822
|
|
|
|
|
|
|
|
2823
|
|
|
|
|
|
|
=head2 $c->log_headers($type => $headers) |
2824
|
|
|
|
|
|
|
|
2825
|
|
|
|
|
|
|
Logs L<HTTP::Headers> (either request or response) to the debug logs. |
2826
|
|
|
|
|
|
|
|
2827
|
|
|
|
|
|
|
=cut |
2828
|
|
|
|
|
|
|
|
2829
|
|
|
|
|
|
|
sub log_headers { |
2830
|
0
|
|
|
0
|
1
|
0
|
my $c = shift; |
2831
|
0
|
|
|
|
|
0
|
my $type = shift; |
2832
|
0
|
|
|
|
|
0
|
my $headers = shift; # an HTTP::Headers instance |
2833
|
|
|
|
|
|
|
|
2834
|
0
|
0
|
|
|
|
0
|
return unless $c->debug; |
2835
|
|
|
|
|
|
|
|
2836
|
0
|
|
|
|
|
0
|
my $column_width = Catalyst::Utils::term_width() - 28; |
2837
|
0
|
|
|
|
|
0
|
my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] ); |
2838
|
|
|
|
|
|
|
$headers->scan( |
2839
|
|
|
|
|
|
|
sub { |
2840
|
0
|
|
|
0
|
|
0
|
my ( $name, $value ) = @_; |
2841
|
0
|
|
|
|
|
0
|
$t->row( $name, $value ); |
2842
|
|
|
|
|
|
|
} |
2843
|
0
|
|
|
|
|
0
|
); |
2844
|
0
|
|
|
|
|
0
|
$c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw ); |
2845
|
|
|
|
|
|
|
} |
2846
|
|
|
|
|
|
|
|
2847
|
|
|
|
|
|
|
|
2848
|
|
|
|
|
|
|
=head2 $c->prepare_read |
2849
|
|
|
|
|
|
|
|
2850
|
|
|
|
|
|
|
Prepares the input for reading. |
2851
|
|
|
|
|
|
|
|
2852
|
|
|
|
|
|
|
=cut |
2853
|
|
|
|
|
|
|
|
2854
|
929
|
|
|
929
|
1
|
2049
|
sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) } |
|
929
|
|
|
|
|
3281
|
|
2855
|
|
|
|
|
|
|
|
2856
|
|
|
|
|
|
|
=head2 $c->prepare_request |
2857
|
|
|
|
|
|
|
|
2858
|
|
|
|
|
|
|
Prepares the engine request. |
2859
|
|
|
|
|
|
|
|
2860
|
|
|
|
|
|
|
=cut |
2861
|
|
|
|
|
|
|
|
2862
|
930
|
|
|
930
|
1
|
2086
|
sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) } |
|
930
|
|
|
|
|
2853
|
|
2863
|
|
|
|
|
|
|
|
2864
|
|
|
|
|
|
|
=head2 $c->prepare_uploads |
2865
|
|
|
|
|
|
|
|
2866
|
|
|
|
|
|
|
Prepares uploads. |
2867
|
|
|
|
|
|
|
|
2868
|
|
|
|
|
|
|
=cut |
2869
|
|
|
|
|
|
|
|
2870
|
|
|
|
|
|
|
sub prepare_uploads { |
2871
|
925
|
|
|
925
|
1
|
2165
|
my $c = shift; |
2872
|
925
|
|
|
|
|
3115
|
$c->engine->prepare_uploads( $c, @_ ); |
2873
|
|
|
|
|
|
|
} |
2874
|
|
|
|
|
|
|
|
2875
|
|
|
|
|
|
|
=head2 $c->prepare_write |
2876
|
|
|
|
|
|
|
|
2877
|
|
|
|
|
|
|
Prepares the output for writing. |
2878
|
|
|
|
|
|
|
|
2879
|
|
|
|
|
|
|
=cut |
2880
|
|
|
|
|
|
|
|
2881
|
0
|
|
|
0
|
1
|
0
|
sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) } |
|
0
|
|
|
|
|
0
|
|
2882
|
|
|
|
|
|
|
|
2883
|
|
|
|
|
|
|
=head2 $c->request_class |
2884
|
|
|
|
|
|
|
|
2885
|
|
|
|
|
|
|
Returns or sets the request class. Defaults to L<Catalyst::Request>. |
2886
|
|
|
|
|
|
|
|
2887
|
|
|
|
|
|
|
=head2 $app->request_class_traits |
2888
|
|
|
|
|
|
|
|
2889
|
|
|
|
|
|
|
An arrayref of L<Moose::Role>s which are applied to the request class. You can |
2890
|
|
|
|
|
|
|
name the full namespace of the role, or a namespace suffix, which will then |
2891
|
|
|
|
|
|
|
be tried against the following standard namespace prefixes. |
2892
|
|
|
|
|
|
|
|
2893
|
|
|
|
|
|
|
$MyApp::TraitFor::Request::$trait_suffix |
2894
|
|
|
|
|
|
|
Catalyst::TraitFor::Request::$trait_suffix |
2895
|
|
|
|
|
|
|
|
2896
|
|
|
|
|
|
|
So for example if you set: |
2897
|
|
|
|
|
|
|
|
2898
|
|
|
|
|
|
|
MyApp->request_class_traits(['Foo']); |
2899
|
|
|
|
|
|
|
|
2900
|
|
|
|
|
|
|
We try each possible role in turn (and throw an error if none load) |
2901
|
|
|
|
|
|
|
|
2902
|
|
|
|
|
|
|
Foo |
2903
|
|
|
|
|
|
|
MyApp::TraitFor::Request::Foo |
2904
|
|
|
|
|
|
|
Catalyst::TraitFor::Request::Foo |
2905
|
|
|
|
|
|
|
|
2906
|
|
|
|
|
|
|
The namespace part 'TraitFor::Request' was chosen to assist in backwards |
2907
|
|
|
|
|
|
|
compatibility with L<CatalystX::RoleApplicator> which previously provided |
2908
|
|
|
|
|
|
|
these features in a stand alone package. |
2909
|
|
|
|
|
|
|
|
2910
|
|
|
|
|
|
|
=head2 $app->composed_request_class |
2911
|
|
|
|
|
|
|
|
2912
|
|
|
|
|
|
|
This is the request class which has been composed with any request_class_traits. |
2913
|
|
|
|
|
|
|
|
2914
|
|
|
|
|
|
|
=head2 $c->response_class |
2915
|
|
|
|
|
|
|
|
2916
|
|
|
|
|
|
|
Returns or sets the response class. Defaults to L<Catalyst::Response>. |
2917
|
|
|
|
|
|
|
|
2918
|
|
|
|
|
|
|
=head2 $app->response_class_traits |
2919
|
|
|
|
|
|
|
|
2920
|
|
|
|
|
|
|
An arrayref of L<Moose::Role>s which are applied to the response class. You can |
2921
|
|
|
|
|
|
|
name the full namespace of the role, or a namespace suffix, which will then |
2922
|
|
|
|
|
|
|
be tried against the following standard namespace prefixes. |
2923
|
|
|
|
|
|
|
|
2924
|
|
|
|
|
|
|
$MyApp::TraitFor::Response::$trait_suffix |
2925
|
|
|
|
|
|
|
Catalyst::TraitFor::Response::$trait_suffix |
2926
|
|
|
|
|
|
|
|
2927
|
|
|
|
|
|
|
So for example if you set: |
2928
|
|
|
|
|
|
|
|
2929
|
|
|
|
|
|
|
MyApp->response_class_traits(['Foo']); |
2930
|
|
|
|
|
|
|
|
2931
|
|
|
|
|
|
|
We try each possible role in turn (and throw an error if none load) |
2932
|
|
|
|
|
|
|
|
2933
|
|
|
|
|
|
|
Foo |
2934
|
|
|
|
|
|
|
MyApp::TraitFor::Response::Foo |
2935
|
|
|
|
|
|
|
Catalyst::TraitFor::Responset::Foo |
2936
|
|
|
|
|
|
|
|
2937
|
|
|
|
|
|
|
The namespace part 'TraitFor::Response' was chosen to assist in backwards |
2938
|
|
|
|
|
|
|
compatibility with L<CatalystX::RoleApplicator> which previously provided |
2939
|
|
|
|
|
|
|
these features in a stand alone package. |
2940
|
|
|
|
|
|
|
|
2941
|
|
|
|
|
|
|
|
2942
|
|
|
|
|
|
|
=head2 $app->composed_response_class |
2943
|
|
|
|
|
|
|
|
2944
|
|
|
|
|
|
|
This is the request class which has been composed with any response_class_traits. |
2945
|
|
|
|
|
|
|
|
2946
|
|
|
|
|
|
|
=head2 $c->read( [$maxlength] ) |
2947
|
|
|
|
|
|
|
|
2948
|
|
|
|
|
|
|
Reads a chunk of data from the request body. This method is designed to |
2949
|
|
|
|
|
|
|
be used in a while loop, reading C<$maxlength> bytes on every call. |
2950
|
|
|
|
|
|
|
C<$maxlength> defaults to the size of the request if not specified. |
2951
|
|
|
|
|
|
|
|
2952
|
|
|
|
|
|
|
You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this |
2953
|
|
|
|
|
|
|
directly. |
2954
|
|
|
|
|
|
|
|
2955
|
|
|
|
|
|
|
Warning: If you use read(), Catalyst will not process the body, |
2956
|
|
|
|
|
|
|
so you will not be able to access POST parameters or file uploads via |
2957
|
|
|
|
|
|
|
$c->request. You must handle all body parsing yourself. |
2958
|
|
|
|
|
|
|
|
2959
|
|
|
|
|
|
|
=cut |
2960
|
|
|
|
|
|
|
|
2961
|
12
|
|
|
12
|
1
|
86
|
sub read { my $c = shift; return $c->request->read( @_ ) } |
|
12
|
|
|
|
|
291
|
|
2962
|
|
|
|
|
|
|
|
2963
|
|
|
|
|
|
|
=head2 $c->run |
2964
|
|
|
|
|
|
|
|
2965
|
|
|
|
|
|
|
Starts the engine. |
2966
|
|
|
|
|
|
|
|
2967
|
|
|
|
|
|
|
=cut |
2968
|
|
|
|
|
|
|
|
2969
|
|
|
|
|
|
|
sub run { |
2970
|
1
|
|
|
1
|
1
|
62
|
my $app = shift; |
2971
|
1
|
|
|
|
|
12
|
$app->_make_immutable_if_needed; |
2972
|
1
|
50
|
|
|
|
442
|
$app->engine_loader->needs_psgi_engine_compat_hack ? |
2973
|
|
|
|
|
|
|
$app->engine->run($app, @_) : |
2974
|
|
|
|
|
|
|
$app->engine->run( $app, $app->_finalized_psgi_app, @_ ); |
2975
|
|
|
|
|
|
|
} |
2976
|
|
|
|
|
|
|
|
2977
|
|
|
|
|
|
|
sub _make_immutable_if_needed { |
2978
|
3
|
|
|
3
|
|
161
|
my $class = shift; |
2979
|
3
|
|
|
|
|
16
|
my $meta = find_meta($class); |
2980
|
3
|
|
66
|
|
|
80
|
my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor'); |
2981
|
3
|
50
|
66
|
|
|
26
|
if ( |
|
|
|
66
|
|
|
|
|
2982
|
|
|
|
|
|
|
$meta->is_immutable |
2983
|
|
|
|
|
|
|
&& ! { $meta->immutable_options }->{replace_constructor} |
2984
|
|
|
|
|
|
|
&& $isa_ca |
2985
|
|
|
|
|
|
|
) { |
2986
|
1
|
|
|
|
|
66
|
warn("You made your application class ($class) immutable, " |
2987
|
|
|
|
|
|
|
. "but did not inline the\nconstructor. " |
2988
|
|
|
|
|
|
|
. "This will break catalyst, as your app \@ISA " |
2989
|
|
|
|
|
|
|
. "Class::Accessor(::Fast)?\nPlease pass " |
2990
|
|
|
|
|
|
|
. "(replace_constructor => 1)\nwhen making your class immutable.\n"); |
2991
|
|
|
|
|
|
|
} |
2992
|
3
|
100
|
|
|
|
45
|
unless ($meta->is_immutable) { |
2993
|
|
|
|
|
|
|
# XXX - FIXME warning here as you should make your app immutable yourself. |
2994
|
2
|
|
|
|
|
18
|
$meta->make_immutable( |
2995
|
|
|
|
|
|
|
replace_constructor => 1, |
2996
|
|
|
|
|
|
|
); |
2997
|
|
|
|
|
|
|
} |
2998
|
|
|
|
|
|
|
} |
2999
|
|
|
|
|
|
|
|
3000
|
|
|
|
|
|
|
=head2 $c->set_action( $action, $code, $namespace, $attrs ) |
3001
|
|
|
|
|
|
|
|
3002
|
|
|
|
|
|
|
Sets an action in a given namespace. |
3003
|
|
|
|
|
|
|
|
3004
|
|
|
|
|
|
|
=cut |
3005
|
|
|
|
|
|
|
|
3006
|
0
|
|
|
0
|
1
|
0
|
sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) } |
|
0
|
|
|
|
|
0
|
|
3007
|
|
|
|
|
|
|
|
3008
|
|
|
|
|
|
|
=head2 $c->setup_actions($component) |
3009
|
|
|
|
|
|
|
|
3010
|
|
|
|
|
|
|
Sets up actions for a component. |
3011
|
|
|
|
|
|
|
|
3012
|
|
|
|
|
|
|
=cut |
3013
|
|
|
|
|
|
|
|
3014
|
169
|
|
|
169
|
1
|
6025
|
sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) } |
|
169
|
|
|
|
|
1559
|
|
3015
|
|
|
|
|
|
|
|
3016
|
|
|
|
|
|
|
=head2 $c->setup_components |
3017
|
|
|
|
|
|
|
|
3018
|
|
|
|
|
|
|
This method is called internally to set up the application's components. |
3019
|
|
|
|
|
|
|
|
3020
|
|
|
|
|
|
|
It finds modules by calling the L<locate_components> method, expands them to |
3021
|
|
|
|
|
|
|
package names with the L<expand_component_module> method, and then installs |
3022
|
|
|
|
|
|
|
each component into the application. |
3023
|
|
|
|
|
|
|
|
3024
|
|
|
|
|
|
|
The C<setup_components> config option is passed to both of the above methods. |
3025
|
|
|
|
|
|
|
|
3026
|
|
|
|
|
|
|
Installation of each component is performed by the L<setup_component> method, |
3027
|
|
|
|
|
|
|
below. |
3028
|
|
|
|
|
|
|
|
3029
|
|
|
|
|
|
|
=cut |
3030
|
|
|
|
|
|
|
|
3031
|
|
|
|
|
|
|
sub setup_components { |
3032
|
164
|
|
|
164
|
1
|
559
|
my $class = shift; |
3033
|
|
|
|
|
|
|
|
3034
|
164
|
|
|
|
|
797
|
my $config = $class->config->{ setup_components }; |
3035
|
|
|
|
|
|
|
|
3036
|
164
|
|
|
|
|
1931
|
my @comps = $class->locate_components($config); |
3037
|
|
|
|
|
|
|
|
3038
|
164
|
|
|
|
|
725
|
my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps; |
|
6699
|
|
|
|
|
15233
|
|
3039
|
164
|
100
|
|
|
|
974
|
$class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}. |
3040
|
|
|
|
|
|
|
qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n} |
3041
|
|
|
|
|
|
|
) if $deprecatedcatalyst_component_names; |
3042
|
|
|
|
|
|
|
|
3043
|
164
|
|
|
|
|
689
|
for my $component ( @comps ) { |
3044
|
|
|
|
|
|
|
|
3045
|
|
|
|
|
|
|
# We pass ignore_loaded here so that overlay files for (e.g.) |
3046
|
|
|
|
|
|
|
# Model::DBI::Schema sub-classes are loaded - if it's in @comps |
3047
|
|
|
|
|
|
|
# we know M::P::O found a file on disk so this is safe |
3048
|
|
|
|
|
|
|
|
3049
|
6699
|
|
|
|
|
29676
|
Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } ); |
3050
|
|
|
|
|
|
|
} |
3051
|
|
|
|
|
|
|
|
3052
|
164
|
|
|
|
|
1093
|
for my $component (@comps) { |
3053
|
6699
|
|
|
|
|
15823
|
my $instance = $class->components->{ $component } = $class->delayed_setup_component($component); |
3054
|
|
|
|
|
|
|
} |
3055
|
|
|
|
|
|
|
|
3056
|
|
|
|
|
|
|
# Inject a component or wrap a stand alone class in an adaptor. This makes a list |
3057
|
|
|
|
|
|
|
# of named components in the configuration that are not actually existing (not a |
3058
|
|
|
|
|
|
|
# real file). |
3059
|
|
|
|
|
|
|
|
3060
|
164
|
|
|
|
|
2466
|
my @injected = $class->setup_injected_components; |
3061
|
|
|
|
|
|
|
|
3062
|
|
|
|
|
|
|
# All components are registered, now we need to 'init' them. |
3063
|
164
|
|
|
|
|
808
|
foreach my $component_name (@comps, @injected) { |
3064
|
|
|
|
|
|
|
$class->components->{$component_name} = $class->components->{$component_name}->() if |
3065
|
6704
|
50
|
50
|
|
|
17081
|
(ref($class->components->{$component_name}) || '') eq 'CODE'; |
3066
|
|
|
|
|
|
|
} |
3067
|
|
|
|
|
|
|
} |
3068
|
|
|
|
|
|
|
|
3069
|
|
|
|
|
|
|
=head2 $app->setup_injected_components |
3070
|
|
|
|
|
|
|
|
3071
|
|
|
|
|
|
|
Called by setup_compoents to setup components that are injected. |
3072
|
|
|
|
|
|
|
|
3073
|
|
|
|
|
|
|
=cut |
3074
|
|
|
|
|
|
|
|
3075
|
|
|
|
|
|
|
sub setup_injected_components { |
3076
|
164
|
|
|
164
|
1
|
779
|
my ($class) = @_; |
3077
|
164
|
100
|
|
|
|
516
|
my @injected_components = keys %{$class->config->{inject_components} ||+{}}; |
|
164
|
|
|
|
|
3272
|
|
3078
|
|
|
|
|
|
|
|
3079
|
164
|
|
|
|
|
1216
|
foreach my $injected_comp_name(@injected_components) { |
3080
|
|
|
|
|
|
|
$class->setup_injected_component( |
3081
|
|
|
|
|
|
|
$injected_comp_name, |
3082
|
5
|
|
|
|
|
21
|
$class->config->{inject_components}->{$injected_comp_name}); |
3083
|
|
|
|
|
|
|
} |
3084
|
|
|
|
|
|
|
|
3085
|
164
|
|
|
|
|
828
|
return map { $class ."::" . $_ } |
|
5
|
|
|
|
|
14
|
|
3086
|
|
|
|
|
|
|
@injected_components; |
3087
|
|
|
|
|
|
|
} |
3088
|
|
|
|
|
|
|
|
3089
|
|
|
|
|
|
|
=head2 $app->setup_injected_component( $injected_component_name, $config ) |
3090
|
|
|
|
|
|
|
|
3091
|
|
|
|
|
|
|
Setup a given injected component. |
3092
|
|
|
|
|
|
|
|
3093
|
|
|
|
|
|
|
=cut |
3094
|
|
|
|
|
|
|
|
3095
|
|
|
|
|
|
|
sub setup_injected_component { |
3096
|
5
|
|
|
5
|
1
|
44
|
my ($class, $injected_comp_name, $config) = @_; |
3097
|
5
|
50
|
|
|
|
21
|
if(my $component_class = $config->{from_component}) { |
3098
|
5
|
100
|
|
|
|
6
|
my @roles = @{$config->{roles} ||[]}; |
|
5
|
|
|
|
|
30
|
|
3099
|
5
|
100
|
|
|
|
26
|
Catalyst::Utils::inject_component( |
3100
|
|
|
|
|
|
|
into => $class, |
3101
|
|
|
|
|
|
|
component => $component_class, |
3102
|
|
|
|
|
|
|
(scalar(@roles) ? (traits => \@roles) : ()), |
3103
|
|
|
|
|
|
|
as => $injected_comp_name); |
3104
|
|
|
|
|
|
|
} |
3105
|
|
|
|
|
|
|
} |
3106
|
|
|
|
|
|
|
|
3107
|
|
|
|
|
|
|
=head2 $app->inject_component($MyApp_Component_name => \%args); |
3108
|
|
|
|
|
|
|
|
3109
|
|
|
|
|
|
|
Add a component that is injected at setup: |
3110
|
|
|
|
|
|
|
|
3111
|
|
|
|
|
|
|
MyApp->inject_component( 'Model::Foo' => { from_component => 'Common::Foo' } ); |
3112
|
|
|
|
|
|
|
|
3113
|
|
|
|
|
|
|
Must be called before ->setup. Expects a component name for your |
3114
|
|
|
|
|
|
|
current application and \%args where |
3115
|
|
|
|
|
|
|
|
3116
|
|
|
|
|
|
|
=over 4 |
3117
|
|
|
|
|
|
|
|
3118
|
|
|
|
|
|
|
=item from_component |
3119
|
|
|
|
|
|
|
|
3120
|
|
|
|
|
|
|
The target component being injected into your application |
3121
|
|
|
|
|
|
|
|
3122
|
|
|
|
|
|
|
=item roles |
3123
|
|
|
|
|
|
|
|
3124
|
|
|
|
|
|
|
An arrayref of L<Moose::Role>s that are applied to your component. |
3125
|
|
|
|
|
|
|
|
3126
|
|
|
|
|
|
|
=back |
3127
|
|
|
|
|
|
|
|
3128
|
|
|
|
|
|
|
Example |
3129
|
|
|
|
|
|
|
|
3130
|
|
|
|
|
|
|
MyApp->inject_component( |
3131
|
|
|
|
|
|
|
'Model::Foo' => { |
3132
|
|
|
|
|
|
|
from_component => 'Common::Model::Foo', |
3133
|
|
|
|
|
|
|
roles => ['Role1', 'Role2'], |
3134
|
|
|
|
|
|
|
}); |
3135
|
|
|
|
|
|
|
|
3136
|
|
|
|
|
|
|
=head2 $app->inject_components |
3137
|
|
|
|
|
|
|
|
3138
|
|
|
|
|
|
|
Inject a list of components: |
3139
|
|
|
|
|
|
|
|
3140
|
|
|
|
|
|
|
MyApp->inject_components( |
3141
|
|
|
|
|
|
|
'Model::FooOne' => { |
3142
|
|
|
|
|
|
|
from_component => 'Common::Model::Foo', |
3143
|
|
|
|
|
|
|
roles => ['Role1', 'Role2'], |
3144
|
|
|
|
|
|
|
}, |
3145
|
|
|
|
|
|
|
'Model::FooTwo' => { |
3146
|
|
|
|
|
|
|
from_component => 'Common::Model::Foo', |
3147
|
|
|
|
|
|
|
roles => ['Role1', 'Role2'], |
3148
|
|
|
|
|
|
|
}); |
3149
|
|
|
|
|
|
|
|
3150
|
|
|
|
|
|
|
=cut |
3151
|
|
|
|
|
|
|
|
3152
|
|
|
|
|
|
|
sub inject_component { |
3153
|
2
|
|
|
2
|
1
|
8
|
my ($app, $name, $args) = @_; |
3154
|
|
|
|
|
|
|
die "Component $name exists" if |
3155
|
2
|
50
|
|
|
|
10
|
$app->config->{inject_components}->{$name}; |
3156
|
2
|
|
|
|
|
8
|
$app->config->{inject_components}->{$name} = $args; |
3157
|
|
|
|
|
|
|
} |
3158
|
|
|
|
|
|
|
|
3159
|
|
|
|
|
|
|
sub inject_components { |
3160
|
1
|
|
|
1
|
1
|
16
|
my $app = shift; |
3161
|
1
|
|
|
|
|
5
|
while(@_) { |
3162
|
2
|
|
|
|
|
14
|
$app->inject_component(shift, shift); |
3163
|
|
|
|
|
|
|
} |
3164
|
|
|
|
|
|
|
} |
3165
|
|
|
|
|
|
|
|
3166
|
|
|
|
|
|
|
=head2 $c->locate_components( $setup_component_config ) |
3167
|
|
|
|
|
|
|
|
3168
|
|
|
|
|
|
|
This method is meant to provide a list of component modules that should be |
3169
|
|
|
|
|
|
|
setup for the application. By default, it will use L<Module::Pluggable>. |
3170
|
|
|
|
|
|
|
|
3171
|
|
|
|
|
|
|
Specify a C<setup_components> config option to pass additional options directly |
3172
|
|
|
|
|
|
|
to L<Module::Pluggable>. To add additional search paths, specify a key named |
3173
|
|
|
|
|
|
|
C<search_extra> as an array reference. Items in the array beginning with C<::> |
3174
|
|
|
|
|
|
|
will have the application class name prepended to them. |
3175
|
|
|
|
|
|
|
|
3176
|
|
|
|
|
|
|
=cut |
3177
|
|
|
|
|
|
|
|
3178
|
|
|
|
|
|
|
sub locate_components { |
3179
|
164
|
|
|
164
|
1
|
510
|
my $class = shift; |
3180
|
164
|
|
|
|
|
435
|
my $config = shift; |
3181
|
|
|
|
|
|
|
|
3182
|
164
|
|
|
|
|
898
|
my @paths = qw( ::M ::Model ::V ::View ::C ::Controller ); |
3183
|
164
|
|
100
|
|
|
1379
|
my $extra = $config->{ search_extra } || []; |
3184
|
|
|
|
|
|
|
|
3185
|
164
|
|
|
|
|
640
|
unshift @paths, @$extra; |
3186
|
|
|
|
|
|
|
|
3187
|
164
|
|
|
|
|
700
|
my @comps = map { sort { length($a) <=> length($b) } Module::Pluggable::Object->new( |
|
27797
|
|
|
|
|
1765989
|
|
3188
|
986
|
|
|
|
|
315769
|
search_path => [ map { s/^(?=::)/$class/; $_; } ($_) ], |
|
986
|
|
|
|
|
4966
|
|
|
986
|
|
|
|
|
7199
|
|
3189
|
|
|
|
|
|
|
%$config |
3190
|
|
|
|
|
|
|
)->plugins } @paths; |
3191
|
|
|
|
|
|
|
|
3192
|
164
|
|
|
|
|
65819
|
return @comps; |
3193
|
|
|
|
|
|
|
} |
3194
|
|
|
|
|
|
|
|
3195
|
|
|
|
|
|
|
=head2 $c->expand_component_module( $component, $setup_component_config ) |
3196
|
|
|
|
|
|
|
|
3197
|
|
|
|
|
|
|
Components found by C<locate_components> will be passed to this method, which |
3198
|
|
|
|
|
|
|
is expected to return a list of component (package) names to be set up. |
3199
|
|
|
|
|
|
|
|
3200
|
|
|
|
|
|
|
=cut |
3201
|
|
|
|
|
|
|
|
3202
|
|
|
|
|
|
|
sub expand_component_module { |
3203
|
0
|
|
|
0
|
1
|
0
|
my ($class, $module) = @_; |
3204
|
0
|
|
|
|
|
0
|
return Devel::InnerPackage::list_packages( $module ); |
3205
|
|
|
|
|
|
|
} |
3206
|
|
|
|
|
|
|
|
3207
|
|
|
|
|
|
|
=head2 $app->delayed_setup_component |
3208
|
|
|
|
|
|
|
|
3209
|
|
|
|
|
|
|
Returns a coderef that points to a setup_component instance. Used |
3210
|
|
|
|
|
|
|
internally for when you want to delay setup until the first time |
3211
|
|
|
|
|
|
|
the component is called. |
3212
|
|
|
|
|
|
|
|
3213
|
|
|
|
|
|
|
=cut |
3214
|
|
|
|
|
|
|
|
3215
|
|
|
|
|
|
|
sub delayed_setup_component { |
3216
|
6710
|
|
|
6710
|
1
|
17827
|
my($class, $component, @more) = @_; |
3217
|
|
|
|
|
|
|
return sub { |
3218
|
6719
|
|
|
6719
|
|
18124
|
return my $instance = $class->setup_component($component, @more); |
3219
|
6710
|
|
|
|
|
32546
|
}; |
3220
|
|
|
|
|
|
|
} |
3221
|
|
|
|
|
|
|
|
3222
|
|
|
|
|
|
|
=head2 $c->setup_component |
3223
|
|
|
|
|
|
|
|
3224
|
|
|
|
|
|
|
=cut |
3225
|
|
|
|
|
|
|
|
3226
|
|
|
|
|
|
|
sub setup_component { |
3227
|
7194
|
|
|
7194
|
1
|
14567
|
my( $class, $component ) = @_; |
3228
|
|
|
|
|
|
|
|
3229
|
7194
|
100
|
|
|
|
135785
|
unless ( $component->can( 'COMPONENT' ) ) { |
3230
|
238
|
|
|
|
|
1314
|
return $component; |
3231
|
|
|
|
|
|
|
} |
3232
|
|
|
|
|
|
|
|
3233
|
6956
|
|
|
|
|
20789
|
my $config = $class->config_for($component); |
3234
|
|
|
|
|
|
|
# Stash catalyst_component_name in the config here, so that custom COMPONENT |
3235
|
|
|
|
|
|
|
# methods also pass it. local to avoid pointlessly shitting in config |
3236
|
|
|
|
|
|
|
# for the debug screen, as $component is already the key name. |
3237
|
6956
|
|
|
|
|
19214
|
local $config->{catalyst_component_name} = $component; |
3238
|
|
|
|
|
|
|
|
3239
|
|
|
|
|
|
|
my $instance = eval { |
3240
|
|
|
|
|
|
|
$component->COMPONENT( $class, $config ); |
3241
|
6956
|
|
33
|
|
|
12621
|
} || do { |
3242
|
|
|
|
|
|
|
my $error = $@; |
3243
|
|
|
|
|
|
|
chomp $error; |
3244
|
|
|
|
|
|
|
Catalyst::Exception->throw( |
3245
|
|
|
|
|
|
|
message => qq/Couldn't instantiate component "$component", "$error"/ |
3246
|
|
|
|
|
|
|
); |
3247
|
|
|
|
|
|
|
}; |
3248
|
|
|
|
|
|
|
|
3249
|
6956
|
50
|
|
|
|
741134
|
unless (blessed $instance) { |
3250
|
0
|
|
|
|
|
0
|
my $metaclass = Moose::Util::find_meta($component); |
3251
|
0
|
|
|
|
|
0
|
my $method_meta = $metaclass->find_method_by_name('COMPONENT'); |
3252
|
0
|
|
|
|
|
0
|
my $component_method_from = $method_meta->associated_metaclass->name; |
3253
|
0
|
0
|
|
|
|
0
|
my $value = defined($instance) ? $instance : 'undef'; |
3254
|
0
|
|
|
|
|
0
|
Catalyst::Exception->throw( |
3255
|
|
|
|
|
|
|
message => |
3256
|
|
|
|
|
|
|
qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./ |
3257
|
|
|
|
|
|
|
); |
3258
|
|
|
|
|
|
|
} |
3259
|
|
|
|
|
|
|
|
3260
|
6956
|
50
|
|
|
|
60575
|
my @expanded_components = $instance->can('expand_modules') |
3261
|
|
|
|
|
|
|
? $instance->expand_modules( $component, $config ) |
3262
|
|
|
|
|
|
|
: $class->expand_component_module( $component, $config ); |
3263
|
6956
|
|
|
|
|
594240
|
for my $component (@expanded_components) { |
3264
|
6955
|
100
|
|
|
|
16001
|
next if $class->components->{ $component }; |
3265
|
475
|
|
|
|
|
2659
|
$class->components->{ $component } = $class->setup_component($component); |
3266
|
|
|
|
|
|
|
} |
3267
|
|
|
|
|
|
|
|
3268
|
6956
|
|
|
|
|
39972
|
return $instance; |
3269
|
|
|
|
|
|
|
} |
3270
|
|
|
|
|
|
|
|
3271
|
|
|
|
|
|
|
=head2 $app->config_for( $component_name ) |
3272
|
|
|
|
|
|
|
|
3273
|
|
|
|
|
|
|
Return the application level configuration (which is not yet merged with any |
3274
|
|
|
|
|
|
|
local component configuration, via $component_class->config) for the named |
3275
|
|
|
|
|
|
|
component or component object. Example: |
3276
|
|
|
|
|
|
|
|
3277
|
|
|
|
|
|
|
MyApp->config( |
3278
|
|
|
|
|
|
|
'Model::Foo' => { a => 1, b => 2}, |
3279
|
|
|
|
|
|
|
); |
3280
|
|
|
|
|
|
|
|
3281
|
|
|
|
|
|
|
my $config = MyApp->config_for('MyApp::Model::Foo'); |
3282
|
|
|
|
|
|
|
|
3283
|
|
|
|
|
|
|
In this case $config is the hashref C<< {a=>1, b=>2} >>. |
3284
|
|
|
|
|
|
|
|
3285
|
|
|
|
|
|
|
This is also handy for looking up configuration for a plugin, to make sure you follow |
3286
|
|
|
|
|
|
|
existing L<Catalyst> standards for where a plugin should put its configuration. |
3287
|
|
|
|
|
|
|
|
3288
|
|
|
|
|
|
|
=cut |
3289
|
|
|
|
|
|
|
|
3290
|
|
|
|
|
|
|
sub config_for { |
3291
|
6956
|
|
|
6956
|
1
|
12782
|
my ($class, $component_name) = @_; |
3292
|
6956
|
|
|
|
|
20171
|
my $component_suffix = Catalyst::Utils::class2classsuffix($component_name); |
3293
|
6956
|
|
100
|
|
|
24855
|
my $config = $class->config->{ $component_suffix } || {}; |
3294
|
|
|
|
|
|
|
|
3295
|
6956
|
|
|
|
|
14911
|
return $config; |
3296
|
|
|
|
|
|
|
} |
3297
|
|
|
|
|
|
|
|
3298
|
|
|
|
|
|
|
=head2 $c->setup_dispatcher |
3299
|
|
|
|
|
|
|
|
3300
|
|
|
|
|
|
|
Sets up dispatcher. |
3301
|
|
|
|
|
|
|
|
3302
|
|
|
|
|
|
|
=cut |
3303
|
|
|
|
|
|
|
|
3304
|
|
|
|
|
|
|
sub setup_dispatcher { |
3305
|
164
|
|
|
164
|
1
|
9306
|
my ( $class, $dispatcher ) = @_; |
3306
|
|
|
|
|
|
|
|
3307
|
164
|
50
|
|
|
|
924
|
if ($dispatcher) { |
3308
|
0
|
|
|
|
|
0
|
$dispatcher = 'Catalyst::Dispatcher::' . $dispatcher; |
3309
|
|
|
|
|
|
|
} |
3310
|
|
|
|
|
|
|
|
3311
|
164
|
50
|
|
|
|
1121
|
if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) { |
3312
|
0
|
|
|
|
|
0
|
$dispatcher = 'Catalyst::Dispatcher::' . $env; |
3313
|
|
|
|
|
|
|
} |
3314
|
|
|
|
|
|
|
|
3315
|
164
|
50
|
|
|
|
992
|
unless ($dispatcher) { |
3316
|
164
|
|
|
|
|
2141
|
$dispatcher = $class->dispatcher_class; |
3317
|
|
|
|
|
|
|
} |
3318
|
|
|
|
|
|
|
|
3319
|
164
|
|
|
|
|
1374
|
load_class($dispatcher); |
3320
|
|
|
|
|
|
|
|
3321
|
|
|
|
|
|
|
# dispatcher instance |
3322
|
164
|
|
|
|
|
12778
|
$class->dispatcher( $dispatcher->new ); |
3323
|
|
|
|
|
|
|
} |
3324
|
|
|
|
|
|
|
|
3325
|
|
|
|
|
|
|
=head2 $c->setup_engine |
3326
|
|
|
|
|
|
|
|
3327
|
|
|
|
|
|
|
Sets up engine. |
3328
|
|
|
|
|
|
|
|
3329
|
|
|
|
|
|
|
=cut |
3330
|
|
|
|
|
|
|
|
3331
|
|
|
|
|
|
|
sub engine_class { |
3332
|
0
|
|
|
0
|
1
|
0
|
my ($class, $requested_engine) = @_; |
3333
|
|
|
|
|
|
|
|
3334
|
0
|
0
|
0
|
|
|
0
|
if (!$class->engine_loader || $requested_engine) { |
3335
|
0
|
0
|
|
|
|
0
|
$class->engine_loader( |
3336
|
|
|
|
|
|
|
Catalyst::EngineLoader->new({ |
3337
|
|
|
|
|
|
|
application_name => $class, |
3338
|
|
|
|
|
|
|
(defined $requested_engine |
3339
|
|
|
|
|
|
|
? (catalyst_engine_class => $requested_engine) : ()), |
3340
|
|
|
|
|
|
|
}), |
3341
|
|
|
|
|
|
|
); |
3342
|
|
|
|
|
|
|
} |
3343
|
|
|
|
|
|
|
|
3344
|
0
|
|
|
|
|
0
|
$class->engine_loader->catalyst_engine_class; |
3345
|
|
|
|
|
|
|
} |
3346
|
|
|
|
|
|
|
|
3347
|
|
|
|
|
|
|
sub setup_engine { |
3348
|
164
|
|
|
164
|
1
|
754
|
my ($class, $requested_engine) = @_; |
3349
|
|
|
|
|
|
|
|
3350
|
164
|
|
|
|
|
456
|
my $engine = do { |
3351
|
164
|
|
|
|
|
1711
|
my $loader = $class->engine_loader; |
3352
|
|
|
|
|
|
|
|
3353
|
164
|
50
|
33
|
|
|
1258
|
if (!$loader || $requested_engine) { |
3354
|
164
|
50
|
|
|
|
9067
|
$loader = Catalyst::EngineLoader->new({ |
3355
|
|
|
|
|
|
|
application_name => $class, |
3356
|
|
|
|
|
|
|
(defined $requested_engine |
3357
|
|
|
|
|
|
|
? (requested_engine => $requested_engine) : ()), |
3358
|
|
|
|
|
|
|
}), |
3359
|
|
|
|
|
|
|
|
3360
|
|
|
|
|
|
|
$class->engine_loader($loader); |
3361
|
|
|
|
|
|
|
} |
3362
|
|
|
|
|
|
|
|
3363
|
164
|
|
|
|
|
7836
|
$loader->catalyst_engine_class; |
3364
|
|
|
|
|
|
|
}; |
3365
|
|
|
|
|
|
|
|
3366
|
|
|
|
|
|
|
# Don't really setup_engine -- see _setup_psgi_app for explanation. |
3367
|
164
|
50
|
|
|
|
2469
|
return if $class->loading_psgi_file; |
3368
|
|
|
|
|
|
|
|
3369
|
164
|
|
|
|
|
3596
|
load_class($engine); |
3370
|
|
|
|
|
|
|
|
3371
|
164
|
50
|
|
|
|
6274
|
if ($ENV{MOD_PERL}) { |
3372
|
0
|
|
|
|
|
0
|
my $apache = $class->engine_loader->auto; |
3373
|
|
|
|
|
|
|
|
3374
|
0
|
|
|
|
|
0
|
my $meta = find_meta($class); |
3375
|
0
|
|
|
|
|
0
|
my $was_immutable = $meta->is_immutable; |
3376
|
0
|
|
|
|
|
0
|
my %immutable_options = $meta->immutable_options; |
3377
|
0
|
0
|
|
|
|
0
|
$meta->make_mutable if $was_immutable; |
3378
|
|
|
|
|
|
|
|
3379
|
|
|
|
|
|
|
$meta->add_method(handler => sub { |
3380
|
0
|
|
|
0
|
|
0
|
my $r = shift; |
3381
|
0
|
|
|
|
|
0
|
my $psgi_app = $class->_finalized_psgi_app; |
3382
|
0
|
|
|
|
|
0
|
$apache->call_app($r, $psgi_app); |
3383
|
0
|
|
|
|
|
0
|
}); |
3384
|
|
|
|
|
|
|
|
3385
|
0
|
0
|
|
|
|
0
|
$meta->make_immutable(%immutable_options) if $was_immutable; |
3386
|
|
|
|
|
|
|
} |
3387
|
|
|
|
|
|
|
|
3388
|
164
|
|
|
|
|
5851
|
$class->engine( $engine->new ); |
3389
|
|
|
|
|
|
|
|
3390
|
164
|
|
|
|
|
612
|
return; |
3391
|
|
|
|
|
|
|
} |
3392
|
|
|
|
|
|
|
|
3393
|
|
|
|
|
|
|
## This exists just to supply a prebuild psgi app for mod_perl and for the |
3394
|
|
|
|
|
|
|
## build in server support (back compat support for pre psgi port behavior). |
3395
|
|
|
|
|
|
|
## This is so that we don't build a new psgi app for each request when using |
3396
|
|
|
|
|
|
|
## the mod_perl handler or the built in servers (http and fcgi, etc). |
3397
|
|
|
|
|
|
|
|
3398
|
|
|
|
|
|
|
sub _finalized_psgi_app { |
3399
|
915
|
|
|
915
|
|
2861
|
my ($app) = @_; |
3400
|
|
|
|
|
|
|
|
3401
|
915
|
100
|
|
|
|
4710
|
unless ($app->_psgi_app) { |
3402
|
123
|
|
|
|
|
1443
|
my $psgi_app = $app->_setup_psgi_app; |
3403
|
123
|
|
|
|
|
825
|
$app->_psgi_app($psgi_app); |
3404
|
|
|
|
|
|
|
} |
3405
|
|
|
|
|
|
|
|
3406
|
915
|
|
|
|
|
3627
|
return $app->_psgi_app; |
3407
|
|
|
|
|
|
|
} |
3408
|
|
|
|
|
|
|
|
3409
|
|
|
|
|
|
|
## Look for a psgi file like 'myapp_web.psgi' (if the app is MyApp::Web) in the |
3410
|
|
|
|
|
|
|
## home directory and load that and return it (just assume it is doing the |
3411
|
|
|
|
|
|
|
## right thing :) ). If that does not exist, call $app->psgi_app, wrap that |
3412
|
|
|
|
|
|
|
## in default_middleware and return it ( this is for backward compatibility |
3413
|
|
|
|
|
|
|
## with pre psgi port behavior ). |
3414
|
|
|
|
|
|
|
|
3415
|
|
|
|
|
|
|
sub _setup_psgi_app { |
3416
|
123
|
|
|
123
|
|
505
|
my ($app) = @_; |
3417
|
|
|
|
|
|
|
|
3418
|
123
|
|
|
|
|
1168
|
for my $home (Path::Class::Dir->new($app->config->{home})) { |
3419
|
90
|
|
|
|
|
14074
|
my $psgi_file = $home->file( |
3420
|
|
|
|
|
|
|
Catalyst::Utils::appprefix($app) . '.psgi', |
3421
|
|
|
|
|
|
|
); |
3422
|
|
|
|
|
|
|
|
3423
|
90
|
100
|
|
|
|
14861
|
next unless -e $psgi_file; |
3424
|
|
|
|
|
|
|
|
3425
|
|
|
|
|
|
|
# If $psgi_file calls ->setup_engine, it's doing so to load |
3426
|
|
|
|
|
|
|
# Catalyst::Engine::PSGI. But if it does that, we're only going to |
3427
|
|
|
|
|
|
|
# throw away the loaded PSGI-app and load the 5.9 Catalyst::Engine |
3428
|
|
|
|
|
|
|
# anyway. So set a flag (ick) that tells setup_engine not to populate |
3429
|
|
|
|
|
|
|
# $c->engine or do any other things we might regret. |
3430
|
|
|
|
|
|
|
|
3431
|
2
|
|
|
|
|
252
|
$app->loading_psgi_file(1); |
3432
|
2
|
|
|
|
|
38
|
my $psgi_app = Plack::Util::load_psgi($psgi_file); |
3433
|
2
|
|
|
|
|
98
|
$app->loading_psgi_file(0); |
3434
|
|
|
|
|
|
|
|
3435
|
2
|
50
|
|
|
|
38
|
return $psgi_app |
3436
|
|
|
|
|
|
|
unless $app->engine_loader->needs_psgi_engine_compat_hack; |
3437
|
|
|
|
|
|
|
|
3438
|
0
|
|
|
|
|
0
|
warn <<"EOW"; |
3439
|
|
|
|
|
|
|
Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}. |
3440
|
|
|
|
|
|
|
|
3441
|
|
|
|
|
|
|
Its content has been ignored. Please consult the Catalyst::Upgrading |
3442
|
|
|
|
|
|
|
documentation on how to upgrade from Catalyst::Engine::PSGI. |
3443
|
|
|
|
|
|
|
EOW |
3444
|
|
|
|
|
|
|
} |
3445
|
|
|
|
|
|
|
|
3446
|
121
|
|
|
|
|
11558
|
return $app->apply_default_middlewares($app->psgi_app); |
3447
|
|
|
|
|
|
|
} |
3448
|
|
|
|
|
|
|
|
3449
|
|
|
|
|
|
|
=head2 $c->apply_default_middlewares |
3450
|
|
|
|
|
|
|
|
3451
|
|
|
|
|
|
|
Adds the following L<Plack> middlewares to your application, since they are |
3452
|
|
|
|
|
|
|
useful and commonly needed: |
3453
|
|
|
|
|
|
|
|
3454
|
|
|
|
|
|
|
L<Plack::Middleware::LighttpdScriptNameFix> (if you are using Lighttpd), |
3455
|
|
|
|
|
|
|
L<Plack::Middleware::IIS6ScriptNameFix> (always applied since this middleware |
3456
|
|
|
|
|
|
|
is smart enough to conditionally apply itself). |
3457
|
|
|
|
|
|
|
|
3458
|
|
|
|
|
|
|
We will also automatically add L<Plack::Middleware::ReverseProxy> if we notice |
3459
|
|
|
|
|
|
|
that your HTTP $env variable C<REMOTE_ADDR> is '127.0.0.1'. This is usually |
3460
|
|
|
|
|
|
|
an indication that your server is running behind a proxy frontend. However in |
3461
|
|
|
|
|
|
|
2014 this is often not the case. We preserve this code for backwards compatibility |
3462
|
|
|
|
|
|
|
however I B<highly> recommend that if you are running the server behind a front |
3463
|
|
|
|
|
|
|
end proxy that you clearly indicate so with the C<using_frontend_proxy> configuration |
3464
|
|
|
|
|
|
|
setting to true for your environment configurations that run behind a proxy. This |
3465
|
|
|
|
|
|
|
way if you change your front end proxy address someday your code would inexplicably |
3466
|
|
|
|
|
|
|
stop working as expected. |
3467
|
|
|
|
|
|
|
|
3468
|
|
|
|
|
|
|
Additionally if we detect we are using Nginx, we add a bit of custom middleware |
3469
|
|
|
|
|
|
|
to solve some problems with the way that server handles $ENV{PATH_INFO} and |
3470
|
|
|
|
|
|
|
$ENV{SCRIPT_NAME}. |
3471
|
|
|
|
|
|
|
|
3472
|
|
|
|
|
|
|
Please B<NOTE> that if you do use C<using_frontend_proxy> the middleware is now |
3473
|
|
|
|
|
|
|
adding via C<registered_middleware> rather than this method. |
3474
|
|
|
|
|
|
|
|
3475
|
|
|
|
|
|
|
If you are using Lighttpd or IIS6 you may wish to apply these middlewares. In |
3476
|
|
|
|
|
|
|
general this is no longer a common case but we have this here for backward |
3477
|
|
|
|
|
|
|
compatibility. |
3478
|
|
|
|
|
|
|
|
3479
|
|
|
|
|
|
|
=cut |
3480
|
|
|
|
|
|
|
|
3481
|
|
|
|
|
|
|
|
3482
|
|
|
|
|
|
|
sub apply_default_middlewares { |
3483
|
123
|
|
|
123
|
1
|
969
|
my ($app, $psgi_app) = @_; |
3484
|
|
|
|
|
|
|
|
3485
|
|
|
|
|
|
|
# Don't add this conditional IF we are explicitly saying we want the |
3486
|
|
|
|
|
|
|
# frontend proxy support. We don't need it here since if that is the |
3487
|
|
|
|
|
|
|
# case it will be always loaded in the default_middleware. |
3488
|
|
|
|
|
|
|
|
3489
|
123
|
50
|
|
|
|
647
|
unless($app->config->{using_frontend_proxy}) { |
3490
|
|
|
|
|
|
|
$psgi_app = Plack::Middleware::Conditional->wrap( |
3491
|
|
|
|
|
|
|
$psgi_app, |
3492
|
123
|
|
|
123
|
|
13586
|
builder => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) }, |
3493
|
|
|
|
|
|
|
condition => sub { |
3494
|
915
|
|
|
915
|
|
13602
|
my ($env) = @_; |
3495
|
915
|
100
|
|
|
|
6773
|
return if $app->config->{ignore_frontend_proxy}; |
3496
|
914
|
|
66
|
|
|
6324
|
return $env->{REMOTE_ADDR} && $env->{REMOTE_ADDR} eq '127.0.0.1'; |
3497
|
|
|
|
|
|
|
}, |
3498
|
123
|
|
|
|
|
2433
|
); |
3499
|
|
|
|
|
|
|
} |
3500
|
|
|
|
|
|
|
|
3501
|
|
|
|
|
|
|
# If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME |
3502
|
|
|
|
|
|
|
# http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html |
3503
|
|
|
|
|
|
|
$psgi_app = Plack::Middleware::Conditional->wrap( |
3504
|
|
|
|
|
|
|
$psgi_app, |
3505
|
123
|
|
|
123
|
|
6106
|
builder => sub { Plack::Middleware::LighttpdScriptNameFix->wrap($_[0]) }, |
3506
|
|
|
|
|
|
|
condition => sub { |
3507
|
915
|
|
|
915
|
|
36880
|
my ($env) = @_; |
3508
|
915
|
100
|
100
|
|
|
4601
|
return unless $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!lighttpd[-/]1\.(\d+\.\d+)!; |
3509
|
1
|
50
|
|
|
|
8
|
return unless $1 < 4.23; |
3510
|
1
|
|
|
|
|
3
|
1; |
3511
|
|
|
|
|
|
|
}, |
3512
|
123
|
|
|
|
|
7358
|
); |
3513
|
|
|
|
|
|
|
|
3514
|
|
|
|
|
|
|
# we're applying this unconditionally as the middleware itself already makes |
3515
|
|
|
|
|
|
|
# sure it doesn't fuck things up if it's not running under one of the right |
3516
|
|
|
|
|
|
|
# IIS versions |
3517
|
123
|
|
|
|
|
13906
|
$psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app); |
3518
|
|
|
|
|
|
|
|
3519
|
|
|
|
|
|
|
# And another IIS issue, this time with IIS7. |
3520
|
|
|
|
|
|
|
$psgi_app = Plack::Middleware::Conditional->wrap( |
3521
|
|
|
|
|
|
|
$psgi_app, |
3522
|
123
|
|
|
123
|
|
5495
|
builder => sub { Plack::Middleware::IIS7KeepAliveFix->wrap($_[0]) }, |
3523
|
|
|
|
|
|
|
condition => sub { |
3524
|
915
|
|
|
915
|
|
17317
|
my ($env) = @_; |
3525
|
915
|
|
66
|
|
|
4160
|
return $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!IIS/7\.[0-9]!; |
3526
|
|
|
|
|
|
|
}, |
3527
|
123
|
|
|
|
|
5695
|
); |
3528
|
|
|
|
|
|
|
|
3529
|
123
|
|
|
|
|
5438
|
return $psgi_app; |
3530
|
|
|
|
|
|
|
} |
3531
|
|
|
|
|
|
|
|
3532
|
|
|
|
|
|
|
=head2 App->psgi_app |
3533
|
|
|
|
|
|
|
|
3534
|
|
|
|
|
|
|
=head2 App->to_app |
3535
|
|
|
|
|
|
|
|
3536
|
|
|
|
|
|
|
Returns a PSGI application code reference for the catalyst application |
3537
|
|
|
|
|
|
|
C<$c>. This is the bare application created without the C<apply_default_middlewares> |
3538
|
|
|
|
|
|
|
method called. We do however apply C<registered_middleware> since those are |
3539
|
|
|
|
|
|
|
integral to how L<Catalyst> functions. Also, unlike starting your application |
3540
|
|
|
|
|
|
|
with a generated server script (via L<Catalyst::Devel> and C<catalyst.pl>) we do |
3541
|
|
|
|
|
|
|
not attempt to return a valid L<PSGI> application using any existing C<${myapp}.psgi> |
3542
|
|
|
|
|
|
|
scripts in your $HOME directory. |
3543
|
|
|
|
|
|
|
|
3544
|
|
|
|
|
|
|
B<NOTE> C<apply_default_middlewares> was originally created when the first PSGI |
3545
|
|
|
|
|
|
|
port was done for v5.90000. These are middlewares that are added to achieve |
3546
|
|
|
|
|
|
|
backward compatibility with older applications. If you start your application |
3547
|
|
|
|
|
|
|
using one of the supplied server scripts (generated with L<Catalyst::Devel> and |
3548
|
|
|
|
|
|
|
the project skeleton script C<catalyst.pl>) we apply C<apply_default_middlewares> |
3549
|
|
|
|
|
|
|
automatically. This was done so that pre and post PSGI port applications would |
3550
|
|
|
|
|
|
|
work the same way. |
3551
|
|
|
|
|
|
|
|
3552
|
|
|
|
|
|
|
This is what you want to be using to retrieve the PSGI application code |
3553
|
|
|
|
|
|
|
reference of your Catalyst application for use in a custom F<.psgi> or in your |
3554
|
|
|
|
|
|
|
own created server modules. |
3555
|
|
|
|
|
|
|
|
3556
|
|
|
|
|
|
|
=cut |
3557
|
|
|
|
|
|
|
|
3558
|
|
|
|
|
|
|
*to_app = \&psgi_app; |
3559
|
|
|
|
|
|
|
|
3560
|
|
|
|
|
|
|
sub psgi_app { |
3561
|
135
|
|
|
135
|
1
|
4463
|
my ($app) = @_; |
3562
|
135
|
|
|
|
|
1223
|
my $psgi = $app->engine->build_psgi_app($app); |
3563
|
135
|
|
|
|
|
1468
|
return $app->Catalyst::Utils::apply_registered_middleware($psgi); |
3564
|
|
|
|
|
|
|
} |
3565
|
|
|
|
|
|
|
|
3566
|
|
|
|
|
|
|
=head2 $c->setup_home |
3567
|
|
|
|
|
|
|
|
3568
|
|
|
|
|
|
|
Sets up the home directory. |
3569
|
|
|
|
|
|
|
|
3570
|
|
|
|
|
|
|
=cut |
3571
|
|
|
|
|
|
|
|
3572
|
|
|
|
|
|
|
sub setup_home { |
3573
|
323
|
|
|
323
|
1
|
1274
|
my ( $class, $home ) = @_; |
3574
|
|
|
|
|
|
|
|
3575
|
323
|
100
|
|
|
|
1903
|
if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) { |
3576
|
2
|
|
|
|
|
6
|
$home = $env; |
3577
|
|
|
|
|
|
|
} |
3578
|
|
|
|
|
|
|
|
3579
|
323
|
|
100
|
|
|
2235
|
$home ||= Catalyst::Utils::home($class); |
3580
|
|
|
|
|
|
|
|
3581
|
323
|
100
|
|
|
|
41523
|
if ($home) { |
3582
|
|
|
|
|
|
|
#I remember recently being scolded for assigning config values like this |
3583
|
219
|
|
66
|
|
|
1591
|
$class->config->{home} ||= $home; |
3584
|
219
|
|
66
|
|
|
842
|
$class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root'); |
3585
|
|
|
|
|
|
|
} |
3586
|
|
|
|
|
|
|
} |
3587
|
|
|
|
|
|
|
|
3588
|
|
|
|
|
|
|
=head2 $c->setup_encoding |
3589
|
|
|
|
|
|
|
|
3590
|
|
|
|
|
|
|
Sets up the input/output encoding. See L<ENCODING> |
3591
|
|
|
|
|
|
|
|
3592
|
|
|
|
|
|
|
=cut |
3593
|
|
|
|
|
|
|
|
3594
|
|
|
|
|
|
|
sub setup_encoding { |
3595
|
164
|
|
|
164
|
1
|
876
|
my $c = shift; |
3596
|
164
|
100
|
100
|
|
|
1377
|
if( exists($c->config->{encoding}) && !defined($c->config->{encoding}) ) { |
3597
|
|
|
|
|
|
|
# Ok, so the user has explicitly said "I don't want encoding..." |
3598
|
1
|
|
|
|
|
19
|
return; |
3599
|
|
|
|
|
|
|
} else { |
3600
|
|
|
|
|
|
|
my $enc = defined($c->config->{encoding}) ? |
3601
|
163
|
100
|
|
|
|
866
|
delete $c->config->{encoding} : 'UTF-8'; # not sure why we delete it... (JNAP) |
3602
|
163
|
|
|
|
|
1835
|
$c->encoding($enc); |
3603
|
|
|
|
|
|
|
} |
3604
|
|
|
|
|
|
|
} |
3605
|
|
|
|
|
|
|
|
3606
|
|
|
|
|
|
|
=head2 handle_unicode_encoding_exception |
3607
|
|
|
|
|
|
|
|
3608
|
|
|
|
|
|
|
Hook to let you customize how encoding errors are handled. By default |
3609
|
|
|
|
|
|
|
we just throw an exception and the default error page will pick it up. |
3610
|
|
|
|
|
|
|
Receives a hashref of debug information. Example of call (from the |
3611
|
|
|
|
|
|
|
Catalyst internals): |
3612
|
|
|
|
|
|
|
|
3613
|
|
|
|
|
|
|
my $decoded_after_fail = $c->handle_unicode_encoding_exception({ |
3614
|
|
|
|
|
|
|
param_value => $value, |
3615
|
|
|
|
|
|
|
error_msg => $_, |
3616
|
|
|
|
|
|
|
encoding_step => 'params', |
3617
|
|
|
|
|
|
|
}); |
3618
|
|
|
|
|
|
|
|
3619
|
|
|
|
|
|
|
The calling code expects to receive a decoded string or an exception. |
3620
|
|
|
|
|
|
|
|
3621
|
|
|
|
|
|
|
You can override this for custom handling of unicode errors. By |
3622
|
|
|
|
|
|
|
default we just die. If you want a custom response here, one approach |
3623
|
|
|
|
|
|
|
is to throw an HTTP style exception, instead of returning a decoded |
3624
|
|
|
|
|
|
|
string or throwing a generic exception. |
3625
|
|
|
|
|
|
|
|
3626
|
|
|
|
|
|
|
sub handle_unicode_encoding_exception { |
3627
|
|
|
|
|
|
|
my ($c, $params) = @_; |
3628
|
|
|
|
|
|
|
HTTP::Exception::BAD_REQUEST->throw(status_message=>$params->{error_msg}); |
3629
|
|
|
|
|
|
|
} |
3630
|
|
|
|
|
|
|
|
3631
|
|
|
|
|
|
|
Alternatively you can 'catch' the error, stash it and write handling code later |
3632
|
|
|
|
|
|
|
in your application: |
3633
|
|
|
|
|
|
|
|
3634
|
|
|
|
|
|
|
sub handle_unicode_encoding_exception { |
3635
|
|
|
|
|
|
|
my ($c, $params) = @_; |
3636
|
|
|
|
|
|
|
$c->stash(BAD_UNICODE_DATA=>$params); |
3637
|
|
|
|
|
|
|
# return a dummy string. |
3638
|
|
|
|
|
|
|
return 1; |
3639
|
|
|
|
|
|
|
} |
3640
|
|
|
|
|
|
|
|
3641
|
|
|
|
|
|
|
<B>NOTE:</b> Please keep in mind that once an error like this occurs, |
3642
|
|
|
|
|
|
|
the request setup is still ongoing, which means the state of C<$c> and |
3643
|
|
|
|
|
|
|
related context parts like the request and response may not be setup |
3644
|
|
|
|
|
|
|
up correctly (since we haven't finished the setup yet). If you throw |
3645
|
|
|
|
|
|
|
an exception the setup is aborted. |
3646
|
|
|
|
|
|
|
|
3647
|
|
|
|
|
|
|
=cut |
3648
|
|
|
|
|
|
|
|
3649
|
|
|
|
|
|
|
sub handle_unicode_encoding_exception { |
3650
|
3
|
|
|
3
|
1
|
11
|
my ( $self, $exception_ctx ) = @_; |
3651
|
3
|
|
|
|
|
23
|
die $exception_ctx->{error_msg}; |
3652
|
|
|
|
|
|
|
} |
3653
|
|
|
|
|
|
|
|
3654
|
|
|
|
|
|
|
# Some unicode helpers cargo culted from the old plugin. These could likely |
3655
|
|
|
|
|
|
|
# be neater. |
3656
|
|
|
|
|
|
|
|
3657
|
|
|
|
|
|
|
sub _handle_unicode_decoding { |
3658
|
120
|
|
|
120
|
|
314
|
my ( $self, $value ) = @_; |
3659
|
|
|
|
|
|
|
|
3660
|
120
|
50
|
|
|
|
331
|
return unless defined $value; |
3661
|
|
|
|
|
|
|
|
3662
|
|
|
|
|
|
|
## I think this mess is to support the old nested |
3663
|
120
|
100
|
|
|
|
422
|
if ( ref $value eq 'ARRAY' ) { |
|
|
100
|
|
|
|
|
|
3664
|
3
|
|
|
|
|
11
|
foreach ( @$value ) { |
3665
|
12
|
|
|
|
|
187
|
$_ = $self->_handle_unicode_decoding($_); |
3666
|
|
|
|
|
|
|
} |
3667
|
3
|
|
|
|
|
62
|
return $value; |
3668
|
|
|
|
|
|
|
} |
3669
|
|
|
|
|
|
|
elsif ( ref $value eq 'HASH' ) { |
3670
|
36
|
|
|
|
|
161
|
foreach (keys %$value) { |
3671
|
34
|
|
|
|
|
134
|
my $encoded_key = $self->_handle_param_unicode_decoding($_); |
3672
|
34
|
|
|
|
|
751
|
$value->{$encoded_key} = $self->_handle_unicode_decoding($value->{$_}); |
3673
|
|
|
|
|
|
|
|
3674
|
|
|
|
|
|
|
# If the key was encoded we now have two (the original and current so |
3675
|
|
|
|
|
|
|
# delete the original. |
3676
|
33
|
100
|
|
|
|
653
|
delete $value->{$_} if $_ ne $encoded_key; |
3677
|
|
|
|
|
|
|
} |
3678
|
35
|
|
|
|
|
124
|
return $value; |
3679
|
|
|
|
|
|
|
} |
3680
|
|
|
|
|
|
|
else { |
3681
|
81
|
|
|
|
|
245
|
return $self->_handle_param_unicode_decoding($value); |
3682
|
|
|
|
|
|
|
} |
3683
|
|
|
|
|
|
|
} |
3684
|
|
|
|
|
|
|
|
3685
|
|
|
|
|
|
|
sub _handle_param_unicode_decoding { |
3686
|
1218
|
|
|
1218
|
|
3311
|
my ( $self, $value, $check ) = @_; |
3687
|
1218
|
50
|
|
|
|
3082
|
return unless defined $value; # not in love with just ignoring undefs - jnap |
3688
|
1218
|
50
|
|
|
|
3689
|
return $value if blessed($value); #don't decode when the value is an object. |
3689
|
|
|
|
|
|
|
|
3690
|
1218
|
|
|
|
|
2744
|
my $enc = $self->encoding; |
3691
|
|
|
|
|
|
|
|
3692
|
1218
|
100
|
|
|
|
3366
|
return $value unless $enc; # don't decode if no encoding is specified |
3693
|
|
|
|
|
|
|
|
3694
|
1214
|
|
66
|
|
|
4733
|
$check ||= $self->_encode_check; |
3695
|
|
|
|
|
|
|
return try { |
3696
|
1214
|
|
|
1214
|
|
58052
|
$enc->decode( $value, $check); |
3697
|
|
|
|
|
|
|
} |
3698
|
|
|
|
|
|
|
catch { |
3699
|
19
|
|
|
19
|
|
647
|
return $self->handle_unicode_encoding_exception({ |
3700
|
|
|
|
|
|
|
param_value => $value, |
3701
|
|
|
|
|
|
|
error_msg => $_, |
3702
|
|
|
|
|
|
|
encoding_step => 'params', |
3703
|
|
|
|
|
|
|
}); |
3704
|
1214
|
|
|
|
|
9179
|
}; |
3705
|
|
|
|
|
|
|
} |
3706
|
|
|
|
|
|
|
|
3707
|
|
|
|
|
|
|
=head2 $c->setup_log |
3708
|
|
|
|
|
|
|
|
3709
|
|
|
|
|
|
|
Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and |
3710
|
|
|
|
|
|
|
passing it to C<log()>. Pass in a comma-delimited list of levels to set the |
3711
|
|
|
|
|
|
|
log to. |
3712
|
|
|
|
|
|
|
|
3713
|
|
|
|
|
|
|
This method also installs a C<debug> method that returns a true value into the |
3714
|
|
|
|
|
|
|
catalyst subclass if the "debug" level is passed in the comma-delimited list, |
3715
|
|
|
|
|
|
|
or if the C<$CATALYST_DEBUG> environment variable is set to a true value. |
3716
|
|
|
|
|
|
|
|
3717
|
|
|
|
|
|
|
Note that if the log has already been setup, by either a previous call to |
3718
|
|
|
|
|
|
|
C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>, |
3719
|
|
|
|
|
|
|
that this method won't actually set up the log object. |
3720
|
|
|
|
|
|
|
|
3721
|
|
|
|
|
|
|
=cut |
3722
|
|
|
|
|
|
|
|
3723
|
|
|
|
|
|
|
sub setup_log { |
3724
|
176
|
|
|
176
|
1
|
36208
|
my ( $class, $levels ) = @_; |
3725
|
|
|
|
|
|
|
|
3726
|
176
|
|
100
|
|
|
1424
|
$levels ||= ''; |
3727
|
176
|
|
|
|
|
568
|
$levels =~ s/^\s+//; |
3728
|
176
|
|
|
|
|
534
|
$levels =~ s/\s+$//; |
3729
|
176
|
|
|
|
|
889
|
my %levels = map { $_ => 1 } split /\s*,\s*/, $levels; |
|
23
|
|
|
|
|
106
|
|
3730
|
|
|
|
|
|
|
|
3731
|
176
|
|
|
|
|
854
|
my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' ); |
3732
|
176
|
100
|
|
|
|
957
|
if ( defined $env_debug ) { |
3733
|
4
|
100
|
|
|
|
17
|
$levels{debug} = 1 if $env_debug; # Ugly! |
3734
|
4
|
100
|
|
|
|
17
|
delete($levels{debug}) unless $env_debug; |
3735
|
|
|
|
|
|
|
} |
3736
|
|
|
|
|
|
|
|
3737
|
176
|
100
|
|
|
|
1426
|
unless ( $class->log ) { |
3738
|
152
|
|
|
|
|
2041
|
$class->log( Catalyst::Log->new(keys %levels) ); |
3739
|
|
|
|
|
|
|
} |
3740
|
|
|
|
|
|
|
|
3741
|
176
|
100
|
|
|
|
1592
|
if ( $levels{debug} ) { |
3742
|
5
|
|
|
33
|
|
22
|
Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 }); |
|
33
|
|
|
18
|
|
1502
|
|
3743
|
5
|
|
|
|
|
356
|
$class->log->debug('Debug messages enabled'); |
3744
|
|
|
|
|
|
|
} |
3745
|
|
|
|
|
|
|
} |
3746
|
|
|
|
|
|
|
|
3747
|
|
|
|
|
|
|
=head2 $c->setup_plugins |
3748
|
|
|
|
|
|
|
|
3749
|
|
|
|
|
|
|
Sets up plugins. |
3750
|
|
|
|
|
|
|
|
3751
|
|
|
|
|
|
|
=cut |
3752
|
|
|
|
|
|
|
|
3753
|
|
|
|
|
|
|
=head2 $c->setup_stats |
3754
|
|
|
|
|
|
|
|
3755
|
|
|
|
|
|
|
Sets up timing statistics class. |
3756
|
|
|
|
|
|
|
|
3757
|
|
|
|
|
|
|
=cut |
3758
|
|
|
|
|
|
|
|
3759
|
|
|
|
|
|
|
sub setup_stats { |
3760
|
169
|
|
|
169
|
1
|
36213
|
my ( $class, $stats ) = @_; |
3761
|
|
|
|
|
|
|
|
3762
|
169
|
|
|
|
|
1645
|
Catalyst::Utils::ensure_class_loaded($class->stats_class); |
3763
|
|
|
|
|
|
|
|
3764
|
169
|
|
|
|
|
1114
|
my $env = Catalyst::Utils::env_value( $class, 'STATS' ); |
3765
|
169
|
100
|
100
|
|
|
4058
|
if ( defined($env) ? $env : ($stats || $class->debug ) ) { |
|
|
100
|
|
|
|
|
|
3766
|
11
|
|
|
258
|
|
75
|
Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 }); |
|
258
|
|
|
|
|
1547
|
|
3767
|
11
|
|
|
|
|
855
|
$class->log->debug('Statistics enabled'); |
3768
|
|
|
|
|
|
|
} |
3769
|
|
|
|
|
|
|
} |
3770
|
|
|
|
|
|
|
|
3771
|
|
|
|
|
|
|
|
3772
|
|
|
|
|
|
|
=head2 $c->registered_plugins |
3773
|
|
|
|
|
|
|
|
3774
|
|
|
|
|
|
|
Returns a sorted list of the plugins which have either been stated in the |
3775
|
|
|
|
|
|
|
import list. |
3776
|
|
|
|
|
|
|
|
3777
|
|
|
|
|
|
|
If passed a given plugin name, it will report a boolean value indicating |
3778
|
|
|
|
|
|
|
whether or not that plugin is loaded. A fully qualified name is required if |
3779
|
|
|
|
|
|
|
the plugin name does not begin with C<Catalyst::Plugin::>. |
3780
|
|
|
|
|
|
|
|
3781
|
|
|
|
|
|
|
if ($c->registered_plugins('Some::Plugin')) { |
3782
|
|
|
|
|
|
|
... |
3783
|
|
|
|
|
|
|
} |
3784
|
|
|
|
|
|
|
|
3785
|
|
|
|
|
|
|
=cut |
3786
|
|
|
|
|
|
|
|
3787
|
|
|
|
|
|
|
{ |
3788
|
|
|
|
|
|
|
|
3789
|
|
|
|
|
|
|
sub registered_plugins { |
3790
|
634
|
|
|
892
|
1
|
48985
|
my $proto = shift; |
3791
|
634
|
100
|
|
|
|
2194
|
return sort keys %{ $proto->_plugins } unless @_; |
|
627
|
|
|
|
|
2938
|
|
3792
|
7
|
|
|
|
|
26
|
my $plugin = shift; |
3793
|
7
|
100
|
|
|
|
23
|
return 1 if exists $proto->_plugins->{$plugin}; |
3794
|
4
|
|
|
|
|
10
|
return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"}; |
3795
|
|
|
|
|
|
|
} |
3796
|
|
|
|
|
|
|
|
3797
|
|
|
|
|
|
|
sub _register_plugin { |
3798
|
564
|
|
|
567
|
|
1625
|
my ( $proto, $plugin, $instant ) = @_; |
3799
|
564
|
|
33
|
|
|
2386
|
my $class = ref $proto || $proto; |
3800
|
|
|
|
|
|
|
|
3801
|
564
|
|
|
|
|
1889
|
load_class( $plugin ); |
3802
|
564
|
50
|
|
|
|
23965
|
$class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" ) |
3803
|
|
|
|
|
|
|
if $plugin->isa( 'Catalyst::Component' ); |
3804
|
564
|
|
|
|
|
3372
|
my $plugin_meta = Moose::Meta::Class->create($plugin); |
3805
|
564
|
100
|
66
|
|
|
581885
|
if (!$plugin_meta->has_method('new') |
|
|
|
66
|
|
|
|
|
3806
|
|
|
|
|
|
|
&& ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) { |
3807
|
1
|
|
|
|
|
43
|
$plugin_meta->add_method('new', Moose::Object->meta->get_method('new')) |
3808
|
|
|
|
|
|
|
} |
3809
|
564
|
50
|
66
|
|
|
23796
|
if (!$instant && !$proto->_plugins->{$plugin}) { |
3810
|
563
|
|
|
|
|
1766
|
my $meta = Class::MOP::get_metaclass_by_name($class); |
3811
|
563
|
|
|
|
|
3107
|
$meta->superclasses($plugin, $meta->superclasses); |
3812
|
|
|
|
|
|
|
} |
3813
|
564
|
|
|
|
|
2823772
|
$proto->_plugins->{$plugin} = 1; |
3814
|
564
|
|
|
|
|
1824
|
return $class; |
3815
|
|
|
|
|
|
|
} |
3816
|
|
|
|
|
|
|
|
3817
|
164
|
|
|
164
|
|
709
|
sub _default_plugins { return qw() } |
3818
|
|
|
|
|
|
|
|
3819
|
|
|
|
|
|
|
sub setup_plugins { |
3820
|
164
|
|
|
164
|
1
|
790
|
my ( $class, $plugins ) = @_; |
3821
|
|
|
|
|
|
|
|
3822
|
164
|
50
|
|
|
|
1497
|
$class->_plugins( {} ) unless $class->_plugins; |
3823
|
|
|
|
|
|
|
$plugins = [ grep { |
3824
|
164
|
50
|
|
|
|
982
|
m/Unicode::Encoding/ ? do { |
|
643
|
|
|
|
|
2011
|
|
3825
|
0
|
|
|
|
|
0
|
$class->log->warn( |
3826
|
|
|
|
|
|
|
'Unicode::Encoding plugin is auto-applied,' |
3827
|
|
|
|
|
|
|
. ' please remove this from your appclass' |
3828
|
|
|
|
|
|
|
. ' and make sure to define "encoding" config' |
3829
|
|
|
|
|
|
|
); |
3830
|
0
|
0
|
|
|
|
0
|
unless (exists $class->config->{'encoding'}) { |
3831
|
0
|
|
|
|
|
0
|
$class->config->{'encoding'} = 'UTF-8'; |
3832
|
|
|
|
|
|
|
} |
3833
|
0
|
|
|
|
|
0
|
() } |
3834
|
|
|
|
|
|
|
: $_ |
3835
|
|
|
|
|
|
|
} @$plugins ]; |
3836
|
164
|
|
|
|
|
1783
|
push @$plugins, $class->_default_plugins; |
3837
|
164
|
|
50
|
|
|
1562
|
$plugins = Data::OptList::mkopt($plugins || []); |
3838
|
|
|
|
|
|
|
|
3839
|
|
|
|
|
|
|
my @plugins = map { |
3840
|
642
|
|
|
|
|
33411
|
[ Catalyst::Utils::resolve_namespace( |
3841
|
|
|
|
|
|
|
$class . '::Plugin', |
3842
|
|
|
|
|
|
|
'Catalyst::Plugin', $_->[0] |
3843
|
|
|
|
|
|
|
), |
3844
|
|
|
|
|
|
|
$_->[1], |
3845
|
|
|
|
|
|
|
] |
3846
|
164
|
|
|
|
|
10958
|
} @{ $plugins }; |
|
164
|
|
|
|
|
724
|
|
3847
|
|
|
|
|
|
|
|
3848
|
164
|
|
|
|
|
5594
|
for my $plugin ( reverse @plugins ) { |
3849
|
642
|
|
|
|
|
2959
|
load_class($plugin->[0], $plugin->[1]); |
3850
|
642
|
|
|
|
|
998036
|
my $meta = find_meta($plugin->[0]); |
3851
|
642
|
100
|
100
|
|
|
9283
|
next if $meta && $meta->isa('Moose::Meta::Role'); |
3852
|
|
|
|
|
|
|
|
3853
|
563
|
|
|
|
|
7184
|
$class->_register_plugin($plugin->[0]); |
3854
|
|
|
|
|
|
|
} |
3855
|
|
|
|
|
|
|
|
3856
|
|
|
|
|
|
|
my @roles = |
3857
|
79
|
|
|
|
|
713
|
map { $_->[0]->name, $_->[1] } |
3858
|
642
|
50
|
|
|
|
4789
|
grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') } |
3859
|
164
|
|
|
|
|
932
|
map { [find_meta($_->[0]), $_->[1]] } |
|
642
|
|
|
|
|
4877
|
|
3860
|
|
|
|
|
|
|
@plugins; |
3861
|
|
|
|
|
|
|
|
3862
|
164
|
100
|
|
|
|
1198
|
Moose::Util::apply_all_roles( |
3863
|
|
|
|
|
|
|
$class => @roles |
3864
|
|
|
|
|
|
|
) if @roles; |
3865
|
|
|
|
|
|
|
} |
3866
|
|
|
|
|
|
|
} |
3867
|
|
|
|
|
|
|
|
3868
|
|
|
|
|
|
|
=head2 default_middleware |
3869
|
|
|
|
|
|
|
|
3870
|
|
|
|
|
|
|
Returns a list of instantiated PSGI middleware objects which is the default |
3871
|
|
|
|
|
|
|
middleware that is active for this application (taking any configuration |
3872
|
|
|
|
|
|
|
options into account, excluding your custom added middleware via the C<psgi_middleware> |
3873
|
|
|
|
|
|
|
configuration option). You can override this method if you wish to change |
3874
|
|
|
|
|
|
|
the default middleware (although do so at risk since some middleware is vital |
3875
|
|
|
|
|
|
|
to application function.) |
3876
|
|
|
|
|
|
|
|
3877
|
|
|
|
|
|
|
The current default middleware list is: |
3878
|
|
|
|
|
|
|
|
3879
|
|
|
|
|
|
|
Catalyst::Middleware::Stash |
3880
|
|
|
|
|
|
|
Plack::Middleware::HTTPExceptions |
3881
|
|
|
|
|
|
|
Plack::Middleware::RemoveRedundantBody |
3882
|
|
|
|
|
|
|
Plack::Middleware::FixMissingBodyInRedirect |
3883
|
|
|
|
|
|
|
Plack::Middleware::ContentLength |
3884
|
|
|
|
|
|
|
Plack::Middleware::MethodOverride |
3885
|
|
|
|
|
|
|
Plack::Middleware::Head |
3886
|
|
|
|
|
|
|
|
3887
|
|
|
|
|
|
|
If the configuration setting C<using_frontend_proxy> is true we add: |
3888
|
|
|
|
|
|
|
|
3889
|
|
|
|
|
|
|
Plack::Middleware::ReverseProxy |
3890
|
|
|
|
|
|
|
|
3891
|
|
|
|
|
|
|
If the configuration setting C<using_frontend_proxy_path> is true we add: |
3892
|
|
|
|
|
|
|
|
3893
|
|
|
|
|
|
|
Plack::Middleware::ReverseProxyPath |
3894
|
|
|
|
|
|
|
|
3895
|
|
|
|
|
|
|
But B<NOTE> that L<Plack::Middleware::ReverseProxyPath> is not a dependency of the |
3896
|
|
|
|
|
|
|
L<Catalyst> distribution so if you want to use this option you should add it to |
3897
|
|
|
|
|
|
|
your project distribution file. |
3898
|
|
|
|
|
|
|
|
3899
|
|
|
|
|
|
|
These middlewares will be added at L</setup_middleware> during the |
3900
|
|
|
|
|
|
|
L</setup> phase of application startup. |
3901
|
|
|
|
|
|
|
|
3902
|
|
|
|
|
|
|
=cut |
3903
|
|
|
|
|
|
|
|
3904
|
|
|
|
|
|
|
sub default_middleware { |
3905
|
144
|
|
|
144
|
1
|
502
|
my $class = shift; |
3906
|
144
|
|
|
|
|
2789
|
my @mw = ( |
3907
|
|
|
|
|
|
|
Catalyst::Middleware::Stash->new, |
3908
|
|
|
|
|
|
|
Plack::Middleware::HTTPExceptions->new, |
3909
|
|
|
|
|
|
|
Plack::Middleware::RemoveRedundantBody->new, |
3910
|
|
|
|
|
|
|
Plack::Middleware::FixMissingBodyInRedirect->new, |
3911
|
|
|
|
|
|
|
Plack::Middleware::ContentLength->new, |
3912
|
|
|
|
|
|
|
Plack::Middleware::MethodOverride->new, |
3913
|
|
|
|
|
|
|
Plack::Middleware::Head->new); |
3914
|
|
|
|
|
|
|
|
3915
|
144
|
50
|
|
|
|
27419
|
if($class->config->{using_frontend_proxy}) { |
3916
|
0
|
|
|
|
|
0
|
push @mw, Plack::Middleware::ReverseProxy->new; |
3917
|
|
|
|
|
|
|
} |
3918
|
|
|
|
|
|
|
|
3919
|
144
|
50
|
|
|
|
1168
|
if($class->config->{using_frontend_proxy_path}) { |
3920
|
0
|
0
|
|
|
|
0
|
if(Class::Load::try_load_class('Plack::Middleware::ReverseProxyPath')) { |
3921
|
0
|
|
|
|
|
0
|
push @mw, Plack::Middleware::ReverseProxyPath->new; |
3922
|
|
|
|
|
|
|
} else { |
3923
|
0
|
|
|
|
|
0
|
$class->log->error("Cannot use configuration 'using_frontend_proxy_path' because 'Plack::Middleware::ReverseProxyPath' is not installed"); |
3924
|
|
|
|
|
|
|
} |
3925
|
|
|
|
|
|
|
} |
3926
|
|
|
|
|
|
|
|
3927
|
144
|
|
|
|
|
906
|
return @mw; |
3928
|
|
|
|
|
|
|
} |
3929
|
|
|
|
|
|
|
|
3930
|
|
|
|
|
|
|
=head2 registered_middlewares |
3931
|
|
|
|
|
|
|
|
3932
|
|
|
|
|
|
|
Read only accessor that returns an array of all the middleware in the order |
3933
|
|
|
|
|
|
|
that they were added (which is the REVERSE of the order they will be applied). |
3934
|
|
|
|
|
|
|
|
3935
|
|
|
|
|
|
|
The values returned will be either instances of L<Plack::Middleware> or of a |
3936
|
|
|
|
|
|
|
compatible interface, or a coderef, which is assumed to be inlined middleware |
3937
|
|
|
|
|
|
|
|
3938
|
|
|
|
|
|
|
=head2 setup_middleware (?@middleware) |
3939
|
|
|
|
|
|
|
|
3940
|
|
|
|
|
|
|
Read configuration information stored in configuration key C<psgi_middleware> or |
3941
|
|
|
|
|
|
|
from passed @args. |
3942
|
|
|
|
|
|
|
|
3943
|
|
|
|
|
|
|
See under L</CONFIGURATION> information regarding C<psgi_middleware> and how |
3944
|
|
|
|
|
|
|
to use it to enable L<Plack::Middleware> |
3945
|
|
|
|
|
|
|
|
3946
|
|
|
|
|
|
|
This method is automatically called during 'setup' of your application, so |
3947
|
|
|
|
|
|
|
you really don't need to invoke it. However you may do so if you find the idea |
3948
|
|
|
|
|
|
|
of loading middleware via configuration weird :). For example: |
3949
|
|
|
|
|
|
|
|
3950
|
|
|
|
|
|
|
package MyApp; |
3951
|
|
|
|
|
|
|
|
3952
|
|
|
|
|
|
|
use Catalyst; |
3953
|
|
|
|
|
|
|
|
3954
|
|
|
|
|
|
|
__PACKAGE__->setup_middleware('Head'); |
3955
|
|
|
|
|
|
|
__PACKAGE__->setup; |
3956
|
|
|
|
|
|
|
|
3957
|
|
|
|
|
|
|
When we read middleware definitions from configuration, we reverse the list |
3958
|
|
|
|
|
|
|
which sounds odd but is likely how you expect it to work if you have prior |
3959
|
|
|
|
|
|
|
experience with L<Plack::Builder> or if you previously used the plugin |
3960
|
|
|
|
|
|
|
L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated) |
3961
|
|
|
|
|
|
|
|
3962
|
|
|
|
|
|
|
So basically your middleware handles an incoming request from the first |
3963
|
|
|
|
|
|
|
registered middleware, down and handles the response from the last middleware |
3964
|
|
|
|
|
|
|
up. |
3965
|
|
|
|
|
|
|
|
3966
|
|
|
|
|
|
|
=cut |
3967
|
|
|
|
|
|
|
|
3968
|
|
|
|
|
|
|
sub registered_middlewares { |
3969
|
144
|
|
|
144
|
1
|
1529
|
my $class = shift; |
3970
|
144
|
50
|
|
|
|
1090
|
if(my $middleware = $class->_psgi_middleware) { |
3971
|
144
|
|
|
|
|
1606
|
my @mw = ($class->default_middleware, @$middleware); |
3972
|
|
|
|
|
|
|
|
3973
|
144
|
50
|
|
|
|
794
|
if($class->config->{using_frontend_proxy}) { |
3974
|
0
|
|
|
|
|
0
|
push @mw, Plack::Middleware::ReverseProxy->new; |
3975
|
|
|
|
|
|
|
} |
3976
|
|
|
|
|
|
|
|
3977
|
144
|
|
|
|
|
1017
|
return @mw; |
3978
|
|
|
|
|
|
|
} else { |
3979
|
0
|
|
|
|
|
0
|
die "You cannot call ->registered_middlewares until middleware has been setup"; |
3980
|
|
|
|
|
|
|
} |
3981
|
|
|
|
|
|
|
} |
3982
|
|
|
|
|
|
|
|
3983
|
|
|
|
|
|
|
sub setup_middleware { |
3984
|
168
|
|
|
168
|
1
|
812
|
my $class = shift; |
3985
|
168
|
|
|
|
|
404
|
my @middleware_definitions; |
3986
|
|
|
|
|
|
|
|
3987
|
|
|
|
|
|
|
# If someone calls this method you can add middleware with args. However if its |
3988
|
|
|
|
|
|
|
# called without an arg we need to setup the configuration middleware. |
3989
|
168
|
100
|
|
|
|
723
|
if(@_) { |
3990
|
2
|
|
|
|
|
8
|
@middleware_definitions = reverse(@_); |
3991
|
|
|
|
|
|
|
} else { |
3992
|
166
|
100
|
|
|
|
1397
|
@middleware_definitions = reverse(@{$class->config->{'psgi_middleware'}||[]}) |
|
164
|
100
|
|
|
|
1147
|
|
3993
|
|
|
|
|
|
|
unless $class->finalized_default_middleware; |
3994
|
166
|
|
|
|
|
1002
|
$class->finalized_default_middleware(1); # Only do this once, just in case some people call setup over and over... |
3995
|
|
|
|
|
|
|
} |
3996
|
|
|
|
|
|
|
|
3997
|
168
|
|
|
|
|
882
|
my @middleware = (); |
3998
|
168
|
|
|
|
|
988
|
while(my $next = shift(@middleware_definitions)) { |
3999
|
14
|
100
|
|
|
|
44
|
if(ref $next) { |
4000
|
8
|
100
|
66
|
|
|
69
|
if(Scalar::Util::blessed $next && $next->can('wrap')) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
4001
|
2
|
|
|
|
|
11
|
push @middleware, $next; |
4002
|
|
|
|
|
|
|
} elsif(ref $next eq 'CODE') { |
4003
|
2
|
|
|
|
|
8
|
push @middleware, $next; |
4004
|
|
|
|
|
|
|
} elsif(ref $next eq 'HASH') { |
4005
|
4
|
|
|
|
|
11
|
my $namespace = shift @middleware_definitions; |
4006
|
4
|
|
|
|
|
38
|
my $mw = $class->Catalyst::Utils::build_middleware($namespace, %$next); |
4007
|
4
|
|
|
|
|
1636
|
push @middleware, $mw; |
4008
|
|
|
|
|
|
|
} else { |
4009
|
0
|
|
|
|
|
0
|
die "I can't handle middleware definition ${\ref $next}"; |
|
0
|
|
|
|
|
0
|
|
4010
|
|
|
|
|
|
|
} |
4011
|
|
|
|
|
|
|
} else { |
4012
|
6
|
|
|
|
|
47
|
my $mw = $class->Catalyst::Utils::build_middleware($next); |
4013
|
5
|
|
|
|
|
193
|
push @middleware, $mw; |
4014
|
|
|
|
|
|
|
} |
4015
|
|
|
|
|
|
|
} |
4016
|
|
|
|
|
|
|
|
4017
|
167
|
100
|
|
|
|
462
|
my @existing = @{$class->_psgi_middleware || []}; |
|
167
|
|
|
|
|
4351
|
|
4018
|
167
|
|
|
|
|
923
|
$class->_psgi_middleware([@middleware,@existing,]); |
4019
|
|
|
|
|
|
|
} |
4020
|
|
|
|
|
|
|
|
4021
|
|
|
|
|
|
|
=head2 registered_data_handlers |
4022
|
|
|
|
|
|
|
|
4023
|
|
|
|
|
|
|
A read only copy of registered Data Handlers returned as a Hash, where each key |
4024
|
|
|
|
|
|
|
is a content type and each value is a subref that attempts to decode that content |
4025
|
|
|
|
|
|
|
type. |
4026
|
|
|
|
|
|
|
|
4027
|
|
|
|
|
|
|
=head2 setup_data_handlers (?@data_handler) |
4028
|
|
|
|
|
|
|
|
4029
|
|
|
|
|
|
|
Read configuration information stored in configuration key C<data_handlers> or |
4030
|
|
|
|
|
|
|
from passed @args. |
4031
|
|
|
|
|
|
|
|
4032
|
|
|
|
|
|
|
See under L</CONFIGURATION> information regarding C<data_handlers>. |
4033
|
|
|
|
|
|
|
|
4034
|
|
|
|
|
|
|
This method is automatically called during 'setup' of your application, so |
4035
|
|
|
|
|
|
|
you really don't need to invoke it. |
4036
|
|
|
|
|
|
|
|
4037
|
|
|
|
|
|
|
=head2 default_data_handlers |
4038
|
|
|
|
|
|
|
|
4039
|
|
|
|
|
|
|
Default Data Handlers that come bundled with L<Catalyst>. Currently there are |
4040
|
|
|
|
|
|
|
only two default data handlers, for 'application/json' and an alternative to |
4041
|
|
|
|
|
|
|
'application/x-www-form-urlencoded' which supposed nested form parameters via |
4042
|
|
|
|
|
|
|
L<CGI::Struct> or via L<CGI::Struct::XS> IF you've installed it. |
4043
|
|
|
|
|
|
|
|
4044
|
|
|
|
|
|
|
The 'application/json' data handler is used to parse incoming JSON into a Perl |
4045
|
|
|
|
|
|
|
data structure. It uses L<JSON::MaybeXS>. This allows you to fail back to |
4046
|
|
|
|
|
|
|
L<JSON::PP>, which is a Pure Perl JSON decoder, and has the smallest dependency |
4047
|
|
|
|
|
|
|
impact. |
4048
|
|
|
|
|
|
|
|
4049
|
|
|
|
|
|
|
Because we don't wish to add more dependencies to L<Catalyst>, if you wish to |
4050
|
|
|
|
|
|
|
use this new feature we recommend installing L<Cpanel::JSON::XS> in order to get |
4051
|
|
|
|
|
|
|
the best performance. You should add either to your dependency list |
4052
|
|
|
|
|
|
|
(Makefile.PL, dist.ini, cpanfile, etc.) |
4053
|
|
|
|
|
|
|
|
4054
|
|
|
|
|
|
|
=cut |
4055
|
|
|
|
|
|
|
|
4056
|
|
|
|
|
|
|
sub registered_data_handlers { |
4057
|
946
|
|
|
946
|
1
|
2114
|
my $class = shift; |
4058
|
946
|
50
|
|
|
|
4025
|
if(my $data_handlers = $class->_data_handlers) { |
4059
|
946
|
|
|
|
|
6753
|
return %$data_handlers; |
4060
|
|
|
|
|
|
|
} else { |
4061
|
0
|
|
|
|
|
0
|
$class->setup_data_handlers; |
4062
|
0
|
|
|
|
|
0
|
return $class->registered_data_handlers; |
4063
|
|
|
|
|
|
|
} |
4064
|
|
|
|
|
|
|
} |
4065
|
|
|
|
|
|
|
|
4066
|
|
|
|
|
|
|
sub setup_data_handlers { |
4067
|
164
|
|
|
164
|
1
|
741
|
my ($class, %data_handler_callbacks) = @_; |
4068
|
|
|
|
|
|
|
%data_handler_callbacks = ( |
4069
|
164
|
|
|
|
|
1280
|
%{$class->default_data_handlers}, |
4070
|
164
|
50
|
|
|
|
434
|
%{$class->config->{'data_handlers'}||+{}}, |
|
164
|
|
|
|
|
1322
|
|
4071
|
|
|
|
|
|
|
%data_handler_callbacks); |
4072
|
|
|
|
|
|
|
|
4073
|
164
|
|
|
|
|
2223
|
$class->_data_handlers(\%data_handler_callbacks); |
4074
|
|
|
|
|
|
|
} |
4075
|
|
|
|
|
|
|
|
4076
|
|
|
|
|
|
|
sub default_data_handlers { |
4077
|
164
|
|
|
164
|
1
|
650
|
my ($class) = @_; |
4078
|
|
|
|
|
|
|
return +{ |
4079
|
|
|
|
|
|
|
'application/x-www-form-urlencoded' => sub { |
4080
|
1
|
|
|
1
|
|
4
|
my ($fh, $req) = @_; |
4081
|
1
|
50
|
|
|
|
29
|
my $params = $req->_use_hash_multivalue ? $req->body_parameters->mixed : $req->body_parameters; |
4082
|
1
|
|
|
|
|
10
|
Class::Load::load_first_existing_class('CGI::Struct::XS', 'CGI::Struct') |
4083
|
|
|
|
|
|
|
->can('build_cgi_struct')->($params); |
4084
|
|
|
|
|
|
|
}, |
4085
|
|
|
|
|
|
|
'application/json' => sub { |
4086
|
5
|
|
|
5
|
|
24
|
my ($fh, $req) = @_; |
4087
|
5
|
|
|
|
|
47
|
require JSON::MaybeXS; |
4088
|
5
|
|
|
|
|
12
|
my $slurped; |
4089
|
5
|
|
66
|
|
|
15
|
return eval { |
4090
|
|
|
|
|
|
|
local $/; |
4091
|
|
|
|
|
|
|
$slurped = $fh->getline; |
4092
|
|
|
|
|
|
|
JSON::MaybeXS::decode_json($slurped); # decode_json does utf8 decoding for us |
4093
|
|
|
|
|
|
|
} || Catalyst::Exception->throw(sprintf "Error Parsing POST '%s', Error: %s", (defined($slurped) ? $slurped : 'undef') ,$@); |
4094
|
|
|
|
|
|
|
}, |
4095
|
164
|
|
|
|
|
2338
|
}; |
4096
|
|
|
|
|
|
|
} |
4097
|
|
|
|
|
|
|
|
4098
|
|
|
|
|
|
|
sub _handle_http_exception { |
4099
|
167
|
|
|
167
|
|
439
|
my ( $self, $error ) = @_; |
4100
|
167
|
100
|
100
|
|
|
596
|
if ( |
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
4101
|
|
|
|
|
|
|
!$self->config->{always_catch_http_exceptions} |
4102
|
|
|
|
|
|
|
&& blessed $error |
4103
|
|
|
|
|
|
|
&& ( |
4104
|
|
|
|
|
|
|
$error->can('as_psgi') |
4105
|
|
|
|
|
|
|
|| ( $error->can('code') |
4106
|
|
|
|
|
|
|
&& $error->code =~ m/^[1-5][0-9][0-9]$/ ) |
4107
|
|
|
|
|
|
|
) |
4108
|
|
|
|
|
|
|
) |
4109
|
|
|
|
|
|
|
{ |
4110
|
14
|
|
|
|
|
97
|
return 1; |
4111
|
|
|
|
|
|
|
} |
4112
|
|
|
|
|
|
|
} |
4113
|
|
|
|
|
|
|
|
4114
|
|
|
|
|
|
|
=head2 $c->stack |
4115
|
|
|
|
|
|
|
|
4116
|
|
|
|
|
|
|
Returns an arrayref of the internal execution stack (actions that are |
4117
|
|
|
|
|
|
|
currently executing). |
4118
|
|
|
|
|
|
|
|
4119
|
|
|
|
|
|
|
=head2 $c->stats |
4120
|
|
|
|
|
|
|
|
4121
|
|
|
|
|
|
|
Returns the current timing statistics object. By default Catalyst uses |
4122
|
|
|
|
|
|
|
L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with |
4123
|
|
|
|
|
|
|
L<< stats_class|/"$c->stats_class" >>. |
4124
|
|
|
|
|
|
|
|
4125
|
|
|
|
|
|
|
Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still |
4126
|
|
|
|
|
|
|
available. By enabling it with C<< $c->stats->enabled(1) >>, it can be used to |
4127
|
|
|
|
|
|
|
profile explicitly, although MyApp.pm still won't profile nor output anything |
4128
|
|
|
|
|
|
|
by itself. |
4129
|
|
|
|
|
|
|
|
4130
|
|
|
|
|
|
|
=head2 $c->stats_class |
4131
|
|
|
|
|
|
|
|
4132
|
|
|
|
|
|
|
Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default. |
4133
|
|
|
|
|
|
|
|
4134
|
|
|
|
|
|
|
=head2 $app->stats_class_traits |
4135
|
|
|
|
|
|
|
|
4136
|
|
|
|
|
|
|
A arrayref of L<Moose::Role>s that are applied to the stats_class before creating it. |
4137
|
|
|
|
|
|
|
|
4138
|
|
|
|
|
|
|
=head2 $app->composed_stats_class |
4139
|
|
|
|
|
|
|
|
4140
|
|
|
|
|
|
|
this is the stats_class composed with any 'stats_class_traits'. You can |
4141
|
|
|
|
|
|
|
name the full namespace of the role, or a namespace suffix, which will then |
4142
|
|
|
|
|
|
|
be tried against the following standard namespace prefixes. |
4143
|
|
|
|
|
|
|
|
4144
|
|
|
|
|
|
|
$MyApp::TraitFor::Stats::$trait_suffix |
4145
|
|
|
|
|
|
|
Catalyst::TraitFor::Stats::$trait_suffix |
4146
|
|
|
|
|
|
|
|
4147
|
|
|
|
|
|
|
So for example if you set: |
4148
|
|
|
|
|
|
|
|
4149
|
|
|
|
|
|
|
MyApp->stats_class_traits(['Foo']); |
4150
|
|
|
|
|
|
|
|
4151
|
|
|
|
|
|
|
We try each possible role in turn (and throw an error if none load) |
4152
|
|
|
|
|
|
|
|
4153
|
|
|
|
|
|
|
Foo |
4154
|
|
|
|
|
|
|
MyApp::TraitFor::Stats::Foo |
4155
|
|
|
|
|
|
|
Catalyst::TraitFor::Stats::Foo |
4156
|
|
|
|
|
|
|
|
4157
|
|
|
|
|
|
|
The namespace part 'TraitFor::Stats' was chosen to assist in backwards |
4158
|
|
|
|
|
|
|
compatibility with L<CatalystX::RoleApplicator> which previously provided |
4159
|
|
|
|
|
|
|
these features in a stand alone package. |
4160
|
|
|
|
|
|
|
|
4161
|
|
|
|
|
|
|
=head2 $c->use_stats |
4162
|
|
|
|
|
|
|
|
4163
|
|
|
|
|
|
|
Returns 1 when L<< stats collection|/"-Stats" >> is enabled. |
4164
|
|
|
|
|
|
|
|
4165
|
|
|
|
|
|
|
Note that this is a static method, not an accessor and should be overridden |
4166
|
|
|
|
|
|
|
by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>. |
4167
|
|
|
|
|
|
|
|
4168
|
|
|
|
|
|
|
=cut |
4169
|
|
|
|
|
|
|
|
4170
|
19927
|
|
|
19927
|
1
|
70333
|
sub use_stats { 0 } |
4171
|
|
|
|
|
|
|
|
4172
|
|
|
|
|
|
|
|
4173
|
|
|
|
|
|
|
=head2 $c->write( $data ) |
4174
|
|
|
|
|
|
|
|
4175
|
|
|
|
|
|
|
Writes $data to the output stream. When using this method directly, you |
4176
|
|
|
|
|
|
|
will need to manually set the C<Content-Length> header to the length of |
4177
|
|
|
|
|
|
|
your output data, if known. |
4178
|
|
|
|
|
|
|
|
4179
|
|
|
|
|
|
|
=cut |
4180
|
|
|
|
|
|
|
|
4181
|
|
|
|
|
|
|
sub write { |
4182
|
0
|
|
|
0
|
1
|
0
|
my $c = shift; |
4183
|
|
|
|
|
|
|
|
4184
|
|
|
|
|
|
|
# Finalize headers if someone manually writes output (for compat) |
4185
|
0
|
|
|
|
|
0
|
$c->finalize_headers; |
4186
|
|
|
|
|
|
|
|
4187
|
0
|
|
|
|
|
0
|
return $c->response->write( @_ ); |
4188
|
|
|
|
|
|
|
} |
4189
|
|
|
|
|
|
|
|
4190
|
|
|
|
|
|
|
=head2 version |
4191
|
|
|
|
|
|
|
|
4192
|
|
|
|
|
|
|
Returns the Catalyst version number. Mostly useful for "powered by" |
4193
|
|
|
|
|
|
|
messages in template systems. |
4194
|
|
|
|
|
|
|
|
4195
|
|
|
|
|
|
|
=cut |
4196
|
|
|
|
|
|
|
|
4197
|
0
|
|
|
0
|
1
|
0
|
sub version { return $Catalyst::VERSION } |
4198
|
|
|
|
|
|
|
|
4199
|
|
|
|
|
|
|
=head1 CONFIGURATION |
4200
|
|
|
|
|
|
|
|
4201
|
|
|
|
|
|
|
There are a number of 'base' config variables which can be set: |
4202
|
|
|
|
|
|
|
|
4203
|
|
|
|
|
|
|
=over |
4204
|
|
|
|
|
|
|
|
4205
|
|
|
|
|
|
|
=item * |
4206
|
|
|
|
|
|
|
|
4207
|
|
|
|
|
|
|
C<always_catch_http_exceptions> - As of version 5.90060 Catalyst |
4208
|
|
|
|
|
|
|
rethrows errors conforming to the interface described by |
4209
|
|
|
|
|
|
|
L<Plack::Middleware::HTTPExceptions> and lets the middleware deal with it. |
4210
|
|
|
|
|
|
|
Set true to get the deprecated behaviour and have Catalyst catch HTTP exceptions. |
4211
|
|
|
|
|
|
|
|
4212
|
|
|
|
|
|
|
=item * |
4213
|
|
|
|
|
|
|
|
4214
|
|
|
|
|
|
|
C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>. |
4215
|
|
|
|
|
|
|
|
4216
|
|
|
|
|
|
|
=item * |
4217
|
|
|
|
|
|
|
|
4218
|
|
|
|
|
|
|
C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>. |
4219
|
|
|
|
|
|
|
|
4220
|
|
|
|
|
|
|
=item * |
4221
|
|
|
|
|
|
|
|
4222
|
|
|
|
|
|
|
C<disable_component_resolution_regex_fallback> - Turns |
4223
|
|
|
|
|
|
|
off the deprecated component resolution functionality so |
4224
|
|
|
|
|
|
|
that if any of the component methods (e.g. C<< $c->controller('Foo') >>) |
4225
|
|
|
|
|
|
|
are called then regex search will not be attempted on string values and |
4226
|
|
|
|
|
|
|
instead C<undef> will be returned. |
4227
|
|
|
|
|
|
|
|
4228
|
|
|
|
|
|
|
=item * |
4229
|
|
|
|
|
|
|
|
4230
|
|
|
|
|
|
|
C<home> - The application home directory. In an uninstalled application, |
4231
|
|
|
|
|
|
|
this is the top level application directory. In an installed application, |
4232
|
|
|
|
|
|
|
this will be the directory containing C<< MyApp.pm >>. |
4233
|
|
|
|
|
|
|
|
4234
|
|
|
|
|
|
|
=item * |
4235
|
|
|
|
|
|
|
|
4236
|
|
|
|
|
|
|
C<ignore_frontend_proxy> - See L</PROXY SUPPORT> |
4237
|
|
|
|
|
|
|
|
4238
|
|
|
|
|
|
|
=item * |
4239
|
|
|
|
|
|
|
|
4240
|
|
|
|
|
|
|
C<name> - The name of the application in debug messages and the debug and |
4241
|
|
|
|
|
|
|
welcome screens |
4242
|
|
|
|
|
|
|
|
4243
|
|
|
|
|
|
|
=item * |
4244
|
|
|
|
|
|
|
|
4245
|
|
|
|
|
|
|
C<parse_on_demand> - The request body (for example file uploads) will not be parsed |
4246
|
|
|
|
|
|
|
until it is accessed. This allows you to (for example) check authentication (and reject |
4247
|
|
|
|
|
|
|
the upload) before actually receiving all the data. See L</ON-DEMAND PARSER> |
4248
|
|
|
|
|
|
|
|
4249
|
|
|
|
|
|
|
=item * |
4250
|
|
|
|
|
|
|
|
4251
|
|
|
|
|
|
|
C<root> - The root directory for templates. Usually this is just a |
4252
|
|
|
|
|
|
|
subdirectory of the home directory, but you can set it to change the |
4253
|
|
|
|
|
|
|
templates to a different directory. |
4254
|
|
|
|
|
|
|
|
4255
|
|
|
|
|
|
|
=item * |
4256
|
|
|
|
|
|
|
|
4257
|
|
|
|
|
|
|
C<search_extra> - Array reference passed to Module::Pluggable to for additional |
4258
|
|
|
|
|
|
|
namespaces from which components will be loaded (and constructed and stored in |
4259
|
|
|
|
|
|
|
C<< $c->components >>). |
4260
|
|
|
|
|
|
|
|
4261
|
|
|
|
|
|
|
=item * |
4262
|
|
|
|
|
|
|
|
4263
|
|
|
|
|
|
|
C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >> |
4264
|
|
|
|
|
|
|
to be shown in hit debug tables in the test server. |
4265
|
|
|
|
|
|
|
|
4266
|
|
|
|
|
|
|
=item * |
4267
|
|
|
|
|
|
|
|
4268
|
|
|
|
|
|
|
C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment |
4269
|
|
|
|
|
|
|
variable should be used for determining the request path. |
4270
|
|
|
|
|
|
|
|
4271
|
|
|
|
|
|
|
Most web server environments pass the requested path to the application using environment variables, |
4272
|
|
|
|
|
|
|
from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application, |
4273
|
|
|
|
|
|
|
exposed as C<< $c->request->base >>) and the request path below that base. |
4274
|
|
|
|
|
|
|
|
4275
|
|
|
|
|
|
|
There are two methods of doing this, both of which have advantages and disadvantages. Which method is used |
4276
|
|
|
|
|
|
|
is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false). |
4277
|
|
|
|
|
|
|
|
4278
|
|
|
|
|
|
|
=over |
4279
|
|
|
|
|
|
|
|
4280
|
|
|
|
|
|
|
=item use_request_uri_for_path => 0 |
4281
|
|
|
|
|
|
|
|
4282
|
|
|
|
|
|
|
This is the default (and the) traditional method that Catalyst has used for determining the path information. |
4283
|
|
|
|
|
|
|
The path is generated from a combination of the C<PATH_INFO> and C<SCRIPT_NAME> environment variables. |
4284
|
|
|
|
|
|
|
The allows the application to behave correctly when C<mod_rewrite> is being used to redirect requests |
4285
|
|
|
|
|
|
|
into the application, as these variables are adjusted by mod_rewrite to take account for the redirect. |
4286
|
|
|
|
|
|
|
|
4287
|
|
|
|
|
|
|
However this method has the major disadvantage that it is impossible to correctly decode some elements |
4288
|
|
|
|
|
|
|
of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot |
4289
|
|
|
|
|
|
|
contain path-segment parameters. >>" This means PATH_INFO is B<always> decoded, and therefore Catalyst |
4290
|
|
|
|
|
|
|
can't distinguish / vs %2F in paths (in addition to other encoded values). |
4291
|
|
|
|
|
|
|
|
4292
|
|
|
|
|
|
|
=item use_request_uri_for_path => 1 |
4293
|
|
|
|
|
|
|
|
4294
|
|
|
|
|
|
|
This method uses the C<REQUEST_URI> and C<SCRIPT_NAME> environment variables. As C<REQUEST_URI> is never |
4295
|
|
|
|
|
|
|
decoded, this means that applications using this mode can correctly handle URIs including the %2F character |
4296
|
|
|
|
|
|
|
(i.e. with C<AllowEncodedSlashes> set to C<On> in Apache). |
4297
|
|
|
|
|
|
|
|
4298
|
|
|
|
|
|
|
Given that this method of path resolution is provably more correct, it is recommended that you use |
4299
|
|
|
|
|
|
|
this unless you have a specific need to deploy your application in a non-standard environment, and you are |
4300
|
|
|
|
|
|
|
aware of the implications of not being able to handle encoded URI paths correctly. |
4301
|
|
|
|
|
|
|
|
4302
|
|
|
|
|
|
|
However it also means that in a number of cases when the app isn't installed directly at a path, but instead |
4303
|
|
|
|
|
|
|
is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a |
4304
|
|
|
|
|
|
|
.htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed |
4305
|
|
|
|
|
|
|
at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of |
4306
|
|
|
|
|
|
|
C<< $c->request->base >> will be incorrect. |
4307
|
|
|
|
|
|
|
|
4308
|
|
|
|
|
|
|
=back |
4309
|
|
|
|
|
|
|
|
4310
|
|
|
|
|
|
|
=item * |
4311
|
|
|
|
|
|
|
|
4312
|
|
|
|
|
|
|
C<using_frontend_proxy> - See L</PROXY SUPPORT>. |
4313
|
|
|
|
|
|
|
|
4314
|
|
|
|
|
|
|
=item * |
4315
|
|
|
|
|
|
|
|
4316
|
|
|
|
|
|
|
C<using_frontend_proxy_path> - Enabled L<Plack::Middleware::ReverseProxyPath> on your application (if |
4317
|
|
|
|
|
|
|
installed, otherwise log an error). This is useful if your application is not running on the |
4318
|
|
|
|
|
|
|
'root' (or /) of your host server. B<NOTE> if you use this feature you should add the required |
4319
|
|
|
|
|
|
|
middleware to your project dependency list since its not automatically a dependency of L<Catalyst>. |
4320
|
|
|
|
|
|
|
This has been done since not all people need this feature and we wish to restrict the growth of |
4321
|
|
|
|
|
|
|
L<Catalyst> dependencies. |
4322
|
|
|
|
|
|
|
|
4323
|
|
|
|
|
|
|
=item * |
4324
|
|
|
|
|
|
|
|
4325
|
|
|
|
|
|
|
C<encoding> - See L</ENCODING> |
4326
|
|
|
|
|
|
|
|
4327
|
|
|
|
|
|
|
This now defaults to 'UTF-8'. You my turn it off by setting this configuration |
4328
|
|
|
|
|
|
|
value to undef. |
4329
|
|
|
|
|
|
|
|
4330
|
|
|
|
|
|
|
=item * |
4331
|
|
|
|
|
|
|
|
4332
|
|
|
|
|
|
|
C<abort_chain_on_error_fix> |
4333
|
|
|
|
|
|
|
|
4334
|
|
|
|
|
|
|
Defaults to true. |
4335
|
|
|
|
|
|
|
|
4336
|
|
|
|
|
|
|
When there is an error in an action chain, the default behavior is to |
4337
|
|
|
|
|
|
|
abort the processing of the remaining actions to avoid running them |
4338
|
|
|
|
|
|
|
when the application is in an unexpected state. |
4339
|
|
|
|
|
|
|
|
4340
|
|
|
|
|
|
|
Before version 5.90070, the default used to be false. To keep the old |
4341
|
|
|
|
|
|
|
behaviour, you can explicitly set the value to false. E.g. |
4342
|
|
|
|
|
|
|
|
4343
|
|
|
|
|
|
|
__PACKAGE__->config(abort_chain_on_error_fix => 0); |
4344
|
|
|
|
|
|
|
|
4345
|
|
|
|
|
|
|
If this setting is set to false, then the remaining actions are |
4346
|
|
|
|
|
|
|
performed and the error is caught at the end of the chain. |
4347
|
|
|
|
|
|
|
|
4348
|
|
|
|
|
|
|
|
4349
|
|
|
|
|
|
|
=item * |
4350
|
|
|
|
|
|
|
|
4351
|
|
|
|
|
|
|
C<use_hash_multivalue_in_request> |
4352
|
|
|
|
|
|
|
|
4353
|
|
|
|
|
|
|
In L<Catalyst::Request> the methods C<query_parameters>, C<body_parametes> |
4354
|
|
|
|
|
|
|
and C<parameters> return a hashref where values might be scalar or an arrayref |
4355
|
|
|
|
|
|
|
depending on the incoming data. In many cases this can be undesirable as it |
4356
|
|
|
|
|
|
|
leads one to writing defensive code like the following: |
4357
|
|
|
|
|
|
|
|
4358
|
|
|
|
|
|
|
my ($val) = ref($c->req->parameters->{a}) ? |
4359
|
|
|
|
|
|
|
@{$c->req->parameters->{a}} : |
4360
|
|
|
|
|
|
|
$c->req->parameters->{a}; |
4361
|
|
|
|
|
|
|
|
4362
|
|
|
|
|
|
|
Setting this configuration item to true will make L<Catalyst> populate the |
4363
|
|
|
|
|
|
|
attributes underlying these methods with an instance of L<Hash::MultiValue> |
4364
|
|
|
|
|
|
|
which is used by L<Plack::Request> and others to solve this very issue. You |
4365
|
|
|
|
|
|
|
may prefer this behavior to the default, if so enable this option (be warned |
4366
|
|
|
|
|
|
|
if you enable it in a legacy application we are not sure if it is completely |
4367
|
|
|
|
|
|
|
backwardly compatible). |
4368
|
|
|
|
|
|
|
|
4369
|
|
|
|
|
|
|
=item * |
4370
|
|
|
|
|
|
|
|
4371
|
|
|
|
|
|
|
C<skip_complex_post_part_handling> |
4372
|
|
|
|
|
|
|
|
4373
|
|
|
|
|
|
|
When creating body parameters from a POST, if we run into a multipart POST |
4374
|
|
|
|
|
|
|
that does not contain uploads, but instead contains inlined complex data |
4375
|
|
|
|
|
|
|
(very uncommon) we cannot reliably convert that into field => value pairs. So |
4376
|
|
|
|
|
|
|
instead we create an instance of L<Catalyst::Request::PartData>. If this causes |
4377
|
|
|
|
|
|
|
issue for you, you can disable this by setting C<skip_complex_post_part_handling> |
4378
|
|
|
|
|
|
|
to true (default is false). |
4379
|
|
|
|
|
|
|
|
4380
|
|
|
|
|
|
|
=item * |
4381
|
|
|
|
|
|
|
|
4382
|
|
|
|
|
|
|
C<skip_body_param_unicode_decoding> |
4383
|
|
|
|
|
|
|
|
4384
|
|
|
|
|
|
|
Generally we decode incoming POST params based on your declared encoding (the |
4385
|
|
|
|
|
|
|
default for this is to decode UTF-8). If this is causing you trouble and you |
4386
|
|
|
|
|
|
|
do not wish to turn all encoding support off (with the C<encoding> configuration |
4387
|
|
|
|
|
|
|
parameter) you may disable this step atomically by setting this configuration |
4388
|
|
|
|
|
|
|
parameter to true. |
4389
|
|
|
|
|
|
|
|
4390
|
|
|
|
|
|
|
=item * |
4391
|
|
|
|
|
|
|
|
4392
|
|
|
|
|
|
|
C<do_not_decode_query> |
4393
|
|
|
|
|
|
|
|
4394
|
|
|
|
|
|
|
If true, then do not try to character decode any wide characters in your |
4395
|
|
|
|
|
|
|
request URL query or keywords. Most readings of the relevant specifications |
4396
|
|
|
|
|
|
|
suggest these should be UTF-* encoded, which is the default that L<Catalyst> |
4397
|
|
|
|
|
|
|
will use, however if you are creating a lot of URLs manually or have external |
4398
|
|
|
|
|
|
|
evil clients, this might cause you trouble. If you find the changes introduced |
4399
|
|
|
|
|
|
|
in Catalyst version 5.90080+ break some of your query code, you may disable |
4400
|
|
|
|
|
|
|
the UTF-8 decoding globally using this configuration. |
4401
|
|
|
|
|
|
|
|
4402
|
|
|
|
|
|
|
This setting takes precedence over C<default_query_encoding> |
4403
|
|
|
|
|
|
|
|
4404
|
|
|
|
|
|
|
=item * |
4405
|
|
|
|
|
|
|
|
4406
|
|
|
|
|
|
|
C<do_not_check_query_encoding> |
4407
|
|
|
|
|
|
|
|
4408
|
|
|
|
|
|
|
Catalyst versions 5.90080 - 5.90106 would decode query parts of an incoming |
4409
|
|
|
|
|
|
|
request but would not raise an exception when the decoding failed due to |
4410
|
|
|
|
|
|
|
incorrect unicode. It now does, but if this change is giving you trouble |
4411
|
|
|
|
|
|
|
you may disable it by setting this configuration to true. |
4412
|
|
|
|
|
|
|
|
4413
|
|
|
|
|
|
|
=item * |
4414
|
|
|
|
|
|
|
|
4415
|
|
|
|
|
|
|
C<default_query_encoding> |
4416
|
|
|
|
|
|
|
|
4417
|
|
|
|
|
|
|
By default we decode query and keywords in your request URL using UTF-8, which |
4418
|
|
|
|
|
|
|
is our reading of the relevant specifications. This setting allows one to |
4419
|
|
|
|
|
|
|
specify a fixed value for how to decode your query. You might need this if |
4420
|
|
|
|
|
|
|
you are doing a lot of custom encoding of your URLs and not using UTF-8. |
4421
|
|
|
|
|
|
|
|
4422
|
|
|
|
|
|
|
=item * |
4423
|
|
|
|
|
|
|
|
4424
|
|
|
|
|
|
|
C<use_chained_args_0_special_case> |
4425
|
|
|
|
|
|
|
|
4426
|
|
|
|
|
|
|
In older versions of Catalyst, when more than one action matched the same path |
4427
|
|
|
|
|
|
|
AND all those matching actions declared Args(0), we'd break the tie by choosing |
4428
|
|
|
|
|
|
|
the first action defined. We now normalized how Args(0) works so that it |
4429
|
|
|
|
|
|
|
follows the same rule as Args(N), which is to say when we need to break a tie |
4430
|
|
|
|
|
|
|
we choose the LAST action defined. If this breaks your code and you don't |
4431
|
|
|
|
|
|
|
have time to update to follow the new normalized approach, you may set this |
4432
|
|
|
|
|
|
|
value to true and it will globally revert to the original chaining behavior. |
4433
|
|
|
|
|
|
|
|
4434
|
|
|
|
|
|
|
=item * |
4435
|
|
|
|
|
|
|
|
4436
|
|
|
|
|
|
|
C<psgi_middleware> - See L<PSGI MIDDLEWARE>. |
4437
|
|
|
|
|
|
|
|
4438
|
|
|
|
|
|
|
=item * |
4439
|
|
|
|
|
|
|
|
4440
|
|
|
|
|
|
|
C<data_handlers> - See L<DATA HANDLERS>. |
4441
|
|
|
|
|
|
|
|
4442
|
|
|
|
|
|
|
=item * |
4443
|
|
|
|
|
|
|
|
4444
|
|
|
|
|
|
|
C<stats_class_traits> |
4445
|
|
|
|
|
|
|
|
4446
|
|
|
|
|
|
|
An arrayref of L<Moose::Role>s that get composed into your stats class. |
4447
|
|
|
|
|
|
|
|
4448
|
|
|
|
|
|
|
=item * |
4449
|
|
|
|
|
|
|
|
4450
|
|
|
|
|
|
|
C<request_class_traits> |
4451
|
|
|
|
|
|
|
|
4452
|
|
|
|
|
|
|
An arrayref of L<Moose::Role>s that get composed into your request class. |
4453
|
|
|
|
|
|
|
|
4454
|
|
|
|
|
|
|
=item * |
4455
|
|
|
|
|
|
|
|
4456
|
|
|
|
|
|
|
C<response_class_traits> |
4457
|
|
|
|
|
|
|
|
4458
|
|
|
|
|
|
|
An arrayref of L<Moose::Role>s that get composed into your response class. |
4459
|
|
|
|
|
|
|
|
4460
|
|
|
|
|
|
|
=item * |
4461
|
|
|
|
|
|
|
|
4462
|
|
|
|
|
|
|
C<inject_components> |
4463
|
|
|
|
|
|
|
|
4464
|
|
|
|
|
|
|
A Hashref of L<Catalyst::Component> subclasses that are 'injected' into configuration. |
4465
|
|
|
|
|
|
|
For example: |
4466
|
|
|
|
|
|
|
|
4467
|
|
|
|
|
|
|
MyApp->config({ |
4468
|
|
|
|
|
|
|
inject_components => { |
4469
|
|
|
|
|
|
|
'Controller::Err' => { from_component => 'Local::Controller::Errors' }, |
4470
|
|
|
|
|
|
|
'Model::Zoo' => { from_component => 'Local::Model::Foo' }, |
4471
|
|
|
|
|
|
|
'Model::Foo' => { from_component => 'Local::Model::Foo', roles => ['TestRole'] }, |
4472
|
|
|
|
|
|
|
}, |
4473
|
|
|
|
|
|
|
'Controller::Err' => { a => 100, b=>200, namespace=>'error' }, |
4474
|
|
|
|
|
|
|
'Model::Zoo' => { a => 2 }, |
4475
|
|
|
|
|
|
|
'Model::Foo' => { a => 100 }, |
4476
|
|
|
|
|
|
|
}); |
4477
|
|
|
|
|
|
|
|
4478
|
|
|
|
|
|
|
Generally L<Catalyst> looks for components in your Model/View or Controller directories. |
4479
|
|
|
|
|
|
|
However for cases when you which to use an existing component and you don't need any |
4480
|
|
|
|
|
|
|
customization (where for when you can apply a role to customize it) you may inject those |
4481
|
|
|
|
|
|
|
components into your application. Please note any configuration should be done 'in the |
4482
|
|
|
|
|
|
|
normal way', with a key under configuration named after the component affix, as in the |
4483
|
|
|
|
|
|
|
above example. |
4484
|
|
|
|
|
|
|
|
4485
|
|
|
|
|
|
|
Using this type of injection allows you to construct significant amounts of your application |
4486
|
|
|
|
|
|
|
with only configuration!. This may or may not lead to increased code understanding. |
4487
|
|
|
|
|
|
|
|
4488
|
|
|
|
|
|
|
Please not you may also call the ->inject_components application method as well, although |
4489
|
|
|
|
|
|
|
you must do so BEFORE setup. |
4490
|
|
|
|
|
|
|
|
4491
|
|
|
|
|
|
|
=back |
4492
|
|
|
|
|
|
|
|
4493
|
|
|
|
|
|
|
=head1 EXCEPTIONS |
4494
|
|
|
|
|
|
|
|
4495
|
|
|
|
|
|
|
Generally when you throw an exception inside an Action (or somewhere in |
4496
|
|
|
|
|
|
|
your stack, such as in a model that an Action is calling) that exception |
4497
|
|
|
|
|
|
|
is caught by Catalyst and unless you either catch it yourself (via eval |
4498
|
|
|
|
|
|
|
or something like L<Try::Tiny> or by reviewing the L</error> stack, it |
4499
|
|
|
|
|
|
|
will eventually reach L</finalize_errors> and return either the debugging |
4500
|
|
|
|
|
|
|
error stack page, or the default error page. However, if your exception |
4501
|
|
|
|
|
|
|
can be caught by L<Plack::Middleware::HTTPExceptions>, L<Catalyst> will |
4502
|
|
|
|
|
|
|
instead rethrow it so that it can be handled by that middleware (which |
4503
|
|
|
|
|
|
|
is part of the default middleware). For example this would allow |
4504
|
|
|
|
|
|
|
|
4505
|
|
|
|
|
|
|
use HTTP::Throwable::Factory 'http_throw'; |
4506
|
|
|
|
|
|
|
|
4507
|
|
|
|
|
|
|
sub throws_exception :Local { |
4508
|
|
|
|
|
|
|
my ($self, $c) = @_; |
4509
|
|
|
|
|
|
|
|
4510
|
|
|
|
|
|
|
http_throw(SeeOther => { location => |
4511
|
|
|
|
|
|
|
$c->uri_for($self->action_for('redirect')) }); |
4512
|
|
|
|
|
|
|
|
4513
|
|
|
|
|
|
|
} |
4514
|
|
|
|
|
|
|
|
4515
|
|
|
|
|
|
|
=head1 INTERNAL ACTIONS |
4516
|
|
|
|
|
|
|
|
4517
|
|
|
|
|
|
|
Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>, |
4518
|
|
|
|
|
|
|
C<_ACTION>, and C<_END>. These are by default not shown in the private |
4519
|
|
|
|
|
|
|
action table, but you can make them visible with a config parameter. |
4520
|
|
|
|
|
|
|
|
4521
|
|
|
|
|
|
|
MyApp->config(show_internal_actions => 1); |
4522
|
|
|
|
|
|
|
|
4523
|
|
|
|
|
|
|
=head1 ON-DEMAND PARSER |
4524
|
|
|
|
|
|
|
|
4525
|
|
|
|
|
|
|
The request body is usually parsed at the beginning of a request, |
4526
|
|
|
|
|
|
|
but if you want to handle input yourself, you can enable on-demand |
4527
|
|
|
|
|
|
|
parsing with a config parameter. |
4528
|
|
|
|
|
|
|
|
4529
|
|
|
|
|
|
|
MyApp->config(parse_on_demand => 1); |
4530
|
|
|
|
|
|
|
|
4531
|
|
|
|
|
|
|
=head1 PROXY SUPPORT |
4532
|
|
|
|
|
|
|
|
4533
|
|
|
|
|
|
|
Many production servers operate using the common double-server approach, |
4534
|
|
|
|
|
|
|
with a lightweight frontend web server passing requests to a larger |
4535
|
|
|
|
|
|
|
backend server. An application running on the backend server must deal |
4536
|
|
|
|
|
|
|
with two problems: the remote user always appears to be C<127.0.0.1> and |
4537
|
|
|
|
|
|
|
the server's hostname will appear to be C<localhost> regardless of the |
4538
|
|
|
|
|
|
|
virtual host that the user connected through. |
4539
|
|
|
|
|
|
|
|
4540
|
|
|
|
|
|
|
Catalyst will automatically detect this situation when you are running |
4541
|
|
|
|
|
|
|
the frontend and backend servers on the same machine. The following |
4542
|
|
|
|
|
|
|
changes are made to the request. |
4543
|
|
|
|
|
|
|
|
4544
|
|
|
|
|
|
|
$c->req->address is set to the user's real IP address, as read from |
4545
|
|
|
|
|
|
|
the HTTP X-Forwarded-For header. |
4546
|
|
|
|
|
|
|
|
4547
|
|
|
|
|
|
|
The host value for $c->req->base and $c->req->uri is set to the real |
4548
|
|
|
|
|
|
|
host, as read from the HTTP X-Forwarded-Host header. |
4549
|
|
|
|
|
|
|
|
4550
|
|
|
|
|
|
|
Additionally, you may be running your backend application on an insecure |
4551
|
|
|
|
|
|
|
connection (port 80) while your frontend proxy is running under SSL. If there |
4552
|
|
|
|
|
|
|
is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to |
4553
|
|
|
|
|
|
|
tell Catalyst what port the frontend listens on. This will allow all URIs to |
4554
|
|
|
|
|
|
|
be created properly. |
4555
|
|
|
|
|
|
|
|
4556
|
|
|
|
|
|
|
In the case of passing in: |
4557
|
|
|
|
|
|
|
|
4558
|
|
|
|
|
|
|
X-Forwarded-Port: 443 |
4559
|
|
|
|
|
|
|
|
4560
|
|
|
|
|
|
|
All calls to C<uri_for> will result in an https link, as is expected. |
4561
|
|
|
|
|
|
|
|
4562
|
|
|
|
|
|
|
Obviously, your web server must support these headers for this to work. |
4563
|
|
|
|
|
|
|
|
4564
|
|
|
|
|
|
|
In a more complex server farm environment where you may have your |
4565
|
|
|
|
|
|
|
frontend proxy server(s) on different machines, you will need to set a |
4566
|
|
|
|
|
|
|
configuration option to tell Catalyst to read the proxied data from the |
4567
|
|
|
|
|
|
|
headers. |
4568
|
|
|
|
|
|
|
|
4569
|
|
|
|
|
|
|
MyApp->config(using_frontend_proxy => 1); |
4570
|
|
|
|
|
|
|
|
4571
|
|
|
|
|
|
|
If you do not wish to use the proxy support at all, you may set: |
4572
|
|
|
|
|
|
|
|
4573
|
|
|
|
|
|
|
MyApp->config(ignore_frontend_proxy => 0); |
4574
|
|
|
|
|
|
|
|
4575
|
|
|
|
|
|
|
=head2 Note about psgi files |
4576
|
|
|
|
|
|
|
|
4577
|
|
|
|
|
|
|
Note that if you supply your own .psgi file, calling |
4578
|
|
|
|
|
|
|
C<< MyApp->psgi_app(@_); >>, then B<this will not happen automatically>. |
4579
|
|
|
|
|
|
|
|
4580
|
|
|
|
|
|
|
You either need to apply L<Plack::Middleware::ReverseProxy> yourself |
4581
|
|
|
|
|
|
|
in your psgi, for example: |
4582
|
|
|
|
|
|
|
|
4583
|
|
|
|
|
|
|
builder { |
4584
|
|
|
|
|
|
|
enable "Plack::Middleware::ReverseProxy"; |
4585
|
|
|
|
|
|
|
MyApp->psgi_app |
4586
|
|
|
|
|
|
|
}; |
4587
|
|
|
|
|
|
|
|
4588
|
|
|
|
|
|
|
This will unconditionally add the ReverseProxy support, or you need to call |
4589
|
|
|
|
|
|
|
C<< $app = MyApp->apply_default_middlewares($app) >> (to conditionally |
4590
|
|
|
|
|
|
|
apply the support depending upon your config). |
4591
|
|
|
|
|
|
|
|
4592
|
|
|
|
|
|
|
See L<Catalyst::PSGI> for more information. |
4593
|
|
|
|
|
|
|
|
4594
|
|
|
|
|
|
|
=head1 THREAD SAFETY |
4595
|
|
|
|
|
|
|
|
4596
|
|
|
|
|
|
|
Catalyst has been tested under Apache 2's threading C<mpm_worker>, |
4597
|
|
|
|
|
|
|
C<mpm_winnt>, and the standalone forking HTTP server on Windows. We |
4598
|
|
|
|
|
|
|
believe the Catalyst core to be thread-safe. |
4599
|
|
|
|
|
|
|
|
4600
|
|
|
|
|
|
|
If you plan to operate in a threaded environment, remember that all other |
4601
|
|
|
|
|
|
|
modules you are using must also be thread-safe. Some modules, most notably |
4602
|
|
|
|
|
|
|
L<DBD::SQLite>, are not thread-safe. |
4603
|
|
|
|
|
|
|
|
4604
|
|
|
|
|
|
|
=head1 DATA HANDLERS |
4605
|
|
|
|
|
|
|
|
4606
|
|
|
|
|
|
|
The L<Catalyst::Request> object uses L<HTTP::Body> to populate 'classic' HTML |
4607
|
|
|
|
|
|
|
form parameters and URL search query fields. However it has become common |
4608
|
|
|
|
|
|
|
for various alternative content types to be PUT or POSTed to your controllers |
4609
|
|
|
|
|
|
|
and actions. People working on RESTful APIs, or using AJAX often use JSON, |
4610
|
|
|
|
|
|
|
XML and other content types when communicating with an application server. In |
4611
|
|
|
|
|
|
|
order to better support this use case, L<Catalyst> defines a global configuration |
4612
|
|
|
|
|
|
|
option, C<data_handlers>, which lets you associate a content type with a coderef |
4613
|
|
|
|
|
|
|
that parses that content type into something Perl can readily access. |
4614
|
|
|
|
|
|
|
|
4615
|
|
|
|
|
|
|
package MyApp::Web; |
4616
|
|
|
|
|
|
|
|
4617
|
|
|
|
|
|
|
use Catalyst; |
4618
|
|
|
|
|
|
|
use JSON::MaybeXS; |
4619
|
|
|
|
|
|
|
|
4620
|
|
|
|
|
|
|
__PACKAGE__->config( |
4621
|
|
|
|
|
|
|
data_handlers => { |
4622
|
|
|
|
|
|
|
'application/json' => sub { local $/; decode_json $_->getline }, |
4623
|
|
|
|
|
|
|
}, |
4624
|
|
|
|
|
|
|
## Any other configuration. |
4625
|
|
|
|
|
|
|
); |
4626
|
|
|
|
|
|
|
|
4627
|
|
|
|
|
|
|
__PACKAGE__->setup; |
4628
|
|
|
|
|
|
|
|
4629
|
|
|
|
|
|
|
By default L<Catalyst> comes with a generic JSON data handler similar to the |
4630
|
|
|
|
|
|
|
example given above, which uses L<JSON::MaybeXS> to provide either L<JSON::PP> |
4631
|
|
|
|
|
|
|
(a pure Perl, dependency free JSON parser) or L<Cpanel::JSON::XS> if you have |
4632
|
|
|
|
|
|
|
it installed (if you want the faster XS parser, add it to you project Makefile.PL |
4633
|
|
|
|
|
|
|
or dist.ini, cpanfile, etc.) |
4634
|
|
|
|
|
|
|
|
4635
|
|
|
|
|
|
|
The C<data_handlers> configuration is a hashref whose keys are HTTP Content-Types |
4636
|
|
|
|
|
|
|
(matched against the incoming request type using a regexp such as to be case |
4637
|
|
|
|
|
|
|
insensitive) and whose values are coderefs that receive a localized version of |
4638
|
|
|
|
|
|
|
C<$_> which is a filehandle object pointing to received body. |
4639
|
|
|
|
|
|
|
|
4640
|
|
|
|
|
|
|
This feature is considered an early access release and we reserve the right |
4641
|
|
|
|
|
|
|
to alter the interface in order to provide a performant and secure solution to |
4642
|
|
|
|
|
|
|
alternative request body content. Your reports welcomed! |
4643
|
|
|
|
|
|
|
|
4644
|
|
|
|
|
|
|
=head1 PSGI MIDDLEWARE |
4645
|
|
|
|
|
|
|
|
4646
|
|
|
|
|
|
|
You can define middleware, defined as L<Plack::Middleware> or a compatible |
4647
|
|
|
|
|
|
|
interface in configuration. Your middleware definitions are in the form of an |
4648
|
|
|
|
|
|
|
arrayref under the configuration key C<psgi_middleware>. Here's an example |
4649
|
|
|
|
|
|
|
with details to follow: |
4650
|
|
|
|
|
|
|
|
4651
|
|
|
|
|
|
|
package MyApp::Web; |
4652
|
|
|
|
|
|
|
|
4653
|
|
|
|
|
|
|
use Catalyst; |
4654
|
|
|
|
|
|
|
use Plack::Middleware::StackTrace; |
4655
|
|
|
|
|
|
|
|
4656
|
|
|
|
|
|
|
my $stacktrace_middleware = Plack::Middleware::StackTrace->new; |
4657
|
|
|
|
|
|
|
|
4658
|
|
|
|
|
|
|
__PACKAGE__->config( |
4659
|
|
|
|
|
|
|
'psgi_middleware', [ |
4660
|
|
|
|
|
|
|
'Debug', |
4661
|
|
|
|
|
|
|
'+MyApp::Custom', |
4662
|
|
|
|
|
|
|
$stacktrace_middleware, |
4663
|
|
|
|
|
|
|
'Session' => {store => 'File'}, |
4664
|
|
|
|
|
|
|
sub { |
4665
|
|
|
|
|
|
|
my $app = shift; |
4666
|
|
|
|
|
|
|
return sub { |
4667
|
|
|
|
|
|
|
my $env = shift; |
4668
|
|
|
|
|
|
|
$env->{myapp.customkey} = 'helloworld'; |
4669
|
|
|
|
|
|
|
$app->($env); |
4670
|
|
|
|
|
|
|
}, |
4671
|
|
|
|
|
|
|
}, |
4672
|
|
|
|
|
|
|
], |
4673
|
|
|
|
|
|
|
); |
4674
|
|
|
|
|
|
|
|
4675
|
|
|
|
|
|
|
__PACKAGE__->setup; |
4676
|
|
|
|
|
|
|
|
4677
|
|
|
|
|
|
|
So the general form is: |
4678
|
|
|
|
|
|
|
|
4679
|
|
|
|
|
|
|
__PACKAGE__->config(psgi_middleware => \@middleware_definitions); |
4680
|
|
|
|
|
|
|
|
4681
|
|
|
|
|
|
|
Where C<@middleware> is one or more of the following, applied in the REVERSE of |
4682
|
|
|
|
|
|
|
the order listed (to make it function similarly to L<Plack::Builder>: |
4683
|
|
|
|
|
|
|
|
4684
|
|
|
|
|
|
|
Alternatively, you may also define middleware by calling the L</setup_middleware> |
4685
|
|
|
|
|
|
|
package method: |
4686
|
|
|
|
|
|
|
|
4687
|
|
|
|
|
|
|
package MyApp::Web; |
4688
|
|
|
|
|
|
|
|
4689
|
|
|
|
|
|
|
use Catalyst; |
4690
|
|
|
|
|
|
|
|
4691
|
|
|
|
|
|
|
__PACKAGE__->setup_middleware( \@middleware_definitions); |
4692
|
|
|
|
|
|
|
__PACKAGE__->setup; |
4693
|
|
|
|
|
|
|
|
4694
|
|
|
|
|
|
|
In the case where you do both (use 'setup_middleware' and configuration) the |
4695
|
|
|
|
|
|
|
package call to setup_middleware will be applied earlier (in other words its |
4696
|
|
|
|
|
|
|
middleware will wrap closer to the application). Keep this in mind since in |
4697
|
|
|
|
|
|
|
some cases the order of middleware is important. |
4698
|
|
|
|
|
|
|
|
4699
|
|
|
|
|
|
|
The two approaches are not exclusive. |
4700
|
|
|
|
|
|
|
|
4701
|
|
|
|
|
|
|
=over 4 |
4702
|
|
|
|
|
|
|
|
4703
|
|
|
|
|
|
|
=item Middleware Object |
4704
|
|
|
|
|
|
|
|
4705
|
|
|
|
|
|
|
An already initialized object that conforms to the L<Plack::Middleware> |
4706
|
|
|
|
|
|
|
specification: |
4707
|
|
|
|
|
|
|
|
4708
|
|
|
|
|
|
|
my $stacktrace_middleware = Plack::Middleware::StackTrace->new; |
4709
|
|
|
|
|
|
|
|
4710
|
|
|
|
|
|
|
__PACKAGE__->config( |
4711
|
|
|
|
|
|
|
'psgi_middleware', [ |
4712
|
|
|
|
|
|
|
$stacktrace_middleware, |
4713
|
|
|
|
|
|
|
]); |
4714
|
|
|
|
|
|
|
|
4715
|
|
|
|
|
|
|
|
4716
|
|
|
|
|
|
|
=item coderef |
4717
|
|
|
|
|
|
|
|
4718
|
|
|
|
|
|
|
A coderef that is an inlined middleware: |
4719
|
|
|
|
|
|
|
|
4720
|
|
|
|
|
|
|
__PACKAGE__->config( |
4721
|
|
|
|
|
|
|
'psgi_middleware', [ |
4722
|
|
|
|
|
|
|
sub { |
4723
|
|
|
|
|
|
|
my $app = shift; |
4724
|
|
|
|
|
|
|
return sub { |
4725
|
|
|
|
|
|
|
my $env = shift; |
4726
|
|
|
|
|
|
|
if($env->{PATH_INFO} =~m/forced/) { |
4727
|
|
|
|
|
|
|
Plack::App::File |
4728
|
|
|
|
|
|
|
->new(file=>TestApp->path_to(qw/share static forced.txt/)) |
4729
|
|
|
|
|
|
|
->call($env); |
4730
|
|
|
|
|
|
|
} else { |
4731
|
|
|
|
|
|
|
return $app->($env); |
4732
|
|
|
|
|
|
|
} |
4733
|
|
|
|
|
|
|
}, |
4734
|
|
|
|
|
|
|
}, |
4735
|
|
|
|
|
|
|
]); |
4736
|
|
|
|
|
|
|
|
4737
|
|
|
|
|
|
|
|
4738
|
|
|
|
|
|
|
|
4739
|
|
|
|
|
|
|
=item a scalar |
4740
|
|
|
|
|
|
|
|
4741
|
|
|
|
|
|
|
We assume the scalar refers to a namespace after normalizing it using the |
4742
|
|
|
|
|
|
|
following rules: |
4743
|
|
|
|
|
|
|
|
4744
|
|
|
|
|
|
|
(1) If the scalar is prefixed with a "+" (as in C<+MyApp::Foo>) then the full string |
4745
|
|
|
|
|
|
|
is assumed to be 'as is', and we just install and use the middleware. |
4746
|
|
|
|
|
|
|
|
4747
|
|
|
|
|
|
|
(2) If the scalar begins with "Plack::Middleware" or your application namespace |
4748
|
|
|
|
|
|
|
(the package name of your Catalyst application subclass), we also assume then |
4749
|
|
|
|
|
|
|
that it is a full namespace, and use it. |
4750
|
|
|
|
|
|
|
|
4751
|
|
|
|
|
|
|
(3) Lastly, we then assume that the scalar is a partial namespace, and attempt to |
4752
|
|
|
|
|
|
|
resolve it first by looking for it under your application namespace (for example |
4753
|
|
|
|
|
|
|
if you application is "MyApp::Web" and the scalar is "MyMiddleware", we'd look |
4754
|
|
|
|
|
|
|
under "MyApp::Web::Middleware::MyMiddleware") and if we don't find it there, we |
4755
|
|
|
|
|
|
|
will then look under the regular L<Plack::Middleware> namespace (i.e. for the |
4756
|
|
|
|
|
|
|
previous we'd try "Plack::Middleware::MyMiddleware"). We look under your application |
4757
|
|
|
|
|
|
|
namespace first to let you 'override' common L<Plack::Middleware> locally, should |
4758
|
|
|
|
|
|
|
you find that a good idea. |
4759
|
|
|
|
|
|
|
|
4760
|
|
|
|
|
|
|
Examples: |
4761
|
|
|
|
|
|
|
|
4762
|
|
|
|
|
|
|
package MyApp::Web; |
4763
|
|
|
|
|
|
|
|
4764
|
|
|
|
|
|
|
__PACKAGE__->config( |
4765
|
|
|
|
|
|
|
'psgi_middleware', [ |
4766
|
|
|
|
|
|
|
'Debug', ## MyAppWeb::Middleware::Debug->wrap or Plack::Middleware::Debug->wrap |
4767
|
|
|
|
|
|
|
'Plack::Middleware::Stacktrace', ## Plack::Middleware::Stacktrace->wrap |
4768
|
|
|
|
|
|
|
'+MyApp::Custom', ## MyApp::Custom->wrap |
4769
|
|
|
|
|
|
|
], |
4770
|
|
|
|
|
|
|
); |
4771
|
|
|
|
|
|
|
|
4772
|
|
|
|
|
|
|
=item a scalar followed by a hashref |
4773
|
|
|
|
|
|
|
|
4774
|
|
|
|
|
|
|
Just like the previous, except the following C<HashRef> is used as arguments |
4775
|
|
|
|
|
|
|
to initialize the middleware object. |
4776
|
|
|
|
|
|
|
|
4777
|
|
|
|
|
|
|
__PACKAGE__->config( |
4778
|
|
|
|
|
|
|
'psgi_middleware', [ |
4779
|
|
|
|
|
|
|
'Session' => {store => 'File'}, |
4780
|
|
|
|
|
|
|
]); |
4781
|
|
|
|
|
|
|
|
4782
|
|
|
|
|
|
|
=back |
4783
|
|
|
|
|
|
|
|
4784
|
|
|
|
|
|
|
Please see L<PSGI> for more on middleware. |
4785
|
|
|
|
|
|
|
|
4786
|
|
|
|
|
|
|
=head1 ENCODING |
4787
|
|
|
|
|
|
|
|
4788
|
|
|
|
|
|
|
Starting in L<Catalyst> version 5.90080 encoding is automatically enabled |
4789
|
|
|
|
|
|
|
and set to encode all body responses to UTF8 when possible and applicable. |
4790
|
|
|
|
|
|
|
Following is documentation on this process. If you are using an older |
4791
|
|
|
|
|
|
|
version of L<Catalyst> you should review documentation for that version since |
4792
|
|
|
|
|
|
|
a lot has changed. |
4793
|
|
|
|
|
|
|
|
4794
|
|
|
|
|
|
|
By default encoding is now 'UTF-8'. You may turn it off by setting |
4795
|
|
|
|
|
|
|
the encoding configuration to undef. |
4796
|
|
|
|
|
|
|
|
4797
|
|
|
|
|
|
|
MyApp->config(encoding => undef); |
4798
|
|
|
|
|
|
|
|
4799
|
|
|
|
|
|
|
This is recommended for temporary backwards compatibility only. |
4800
|
|
|
|
|
|
|
|
4801
|
|
|
|
|
|
|
To turn it off for a single request use the L<clear_encoding> |
4802
|
|
|
|
|
|
|
method to turn off encoding for this request. This can be useful |
4803
|
|
|
|
|
|
|
when you are setting the body to be an arbitrary block of bytes, |
4804
|
|
|
|
|
|
|
especially if that block happens to be a block of UTF8 text. |
4805
|
|
|
|
|
|
|
|
4806
|
|
|
|
|
|
|
Encoding is automatically applied when the content-type is set to |
4807
|
|
|
|
|
|
|
a type that can be encoded. Currently we encode when the content type |
4808
|
|
|
|
|
|
|
matches the following regular expression: |
4809
|
|
|
|
|
|
|
|
4810
|
|
|
|
|
|
|
$content_type =~ /^text|xml$|javascript$/ |
4811
|
|
|
|
|
|
|
|
4812
|
|
|
|
|
|
|
Encoding is set on the application, but it is copied to the context object |
4813
|
|
|
|
|
|
|
so that you can override it on a request basis. |
4814
|
|
|
|
|
|
|
|
4815
|
|
|
|
|
|
|
Be default we don't automatically encode 'application/json' since the most |
4816
|
|
|
|
|
|
|
common approaches to generating this type of response (Either via L<Catalyst::View::JSON> |
4817
|
|
|
|
|
|
|
or L<Catalyst::Action::REST>) will do so already and we want to avoid double |
4818
|
|
|
|
|
|
|
encoding issues. |
4819
|
|
|
|
|
|
|
|
4820
|
|
|
|
|
|
|
If you are producing JSON response in an unconventional manner (such |
4821
|
|
|
|
|
|
|
as via a template or manual strings) you should perform the UTF8 encoding |
4822
|
|
|
|
|
|
|
manually as well such as to conform to the JSON specification. |
4823
|
|
|
|
|
|
|
|
4824
|
|
|
|
|
|
|
NOTE: We also examine the value of $c->response->content_encoding. If |
4825
|
|
|
|
|
|
|
you set this (like for example 'gzip', and manually gzipping the body) |
4826
|
|
|
|
|
|
|
we assume that you have done all the necessary encoding yourself, since |
4827
|
|
|
|
|
|
|
we cannot encode the gzipped contents. If you use a plugin like |
4828
|
|
|
|
|
|
|
L<Catalyst::Plugin::Compress> you need to update to a modern version in order |
4829
|
|
|
|
|
|
|
to have this function correctly with the new UTF8 encoding code, or you |
4830
|
|
|
|
|
|
|
can use L<Plack::Middleware::Deflater> or (probably best) do your compression on |
4831
|
|
|
|
|
|
|
a front end proxy. |
4832
|
|
|
|
|
|
|
|
4833
|
|
|
|
|
|
|
=head2 Methods |
4834
|
|
|
|
|
|
|
|
4835
|
|
|
|
|
|
|
=over 4 |
4836
|
|
|
|
|
|
|
|
4837
|
|
|
|
|
|
|
=item encoding |
4838
|
|
|
|
|
|
|
|
4839
|
|
|
|
|
|
|
Returns an instance of an C<Encode> encoding |
4840
|
|
|
|
|
|
|
|
4841
|
|
|
|
|
|
|
print $c->encoding->name |
4842
|
|
|
|
|
|
|
|
4843
|
|
|
|
|
|
|
=item handle_unicode_encoding_exception ($exception_context) |
4844
|
|
|
|
|
|
|
|
4845
|
|
|
|
|
|
|
Method called when decoding process for a request fails. |
4846
|
|
|
|
|
|
|
|
4847
|
|
|
|
|
|
|
An C<$exception_context> hashref is provided to allow you to override the |
4848
|
|
|
|
|
|
|
behaviour of your application when given data with incorrect encodings. |
4849
|
|
|
|
|
|
|
|
4850
|
|
|
|
|
|
|
The default method throws exceptions in the case of invalid request parameters |
4851
|
|
|
|
|
|
|
(resulting in a 500 error), but ignores errors in upload filenames. |
4852
|
|
|
|
|
|
|
|
4853
|
|
|
|
|
|
|
The keys passed in the C<$exception_context> hash are: |
4854
|
|
|
|
|
|
|
|
4855
|
|
|
|
|
|
|
=over |
4856
|
|
|
|
|
|
|
|
4857
|
|
|
|
|
|
|
=item param_value |
4858
|
|
|
|
|
|
|
|
4859
|
|
|
|
|
|
|
The value which was not able to be decoded. |
4860
|
|
|
|
|
|
|
|
4861
|
|
|
|
|
|
|
=item error_msg |
4862
|
|
|
|
|
|
|
|
4863
|
|
|
|
|
|
|
The exception received from L<Encode>. |
4864
|
|
|
|
|
|
|
|
4865
|
|
|
|
|
|
|
=item encoding_step |
4866
|
|
|
|
|
|
|
|
4867
|
|
|
|
|
|
|
What type of data was being decoded. Valid values are (currently) |
4868
|
|
|
|
|
|
|
C<params> - for request parameters / arguments / captures |
4869
|
|
|
|
|
|
|
and C<uploads> - for request upload filenames. |
4870
|
|
|
|
|
|
|
|
4871
|
|
|
|
|
|
|
=back |
4872
|
|
|
|
|
|
|
|
4873
|
|
|
|
|
|
|
=back |
4874
|
|
|
|
|
|
|
|
4875
|
|
|
|
|
|
|
=head1 SUPPORT |
4876
|
|
|
|
|
|
|
|
4877
|
|
|
|
|
|
|
IRC: |
4878
|
|
|
|
|
|
|
|
4879
|
|
|
|
|
|
|
Join #catalyst on irc.perl.org. |
4880
|
|
|
|
|
|
|
|
4881
|
|
|
|
|
|
|
Mailing Lists: |
4882
|
|
|
|
|
|
|
|
4883
|
|
|
|
|
|
|
http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst |
4884
|
|
|
|
|
|
|
http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev |
4885
|
|
|
|
|
|
|
|
4886
|
|
|
|
|
|
|
Web: |
4887
|
|
|
|
|
|
|
|
4888
|
|
|
|
|
|
|
http://catalyst.perl.org |
4889
|
|
|
|
|
|
|
|
4890
|
|
|
|
|
|
|
Wiki: |
4891
|
|
|
|
|
|
|
|
4892
|
|
|
|
|
|
|
http://dev.catalyst.perl.org |
4893
|
|
|
|
|
|
|
|
4894
|
|
|
|
|
|
|
=head1 SEE ALSO |
4895
|
|
|
|
|
|
|
|
4896
|
|
|
|
|
|
|
=head2 L<Task::Catalyst> - All you need to start with Catalyst |
4897
|
|
|
|
|
|
|
|
4898
|
|
|
|
|
|
|
=head2 L<Catalyst::Manual> - The Catalyst Manual |
4899
|
|
|
|
|
|
|
|
4900
|
|
|
|
|
|
|
=head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components |
4901
|
|
|
|
|
|
|
|
4902
|
|
|
|
|
|
|
=head2 L<Catalyst::Engine> - Core engine |
4903
|
|
|
|
|
|
|
|
4904
|
|
|
|
|
|
|
=head2 L<Catalyst::Log> - Log class. |
4905
|
|
|
|
|
|
|
|
4906
|
|
|
|
|
|
|
=head2 L<Catalyst::Request> - Request object |
4907
|
|
|
|
|
|
|
|
4908
|
|
|
|
|
|
|
=head2 L<Catalyst::Response> - Response object |
4909
|
|
|
|
|
|
|
|
4910
|
|
|
|
|
|
|
=head2 L<Catalyst::Test> - The test suite. |
4911
|
|
|
|
|
|
|
|
4912
|
|
|
|
|
|
|
=head1 PROJECT FOUNDER |
4913
|
|
|
|
|
|
|
|
4914
|
|
|
|
|
|
|
sri: Sebastian Riedel <sri@cpan.org> |
4915
|
|
|
|
|
|
|
|
4916
|
|
|
|
|
|
|
=head1 CONTRIBUTORS |
4917
|
|
|
|
|
|
|
|
4918
|
|
|
|
|
|
|
abw: Andy Wardley |
4919
|
|
|
|
|
|
|
|
4920
|
|
|
|
|
|
|
acme: Leon Brocard <leon@astray.com> |
4921
|
|
|
|
|
|
|
|
4922
|
|
|
|
|
|
|
abraxxa: Alexander Hartmaier <abraxxa@cpan.org> |
4923
|
|
|
|
|
|
|
|
4924
|
|
|
|
|
|
|
andrewalker: André Walker <andre@cpan.org> |
4925
|
|
|
|
|
|
|
|
4926
|
|
|
|
|
|
|
Andrew Bramble |
4927
|
|
|
|
|
|
|
|
4928
|
|
|
|
|
|
|
Andrew Ford <A.Ford@ford-mason.co.uk> |
4929
|
|
|
|
|
|
|
|
4930
|
|
|
|
|
|
|
Andrew Ruthven |
4931
|
|
|
|
|
|
|
|
4932
|
|
|
|
|
|
|
andyg: Andy Grundman <andy@hybridized.org> |
4933
|
|
|
|
|
|
|
|
4934
|
|
|
|
|
|
|
audreyt: Audrey Tang |
4935
|
|
|
|
|
|
|
|
4936
|
|
|
|
|
|
|
bricas: Brian Cassidy <bricas@cpan.org> |
4937
|
|
|
|
|
|
|
|
4938
|
|
|
|
|
|
|
Caelum: Rafael Kitover <rkitover@io.com> |
4939
|
|
|
|
|
|
|
|
4940
|
|
|
|
|
|
|
chansen: Christian Hansen |
4941
|
|
|
|
|
|
|
|
4942
|
|
|
|
|
|
|
Chase Venters <chase.venters@gmail.com> |
4943
|
|
|
|
|
|
|
|
4944
|
|
|
|
|
|
|
chicks: Christopher Hicks |
4945
|
|
|
|
|
|
|
|
4946
|
|
|
|
|
|
|
Chisel Wright <pause@herlpacker.co.uk> |
4947
|
|
|
|
|
|
|
|
4948
|
|
|
|
|
|
|
Danijel Milicevic <me@danijel.de> |
4949
|
|
|
|
|
|
|
|
4950
|
|
|
|
|
|
|
davewood: David Schmidt <davewood@cpan.org> |
4951
|
|
|
|
|
|
|
|
4952
|
|
|
|
|
|
|
David Kamholz <dkamholz@cpan.org> |
4953
|
|
|
|
|
|
|
|
4954
|
|
|
|
|
|
|
David Naughton <naughton@umn.edu> |
4955
|
|
|
|
|
|
|
|
4956
|
|
|
|
|
|
|
David E. Wheeler |
4957
|
|
|
|
|
|
|
|
4958
|
|
|
|
|
|
|
dhoss: Devin Austin <dhoss@cpan.org> |
4959
|
|
|
|
|
|
|
|
4960
|
|
|
|
|
|
|
dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com> |
4961
|
|
|
|
|
|
|
|
4962
|
|
|
|
|
|
|
Drew Taylor |
4963
|
|
|
|
|
|
|
|
4964
|
|
|
|
|
|
|
dwc: Daniel Westermann-Clark <danieltwc@cpan.org> |
4965
|
|
|
|
|
|
|
|
4966
|
|
|
|
|
|
|
esskar: Sascha Kiefer |
4967
|
|
|
|
|
|
|
|
4968
|
|
|
|
|
|
|
fireartist: Carl Franks <cfranks@cpan.org> |
4969
|
|
|
|
|
|
|
|
4970
|
|
|
|
|
|
|
frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com> |
4971
|
|
|
|
|
|
|
|
4972
|
|
|
|
|
|
|
gabb: Danijel Milicevic |
4973
|
|
|
|
|
|
|
|
4974
|
|
|
|
|
|
|
Gary Ashton Jones |
4975
|
|
|
|
|
|
|
|
4976
|
|
|
|
|
|
|
Gavin Henry <ghenry@perl.me.uk> |
4977
|
|
|
|
|
|
|
|
4978
|
|
|
|
|
|
|
Geoff Richards |
4979
|
|
|
|
|
|
|
|
4980
|
|
|
|
|
|
|
groditi: Guillermo Roditi <groditi@gmail.com> |
4981
|
|
|
|
|
|
|
|
4982
|
|
|
|
|
|
|
hobbs: Andrew Rodland <andrew@cleverdomain.org> |
4983
|
|
|
|
|
|
|
|
4984
|
|
|
|
|
|
|
ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org> |
4985
|
|
|
|
|
|
|
|
4986
|
|
|
|
|
|
|
jcamacho: Juan Camacho |
4987
|
|
|
|
|
|
|
|
4988
|
|
|
|
|
|
|
jester: Jesse Sheidlower <jester@panix.com> |
4989
|
|
|
|
|
|
|
|
4990
|
|
|
|
|
|
|
jhannah: Jay Hannah <jay@jays.net> |
4991
|
|
|
|
|
|
|
|
4992
|
|
|
|
|
|
|
Jody Belka |
4993
|
|
|
|
|
|
|
|
4994
|
|
|
|
|
|
|
Johan Lindstrom |
4995
|
|
|
|
|
|
|
|
4996
|
|
|
|
|
|
|
jon: Jon Schutz <jjschutz@cpan.org> |
4997
|
|
|
|
|
|
|
|
4998
|
|
|
|
|
|
|
Jonathan Rockway <jrockway@cpan.org> |
4999
|
|
|
|
|
|
|
|
5000
|
|
|
|
|
|
|
Kieren Diment <kd@totaldatasolution.com> |
5001
|
|
|
|
|
|
|
|
5002
|
|
|
|
|
|
|
konobi: Scott McWhirter <konobi@cpan.org> |
5003
|
|
|
|
|
|
|
|
5004
|
|
|
|
|
|
|
marcus: Marcus Ramberg <mramberg@cpan.org> |
5005
|
|
|
|
|
|
|
|
5006
|
|
|
|
|
|
|
miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net> |
5007
|
|
|
|
|
|
|
|
5008
|
|
|
|
|
|
|
mgrimes: Mark Grimes <mgrimes@cpan.org> |
5009
|
|
|
|
|
|
|
|
5010
|
|
|
|
|
|
|
mst: Matt S. Trout <mst@shadowcatsystems.co.uk> |
5011
|
|
|
|
|
|
|
|
5012
|
|
|
|
|
|
|
mugwump: Sam Vilain |
5013
|
|
|
|
|
|
|
|
5014
|
|
|
|
|
|
|
naughton: David Naughton |
5015
|
|
|
|
|
|
|
|
5016
|
|
|
|
|
|
|
ningu: David Kamholz <dkamholz@cpan.org> |
5017
|
|
|
|
|
|
|
|
5018
|
|
|
|
|
|
|
nothingmuch: Yuval Kogman <nothingmuch@woobling.org> |
5019
|
|
|
|
|
|
|
|
5020
|
|
|
|
|
|
|
numa: Dan Sully <daniel@cpan.org> |
5021
|
|
|
|
|
|
|
|
5022
|
|
|
|
|
|
|
obra: Jesse Vincent |
5023
|
|
|
|
|
|
|
|
5024
|
|
|
|
|
|
|
Octavian Rasnita |
5025
|
|
|
|
|
|
|
|
5026
|
|
|
|
|
|
|
omega: Andreas Marienborg |
5027
|
|
|
|
|
|
|
|
5028
|
|
|
|
|
|
|
Oleg Kostyuk <cub.uanic@gmail.com> |
5029
|
|
|
|
|
|
|
|
5030
|
|
|
|
|
|
|
phaylon: Robert Sedlacek <phaylon@dunkelheit.at> |
5031
|
|
|
|
|
|
|
|
5032
|
|
|
|
|
|
|
rafl: Florian Ragwitz <rafl@debian.org> |
5033
|
|
|
|
|
|
|
|
5034
|
|
|
|
|
|
|
random: Roland Lammel <lammel@cpan.org> |
5035
|
|
|
|
|
|
|
|
5036
|
|
|
|
|
|
|
revmischa: Mischa Spiegelmock <revmischa@cpan.org> |
5037
|
|
|
|
|
|
|
|
5038
|
|
|
|
|
|
|
Robert Sedlacek <rs@474.at> |
5039
|
|
|
|
|
|
|
|
5040
|
|
|
|
|
|
|
rrwo: Robert Rothenberg <rrwo@cpan.org> |
5041
|
|
|
|
|
|
|
|
5042
|
|
|
|
|
|
|
SpiceMan: Marcel Montes |
5043
|
|
|
|
|
|
|
|
5044
|
|
|
|
|
|
|
sky: Arthur Bergman |
5045
|
|
|
|
|
|
|
|
5046
|
|
|
|
|
|
|
szbalint: Balint Szilakszi <szbalint@cpan.org> |
5047
|
|
|
|
|
|
|
|
5048
|
|
|
|
|
|
|
t0m: Tomas Doran <bobtfish@bobtfish.net> |
5049
|
|
|
|
|
|
|
|
5050
|
|
|
|
|
|
|
Ulf Edvinsson |
5051
|
|
|
|
|
|
|
|
5052
|
|
|
|
|
|
|
vanstyn: Henry Van Styn <vanstyn@cpan.org> |
5053
|
|
|
|
|
|
|
|
5054
|
|
|
|
|
|
|
Viljo Marrandi <vilts@yahoo.com> |
5055
|
|
|
|
|
|
|
|
5056
|
|
|
|
|
|
|
Will Hawes <info@whawes.co.uk> |
5057
|
|
|
|
|
|
|
|
5058
|
|
|
|
|
|
|
willert: Sebastian Willert <willert@cpan.org> |
5059
|
|
|
|
|
|
|
|
5060
|
|
|
|
|
|
|
wreis: Wallace Reis <wreis@cpan.org> |
5061
|
|
|
|
|
|
|
|
5062
|
|
|
|
|
|
|
Yuval Kogman <nothingmuch@woobling.org> |
5063
|
|
|
|
|
|
|
|
5064
|
|
|
|
|
|
|
rainboxx: Matthias Dietrich <perl@rainboxx.de> |
5065
|
|
|
|
|
|
|
|
5066
|
|
|
|
|
|
|
dd070: Dhaval Dhanani <dhaval070@gmail.com> |
5067
|
|
|
|
|
|
|
|
5068
|
|
|
|
|
|
|
Upasana <me@upasana.me> |
5069
|
|
|
|
|
|
|
|
5070
|
|
|
|
|
|
|
John Napiorkowski (jnap) <jjnapiork@cpan.org> |
5071
|
|
|
|
|
|
|
|
5072
|
|
|
|
|
|
|
=head1 COPYRIGHT |
5073
|
|
|
|
|
|
|
|
5074
|
|
|
|
|
|
|
Copyright (c) 2005-2015, the above named PROJECT FOUNDER and CONTRIBUTORS. |
5075
|
|
|
|
|
|
|
|
5076
|
|
|
|
|
|
|
=head1 LICENSE |
5077
|
|
|
|
|
|
|
|
5078
|
|
|
|
|
|
|
This library is free software. You can redistribute it and/or modify it under |
5079
|
|
|
|
|
|
|
the same terms as Perl itself. |
5080
|
|
|
|
|
|
|
|
5081
|
|
|
|
|
|
|
=cut |
5082
|
|
|
|
|
|
|
|
5083
|
165
|
|
|
165
|
|
1923
|
no Moose; |
|
165
|
|
|
|
|
538
|
|
|
165
|
|
|
|
|
2522
|
|
5084
|
|
|
|
|
|
|
|
5085
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
5086
|
|
|
|
|
|
|
|
5087
|
|
|
|
|
|
|
1; |