File Coverage

blib/lib/Catalyst.pm
Criterion Covered Total %
statement 1129 1279 88.2
branch 427 572 74.6
condition 171 230 74.3
subroutine 191 208 91.8
pod 109 110 99.0
total 2027 2399 84.4


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;