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