removed unneeded dependency that was causing test fails
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
CommitLineData
fc7ec1d9 1package Catalyst;
2
a7caa492 3use Moose;
c98492ae 4use Moose::Meta::Class ();
60eabdaf 5extends 'Catalyst::Component';
2f5cb070 6use Moose::Util qw/find_meta/;
38e43e65 7use namespace::clean -except => 'meta';
a2f2cde9 8use Catalyst::Exception;
154ef0c8 9use Catalyst::Exception::Detach;
10use Catalyst::Exception::Go;
fc7ec1d9 11use Catalyst::Log;
fbcc39ad 12use Catalyst::Request;
13use Catalyst::Request::Upload;
14use Catalyst::Response;
812a28c9 15use Catalyst::Utils;
31375184 16use Catalyst::Controller;
62b6b631 17use Data::OptList;
364d7324 18use Devel::InnerPackage ();
c50f595c 19use Module::Pluggable::Object ();
c50f595c 20use Text::SimpleTable ();
21use Path::Class::Dir ();
22use Path::Class::File ();
c50f595c 23use URI ();
933ba403 24use URI::http;
25use URI::https;
7af54927 26use HTML::Entities;
5513038d 27use Tree::Simple qw/use_weak_refs/;
28use Tree::Simple::Visitor::FindByUID;
269408a4 29use Class::C3::Adopt::NEXT;
196f06d1 30use List::MoreUtils qw/uniq/;
261c571e 31use attributes;
532f0516 32use String::RewritePrefix;
b1ededd4 33use Catalyst::EngineLoader;
5789a3d8 34use utf8;
108201b5 35use Carp qw/croak carp shortmess/;
3640641e 36use Try::Tiny;
4995a5ce 37use Safe::Isa;
dd5b1dc4 38use Moose::Util 'find_meta';
ad79be34 39use Plack::Middleware::Conditional;
40use Plack::Middleware::ReverseProxy;
fb99321f 41use Plack::Middleware::IIS6ScriptNameFix;
201e0a1f 42use Plack::Middleware::IIS7KeepAliveFix;
d3670826 43use Plack::Middleware::LighttpdScriptNameFix;
aa20e9f5 44use Plack::Middleware::ContentLength;
45use Plack::Middleware::Head;
660f9bb0 46use Plack::Middleware::HTTPExceptions;
ecf903d0 47use Plack::Middleware::FixMissingBodyInRedirect;
3157d22a 48use Plack::Middleware::MethodOverride;
79070bc6 49use Plack::Middleware::RemoveRedundantBody;
6561feae 50use Catalyst::Middleware::Stash;
20a09634 51use Plack::Util;
e7399d8b 52use Class::Load 'load_class';
0ca510f0 53use Encode 2.21 'decode_utf8', 'encode_utf8';
fc7ec1d9 54
0f6be50c 55BEGIN { require 5.008003; }
f63c03e4 56
8a440eba 57has stack => (is => 'ro', default => sub { [] });
6680c772 58has state => (is => 'rw', default => 0);
b6d4ee6e 59has stats => (is => 'rw');
60has action => (is => 'rw');
6680c772 61has counter => (is => 'rw', default => sub { {} });
398f13db 62has request => (
63 is => 'rw',
64 default => sub {
65 my $self = shift;
a2c6c7b9 66 $self->request_class->new($self->_build_request_constructor_args);
398f13db 67 },
68 lazy => 1,
69);
a2c6c7b9 70sub _build_request_constructor_args {
0df490ef 71 my $self = shift;
72 my %p = ( _log => $self->log );
73 $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
b87d834e 74 $p{data_handlers} = {$self->registered_data_handlers};
88ba7793 75 $p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request}
76 if $self->config->{use_hash_multivalue_in_request};
0df490ef 77 \%p;
78}
79
7c1c4dc6 80has response => (
81 is => 'rw',
82 default => sub {
83 my $self = shift;
a2c6c7b9 84 $self->response_class->new($self->_build_response_constructor_args);
7c1c4dc6 85 },
86 lazy => 1,
87);
a2c6c7b9 88sub _build_response_constructor_args {
e8361cf8 89 return +{
90 _log => $_[0]->log,
91 encoding => $_[0]->encoding,
92 };
0df490ef 93}
94
e63bdf38 95has namespace => (is => 'rw');
96
8767c5a3 97sub depth { scalar @{ shift->stack || [] }; }
0fc2d522 98sub comp { shift->component(@_) }
6680c772 99
100sub req {
6680c772 101 my $self = shift; return $self->request(@_);
102}
103sub res {
6680c772 104 my $self = shift; return $self->response(@_);
105}
fbcc39ad 106
107# For backwards compatibility
0fc2d522 108sub finalize_output { shift->finalize_body(@_) };
fbcc39ad 109
110# For statistics
111our $COUNT = 1;
112our $START = time;
113our $RECURSION = 1000;
154ef0c8 114our $DETACH = Catalyst::Exception::Detach->new;
115our $GO = Catalyst::Exception::Go->new;
fbcc39ad 116
b6d4ee6e 117#I imagine that very few of these really need to be class variables. if any.
118#maybe we should just make them attributes with a default?
fbcc39ad 119__PACKAGE__->mk_classdata($_)
3cec521a 120 for qw/components arguments dispatcher engine log dispatcher_class
1e5dad00 121 engine_loader context_class request_class response_class stats_class
b87d834e 122 setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware
9c38cb50 123 _data_handlers _encoding _encode_check/;
cb0354c6 124
3cec521a 125__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
3cec521a 126__PACKAGE__->request_class('Catalyst::Request');
127__PACKAGE__->response_class('Catalyst::Response');
dc5f035e 128__PACKAGE__->stats_class('Catalyst::Stats');
9c38cb50 129__PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
fbcc39ad 130
6415bb4d 131# Remember to update this in Catalyst::Runtime as well!
6dcc5307 132our $VERSION = '5.90079_005';
5c779e98 133$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
189e2a51 134
fbcc39ad 135sub import {
136 my ( $class, @arguments ) = @_;
137
138 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
139 # callers @ISA.
140 return unless $class eq 'Catalyst';
141
84ff88cf 142 my $caller = caller();
143 return if $caller eq 'main';
269408a4 144
84ff88cf 145 my $meta = Moose::Meta::Class->initialize($caller);
fbcc39ad 146 unless ( $caller->isa('Catalyst') ) {
84ff88cf 147 my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
148 $meta->superclasses(@superclasses);
149 }
1cad29ab 150 # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
151 $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
152
84ff88cf 153 unless( $meta->has_method('meta') ){
9c74923d 154 if ($Moose::VERSION >= 1.15) {
155 $meta->_add_meta_method('meta');
156 }
157 else {
158 $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
159 }
fbcc39ad 160 }
161
162 $caller->arguments( [@arguments] );
163 $caller->setup_home;
164}
fc7ec1d9 165
e6bfaa20 166sub _application { $_[0] }
167
bf590d36 168=encoding UTF-8
169
fc7ec1d9 170=head1 NAME
171
172Catalyst - The Elegant MVC Web Application Framework
173
174=head1 SYNOPSIS
175
e7ad3b81 176See the L<Catalyst::Manual> distribution for comprehensive
177documentation and tutorials.
178
86418559 179 # Install Catalyst::Devel for helpers and other development tools
b4b01a8a 180 # use the helper to create a new application
91864987 181 catalyst.pl MyApp
fc7ec1d9 182
183 # add models, views, controllers
2f381252 184 script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
cc95842f 185 script/myapp_create.pl view MyTemplate TT
0ef52a96 186 script/myapp_create.pl controller Search
fc7ec1d9 187
e7f1cf73 188 # built in testserver -- use -r to restart automatically on changes
cc95842f 189 # --help to see all available options
ae4e40a7 190 script/myapp_server.pl
fc7ec1d9 191
0ef52a96 192 # command line testing interface
ae4e40a7 193 script/myapp_test.pl /yada
fc7ec1d9 194
b4b01a8a 195 ### in lib/MyApp.pm
0ef52a96 196 use Catalyst qw/-Debug/; # include plugins here as well
62a6df80 197
85d9fce6 198 ### In lib/MyApp/Controller/Root.pm (autocreated)
20f0d47b 199 sub foo : Chained('/') Args() { # called for /foo, /foo/1, /foo/1/2, etc.
ae1e6b59 200 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
201 $c->stash->{template} = 'foo.tt'; # set the template
0ef52a96 202 # lookup something from db -- stash vars are passed to TT
62a6df80 203 $c->stash->{data} =
b4b01a8a 204 $c->model('Database::Foo')->search( { country => $args[0] } );
0ef52a96 205 if ( $c->req->params->{bar} ) { # access GET or POST parameters
206 $c->forward( 'bar' ); # process another action
62a6df80 207 # do something else after forward returns
0ef52a96 208 }
209 }
62a6df80 210
ae1e6b59 211 # The foo.tt TT template can use the stash data from the database
0ef52a96 212 [% WHILE (item = data.next) %]
213 [% item.foo %]
214 [% END %]
62a6df80 215
0ef52a96 216 # called for /bar/of/soap, /bar/of/soap/10, etc.
20f0d47b 217 sub bar : Chained('/') PathPart('/bar/of/soap') Args() { ... }
62a6df80 218
ae1e6b59 219 # called after all actions are finished
20f0d47b 220 sub end : Action {
5a8ed4fe 221 my ( $self, $c ) = @_;
0ef52a96 222 if ( scalar @{ $c->error } ) { ... } # handle errors
223 return if $c->res->body; # already have a response
224 $c->forward( 'MyApp::View::TT' ); # render template
5a8ed4fe 225 }
226
0ef52a96 227See L<Catalyst::Manual::Intro> for additional information.
3803e98f 228
fc7ec1d9 229=head1 DESCRIPTION
230
86418559 231Catalyst is a modern framework for making web applications without the
232pain usually associated with this process. This document is a reference
233to the main Catalyst application. If you are a new user, we suggest you
234start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
fc7ec1d9 235
236See L<Catalyst::Manual> for more documentation.
237
ae1e6b59 238Catalyst plugins can be loaded by naming them as arguments to the "use
239Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
240plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
241C<My::Module>.
fc7ec1d9 242
0ef52a96 243 use Catalyst qw/My::Module/;
fc7ec1d9 244
836e1134 245If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
246fully qualify the name by using a unary plus:
247
248 use Catalyst qw/
249 My::Module
250 +Fully::Qualified::Plugin::Name
251 /;
252
5853fd49 253Special flags like C<-Debug> can also be specified as
ae1e6b59 254arguments when Catalyst is loaded:
fc7ec1d9 255
256 use Catalyst qw/-Debug My::Module/;
257
ae1e6b59 258The position of plugins and flags in the chain is important, because
86418559 259they are loaded in the order in which they appear.
fc7ec1d9 260
23f9d934 261The following flags are supported:
262
b5ecfcf0 263=head2 -Debug
23f9d934 264
f8ad6ea5 265Enables debug output. You can also force this setting from the system
86418559 266environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
267settings override the application, with <MYAPP>_DEBUG having the highest
268priority.
fc7ec1d9 269
c8083f4e 270This sets the log level to 'debug' and enables full debug output on the
271error screen. If you only want the latter, see L<< $c->debug >>.
272
b5ecfcf0 273=head2 -Home
fbcc39ad 274
ae1e6b59 275Forces Catalyst to use a specific home directory, e.g.:
276
86418559 277 use Catalyst qw[-Home=/usr/mst];
fbcc39ad 278
cc95842f 279This can also be done in the shell environment by setting either the
280C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
281is replaced with the uppercased name of your application, any "::" in
282the name will be replaced with underscores, e.g. MyApp::Web should use
283MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
284
d7a82605 285If none of these are set, Catalyst will attempt to automatically detect the
8ad6fd58 286home directory. If you are working in a development environment, Catalyst
a943d722 287will try and find the directory containing either Makefile.PL, Build.PL,
288dist.ini, or cpanfile. If the application has been installed into the system
289(i.e. you have done C<make install>), then Catalyst will use the path to your
8ad6fd58 290application module, without the .pm extension (e.g., /foo/MyApp if your
d7a82605 291application was installed at /foo/MyApp.pm)
292
b5ecfcf0 293=head2 -Log
fbcc39ad 294
0fa676a7 295 use Catalyst '-Log=warn,fatal,error';
62a6df80 296
0fa676a7 297Specifies a comma-delimited list of log levels.
fbcc39ad 298
dc5f035e 299=head2 -Stats
300
01c5eab0 301Enables statistics collection and reporting.
dc5f035e 302
01c5eab0 303 use Catalyst qw/-Stats=1/;
dc5f035e 304
01c5eab0 305You can also force this setting from the system environment with CATALYST_STATS
306or <MYAPP>_STATS. The environment settings override the application, with
307<MYAPP>_STATS having the highest priority.
dc5f035e 308
01c5eab0 309Stats are also enabled if L<< debugging |/"-Debug" >> is enabled.
dc5f035e 310
23f9d934 311=head1 METHODS
312
f7b672ef 313=head2 INFORMATION ABOUT THE CURRENT REQUEST
0ef52a96 314
b5ecfcf0 315=head2 $c->action
66e28e3f 316
ae1e6b59 317Returns a L<Catalyst::Action> object for the current action, which
318stringifies to the action name. See L<Catalyst::Action>.
0ef52a96 319
b5ecfcf0 320=head2 $c->namespace
0ef52a96 321
86418559 322Returns the namespace of the current action, i.e., the URI prefix
ae1e6b59 323corresponding to the controller of the current action. For example:
324
325 # in Controller::Foo::Bar
326 $c->namespace; # returns 'foo/bar';
0ef52a96 327
b5ecfcf0 328=head2 $c->request
0ef52a96 329
b5ecfcf0 330=head2 $c->req
0ef52a96 331
86418559 332Returns the current L<Catalyst::Request> object, giving access to
333information about the current client request (including parameters,
334cookies, HTTP headers, etc.). See L<Catalyst::Request>.
0ef52a96 335
b4b01a8a 336=head2 REQUEST FLOW HANDLING
0ef52a96 337
b5ecfcf0 338=head2 $c->forward( $action [, \@arguments ] )
0ef52a96 339
b5ecfcf0 340=head2 $c->forward( $class, $method, [, \@arguments ] )
0ef52a96 341
52c77837 342This is one way of calling another action (method) in the same or
343a different controller. You can also use C<< $self->my_method($c, @args) >>
344in the same controller or C<< $c->controller('MyController')->my_method($c, @args) >>
345in a different controller.
346The main difference is that 'forward' uses some of the Catalyst request
347cycle overhead, including debugging, which may be useful to you. On the
348other hand, there are some complications to using 'forward', restrictions
349on values returned from 'forward', and it may not handle errors as you prefer.
350Whether you use 'forward' or not is up to you; it is not considered superior to
351the other ways to call a method.
352
353'forward' calls another action, by its private name. If you give a
b4b01a8a 354class name but no method, C<process()> is called. You may also optionally
355pass arguments in an arrayref. The action will receive the arguments in
cc95842f 356C<@_> and C<< $c->req->args >>. Upon returning from the function,
357C<< $c->req->args >> will be restored to the previous values.
0ef52a96 358
3b984c64 359Any data C<return>ed from the action forwarded to, will be returned by the
d759db1e 360call to forward.
3b984c64 361
362 my $foodata = $c->forward('/foo');
0ef52a96 363 $c->forward('index');
1d3a0700 364 $c->forward(qw/Model::DBIC::Foo do_stuff/);
365 $c->forward('View::TT');
0ef52a96 366
18a9655c 367Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
368an C<< eval { } >> around the call (actually
8ad6fd58 369L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all
370exceptions thrown by the called action non-fatal and pushing them onto
371$c->error instead. If you want C<die> to propagate you need to do something
372like:
f3e6a8c0 373
374 $c->forward('foo');
7d6820cc 375 die join "\n", @{ $c->error } if @{ $c->error };
f3e6a8c0 376
86418559 377Or make sure to always return true values from your actions and write
378your code like this:
f3e6a8c0 379
380 $c->forward('foo') || return;
1d3a0700 381
2e60292e 382Another note is that C<< $c->forward >> always returns a scalar because it
383actually returns $c->state which operates in a scalar context.
384Thus, something like:
385
386 return @array;
1d3a0700 387
388in an action that is forwarded to is going to return a scalar,
2e60292e 389i.e. how many items are in that array, which is probably not what you want.
1d3a0700 390If you need to return an array then return a reference to it,
2e60292e 391or stash it like so:
392
393 $c->stash->{array} = \@array;
394
395and access it from the stash.
f3e6a8c0 396
9c74923d 397Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
398
0ef52a96 399=cut
400
6680c772 401sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
0ef52a96 402
b5ecfcf0 403=head2 $c->detach( $action [, \@arguments ] )
0ef52a96 404
b5ecfcf0 405=head2 $c->detach( $class, $method, [, \@arguments ] )
0ef52a96 406
264bac8c 407=head2 $c->detach()
408
18a9655c 409The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
410doesn't return to the previous action when processing is finished.
0ef52a96 411
264bac8c 412When called with no arguments it escapes the processing chain entirely.
413
0ef52a96 414=cut
415
416sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
417
8431b9cc 418=head2 $c->visit( $action [, \@arguments ] )
419
5d91ffe2 420=head2 $c->visit( $action [, \@captures, \@arguments ] )
ae0e35ee 421
8431b9cc 422=head2 $c->visit( $class, $method, [, \@arguments ] )
423
5d91ffe2 424=head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
ae0e35ee 425
18a9655c 426Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
427but does a full dispatch, instead of just calling the new C<$action> /
428C<< $class->$method >>. This means that C<begin>, C<auto> and the method
429you go to are called, just like a new request.
ae0e35ee 430
4b48773e 431In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
18a9655c 432This means, for example, that C<< $c->action >> methods such as
433L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
434L<reverse|Catalyst::Action/reverse> return information for the visited action
435when they are invoked within the visited action. This is different from the
436behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
437continues to use the $c->action object from the caller action even when
8ad6fd58 438invoked from the called action.
4b48773e 439
18a9655c 440C<< $c->stash >> is kept unchanged.
ae0e35ee 441
18a9655c 442In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
443allows you to "wrap" another action, just as it would have been called by
444dispatching from a URL, while the analogous
445L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
446transfer control to another action as if it had been reached directly from a URL.
ae0e35ee 447
448=cut
449
450sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
451
8431b9cc 452=head2 $c->go( $action [, \@arguments ] )
453
5d91ffe2 454=head2 $c->go( $action [, \@captures, \@arguments ] )
2f381252 455
8431b9cc 456=head2 $c->go( $class, $method, [, \@arguments ] )
457
5d91ffe2 458=head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
2f381252 459
1d3a0700 460The relationship between C<go> and
12c48597 461L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
1d3a0700 462the relationship between
12c48597 463L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
464L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
465C<< $c->go >> will perform a full dispatch on the specified action or method,
466with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
467C<go> escapes the processing of the current request chain on completion, and
468does not return to its caller.
2f381252 469
9c74923d 470@arguments are arguments to the final destination of $action. @captures are
471arguments to the intermediate steps, if any, on the way to the final sub of
472$action.
473
2f381252 474=cut
475
476sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
477
b4b01a8a 478=head2 $c->response
479
480=head2 $c->res
481
cc95842f 482Returns the current L<Catalyst::Response> object, see there for details.
b4b01a8a 483
484=head2 $c->stash
485
486Returns a hashref to the stash, which may be used to store data and pass
487it between components during a request. You can also set hash keys by
488passing arguments. The stash is automatically sent to the view. The
489stash is cleared at the end of a request; it cannot be used for
86418559 490persistent storage (for this you must use a session; see
491L<Catalyst::Plugin::Session> for a complete system integrated with
492Catalyst).
b4b01a8a 493
494 $c->stash->{foo} = $bar;
495 $c->stash( { moose => 'majestic', qux => 0 } );
496 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
62a6df80 497
b4b01a8a 498 # stash is automatically passed to the view for use in a template
cc95842f 499 $c->forward( 'MyApp::View::TT' );
b4b01a8a 500
4b0b7489 501The stash hash is currently stored in the PSGI C<$env> and is managed by
502L<Catalyst::Middleware::Stash>. Since it's part of the C<$env> items in
503the stash can be accessed in sub applications mounted under your main
504L<Catalyst> application. For example if you delegate the response of an
505action to another L<Catalyst> application, that sub application will have
506access to all the stash keys of the main one, and if can of course add
507more keys of its own. However those new keys will not 'bubble' back up
508to the main application.
509
510For more information the best thing to do is to review the test case:
511t/middleware-stash.t in the distribution /t directory.
512
6561feae 513=cut
514
515sub stash {
516 my $c = shift;
561098d1 517 return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_);
6561feae 518}
b4b01a8a 519
b5ecfcf0 520=head2 $c->error
0ef52a96 521
b5ecfcf0 522=head2 $c->error($error, ...)
0ef52a96 523
b5ecfcf0 524=head2 $c->error($arrayref)
0ef52a96 525
83a8fcac 526Returns an arrayref containing error messages. If Catalyst encounters an
527error while processing a request, it stores the error in $c->error. This
e7ad3b81 528method should only be used to store fatal error messages.
0ef52a96 529
530 my @error = @{ $c->error };
531
532Add a new error.
533
534 $c->error('Something bad happened');
535
b94f8e72 536Calling this will always return an arrayref (if there are no errors it
537will be an empty arrayref.
538
0ef52a96 539=cut
540
541sub error {
542 my $c = shift;
543 if ( $_[0] ) {
544 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
9ce44430 545 croak @$error unless ref $c;
0ef52a96 546 push @{ $c->{error} }, @$error;
547 }
548 elsif ( defined $_[0] ) { $c->{error} = undef }
549 return $c->{error} || [];
550}
551
b4b01a8a 552
553=head2 $c->state
554
1d3a0700 555Contains the return value of the last executed action.
2e60292e 556Note that << $c->state >> operates in a scalar context which means that all
557values it returns are scalar.
b4b01a8a 558
ca81eb67 559=head2 $c->clear_errors
560
561Clear errors. You probably don't want to clear the errors unless you are
562implementing a custom error screen.
563
564This is equivalent to running
565
566 $c->error(0);
567
568=cut
569
570sub clear_errors {
571 my $c = shift;
572 $c->error(0);
573}
574
30e84ba1 575=head2 $c->has_errors
576
577Returns true if you have errors
578
579=cut
580
581sub has_errors { scalar(@{shift->error}) ? 1:0 }
582
b94f8e72 583=head2 $c->last_error
584
585Returns the most recent error in the stack (the one most recently added...)
586or nothing if there are no errors.
587
588=cut
589
590sub last_error { my ($err, @errs) = @{shift->error}; return $err }
591
592=head2 shift_errors
593
594shifts the most recently added error off the error stack and returns if. Returns
595nothing if there are nomore errors.
596
597=cut
598
599sub shift_errors {
600 my ($self) = @_;
601 my ($err, @errors) = @{$self->error};
602 $self->{error} = \@errors;
603 return $err;
604}
605
2f381252 606sub _comp_search_prefixes {
c23b894b 607 my $c = shift;
608 return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
609}
610
611# search components given a name and some prefixes
612sub _comp_names_search_prefixes {
2f381252 613 my ( $c, $name, @prefixes ) = @_;
614 my $appclass = ref $c || $c;
615 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
cce626ed 616 $filter = qr/$filter/; # Compile regex now rather than once per loop
0ef52a96 617
2f381252 618 # map the original component name to the sub part that we will search against
619 my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
620 grep { /$filter/ } keys %{ $c->components };
0756fe3b 621
2f381252 622 # undef for a name will return all
623 return keys %eligible if !defined $name;
0756fe3b 624
4995a5ce 625 my $query = $name->$_isa('Regexp') ? $name : qr/^$name$/i;
2f381252 626 my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
0756fe3b 627
c23b894b 628 return @result if @result;
0756fe3b 629
2f381252 630 # if we were given a regexp to search against, we're done.
4995a5ce 631 return if $name->$_isa('Regexp');
0756fe3b 632
ab86b480 633 # skip regexp fallback if configured
634 return
635 if $appclass->config->{disable_component_resolution_regex_fallback};
636
2f381252 637 # regexp fallback
638 $query = qr/$name/i;
c23b894b 639 @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
0756fe3b 640
2f381252 641 # no results? try against full names
642 if( !@result ) {
c23b894b 643 @result = grep { m{$query} } keys %eligible;
2f381252 644 }
0756fe3b 645
2f381252 646 # don't warn if we didn't find any results, it just might not exist
647 if( @result ) {
cce626ed 648 # Disgusting hack to work out correct method name
649 my $warn_for = lc $prefixes[0];
e260802a 650 my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
108201b5 651 (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
652 "component resolution is unreliable and unsafe.";
653 my $short = $result[0];
ab86b480 654 # remove the component namespace prefix
655 $short =~ s/.*?(Model|Controller|View):://;
108201b5 656 my $shortmess = Carp::shortmess('');
657 if ($shortmess =~ m#Catalyst/Plugin#) {
658 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
659 "plugin's config";
660 } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
661 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
662 "component's config";
663 } else {
ab86b480 664 $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " .
108201b5 665 "but if you really wanted to search, pass in a regexp as the argument " .
cce626ed 666 "like so: \$c->${warn_for}(qr/${name}/)";
108201b5 667 }
668 $c->log->warn( "${msg}$shortmess" );
2f381252 669 }
0756fe3b 670
2f381252 671 return @result;
0756fe3b 672}
673
62a6df80 674# Find possible names for a prefix
3b88a455 675sub _comp_names {
676 my ( $c, @prefixes ) = @_;
3b88a455 677 my $appclass = ref $c || $c;
678
2f381252 679 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
3b88a455 680
c23b894b 681 my @names = map { s{$filter}{}; $_; }
682 $c->_comp_names_search_prefixes( undef, @prefixes );
683
3b88a455 684 return @names;
685}
686
197bd788 687# Filter a component before returning by calling ACCEPT_CONTEXT if available
688sub _filter_component {
689 my ( $c, $comp, @args ) = @_;
2f381252 690
8abaac85 691 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
197bd788 692 return $comp->ACCEPT_CONTEXT( $c, @args );
693 }
62a6df80 694
2f381252 695 return $comp;
197bd788 696}
697
f7b672ef 698=head2 COMPONENT ACCESSORS
0ef52a96 699
b5ecfcf0 700=head2 $c->controller($name)
af3ff00e 701
0ef52a96 702Gets a L<Catalyst::Controller> instance by name.
af3ff00e 703
704 $c->controller('Foo')->do_stuff;
705
86418559 706If the name is omitted, will return the controller for the dispatched
707action.
649fd1fa 708
2f381252 709If you want to search for controllers, pass in a regexp as the argument.
710
711 # find all controllers that start with Foo
712 my @foo_controllers = $c->controller(qr{^Foo});
713
714
af3ff00e 715=cut
716
717sub controller {
197bd788 718 my ( $c, $name, @args ) = @_;
2f381252 719
13311c16 720 my $appclass = ref($c) || $c;
2f381252 721 if( $name ) {
4995a5ce 722 unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
13311c16 723 my $comps = $c->components;
724 my $check = $appclass."::Controller::".$name;
725 return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
726 }
2f381252 727 my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
728 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
729 return $c->_filter_component( $result[ 0 ], @args );
730 }
731
197bd788 732 return $c->component( $c->action->class );
af3ff00e 733}
734
b5ecfcf0 735=head2 $c->model($name)
fc7ec1d9 736
0ef52a96 737Gets a L<Catalyst::Model> instance by name.
738
739 $c->model('Foo')->do_stuff;
fc7ec1d9 740
72f87c4b 741Any extra arguments are directly passed to ACCEPT_CONTEXT.
742
62a6df80 743If the name is omitted, it will look for
2f381252 744 - a model object in $c->stash->{current_model_instance}, then
a3b71f0f 745 - a model name in $c->stash->{current_model}, then
746 - a config setting 'default_model', or
747 - check if there is only one model, and return it if that's the case.
649fd1fa 748
2f381252 749If you want to search for models, pass in a regexp as the argument.
750
751 # find all models that start with Foo
752 my @foo_models = $c->model(qr{^Foo});
753
fc7ec1d9 754=cut
755
0ef52a96 756sub model {
197bd788 757 my ( $c, $name, @args ) = @_;
df960201 758 my $appclass = ref($c) || $c;
2f381252 759 if( $name ) {
4995a5ce 760 unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
13311c16 761 my $comps = $c->components;
762 my $check = $appclass."::Model::".$name;
763 return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
764 }
2f381252 765 my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
766 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
767 return $c->_filter_component( $result[ 0 ], @args );
768 }
769
a3b71f0f 770 if (ref $c) {
62a6df80 771 return $c->stash->{current_model_instance}
a3b71f0f 772 if $c->stash->{current_model_instance};
773 return $c->model( $c->stash->{current_model} )
774 if $c->stash->{current_model};
a3b71f0f 775 }
df960201 776 return $c->model( $appclass->config->{default_model} )
777 if $appclass->config->{default_model};
3b88a455 778
2f381252 779 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
3b88a455 780
2f381252 781 if( $rest ) {
108201b5 782 $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
4600a5a1 783 $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' );
2f381252 784 $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
785 $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
11c270bd 786 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
2f381252 787 }
3b88a455 788
2f381252 789 return $c->_filter_component( $comp );
3b88a455 790}
791
b4b01a8a 792
b5ecfcf0 793=head2 $c->view($name)
0ef52a96 794
795Gets a L<Catalyst::View> instance by name.
fc7ec1d9 796
0ef52a96 797 $c->view('Foo')->do_stuff;
fc7ec1d9 798
72f87c4b 799Any extra arguments are directly passed to ACCEPT_CONTEXT.
800
62a6df80 801If the name is omitted, it will look for
2f381252 802 - a view object in $c->stash->{current_view_instance}, then
a3b71f0f 803 - a view name in $c->stash->{current_view}, then
804 - a config setting 'default_view', or
805 - check if there is only one view, and return it if that's the case.
649fd1fa 806
2f381252 807If you want to search for views, pass in a regexp as the argument.
808
809 # find all views that start with Foo
810 my @foo_views = $c->view(qr{^Foo});
811
fc7ec1d9 812=cut
813
0ef52a96 814sub view {
197bd788 815 my ( $c, $name, @args ) = @_;
2f381252 816
df960201 817 my $appclass = ref($c) || $c;
2f381252 818 if( $name ) {
4995a5ce 819 unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
13311c16 820 my $comps = $c->components;
821 my $check = $appclass."::View::".$name;
9c74923d 822 if( exists $comps->{$check} ) {
823 return $c->_filter_component( $comps->{$check}, @args );
824 }
825 else {
826 $c->log->warn( "Attempted to use view '$check', but does not exist" );
827 }
13311c16 828 }
2f381252 829 my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
830 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
831 return $c->_filter_component( $result[ 0 ], @args );
832 }
833
a3b71f0f 834 if (ref $c) {
62a6df80 835 return $c->stash->{current_view_instance}
a3b71f0f 836 if $c->stash->{current_view_instance};
837 return $c->view( $c->stash->{current_view} )
838 if $c->stash->{current_view};
a3b71f0f 839 }
df960201 840 return $c->view( $appclass->config->{default_view} )
841 if $appclass->config->{default_view};
2f381252 842
843 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
844
845 if( $rest ) {
846 $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
4600a5a1 847 $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
2f381252 848 $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
849 $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
11c270bd 850 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
2f381252 851 }
852
853 return $c->_filter_component( $comp );
854}
855
856=head2 $c->controllers
857
858Returns the available names which can be passed to $c->controller
859
860=cut
861
862sub controllers {
863 my ( $c ) = @_;
864 return $c->_comp_names(qw/Controller C/);
0ef52a96 865}
fbcc39ad 866
b4b01a8a 867=head2 $c->models
868
869Returns the available names which can be passed to $c->model
870
871=cut
872
873sub models {
874 my ( $c ) = @_;
875 return $c->_comp_names(qw/Model M/);
876}
877
878
3b88a455 879=head2 $c->views
880
881Returns the available names which can be passed to $c->view
882
883=cut
884
885sub views {
886 my ( $c ) = @_;
887 return $c->_comp_names(qw/View V/);
888}
889
b4b01a8a 890=head2 $c->comp($name)
891
892=head2 $c->component($name)
893
cc95842f 894Gets a component object by name. This method is not recommended,
b4b01a8a 895unless you want to get a specific component by full
cc95842f 896class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
b4b01a8a 897should be used instead.
898
2f381252 899If C<$name> is a regexp, a list of components matched against the full
900component name will be returned.
901
ab86b480 902If Catalyst can't find a component by name, it will fallback to regex
903matching by default. To disable this behaviour set
904disable_component_resolution_regex_fallback to a true value.
1d3a0700 905
220f4575 906 __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 );
ab86b480 907
b4b01a8a 908=cut
909
910sub component {
2f381252 911 my ( $c, $name, @args ) = @_;
b4b01a8a 912
2f381252 913 if( $name ) {
914 my $comps = $c->components;
b4b01a8a 915
2f381252 916 if( !ref $name ) {
917 # is it the exact name?
918 return $c->_filter_component( $comps->{ $name }, @args )
919 if exists $comps->{ $name };
b4b01a8a 920
2f381252 921 # perhaps we just omitted "MyApp"?
922 my $composed = ( ref $c || $c ) . "::${name}";
923 return $c->_filter_component( $comps->{ $composed }, @args )
924 if exists $comps->{ $composed };
b4b01a8a 925
2f381252 926 # search all of the models, views and controllers
927 my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
928 return $c->_filter_component( $comp, @args ) if $comp;
929 }
930
f899107d 931 return
932 if $c->config->{disable_component_resolution_regex_fallback};
933
2f381252 934 # This is here so $c->comp( '::M::' ) works
935 my $query = ref $name ? $name : qr{$name}i;
b4b01a8a 936
2f381252 937 my @result = grep { m{$query} } keys %{ $c->components };
938 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
b4b01a8a 939
2f381252 940 if( $result[ 0 ] ) {
108201b5 941 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
2f381252 942 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
943 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
944 return $c->_filter_component( $result[ 0 ], @args );
945 }
946
947 # I would expect to return an empty list here, but that breaks back-compat
b4b01a8a 948 }
949
2f381252 950 # fallback
b4b01a8a 951 return sort keys %{ $c->components };
952}
953
b4b01a8a 954=head2 CLASS DATA AND HELPER CLASSES
fbcc39ad 955
b5ecfcf0 956=head2 $c->config
fbcc39ad 957
0ef52a96 958Returns or takes a hashref containing the application's configuration.
959
61b1d329 960 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
81557adf 961
18a9655c 962You can also use a C<YAML>, C<XML> or L<Config::General> config file
963like C<myapp.conf> in your applications home directory. See
cc95842f 964L<Catalyst::Plugin::ConfigLoader>.
a6ad13b6 965
6df30f7e 966=head3 Cascading configuration
a6ad13b6 967
b3542016 968The config method is present on all Catalyst components, and configuration
969will be merged when an application is started. Configuration loaded with
970L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
62a6df80 971followed by configuration in your top level C<MyApp> class. These two
a51d14ff 972configurations are merged, and then configuration data whose hash key matches a
b3542016 973component name is merged with configuration for that component.
974
975The configuration for a component is then passed to the C<new> method when a
976component is constructed.
977
978For example:
979
980 MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
790ff9aa 981 MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
62a6df80 982
983will mean that C<MyApp::Model::Foo> receives the following data when
b3542016 984constructed:
985
986 MyApp::Model::Foo->new({
987 bar => 'baz',
988 quux => 'frob',
989 overrides => 'me',
990 });
b4b01a8a 991
f8a54681 992It's common practice to use a Moose attribute
993on the receiving component to access the config value.
994
995 package MyApp::Model::Foo;
996
997 use Moose;
998
999 # this attr will receive 'baz' at construction time
9c74923d 1000 has 'bar' => (
f8a54681 1001 is => 'rw',
1002 isa => 'Str',
1003 );
1004
1005You can then get the value 'baz' by calling $c->model('Foo')->bar
9c74923d 1006(or $self->bar inside code in the model).
1007
1008B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
1009as a way of reading config within your code, as this B<will not> give you the
1010correctly merged config back. You B<MUST> take the config values supplied to
1011the constructor and use those instead.
f8a54681 1012
3643e890 1013=cut
1014
4090e3bb 1015around config => sub {
1016 my $orig = shift;
3643e890 1017 my $c = shift;
1018
fcf89172 1019 croak('Setting config after setup has been run is not allowed.')
1020 if ( @_ and $c->setup_finished );
3643e890 1021
4090e3bb 1022 $c->$orig(@_);
1023};
3643e890 1024
b5ecfcf0 1025=head2 $c->log
0ef52a96 1026
86418559 1027Returns the logging object instance. Unless it is already set, Catalyst
1028sets this up with a L<Catalyst::Log> object. To use your own log class,
1029set the logger with the C<< __PACKAGE__->log >> method prior to calling
9e7673af 1030C<< __PACKAGE__->setup >>.
1031
1032 __PACKAGE__->log( MyLogger->new );
1033 __PACKAGE__->setup;
1034
1035And later:
0ef52a96 1036
ae1e6b59 1037 $c->log->info( 'Now logging with my own logger!' );
0ef52a96 1038
86418559 1039Your log class should implement the methods described in
1040L<Catalyst::Log>.
af3ff00e 1041
6adc45cf 1042=head2 has_encoding
1043
1044Returned True if there's a valid encoding
1045
1046=head2 clear_encoding
1047
1048Clears the encoding for the current context
1049
9c38cb50 1050=head2 encoding
1051
1052Sets or gets the application encoding.
1053
1054=cut
1055
6adc45cf 1056sub has_encoding { shift->encoding ? 1:0 }
1057
1058sub clear_encoding {
1059 my $c = shift;
1060 if(blessed $c) {
1061 $c->encoding(undef);
1062 } else {
1063 $c->debug->error("You can't clear encoding on the application");
1064 }
1065}
1066
9c38cb50 1067sub encoding {
1068 my $c = shift;
1069 my $encoding;
1070
1071 if ( scalar @_ ) {
1072 # Let it be set to undef
1073 if (my $wanted = shift) {
1074 $encoding = Encode::find_encoding($wanted)
1075 or Carp::croak( qq/Unknown encoding '$wanted'/ );
1076 binmode(STDERR, ':encoding(' . $encoding->name . ')');
1077 }
1078 else {
1079 binmode(STDERR);
1080 }
1081
1082 $encoding = ref $c
1083 ? $c->{encoding} = $encoding
1084 : $c->_encoding($encoding);
1085 } else {
1086 $encoding = ref $c && exists $c->{encoding}
1087 ? $c->{encoding}
1088 : $c->_encoding;
1089 }
1090
1091 return $encoding;
1092}
b4b01a8a 1093
1094=head2 $c->debug
1095
c74d3f0c 1096Returns 1 if debug mode is enabled, 0 otherwise.
b4b01a8a 1097
7e5c67f2 1098You can enable debug mode in several ways:
1099
1100=over
1101
62a6df80 1102=item By calling myapp_server.pl with the -d flag
1103
7e5c67f2 1104=item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
1105
1106=item The -Debug option in your MyApp.pm
1107
8eae92ad 1108=item By declaring C<sub debug { 1 }> in your MyApp.pm.
7e5c67f2 1109
1110=back
c74d3f0c 1111
c8083f4e 1112The first three also set the log level to 'debug'.
1113
8eae92ad 1114Calling C<< $c->debug(1) >> has no effect.
e80e8542 1115
af3ff00e 1116=cut
1117
b4b01a8a 1118sub debug { 0 }
1119
1120=head2 $c->dispatcher
1121
2887a7f1 1122Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
b4b01a8a 1123
1124=head2 $c->engine
1125
2887a7f1 1126Returns the engine instance. See L<Catalyst::Engine>.
b4b01a8a 1127
1128
f7b672ef 1129=head2 UTILITY METHODS
66e28e3f 1130
b5ecfcf0 1131=head2 $c->path_to(@path)
01033d73 1132
cc95842f 1133Merges C<@path> with C<< $c->config->{home} >> and returns a
4e392da6 1134L<Path::Class::Dir> object. Note you can usually use this object as
1135a filename, but sometimes you will have to explicitly stringify it
18a9655c 1136yourself by calling the C<< ->stringify >> method.
01033d73 1137
1138For example:
1139
1140 $c->path_to( 'db', 'sqlite.db' );
1141
1142=cut
1143
1144sub path_to {
1145 my ( $c, @path ) = @_;
a738ab68 1146 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
01033d73 1147 if ( -d $path ) { return $path }
a738ab68 1148 else { return Path::Class::File->new( $c->config->{home}, @path ) }
01033d73 1149}
1150
0ef52a96 1151sub plugin {
1152 my ( $class, $name, $plugin, @args ) = @_;
6b2a933b 1153
4e68badc 1154 # See block comment in t/unit_core_plugin.t
3bdf9e57 1155 $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in a future release/);
4e68badc 1156
97b58e17 1157 $class->_register_plugin( $plugin, 1 );
0ef52a96 1158
1159 eval { $plugin->import };
1160 $class->mk_classdata($name);
1161 my $obj;
1162 eval { $obj = $plugin->new(@args) };
1163
1164 if ($@) {
1165 Catalyst::Exception->throw( message =>
1166 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
1167 }
1168
1169 $class->$name($obj);
1170 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
1171 if $class->debug;
1172}
1173
b5ecfcf0 1174=head2 MyApp->setup
fbcc39ad 1175
e7f1cf73 1176Initializes the dispatcher and engine, loads any plugins, and loads the
ae1e6b59 1177model, view, and controller components. You may also specify an array
1178of plugins to load here, if you choose to not load them in the C<use
1179Catalyst> line.
fbcc39ad 1180
0ef52a96 1181 MyApp->setup;
1182 MyApp->setup( qw/-Debug/ );
fbcc39ad 1183
cf7ace24 1184B<Note:> You B<should not> wrap this method with method modifiers
1185or bad things will happen - wrap the C<setup_finalize> method instead.
1186
fbcc39ad 1187=cut
1188
1189sub setup {
0319a12c 1190 my ( $class, @arguments ) = @_;
c2f3cc1b 1191 croak('Running setup more than once')
1192 if ( $class->setup_finished );
5168a5fc 1193
fbcc39ad 1194 unless ( $class->isa('Catalyst') ) {
953b0e15 1195
fbcc39ad 1196 Catalyst::Exception->throw(
1197 message => qq/'$class' does not inherit from Catalyst/ );
1c99e125 1198 }
0319a12c 1199
fbcc39ad 1200 if ( $class->arguments ) {
1201 @arguments = ( @arguments, @{ $class->arguments } );
1202 }
1203
1204 # Process options
1205 my $flags = {};
1206
1207 foreach (@arguments) {
1208
1209 if (/^-Debug$/) {
1210 $flags->{log} =
1211 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
1212 }
1213 elsif (/^-(\w+)=?(.*)$/) {
1214 $flags->{ lc $1 } = $2;
1215 }
1216 else {
1217 push @{ $flags->{plugins} }, $_;
1218 }
1219 }
1220
99f187d6 1221 $class->setup_home( delete $flags->{home} );
1222
5bb2a5b3 1223 $class->setup_log( delete $flags->{log} );
fbcc39ad 1224 $class->setup_plugins( delete $flags->{plugins} );
17176f15 1225
b87d834e 1226 $class->setup_data_handlers();
fbcc39ad 1227 $class->setup_dispatcher( delete $flags->{dispatcher} );
acbecf08 1228 if (my $engine = delete $flags->{engine}) {
0aafa77a 1229 $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading");
acbecf08 1230 }
1231 $class->setup_engine();
dc5f035e 1232 $class->setup_stats( delete $flags->{stats} );
fbcc39ad 1233
1234 for my $flag ( sort keys %{$flags} ) {
1235
1236 if ( my $code = $class->can( 'setup_' . $flag ) ) {
1237 &$code( $class, delete $flags->{$flag} );
1238 }
1239 else {
1240 $class->log->warn(qq/Unknown flag "$flag"/);
1241 }
1242 }
1243
0eb4af72 1244 eval { require Catalyst::Devel; };
1245 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1246 $class->log->warn(<<"EOF");
4ff0d824 1247You are running an old script!
1248
34a83d89 1249 Please update by running (this will overwrite existing files):
1250 catalyst.pl -force -scripts $class
1251
1252 or (this will not overwrite existing files):
1253 catalyst.pl -scripts $class
1cf0345b 1254
4ff0d824 1255EOF
0eb4af72 1256 }
62a6df80 1257
b677b4c2 1258 # Call plugins setup, this is stupid and evil.
1259 # Also screws C3 badly on 5.10, hack to avoid.
1260 {
1261 no warnings qw/redefine/;
1262 local *setup = sub { };
1263 $class->setup unless $Catalyst::__AM_RESTARTING;
1264 }
1265
9c38cb50 1266 # If you are expecting configuration info as part of your setup, it needs
1267 # to get called here and below, since we need the above line to support
1268 # ConfigLoader based configs.
1269
1270 $class->setup_encoding();
ac34e337 1271 $class->setup_middleware();
1272
02352a28 1273 # Initialize our data structure
1274 $class->components( {} );
1275
1276 $class->setup_components;
1277
fbcc39ad 1278 if ( $class->debug ) {
6601f2ad 1279 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
fbcc39ad 1280
1281 if (@plugins) {
39fc2ce1 1282 my $column_width = Catalyst::Utils::term_width() - 6;
1283 my $t = Text::SimpleTable->new($column_width);
8c113188 1284 $t->row($_) for @plugins;
1cf0345b 1285 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
fbcc39ad 1286 }
1287
ba0b0de3 1288 my @middleware = map {
1289 ref $_ eq 'CODE' ?
1290 "Inline Coderef" :
ef5ad930 1291 (ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '')
ba0b0de3 1292 || '') } $class->registered_middlewares;
10e39267 1293
1294 if (@middleware) {
1295 my $column_width = Catalyst::Utils::term_width() - 6;
1296 my $t = Text::SimpleTable->new($column_width);
1297 $t->row($_) for @middleware;
1298 $class->log->debug( "Loaded PSGI Middleware:\n" . $t->draw . "\n" );
1299 }
1300
ef5ad930 1301 my %dh = $class->registered_data_handlers;
1302 if (my @data_handlers = keys %dh) {
b87d834e 1303 my $column_width = Catalyst::Utils::term_width() - 6;
1304 my $t = Text::SimpleTable->new($column_width);
1305 $t->row($_) for @data_handlers;
1306 $class->log->debug( "Loaded Request Data Handlers:\n" . $t->draw . "\n" );
1307 }
1308
fbcc39ad 1309 my $dispatcher = $class->dispatcher;
1310 my $engine = $class->engine;
1311 my $home = $class->config->{home};
1312
01ce7075 1313 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1314 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
fbcc39ad 1315
1316 $home
1317 ? ( -d $home )
1318 ? $class->log->debug(qq/Found home "$home"/)
1319 : $class->log->debug(qq/Home "$home" doesn't exist/)
1320 : $class->log->debug(q/Couldn't find home/);
fbcc39ad 1321
39fc2ce1 1322 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1323 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
684d10ed 1324 for my $comp ( sort keys %{ $class->components } ) {
1325 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1326 $t->row( $comp, $type );
1327 }
1cf0345b 1328 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
8c113188 1329 if ( keys %{ $class->components } );
fbcc39ad 1330 }
1331
1332 # Add our self to components, since we are also a component
96d8d513 1333 if( $class->isa('Catalyst::Controller') ){
1334 $class->components->{$class} = $class;
1335 }
fbcc39ad 1336
1337 $class->setup_actions;
1338
1339 if ( $class->debug ) {
1340 my $name = $class->config->{name} || 'Application';
1341 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1342 }
3643e890 1343
647a3de1 1344 if ($class->config->{case_sensitive}) {
1345 $class->log->warn($class . "->config->{case_sensitive} is set.");
1346 $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1347 }
1348
a5d07d29 1349 $class->setup_finalize;
1b526dcc 1350
1351 # Flush the log for good measure (in case something turned off 'autoflush' early)
647a3de1 1352 $class->log->_flush() if $class->log->can('_flush');
1b526dcc 1353
5077b8a3 1354 return $class || 1; # Just in case someone named their Application 0...
a5d07d29 1355}
1356
23c63a17 1357=head2 $app->setup_finalize
1358
128a7cee 1359A hook to attach modifiers to. This method does not do anything except set the
1360C<setup_finished> accessor.
23c63a17 1361
ae7da8f5 1362Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
23c63a17 1363
128a7cee 1364Example:
23c63a17 1365
128a7cee 1366 after setup_finalize => sub {
1367 my $app = shift;
23c63a17 1368
128a7cee 1369 ## do stuff here..
1370 };
23c63a17 1371
1372=cut
1373
a5d07d29 1374sub setup_finalize {
1375 my ($class) = @_;
3643e890 1376 $class->setup_finished(1);
fbcc39ad 1377}
1378
d71da6fe 1379=head2 $c->uri_for( $path?, @args?, \%query_values? )
fbcc39ad 1380
ee8963de 1381=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
9df7c5d9 1382
b063a165 1383=head2 $c->uri_for( $action, [@captures, @args], \%query_values? )
1384
ee8963de 1385Constructs an absolute L<URI> object based on the application root, the
1386provided path, and the additional arguments and query parameters provided.
186d5270 1387When used as a string, provides a textual URI. If you need more flexibility
92981fc3 1388than this (i.e. the option to provide relative URIs etc.) see
186d5270 1389L<Catalyst::Plugin::SmartURI>.
ee8963de 1390
d71da6fe 1391If no arguments are provided, the URI for the current action is returned.
1392To return the current action and also provide @args, use
1d3a0700 1393C<< $c->uri_for( $c->action, @args ) >>.
d71da6fe 1394
ee8963de 1395If the first argument is a string, it is taken as a public URI path relative
1396to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
e7e4c469 1397relative to the application root (if it does). It is then merged with
ee8963de 1398C<< $c->request->base >>; any C<@args> are appended as additional path
1399components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1400
1401If the first argument is a L<Catalyst::Action> it represents an action which
1402will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1403optional C<\@captures> argument (an arrayref) allows passing the captured
1404variables that are needed to fill in the paths of Chained and Regex actions;
1405once the path is resolved, C<uri_for> continues as though a path was
1406provided, appending any arguments or parameters and creating an absolute
1407URI.
1408
e7e4c469 1409The captures for the current request can be found in
ee8963de 1410C<< $c->request->captures >>, and actions can be resolved using
1411C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1412path, use C<< $c->uri_for_action >> instead.
1413
1414 # Equivalent to $c->req->uri
e7e4c469 1415 $c->uri_for($c->action, $c->req->captures,
ee8963de 1416 @{ $c->req->args }, $c->req->params);
62a6df80 1417
9df7c5d9 1418 # For the Foo action in the Bar controller
ee8963de 1419 $c->uri_for($c->controller('Bar')->action_for('Foo'));
9df7c5d9 1420
ee8963de 1421 # Path to a static resource
1422 $c->uri_for('/static/images/logo.png');
d5e3d528 1423
342d2169 1424In general the scheme of the generated URI object will follow the incoming request
1425however if your targeted action or action chain has the Scheme attribute it will
1426use that instead.
1427
4cf1dd00 1428=cut
1429
fbcc39ad 1430sub uri_for {
00e6a2b7 1431 my ( $c, $path, @args ) = @_;
00e6a2b7 1432
0ee04045 1433 if ( $path->$_isa('Catalyst::Controller') ) {
7069eab5 1434 $path = $path->path_prefix;
1435 $path =~ s{/+\z}{};
1436 $path .= '/';
1437 }
1438
2689f8a4 1439 undef($path) if (defined $path && $path eq '');
1440
1441 my $params =
1442 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1443
1444 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
5c779e98 1445
fdbf03db 1446 my @encoded_args = ();
1447 foreach my $arg (@args) {
1448 if(ref($arg)||'' eq 'ARRAY') {
1449 push @encoded_args, [map {
1450 my $encoded = encode_utf8 $_;
1451 $encoded =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1452 $encoded;
1453 } @$arg];
1454 } else {
1455 push @encoded_args, do {
1456 my $encoded = encode_utf8 $arg;
1457 $encoded =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1458 $encoded;
1459 }
5c779e98 1460 }
fdbf03db 1461 }
2689f8a4 1462
342d2169 1463 my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef;
0ee04045 1464 if ( $path->$_isa('Catalyst::Action') ) { # action object
fdbf03db 1465 s|/|%2F|g for @encoded_args;
2689f8a4 1466 my $captures = [ map { s|/|%2F|g; $_; }
fdbf03db 1467 ( scalar @encoded_args && ref $encoded_args[0] eq 'ARRAY'
1468 ? @{ shift(@encoded_args) }
aaf72276 1469 : ()) ];
7b346bc3 1470
aa7e913e 1471 my $action = $path;
0cff119a 1472 # ->uri_for( $action, \@captures_and_args, \%query_values? )
fdbf03db 1473 if( !@encoded_args && $action->number_of_args ) {
0cff119a 1474 my $expanded_action = $c->dispatcher->expand_action( $action );
0cff119a 1475 my $num_captures = $expanded_action->number_of_captures;
fdbf03db 1476 unshift @encoded_args, splice @$captures, $num_captures;
0cff119a 1477 }
1478
1479 $path = $c->dispatcher->uri_for_action($action, $captures);
aa7e913e 1480 if (not defined $path) {
1481 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1482 if $c->debug;
1483 return undef;
1484 }
81e75875 1485 $path = '/' if $path eq '';
ea0e58d9 1486 }
1487
fdbf03db 1488 unshift(@encoded_args, $path);
51674a63 1489
1490 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1491 my $namespace = $c->namespace;
1492 if (defined $path) { # cheesy hack to handle path '../foo'
fdbf03db 1493 $namespace =~ s{(?:^|/)[^/]+$}{} while $encoded_args[0] =~ s{^\.\./}{};
6601f2ad 1494 }
fdbf03db 1495 unshift(@encoded_args, $namespace || '');
51674a63 1496 }
62a6df80 1497
189e2a51 1498 # join args with '/', or a blank string
fdbf03db 1499 my $args = join('/', grep { defined($_) } @encoded_args);
51674a63 1500 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
e6968720 1501 $args =~ s!^/+!!;
f9451270 1502
1503 my ($base, $class) = ('/', 'URI::_generic');
1504 if(blessed($c)) {
1505 $base = $c->req->base;
342d2169 1506 if($target_action) {
1507 $target_action = $c->dispatcher->expand_action($target_action);
1508 if(my $s = $target_action->scheme) {
1509 $s = lc($s);
1510 $class = "URI::$s";
1511 $base->scheme($s);
1512 } else {
1513 $class = ref($base);
1514 }
1515 } else {
1516 $class = ref($base);
1517 }
1518
f9451270 1519 $base =~ s{(?<!/)$}{/};
1520 }
51674a63 1521
1522 my $query = '';
1523
1524 if (my @keys = keys %$params) {
1525 # somewhat lifted from URI::_query's query_form
1526 $query = '?'.join('&', map {
2f381252 1527 my $val = $params->{$_};
5c779e98 1528 #s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; ## Commented out because seems to lead to double encoding - JNAP
51674a63 1529 s/ /+/g;
1530 my $key = $_;
51674a63 1531 $val = '' unless defined $val;
1532 (map {
1f851263 1533 my $param = "$_";
fdbf03db 1534 $param = encode_utf8($param);
51674a63 1535 # using the URI::Escape pattern here so utf8 chars survive
1f851263 1536 $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1537 $param =~ s/ /+/g;
5c779e98 1538
fdbf03db 1539 $key = encode_utf8($key);
5c779e98 1540 # using the URI::Escape pattern here so utf8 chars survive
1541 $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1542 $key =~ s/ /+/g;
1543
1f851263 1544 "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
51674a63 1545 } @keys);
1546 }
1547
1548 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1549 $res;
fbcc39ad 1550}
1551
25d61080 1552=head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? )
833b385e 1553
25d61080 1554=head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? )
833b385e 1555
1556=over
1557
1558=item $path
1559
1560A private path to the Catalyst action you want to create a URI for.
1561
1562This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1563>> and passing the resulting C<$action> and the remaining arguments to C<<
1564$c->uri_for >>.
1565
1566You can also pass in a Catalyst::Action object, in which case it is passed to
1567C<< $c->uri_for >>.
1568
c9ec25f8 1569Note 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.
1570
1571For example, if the action looks like:
1572
1573 package MyApp::Controller::Users;
1574
1575 sub lst : Path('the-list') {}
1576
1577You can use:
1578
1579 $c->uri_for_action('/users/lst')
1580
1581and it will create the URI /users/the-list.
1582
25d61080 1583=item \@captures_and_args?
1584
1585Optional array reference of Captures (i.e. C<<CaptureArgs or $c->req->captures>)
1586and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained>
1587to interpolate all the parameters in the URI.
1588
1589=item @args?
1590
942572d7 1591Optional list of extra arguments - can be supplied in the
1592C<< \@captures_and_args? >> array ref, or here - whichever is easier for your
1593code.
25d61080 1594
942572d7 1595Your action can have zero, a fixed or a variable number of args (e.g.
1596C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number)..
25d61080 1597
1598=item \%query_values?
1599
1600Optional array reference of query parameters to append. E.g.
1601
1602 { foo => 'bar' }
1603
1604will generate
1605
1606 /rest/of/your/uri?foo=bar
1607
833b385e 1608=back
1609
1610=cut
1611
1612sub uri_for_action {
1613 my ( $c, $path, @args ) = @_;
62a6df80 1614 my $action = blessed($path)
1615 ? $path
833b385e 1616 : $c->dispatcher->get_action_by_path($path);
4ac0b9cb 1617 unless (defined $action) {
1618 croak "Can't find action for path '$path'";
1619 }
833b385e 1620 return $c->uri_for( $action, @args );
1621}
1622
b5ecfcf0 1623=head2 $c->welcome_message
ab2374d3 1624
1625Returns the Catalyst welcome HTML page.
1626
1627=cut
1628
1629sub welcome_message {
bf1f2c60 1630 my $c = shift;
1631 my $name = $c->config->{name};
1632 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1633 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1634 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1635 return <<"EOF";
80cdbbff 1636<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1637 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1638<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1639 <head>
85d9fce6 1640 <meta http-equiv="Content-Language" content="en" />
1641 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1642 <title>$name on Catalyst $VERSION</title>
1643 <style type="text/css">
1644 body {
ab2374d3 1645 color: #000;
1646 background-color: #eee;
1647 }
1648 div#content {
1649 width: 640px;
80cdbbff 1650 margin-left: auto;
1651 margin-right: auto;
ab2374d3 1652 margin-top: 10px;
1653 margin-bottom: 10px;
1654 text-align: left;
1655 background-color: #ccc;
1656 border: 1px solid #aaa;
ab2374d3 1657 }
d84c4dab 1658 p, h1, h2 {
ab2374d3 1659 margin-left: 20px;
1660 margin-right: 20px;
16215972 1661 font-family: verdana, tahoma, sans-serif;
ab2374d3 1662 }
d84c4dab 1663 a {
1664 font-family: verdana, tahoma, sans-serif;
1665 }
d114e033 1666 :link, :visited {
1667 text-decoration: none;
1668 color: #b00;
1669 border-bottom: 1px dotted #bbb;
1670 }
1671 :link:hover, :visited:hover {
d114e033 1672 color: #555;
1673 }
ab2374d3 1674 div#topbar {
1675 margin: 0px;
1676 }
3e82a295 1677 pre {
3e82a295 1678 margin: 10px;
1679 padding: 8px;
1680 }
ab2374d3 1681 div#answers {
1682 padding: 8px;
1683 margin: 10px;
d114e033 1684 background-color: #fff;
ab2374d3 1685 border: 1px solid #aaa;
ab2374d3 1686 }
1687 h1 {
33108eaf 1688 font-size: 0.9em;
1689 font-weight: normal;
ab2374d3 1690 text-align: center;
1691 }
1692 h2 {
1693 font-size: 1.0em;
1694 }
1695 p {
1696 font-size: 0.9em;
1697 }
ae7c5252 1698 p img {
1699 float: right;
1700 margin-left: 10px;
1701 }
9619f23c 1702 span#appname {
1703 font-weight: bold;
33108eaf 1704 font-size: 1.6em;
ab2374d3 1705 }
1706 </style>
1707 </head>
1708 <body>
1709 <div id="content">
1710 <div id="topbar">
9619f23c 1711 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1712 $VERSION</h1>
ab2374d3 1713 </div>
1714 <div id="answers">
ae7c5252 1715 <p>
80cdbbff 1716 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1717 </p>
596aaffe 1718 <p>Welcome to the world of Catalyst.
f92fd545 1719 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1720 framework will make web development something you had
60dd6e1d 1721 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1722 <h2>What to do now?</h2>
4b8cb778 1723 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1724 We do, however, provide you with a few starting points.</p>
1725 <p>If you want to jump right into web development with Catalyst
2f381252 1726 you might want to start with a tutorial.</p>
80267996 1727<pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code>
596aaffe 1728</pre>
1729<p>Afterwards you can go on to check out a more complete look at our features.</p>
1730<pre>
80267996 1731<code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a>
b607f8a0 1732<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1733</code></pre>
ab2374d3 1734 <h2>What to do next?</h2>
f5681c92 1735 <p>Next it's time to write an actual application. Use the
80267996 1736 helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>,
1737 <a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and
1738 <a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>;
bf1f2c60 1739 they can save you a lot of work.</p>
c5f31918 1740 <pre><code>script/${prefix}_create.pl --help</code></pre>
bf1f2c60 1741 <p>Also, be sure to check out the vast and growing
802bf2cb 1742 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
bf1f2c60 1743 you are likely to find what you need there.
f5681c92 1744 </p>
1745
82245cc4 1746 <h2>Need help?</h2>
f5681c92 1747 <p>Catalyst has a very active community. Here are the main places to
1748 get in touch with us.</p>
16215972 1749 <ul>
1750 <li>
2b9a7d76 1751 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1752 </li>
1753 <li>
6d4c3368 1754 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1755 </li>
1756 <li>
4eaf7c88 1757 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1758 </li>
1759 </ul>
ab2374d3 1760 <h2>In conclusion</h2>
62a6df80 1761 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1762 as we enjoyed making it. Please contact us if you have ideas
1763 for improvement or other feedback.</p>
ab2374d3 1764 </div>
1765 </div>
1766 </body>
1767</html>
1768EOF
1769}
1770
aee7cdcc 1771=head2 run_options
1772
1773Contains a hash of options passed from the application script, including
c2c8d3cb 1774the original ARGV the script received, the processed values from that
aee7cdcc 1775ARGV and any extra arguments to the script which were not processed.
1776
1777This can be used to add custom options to your application's scripts
1778and setup your application differently depending on the values of these
1779options.
1780
fbcc39ad 1781=head1 INTERNAL METHODS
1782
ae1e6b59 1783These methods are not meant to be used by end users.
1784
b5ecfcf0 1785=head2 $c->components
fbcc39ad 1786
e7f1cf73 1787Returns a hash of components.
fbcc39ad 1788
b5ecfcf0 1789=head2 $c->context_class
1f9cb7c1 1790
e7f1cf73 1791Returns or sets the context class.
1f9cb7c1 1792
b5ecfcf0 1793=head2 $c->counter
fbcc39ad 1794
ae1e6b59 1795Returns a hashref containing coderefs and execution counts (needed for
1796deep recursion detection).
fbcc39ad 1797
b5ecfcf0 1798=head2 $c->depth
fbcc39ad 1799
e7f1cf73 1800Returns the number of actions on the current internal execution stack.
fbcc39ad 1801
b5ecfcf0 1802=head2 $c->dispatch
fbcc39ad 1803
e7f1cf73 1804Dispatches a request to actions.
fbcc39ad 1805
1806=cut
1807
1808sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1809
b5ecfcf0 1810=head2 $c->dispatcher_class
1f9cb7c1 1811
e7f1cf73 1812Returns or sets the dispatcher class.
1f9cb7c1 1813
b5ecfcf0 1814=head2 $c->dump_these
7f92deef 1815
ae1e6b59 1816Returns a list of 2-element array references (name, structure) pairs
1817that will be dumped on the error page in debug mode.
7f92deef 1818
1819=cut
1820
1821sub dump_these {
1822 my $c = shift;
62a6df80 1823 [ Request => $c->req ],
1824 [ Response => $c->res ],
052a2d89 1825 [ Stash => $c->stash ],
1826 [ Config => $c->config ];
7f92deef 1827}
1828
b5ecfcf0 1829=head2 $c->engine_class
1f9cb7c1 1830
e7f1cf73 1831Returns or sets the engine class.
1f9cb7c1 1832
b5ecfcf0 1833=head2 $c->execute( $class, $coderef )
fbcc39ad 1834
0ef52a96 1835Execute a coderef in given class and catch exceptions. Errors are available
1836via $c->error.
fbcc39ad 1837
1838=cut
1839
1840sub execute {
1841 my ( $c, $class, $code ) = @_;
858828dd 1842 $class = $c->component($class) || $class;
fbcc39ad 1843 $c->state(0);
a0eca838 1844
197bd788 1845 if ( $c->depth >= $RECURSION ) {
f3414019 1846 my $action = $code->reverse();
91d08727 1847 $action = "/$action" unless $action =~ /->/;
f3414019 1848 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 1849 $c->log->error($error);
1850 $c->error($error);
1851 $c->state(0);
1852 return $c->state;
1853 }
1854
dc5f035e 1855 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 1856
8767c5a3 1857 push( @{ $c->stack }, $code );
62a6df80 1858
6f3df815 1859 no warnings 'recursion';
524b0e1c 1860 # N.B. This used to be combined, but I have seen $c get clobbered if so, and
1861 # I have no idea how, ergo $ret (which appears to fix the issue)
1862 eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
22247e54 1863
dc5f035e 1864 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
62a6df80 1865
a6724a82 1866 my $last = pop( @{ $c->stack } );
fbcc39ad 1867
1868 if ( my $error = $@ ) {
e25e23a7 1869 #rethow if this can be handled by middleware
80172e7d 1870 if ( $c->_handle_http_exception($error) ) {
30e84ba1 1871 foreach my $err (@{$c->error}) {
1872 $c->log->error($err);
1873 }
1874 $c->clear_errors;
1875 $c->log->_flush if $c->log->can('_flush');
1876
e25e23a7 1877 $error->can('rethrow') ? $error->rethrow : croak $error;
1878 }
79f5d571 1879 if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
f87b7c21 1880 $error->rethrow if $c->depth > 1;
2f381252 1881 }
79f5d571 1882 elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
f87b7c21 1883 $error->rethrow if $c->depth > 0;
55424863 1884 }
fbcc39ad 1885 else {
1886 unless ( ref $error ) {
91d08727 1887 no warnings 'uninitialized';
fbcc39ad 1888 chomp $error;
f59def82 1889 my $class = $last->class;
1890 my $name = $last->name;
1891 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 1892 }
fbcc39ad 1893 $c->error($error);
fbcc39ad 1894 }
2688734f 1895 $c->state(0);
fbcc39ad 1896 }
1897 return $c->state;
1898}
1899
7a7d7af5 1900sub _stats_start_execute {
1901 my ( $c, $code ) = @_;
df960201 1902 my $appclass = ref($c) || $c;
a6724a82 1903 return if ( ( $code->name =~ /^_.*/ )
df960201 1904 && ( !$appclass->config->{show_internal_actions} ) );
7a7d7af5 1905
f3414019 1906 my $action_name = $code->reverse();
1907 $c->counter->{$action_name}++;
7a7d7af5 1908
f3414019 1909 my $action = $action_name;
a6724a82 1910 $action = "/$action" unless $action =~ /->/;
1911
7a7d7af5 1912 # determine if the call was the result of a forward
1913 # this is done by walking up the call stack and looking for a calling
1914 # sub of Catalyst::forward before the eval
1915 my $callsub = q{};
1916 for my $index ( 2 .. 11 ) {
1917 last
1918 if ( ( caller($index) )[0] eq 'Catalyst'
1919 && ( caller($index) )[3] eq '(eval)' );
1920
1921 if ( ( caller($index) )[3] =~ /forward$/ ) {
1922 $callsub = ( caller($index) )[3];
1923 $action = "-> $action";
1924 last;
1925 }
1926 }
1927
f3414019 1928 my $uid = $action_name . $c->counter->{$action_name};
74efc144 1929
a6724a82 1930 # is this a root-level call or a forwarded call?
1931 if ( $callsub =~ /forward$/ ) {
91740f34 1932 my $parent = $c->stack->[-1];
a6724a82 1933
1934 # forward, locate the caller
9c74923d 1935 if ( defined $parent && exists $c->counter->{"$parent"} ) {
69d8f33c 1936 $c->stats->profile(
62a6df80 1937 begin => $action,
69d8f33c 1938 parent => "$parent" . $c->counter->{"$parent"},
1939 uid => $uid,
1940 );
7a7d7af5 1941 }
1942 else {
1943
a6724a82 1944 # forward with no caller may come from a plugin
69d8f33c 1945 $c->stats->profile(
1946 begin => $action,
1947 uid => $uid,
1948 );
7a7d7af5 1949 }
1950 }
a6724a82 1951 else {
62a6df80 1952
a6724a82 1953 # root-level call
69d8f33c 1954 $c->stats->profile(
1955 begin => $action,
1956 uid => $uid,
1957 );
a6724a82 1958 }
dc5f035e 1959 return $action;
7a7d7af5 1960
7a7d7af5 1961}
1962
1963sub _stats_finish_execute {
1964 my ( $c, $info ) = @_;
69d8f33c 1965 $c->stats->profile( end => $info );
7a7d7af5 1966}
1967
b5ecfcf0 1968=head2 $c->finalize
fbcc39ad 1969
e7f1cf73 1970Finalizes the request.
fbcc39ad 1971
1972=cut
1973
1974sub finalize {
1975 my $c = shift;
1976
369c09bc 1977 for my $error ( @{ $c->error } ) {
1978 $c->log->error($error);
1979 }
1980
eb1f4b49 1981 # Support skipping finalize for psgix.io style 'jailbreak'. Used to support
1982 # stuff like cometd and websockets
c4df830e 1983
c2fef52f 1984 if($c->request->_has_io_fh) {
74bebe95 1985 $c->log_response;
1986 return;
1987 }
eb1f4b49 1988
5050d7a7 1989 # Allow engine to handle finalize flow (for POE)
e63bdf38 1990 my $engine = $c->engine;
1991 if ( my $code = $engine->can('finalize') ) {
1992 $engine->$code($c);
fbcc39ad 1993 }
5050d7a7 1994 else {
fbcc39ad 1995
5050d7a7 1996 $c->finalize_uploads;
fbcc39ad 1997
5050d7a7 1998 # Error
1999 if ( $#{ $c->error } >= 0 ) {
2000 $c->finalize_error;
2001 }
2002
9c38cb50 2003 $c->finalize_encoding;
89ba65d5 2004 $c->finalize_headers unless $c->response->finalized_headers;
5050d7a7 2005 $c->finalize_body;
2006 }
62a6df80 2007
2bf54936 2008 $c->log_response;
10f204e1 2009
62a6df80 2010 if ($c->use_stats) {
87b41398 2011 my $elapsed = $c->stats->elapsed;
12bf12c0 2012 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
908e3d9e 2013 $c->log->info(
62a6df80 2014 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
908e3d9e 2015 }
fbcc39ad 2016
2017 return $c->response->status;
2018}
2019
b5ecfcf0 2020=head2 $c->finalize_body
fbcc39ad 2021
e7f1cf73 2022Finalizes body.
fbcc39ad 2023
2024=cut
2025
2026sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
2027
b5ecfcf0 2028=head2 $c->finalize_cookies
fbcc39ad 2029
e7f1cf73 2030Finalizes cookies.
fbcc39ad 2031
2032=cut
2033
147821ea 2034sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 2035
b5ecfcf0 2036=head2 $c->finalize_error
fbcc39ad 2037
df93c9b5 2038Finalizes error. If there is only one error in L</error> and it is an object that
2039does C<as_psgi> or C<code> we rethrow the error and presume it caught by middleware
2040up the ladder. Otherwise we return the debugging error page (in debug mode) or we
2041return the default error page (production mode).
fbcc39ad 2042
2043=cut
2044
660f9bb0 2045sub finalize_error {
2046 my $c = shift;
2047 if($#{$c->error} > 0) {
2048 $c->engine->finalize_error( $c, @_ );
2049 } else {
2050 my ($error) = @{$c->error};
80172e7d 2051 if ( $c->_handle_http_exception($error) ) {
660f9bb0 2052 # In the case where the error 'knows what it wants', becauses its PSGI
2053 # aware, just rethow and let middleware catch it
2054 $error->can('rethrow') ? $error->rethrow : croak $error;
660f9bb0 2055 } else {
2056 $c->engine->finalize_error( $c, @_ )
2057 }
2058 }
2059}
fbcc39ad 2060
b5ecfcf0 2061=head2 $c->finalize_headers
fbcc39ad 2062
e7f1cf73 2063Finalizes headers.
fbcc39ad 2064
2065=cut
2066
2067sub finalize_headers {
2068 my $c = shift;
2069
e63bdf38 2070 my $response = $c->response; #accessor calls can add up?
2071
fbcc39ad 2072 # Check if we already finalized headers
6680c772 2073 return if $response->finalized_headers;
fbcc39ad 2074
2075 # Handle redirects
e63bdf38 2076 if ( my $location = $response->redirect ) {
fbcc39ad 2077 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 2078 $response->header( Location => $location );
fbcc39ad 2079 }
2080
9629478d 2081 # Remove incorrectly added body and content related meta data when returning
2082 # an information response, or a response the is required to not include a body
2083
fbcc39ad 2084 $c->finalize_cookies;
2085
6adc45cf 2086 # This currently is a NOOP but I don't want to remove it since I guess people
2087 # might have Response subclasses that use it for something... (JNAP)
89ba65d5 2088 $c->response->finalize_headers();
fbcc39ad 2089
2090 # Done
6680c772 2091 $response->finalized_headers(1);
fbcc39ad 2092}
2093
9c38cb50 2094=head2 $c->finalize_encoding
2095
4a64c27b 2096Make sure your body is encoded properly IF you set an encoding. By
dd096a3a 2097default the encoding is UTF-8 but you can disable it by explictly setting the
2098encoding configuration value to undef.
2099
6adc45cf 2100We can only encode when the body is a scalar. Methods for encoding via the
2101streaming interfaces (such as C<write> and C<write_fh> on L<Catalyst::Response>
2102are available).
2103
9c38cb50 2104See L</ENCODING>.
2105
2106=cut
2107
2108sub finalize_encoding {
2109 my $c = shift;
6adc45cf 2110 my $res = $c->res || return;
2111
2112 # Warn if the set charset is different from the one you put into encoding. We need
2113 # to do this early since encodable_response is false for this condition and we need
2114 # to match the debug output for backcompat (there's a test for this...) -JNAP
2115 if(
2116 $res->content_type_charset and $c->encoding and
2117 (uc($c->encoding->mime_name) ne uc($res->content_type_charset))
2118 ) {
2119 my $ct = lc($res->content_type_charset);
2120 $c->log->debug("Catalyst encoding config is set to encode in '" .
2121 $c->encoding->mime_name .
2122 "', content type is '$ct', not encoding ");
2123 }
9c38cb50 2124
6adc45cf 2125 if(
2126 ($res->encodable_response) and
2127 (defined($res->body)) and
2128 (ref(\$res->body) eq 'SCALAR')
2129 ) {
2130 $c->res->body( $c->encoding->encode( $c->res->body, $c->_encode_check ) );
9c38cb50 2131
6adc45cf 2132 # Set the charset if necessary. This might be a bit bonkers since encodable response
2133 # is false when the set charset is not the same as the encoding mimetype (maybe
2134 # confusing action at a distance here..
2135 # Don't try to set the charset if one already exists
2136 $c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name)
2137 unless($c->res->content_type_charset);
9c38cb50 2138 }
9c38cb50 2139}
2140
b5ecfcf0 2141=head2 $c->finalize_output
fbcc39ad 2142
2143An alias for finalize_body.
2144
b5ecfcf0 2145=head2 $c->finalize_read
fbcc39ad 2146
e7f1cf73 2147Finalizes the input after reading is complete.
fbcc39ad 2148
2149=cut
2150
2151sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
2152
b5ecfcf0 2153=head2 $c->finalize_uploads
fbcc39ad 2154
ae1e6b59 2155Finalizes uploads. Cleans up any temporary files.
fbcc39ad 2156
2157=cut
2158
2159sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
2160
b5ecfcf0 2161=head2 $c->get_action( $action, $namespace )
fbcc39ad 2162
e7f1cf73 2163Gets an action in a given namespace.
fbcc39ad 2164
2165=cut
2166
684d10ed 2167sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 2168
b5ecfcf0 2169=head2 $c->get_actions( $action, $namespace )
a9dc674c 2170
ae1e6b59 2171Gets all actions of a given name in a namespace and all parent
2172namespaces.
a9dc674c 2173
2174=cut
2175
2176sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
2177
e5ce5f04 2178=head2 $app->handle_request( @arguments )
fbcc39ad 2179
e7f1cf73 2180Called to handle each HTTP request.
fbcc39ad 2181
2182=cut
2183
2184sub handle_request {
2185 my ( $class, @arguments ) = @_;
2186
2187 # Always expect worst case!
2188 my $status = -1;
3640641e 2189 try {
dea1884f 2190 if ($class->debug) {
908e3d9e 2191 my $secs = time - $START || 1;
2192 my $av = sprintf '%.3f', $COUNT / $secs;
2193 my $time = localtime time;
2194 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 2195 }
908e3d9e 2196
2197 my $c = $class->prepare(@arguments);
2198 $c->dispatch;
62a6df80 2199 $status = $c->finalize;
660f9bb0 2200 } catch {
660f9bb0 2201 #rethow if this can be handled by middleware
80172e7d 2202 if ( $class->_handle_http_exception($_) ) {
6e94698d 2203 $_->can('rethrow') ? $_->rethrow : croak $_;
660f9bb0 2204 }
6e94698d 2205 chomp(my $error = $_);
2206 $class->log->error(qq/Caught exception in engine "$error"/);
3640641e 2207 };
fbcc39ad 2208
2209 $COUNT++;
62a6df80 2210
6680c772 2211 if(my $coderef = $class->log->can('_flush')){
2212 $class->log->$coderef();
2213 }
fbcc39ad 2214 return $status;
2215}
2216
d536010b 2217=head2 $class->prepare( @arguments )
fbcc39ad 2218
ae1e6b59 2219Creates a Catalyst context from an engine-specific request (Apache, CGI,
2220etc.).
fbcc39ad 2221
2222=cut
2223
398f13db 2224has _uploadtmp => (
2225 is => 'ro',
2226 predicate => '_has_uploadtmp',
2227);
2228
fbcc39ad 2229sub prepare {
2230 my ( $class, @arguments ) = @_;
2231
6680c772 2232 # XXX
2233 # After the app/ctxt split, this should become an attribute based on something passed
2234 # into the application.
3cec521a 2235 $class->context_class( ref $class || $class ) unless $class->context_class;
62a6df80 2236
398f13db 2237 my $uploadtmp = $class->config->{uploadtmp};
2238 my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
fbcc39ad 2239
258733f1 2240 $c->response->_context($c);
2241
b6d4ee6e 2242 #surely this is not the most efficient way to do things...
dc5f035e 2243 $c->stats($class->stats_class->new)->enable($c->use_stats);
4f0b7cf1 2244 if ( $c->debug || $c->config->{enable_catalyst_header} ) {
62a6df80 2245 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 2246 }
2247
3640641e 2248 try {
2249 # Allow engine to direct the prepare flow (for POE)
2250 if ( my $prepare = $c->engine->can('prepare') ) {
2251 $c->engine->$prepare( $c, @arguments );
2252 }
2253 else {
2254 $c->prepare_request(@arguments);
2255 $c->prepare_connection;
2256 $c->prepare_query_parameters;
41aaa5d6 2257 $c->prepare_headers; # Just hooks, no longer needed - they just
2258 $c->prepare_cookies; # cause the lazy attribute on req to build
3640641e 2259 $c->prepare_path;
2260
2261 # Prepare the body for reading, either by prepare_body
2262 # or the user, if they are using $c->read
2263 $c->prepare_read;
2264
2265 # Parse the body unless the user wants it on-demand
2266 unless ( ref($c)->config->{parse_on_demand} ) {
2267 $c->prepare_body;
2268 }
878b821c 2269 }
676bed72 2270 $c->prepare_action;
5050d7a7 2271 }
3640641e 2272 # VERY ugly and probably shouldn't rely on ->finalize actually working
2273 catch {
2274 # failed prepare is always due to an invalid request, right?
2275 $c->response->status(400);
2276 $c->response->content_type('text/plain');
2277 $c->response->body('Bad Request');
5e25c01f 2278 # Note we call finalize and then die here, which escapes
2279 # finalize being called in the enclosing block..
2280 # It in fact couldn't be called, as we don't return $c..
2281 # This is a mess - but I'm unsure you can fix this without
2282 # breaking compat for people doing crazy things (we should set
2283 # the 400 and just return the ctx here IMO, letting finalize get called
2284 # above...
3640641e 2285 $c->finalize;
2286 die $_;
2287 };
fbcc39ad 2288
10f204e1 2289 $c->log_request;
fbcc39ad 2290
2291 return $c;
2292}
2293
b5ecfcf0 2294=head2 $c->prepare_action
fbcc39ad 2295
b4b01a8a 2296Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 2297
2298=cut
2299
9c38cb50 2300sub prepare_action {
2301 my $c = shift;
2302 my $ret = $c->dispatcher->prepare_action( $c, @_);
2303
2304 if($c->encoding) {
2305 foreach (@{$c->req->arguments}, @{$c->req->captures}) {
2306 $_ = $c->_handle_param_unicode_decoding($_);
2307 }
2308 }
2309
2310 return $ret;
2311}
2312
fbcc39ad 2313
b5ecfcf0 2314=head2 $c->prepare_body
fbcc39ad 2315
e7f1cf73 2316Prepares message body.
fbcc39ad 2317
2318=cut
2319
2320sub prepare_body {
2321 my $c = shift;
2322
0f56bbcf 2323 return if $c->request->_has_body;
fbcc39ad 2324
2325 # Initialize on-demand data
2326 $c->engine->prepare_body( $c, @_ );
2327 $c->prepare_parameters;
2328 $c->prepare_uploads;
fbcc39ad 2329}
2330
b5ecfcf0 2331=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 2332
e7f1cf73 2333Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 2334
b4b01a8a 2335See L<Catalyst::Engine>.
2336
4bd82c41 2337=cut
2338
4f5ebacd 2339sub prepare_body_chunk {
2340 my $c = shift;
4bd82c41 2341 $c->engine->prepare_body_chunk( $c, @_ );
2342}
2343
b5ecfcf0 2344=head2 $c->prepare_body_parameters
fbcc39ad 2345
e7f1cf73 2346Prepares body parameters.
fbcc39ad 2347
2348=cut
2349
2350sub prepare_body_parameters {
2351 my $c = shift;
b9d96e27 2352 $c->request->prepare_body_parameters( $c, @_ );
fbcc39ad 2353}
2354
b5ecfcf0 2355=head2 $c->prepare_connection
fbcc39ad 2356
e7f1cf73 2357Prepares connection.
fbcc39ad 2358
2359=cut
2360
2361sub prepare_connection {
2362 my $c = shift;
817ed8ab 2363 $c->request->prepare_connection($c);
fbcc39ad 2364}
2365
b5ecfcf0 2366=head2 $c->prepare_cookies
fbcc39ad 2367
41aaa5d6 2368Prepares cookies by ensuring that the attribute on the request
2369object has been built.
fbcc39ad 2370
2371=cut
2372
41aaa5d6 2373sub prepare_cookies { my $c = shift; $c->request->cookies }
fbcc39ad 2374
b5ecfcf0 2375=head2 $c->prepare_headers
fbcc39ad 2376
41aaa5d6 2377Prepares request headers by ensuring that the attribute on the request
2378object has been built.
fbcc39ad 2379
2380=cut
2381
41aaa5d6 2382sub prepare_headers { my $c = shift; $c->request->headers }
fbcc39ad 2383
b5ecfcf0 2384=head2 $c->prepare_parameters
fbcc39ad 2385
e7f1cf73 2386Prepares parameters.
fbcc39ad 2387
2388=cut
2389
2390sub prepare_parameters {
2391 my $c = shift;
2392 $c->prepare_body_parameters;
2393 $c->engine->prepare_parameters( $c, @_ );
2394}
2395
b5ecfcf0 2396=head2 $c->prepare_path
fbcc39ad 2397
e7f1cf73 2398Prepares path and base.
fbcc39ad 2399
2400=cut
2401
2402sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2403
b5ecfcf0 2404=head2 $c->prepare_query_parameters
fbcc39ad 2405
e7f1cf73 2406Prepares query parameters.
fbcc39ad 2407
2408=cut
2409
2410sub prepare_query_parameters {
2411 my $c = shift;
2412
2413 $c->engine->prepare_query_parameters( $c, @_ );
10f204e1 2414}
fbcc39ad 2415
10f204e1 2416=head2 $c->log_request
2417
2418Writes information about the request to the debug logs. This includes:
2419
2420=over 4
2421
854e5dcd 2422=item * Request method, path, and remote IP address
10f204e1 2423
2424=item * Query keywords (see L<Catalyst::Request/query_keywords>)
2425
e7cbe1bf 2426=item * Request parameters
10f204e1 2427
2428=item * File uploads
2429
2430=back
fbcc39ad 2431
2432=cut
2433
10f204e1 2434sub log_request {
2435 my $c = shift;
fbcc39ad 2436
10f204e1 2437 return unless $c->debug;
fbcc39ad 2438
2bf54936 2439 my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2440 my $request = $dump->[1];
e7cbe1bf 2441
2442 my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
10f204e1 2443 $method ||= '';
2444 $path = '/' unless length $path;
2445 $address ||= '';
0ca510f0 2446
2447 $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
2448 $path = decode_utf8($path);
2449
10f204e1 2450 $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2451
3a4abdb3 2452 $c->log_request_headers($request->headers);
e7cbe1bf 2453
2454 if ( my $keywords = $request->query_keywords ) {
10f204e1 2455 $c->log->debug("Query keywords are: $keywords");
fbcc39ad 2456 }
10f204e1 2457
9c74923d 2458 $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
10f204e1 2459
e7cbe1bf 2460 $c->log_request_uploads($request);
fbcc39ad 2461}
2462
10f204e1 2463=head2 $c->log_response
fbcc39ad 2464
75b65816 2465Writes information about the response to the debug logs by calling
2466C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
fbcc39ad 2467
2468=cut
2469
75b65816 2470sub log_response {
2471 my $c = shift;
fbcc39ad 2472
75b65816 2473 return unless $c->debug;
fbcc39ad 2474
75b65816 2475 my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2476 my $response = $dump->[1];
2477
2478 $c->log_response_status_line($response);
2479 $c->log_response_headers($response->headers);
2480}
2481
2482=head2 $c->log_response_status_line($response)
2483
2484Writes one line of information about the response to the debug logs. This includes:
10f204e1 2485
2486=over 4
2487
2488=item * Response status code
2489
3a4abdb3 2490=item * Content-Type header (if present)
2491
2492=item * Content-Length header (if present)
10f204e1 2493
2494=back
fbcc39ad 2495
2496=cut
2497
75b65816 2498sub log_response_status_line {
2499 my ($c, $response) = @_;
fbcc39ad 2500
697bab77 2501 $c->log->debug(
2502 sprintf(
2503 'Response Code: %s; Content-Type: %s; Content-Length: %s',
2504 $response->status || 'unknown',
2505 $response->headers->header('Content-Type') || 'unknown',
2506 $response->headers->header('Content-Length') || 'unknown'
2507 )
2508 );
10f204e1 2509}
fbcc39ad 2510
75b65816 2511=head2 $c->log_response_headers($headers);
2512
8ad6fd58 2513Hook method which can be wrapped by plugins to log the response headers.
75b65816 2514No-op in the default implementation.
fbcc39ad 2515
2516=cut
2517
75b65816 2518sub log_response_headers {}
fbcc39ad 2519
10f204e1 2520=head2 $c->log_request_parameters( query => {}, body => {} )
2521
2522Logs request parameters to debug logs
2523
10f204e1 2524=cut
2525
2526sub log_request_parameters {
2527 my $c = shift;
2528 my %all_params = @_;
2529
2bf54936 2530 return unless $c->debug;
e7cbe1bf 2531
10f204e1 2532 my $column_width = Catalyst::Utils::term_width() - 44;
2533 foreach my $type (qw(query body)) {
2bf54936 2534 my $params = $all_params{$type};
2535 next if ! keys %$params;
10f204e1 2536 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
e7cbe1bf 2537 for my $key ( sort keys %$params ) {
2538 my $param = $params->{$key};
10f204e1 2539 my $value = defined($param) ? $param : '';
2540 $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2541 }
2542 $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2543 }
2544}
2545
2546=head2 $c->log_request_uploads
2547
2548Logs file uploads included in the request to the debug logs.
854e5dcd 2549The parameter name, filename, file type, and file size are all included in
10f204e1 2550the debug logs.
2551
2552=cut
fbcc39ad 2553
10f204e1 2554sub log_request_uploads {
2555 my $c = shift;
2bf54936 2556 my $request = shift;
e7cbe1bf 2557 return unless $c->debug;
2558 my $uploads = $request->uploads;
10f204e1 2559 if ( keys %$uploads ) {
8c113188 2560 my $t = Text::SimpleTable->new(
34d28dfd 2561 [ 12, 'Parameter' ],
2562 [ 26, 'Filename' ],
8c113188 2563 [ 18, 'Type' ],
2564 [ 9, 'Size' ]
2565 );
10f204e1 2566 for my $key ( sort keys %$uploads ) {
2567 my $upload = $uploads->{$key};
fbcc39ad 2568 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 2569 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 2570 }
2571 }
2572 $c->log->debug( "File Uploads are:\n" . $t->draw );
2573 }
2574}
2575
3a4abdb3 2576=head2 $c->log_request_headers($headers);
2577
2578Hook method which can be wrapped by plugins to log the request headers.
2579No-op in the default implementation.
2580
2581=cut
2582
2583sub log_request_headers {}
2584
10f204e1 2585=head2 $c->log_headers($type => $headers)
2586
e7cbe1bf 2587Logs L<HTTP::Headers> (either request or response) to the debug logs.
10f204e1 2588
2589=cut
2590
2591sub log_headers {
2592 my $c = shift;
2593 my $type = shift;
2594 my $headers = shift; # an HTTP::Headers instance
2595
e7cbe1bf 2596 return unless $c->debug;
10f204e1 2597
f0e9921a 2598 my $column_width = Catalyst::Utils::term_width() - 28;
2599 my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
e7cbe1bf 2600 $headers->scan(
10f204e1 2601 sub {
2602 my ( $name, $value ) = @_;
2603 $t->row( $name, $value );
2604 }
2605 );
2606 $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2607}
2608
10f204e1 2609
2610=head2 $c->prepare_read
2611
2612Prepares the input for reading.
2613
2614=cut
2615
2616sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2617
2618=head2 $c->prepare_request
2619
2620Prepares the engine request.
2621
2622=cut
2623
2624sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2625
2626=head2 $c->prepare_uploads
2627
2628Prepares uploads.
2629
2630=cut
2631
2632sub prepare_uploads {
2633 my $c = shift;
10f204e1 2634 $c->engine->prepare_uploads( $c, @_ );
2635}
2636
b5ecfcf0 2637=head2 $c->prepare_write
fbcc39ad 2638
e7f1cf73 2639Prepares the output for writing.
fbcc39ad 2640
2641=cut
2642
2643sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2644
b5ecfcf0 2645=head2 $c->request_class
1f9cb7c1 2646
3f87d500 2647Returns or sets the request class. Defaults to L<Catalyst::Request>.
1f9cb7c1 2648
b5ecfcf0 2649=head2 $c->response_class
1f9cb7c1 2650
3f87d500 2651Returns or sets the response class. Defaults to L<Catalyst::Response>.
1f9cb7c1 2652
b5ecfcf0 2653=head2 $c->read( [$maxlength] )
fbcc39ad 2654
ae1e6b59 2655Reads a chunk of data from the request body. This method is designed to
2656be used in a while loop, reading C<$maxlength> bytes on every call.
2657C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 2658
4600a5a1 2659You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
ae1e6b59 2660directly.
fbcc39ad 2661
878b821c 2662Warning: If you use read(), Catalyst will not process the body,
2663so you will not be able to access POST parameters or file uploads via
2664$c->request. You must handle all body parsing yourself.
2665
fbcc39ad 2666=cut
2667
f083854e 2668sub read { my $c = shift; return $c->request->read( @_ ) }
fbcc39ad 2669
b5ecfcf0 2670=head2 $c->run
fbcc39ad 2671
2672Starts the engine.
2673
2674=cut
2675
0c6352ff 2676sub run {
2677 my $app = shift;
38e43e65 2678 $app->_make_immutable_if_needed;
0c6352ff 2679 $app->engine_loader->needs_psgi_engine_compat_hack ?
2680 $app->engine->run($app, @_) :
2681 $app->engine->run( $app, $app->_finalized_psgi_app, @_ );
2682}
fbcc39ad 2683
38e43e65 2684sub _make_immutable_if_needed {
2685 my $class = shift;
dd5b1dc4 2686 my $meta = find_meta($class);
38e43e65 2687 my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
2688 if (
2689 $meta->is_immutable
2690 && ! { $meta->immutable_options }->{replace_constructor}
2691 && $isa_ca
2692 ) {
2693 warn("You made your application class ($class) immutable, "
2694 . "but did not inline the\nconstructor. "
2695 . "This will break catalyst, as your app \@ISA "
2696 . "Class::Accessor(::Fast)?\nPlease pass "
2697 . "(replace_constructor => 1)\nwhen making your class immutable.\n");
2698 }
2699 unless ($meta->is_immutable) {
2700 # XXX - FIXME warning here as you should make your app immutable yourself.
2701 $meta->make_immutable(
2702 replace_constructor => 1,
2703 );
2704 }
2705}
2706
b5ecfcf0 2707=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 2708
e7f1cf73 2709Sets an action in a given namespace.
fbcc39ad 2710
2711=cut
2712
2713sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2714
b5ecfcf0 2715=head2 $c->setup_actions($component)
fbcc39ad 2716
e7f1cf73 2717Sets up actions for a component.
fbcc39ad 2718
2719=cut
2720
2721sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2722
b5ecfcf0 2723=head2 $c->setup_components
fbcc39ad 2724
d261d153 2725This method is called internally to set up the application's components.
fbcc39ad 2726
d261d153 2727It finds modules by calling the L<locate_components> method, expands them to
2728package names with the L<expand_component_module> method, and then installs
2729each component into the application.
2730
2731The C<setup_components> config option is passed to both of the above methods.
fbcc39ad 2732
d261d153 2733Installation of each component is performed by the L<setup_component> method,
2734below.
2f381252 2735
fbcc39ad 2736=cut
2737
2738sub setup_components {
2739 my $class = shift;
2740
18de900e 2741 my $config = $class->config->{ setup_components };
62a6df80 2742
69c6b6cb 2743 my @comps = $class->locate_components($config);
b94b200c 2744 my %comps = map { $_ => 1 } @comps;
73e1183e 2745
8f6cebb2 2746 my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
73e1183e 2747 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2748 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
8f6cebb2 2749 ) if $deprecatedcatalyst_component_names;
73e1183e 2750
b94b200c 2751 for my $component ( @comps ) {
dd91afb5 2752
2753 # We pass ignore_loaded here so that overlay files for (e.g.)
2754 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2755 # we know M::P::O found a file on disk so this is safe
2756
f5a4863c 2757 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
196f06d1 2758 }
2759
e7e4c469 2760 for my $component (@comps) {
5d02e790 2761 my $instance = $class->components->{ $component } = $class->setup_component($component);
2762 my @expanded_components = $instance->can('expand_modules')
2763 ? $instance->expand_modules( $component, $config )
2764 : $class->expand_component_module( $component, $config );
2765 for my $component (@expanded_components) {
05887b58 2766 next if $comps{$component};
e7e4c469 2767 $class->components->{ $component } = $class->setup_component($component);
fbcc39ad 2768 }
364d7324 2769 }
2770}
fbcc39ad 2771