Version 5.90015
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
CommitLineData
fc7ec1d9 1package Catalyst;
2
a7caa492 3use Moose;
c98492ae 4use Moose::Meta::Class ();
60eabdaf 5extends 'Catalyst::Component';
2f5cb070 6use Moose::Util qw/find_meta/;
38e43e65 7use namespace::clean -except => 'meta';
a2f2cde9 8use Catalyst::Exception;
154ef0c8 9use Catalyst::Exception::Detach;
10use Catalyst::Exception::Go;
fc7ec1d9 11use Catalyst::Log;
fbcc39ad 12use Catalyst::Request;
13use Catalyst::Request::Upload;
14use Catalyst::Response;
812a28c9 15use Catalyst::Utils;
31375184 16use Catalyst::Controller;
62b6b631 17use Data::OptList;
364d7324 18use Devel::InnerPackage ();
c50f595c 19use Module::Pluggable::Object ();
c50f595c 20use Text::SimpleTable ();
21use Path::Class::Dir ();
22use Path::Class::File ();
c50f595c 23use URI ();
933ba403 24use URI::http;
25use URI::https;
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
cfdd890d 103our $VERSION = '5.90015';
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
647a3de1 1187 if ($class->config->{case_sensitive}) {
1188 $class->log->warn($class . "->config->{case_sensitive} is set.");
1189 $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1190 }
1191
a5d07d29 1192 $class->setup_finalize;
647a3de1 1193 # Should be the last thing we do so that user things hooking
1194 # setup_finalize can log..
1195 $class->log->_flush() if $class->log->can('_flush');
64ceb36b 1196 return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE.
a5d07d29 1197}
1198
23c63a17 1199=head2 $app->setup_finalize
1200
128a7cee 1201A hook to attach modifiers to. This method does not do anything except set the
1202C<setup_finished> accessor.
23c63a17 1203
ae7da8f5 1204Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
23c63a17 1205
128a7cee 1206Example:
23c63a17 1207
128a7cee 1208 after setup_finalize => sub {
1209 my $app = shift;
23c63a17 1210
128a7cee 1211 ## do stuff here..
1212 };
23c63a17 1213
1214=cut
1215
a5d07d29 1216sub setup_finalize {
1217 my ($class) = @_;
3643e890 1218 $class->setup_finished(1);
fbcc39ad 1219}
1220
d71da6fe 1221=head2 $c->uri_for( $path?, @args?, \%query_values? )
fbcc39ad 1222
ee8963de 1223=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
9df7c5d9 1224
ee8963de 1225Constructs an absolute L<URI> object based on the application root, the
1226provided path, and the additional arguments and query parameters provided.
186d5270 1227When used as a string, provides a textual URI. If you need more flexibility
92981fc3 1228than this (i.e. the option to provide relative URIs etc.) see
186d5270 1229L<Catalyst::Plugin::SmartURI>.
ee8963de 1230
d71da6fe 1231If no arguments are provided, the URI for the current action is returned.
1232To return the current action and also provide @args, use
1d3a0700 1233C<< $c->uri_for( $c->action, @args ) >>.
d71da6fe 1234
ee8963de 1235If the first argument is a string, it is taken as a public URI path relative
1236to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
e7e4c469 1237relative to the application root (if it does). It is then merged with
ee8963de 1238C<< $c->request->base >>; any C<@args> are appended as additional path
1239components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1240
1241If the first argument is a L<Catalyst::Action> it represents an action which
1242will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1243optional C<\@captures> argument (an arrayref) allows passing the captured
1244variables that are needed to fill in the paths of Chained and Regex actions;
1245once the path is resolved, C<uri_for> continues as though a path was
1246provided, appending any arguments or parameters and creating an absolute
1247URI.
1248
e7e4c469 1249The captures for the current request can be found in
ee8963de 1250C<< $c->request->captures >>, and actions can be resolved using
1251C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1252path, use C<< $c->uri_for_action >> instead.
1253
1254 # Equivalent to $c->req->uri
e7e4c469 1255 $c->uri_for($c->action, $c->req->captures,
ee8963de 1256 @{ $c->req->args }, $c->req->params);
62a6df80 1257
9df7c5d9 1258 # For the Foo action in the Bar controller
ee8963de 1259 $c->uri_for($c->controller('Bar')->action_for('Foo'));
9df7c5d9 1260
ee8963de 1261 # Path to a static resource
1262 $c->uri_for('/static/images/logo.png');
d5e3d528 1263
4cf1dd00 1264=cut
1265
fbcc39ad 1266sub uri_for {
00e6a2b7 1267 my ( $c, $path, @args ) = @_;
00e6a2b7 1268
7069eab5 1269 if (blessed($path) && $path->isa('Catalyst::Controller')) {
1270 $path = $path->path_prefix;
1271 $path =~ s{/+\z}{};
1272 $path .= '/';
1273 }
1274
2689f8a4 1275 undef($path) if (defined $path && $path eq '');
1276
1277 my $params =
1278 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1279
1280 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
a4f2cdc8 1281 foreach my $arg (@args) {
1282 utf8::encode($arg) if utf8::is_utf8($arg);
49229f68 1283 $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
2689f8a4 1284 }
1285
7e95ba12 1286 if ( blessed($path) ) { # action object
49229f68 1287 s|/|%2F|g for @args;
2689f8a4 1288 my $captures = [ map { s|/|%2F|g; $_; }
aaf72276 1289 ( scalar @args && ref $args[0] eq 'ARRAY'
1290 ? @{ shift(@args) }
1291 : ()) ];
7b346bc3 1292
1293 foreach my $capture (@$captures) {
1294 utf8::encode($capture) if utf8::is_utf8($capture);
1295 $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1296 }
1297
aa7e913e 1298 my $action = $path;
0cff119a 1299 # ->uri_for( $action, \@captures_and_args, \%query_values? )
1300 if( !@args && $action->number_of_args ) {
1301 my $expanded_action = $c->dispatcher->expand_action( $action );
1302
1303 my $num_captures = $expanded_action->number_of_captures;
1304 unshift @args, splice @$captures, $num_captures;
1305 }
1306
1307 $path = $c->dispatcher->uri_for_action($action, $captures);
aa7e913e 1308 if (not defined $path) {
1309 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1310 if $c->debug;
1311 return undef;
1312 }
81e75875 1313 $path = '/' if $path eq '';
ea0e58d9 1314 }
1315
51674a63 1316 unshift(@args, $path);
1317
1318 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1319 my $namespace = $c->namespace;
1320 if (defined $path) { # cheesy hack to handle path '../foo'
1321 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 1322 }
51674a63 1323 unshift(@args, $namespace || '');
1324 }
62a6df80 1325
189e2a51 1326 # join args with '/', or a blank string
51674a63 1327 my $args = join('/', grep { defined($_) } @args);
1328 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
7a2295bc 1329 $args =~ s!^/+!!;
51674a63 1330 my $base = $c->req->base;
1331 my $class = ref($base);
1332 $base =~ s{(?<!/)$}{/};
1333
1334 my $query = '';
1335
1336 if (my @keys = keys %$params) {
1337 # somewhat lifted from URI::_query's query_form
1338 $query = '?'.join('&', map {
2f381252 1339 my $val = $params->{$_};
51674a63 1340 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1341 s/ /+/g;
1342 my $key = $_;
51674a63 1343 $val = '' unless defined $val;
1344 (map {
1f851263 1345 my $param = "$_";
1346 utf8::encode( $param ) if utf8::is_utf8($param);
51674a63 1347 # using the URI::Escape pattern here so utf8 chars survive
1f851263 1348 $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1349 $param =~ s/ /+/g;
1350 "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
51674a63 1351 } @keys);
1352 }
1353
1354 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1355 $res;
fbcc39ad 1356}
1357
25d61080 1358=head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? )
833b385e 1359
25d61080 1360=head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? )
833b385e 1361
1362=over
1363
1364=item $path
1365
1366A private path to the Catalyst action you want to create a URI for.
1367
1368This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1369>> and passing the resulting C<$action> and the remaining arguments to C<<
1370$c->uri_for >>.
1371
1372You can also pass in a Catalyst::Action object, in which case it is passed to
1373C<< $c->uri_for >>.
1374
c9ec25f8 1375Note 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.
1376
1377For example, if the action looks like:
1378
1379 package MyApp::Controller::Users;
1380
1381 sub lst : Path('the-list') {}
1382
1383You can use:
1384
1385 $c->uri_for_action('/users/lst')
1386
1387and it will create the URI /users/the-list.
1388
25d61080 1389=item \@captures_and_args?
1390
1391Optional array reference of Captures (i.e. C<<CaptureArgs or $c->req->captures>)
1392and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained>
1393to interpolate all the parameters in the URI.
1394
1395=item @args?
1396
942572d7 1397Optional list of extra arguments - can be supplied in the
1398C<< \@captures_and_args? >> array ref, or here - whichever is easier for your
1399code.
25d61080 1400
942572d7 1401Your action can have zero, a fixed or a variable number of args (e.g.
1402C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number)..
25d61080 1403
1404=item \%query_values?
1405
1406Optional array reference of query parameters to append. E.g.
1407
1408 { foo => 'bar' }
1409
1410will generate
1411
1412 /rest/of/your/uri?foo=bar
1413
833b385e 1414=back
1415
1416=cut
1417
1418sub uri_for_action {
1419 my ( $c, $path, @args ) = @_;
62a6df80 1420 my $action = blessed($path)
1421 ? $path
833b385e 1422 : $c->dispatcher->get_action_by_path($path);
4ac0b9cb 1423 unless (defined $action) {
1424 croak "Can't find action for path '$path'";
1425 }
833b385e 1426 return $c->uri_for( $action, @args );
1427}
1428
b5ecfcf0 1429=head2 $c->welcome_message
ab2374d3 1430
1431Returns the Catalyst welcome HTML page.
1432
1433=cut
1434
1435sub welcome_message {
bf1f2c60 1436 my $c = shift;
1437 my $name = $c->config->{name};
1438 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1439 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1440 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1441 return <<"EOF";
80cdbbff 1442<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1443 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1444<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1445 <head>
85d9fce6 1446 <meta http-equiv="Content-Language" content="en" />
1447 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1448 <title>$name on Catalyst $VERSION</title>
1449 <style type="text/css">
1450 body {
ab2374d3 1451 color: #000;
1452 background-color: #eee;
1453 }
1454 div#content {
1455 width: 640px;
80cdbbff 1456 margin-left: auto;
1457 margin-right: auto;
ab2374d3 1458 margin-top: 10px;
1459 margin-bottom: 10px;
1460 text-align: left;
1461 background-color: #ccc;
1462 border: 1px solid #aaa;
ab2374d3 1463 }
d84c4dab 1464 p, h1, h2 {
ab2374d3 1465 margin-left: 20px;
1466 margin-right: 20px;
16215972 1467 font-family: verdana, tahoma, sans-serif;
ab2374d3 1468 }
d84c4dab 1469 a {
1470 font-family: verdana, tahoma, sans-serif;
1471 }
d114e033 1472 :link, :visited {
1473 text-decoration: none;
1474 color: #b00;
1475 border-bottom: 1px dotted #bbb;
1476 }
1477 :link:hover, :visited:hover {
d114e033 1478 color: #555;
1479 }
ab2374d3 1480 div#topbar {
1481 margin: 0px;
1482 }
3e82a295 1483 pre {
3e82a295 1484 margin: 10px;
1485 padding: 8px;
1486 }
ab2374d3 1487 div#answers {
1488 padding: 8px;
1489 margin: 10px;
d114e033 1490 background-color: #fff;
ab2374d3 1491 border: 1px solid #aaa;
ab2374d3 1492 }
1493 h1 {
33108eaf 1494 font-size: 0.9em;
1495 font-weight: normal;
ab2374d3 1496 text-align: center;
1497 }
1498 h2 {
1499 font-size: 1.0em;
1500 }
1501 p {
1502 font-size: 0.9em;
1503 }
ae7c5252 1504 p img {
1505 float: right;
1506 margin-left: 10px;
1507 }
9619f23c 1508 span#appname {
1509 font-weight: bold;
33108eaf 1510 font-size: 1.6em;
ab2374d3 1511 }
1512 </style>
1513 </head>
1514 <body>
1515 <div id="content">
1516 <div id="topbar">
9619f23c 1517 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1518 $VERSION</h1>
ab2374d3 1519 </div>
1520 <div id="answers">
ae7c5252 1521 <p>
80cdbbff 1522 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1523 </p>
596aaffe 1524 <p>Welcome to the world of Catalyst.
f92fd545 1525 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1526 framework will make web development something you had
60dd6e1d 1527 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1528 <h2>What to do now?</h2>
4b8cb778 1529 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1530 We do, however, provide you with a few starting points.</p>
1531 <p>If you want to jump right into web development with Catalyst
2f381252 1532 you might want to start with a tutorial.</p>
80267996 1533<pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code>
596aaffe 1534</pre>
1535<p>Afterwards you can go on to check out a more complete look at our features.</p>
1536<pre>
80267996 1537<code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a>
b607f8a0 1538<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1539</code></pre>
ab2374d3 1540 <h2>What to do next?</h2>
f5681c92 1541 <p>Next it's time to write an actual application. Use the
80267996 1542 helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>,
1543 <a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and
1544 <a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>;
bf1f2c60 1545 they can save you a lot of work.</p>
c5f31918 1546 <pre><code>script/${prefix}_create.pl --help</code></pre>
bf1f2c60 1547 <p>Also, be sure to check out the vast and growing
802bf2cb 1548 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
bf1f2c60 1549 you are likely to find what you need there.
f5681c92 1550 </p>
1551
82245cc4 1552 <h2>Need help?</h2>
f5681c92 1553 <p>Catalyst has a very active community. Here are the main places to
1554 get in touch with us.</p>
16215972 1555 <ul>
1556 <li>
2b9a7d76 1557 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1558 </li>
1559 <li>
6d4c3368 1560 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1561 </li>
1562 <li>
4eaf7c88 1563 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1564 </li>
1565 </ul>
ab2374d3 1566 <h2>In conclusion</h2>
62a6df80 1567 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1568 as we enjoyed making it. Please contact us if you have ideas
1569 for improvement or other feedback.</p>
ab2374d3 1570 </div>
1571 </div>
1572 </body>
1573</html>
1574EOF
1575}
1576
aee7cdcc 1577=head2 run_options
1578
1579Contains a hash of options passed from the application script, including
c2c8d3cb 1580the original ARGV the script received, the processed values from that
aee7cdcc 1581ARGV and any extra arguments to the script which were not processed.
1582
1583This can be used to add custom options to your application's scripts
1584and setup your application differently depending on the values of these
1585options.
1586
fbcc39ad 1587=head1 INTERNAL METHODS
1588
ae1e6b59 1589These methods are not meant to be used by end users.
1590
b5ecfcf0 1591=head2 $c->components
fbcc39ad 1592
e7f1cf73 1593Returns a hash of components.
fbcc39ad 1594
b5ecfcf0 1595=head2 $c->context_class
1f9cb7c1 1596
e7f1cf73 1597Returns or sets the context class.
1f9cb7c1 1598
b5ecfcf0 1599=head2 $c->counter
fbcc39ad 1600
ae1e6b59 1601Returns a hashref containing coderefs and execution counts (needed for
1602deep recursion detection).
fbcc39ad 1603
b5ecfcf0 1604=head2 $c->depth
fbcc39ad 1605
e7f1cf73 1606Returns the number of actions on the current internal execution stack.
fbcc39ad 1607
b5ecfcf0 1608=head2 $c->dispatch
fbcc39ad 1609
e7f1cf73 1610Dispatches a request to actions.
fbcc39ad 1611
1612=cut
1613
1614sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1615
b5ecfcf0 1616=head2 $c->dispatcher_class
1f9cb7c1 1617
e7f1cf73 1618Returns or sets the dispatcher class.
1f9cb7c1 1619
b5ecfcf0 1620=head2 $c->dump_these
7f92deef 1621
ae1e6b59 1622Returns a list of 2-element array references (name, structure) pairs
1623that will be dumped on the error page in debug mode.
7f92deef 1624
1625=cut
1626
1627sub dump_these {
1628 my $c = shift;
62a6df80 1629 [ Request => $c->req ],
1630 [ Response => $c->res ],
052a2d89 1631 [ Stash => $c->stash ],
1632 [ Config => $c->config ];
7f92deef 1633}
1634
b5ecfcf0 1635=head2 $c->engine_class
1f9cb7c1 1636
e7f1cf73 1637Returns or sets the engine class.
1f9cb7c1 1638
b5ecfcf0 1639=head2 $c->execute( $class, $coderef )
fbcc39ad 1640
0ef52a96 1641Execute a coderef in given class and catch exceptions. Errors are available
1642via $c->error.
fbcc39ad 1643
1644=cut
1645
1646sub execute {
1647 my ( $c, $class, $code ) = @_;
858828dd 1648 $class = $c->component($class) || $class;
fbcc39ad 1649 $c->state(0);
a0eca838 1650
197bd788 1651 if ( $c->depth >= $RECURSION ) {
f3414019 1652 my $action = $code->reverse();
91d08727 1653 $action = "/$action" unless $action =~ /->/;
f3414019 1654 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 1655 $c->log->error($error);
1656 $c->error($error);
1657 $c->state(0);
1658 return $c->state;
1659 }
1660
dc5f035e 1661 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 1662
8767c5a3 1663 push( @{ $c->stack }, $code );
62a6df80 1664
6f3df815 1665 no warnings 'recursion';
524b0e1c 1666 # N.B. This used to be combined, but I have seen $c get clobbered if so, and
1667 # I have no idea how, ergo $ret (which appears to fix the issue)
1668 eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
22247e54 1669
dc5f035e 1670 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
62a6df80 1671
a6724a82 1672 my $last = pop( @{ $c->stack } );
fbcc39ad 1673
1674 if ( my $error = $@ ) {
79f5d571 1675 if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
f87b7c21 1676 $error->rethrow if $c->depth > 1;
2f381252 1677 }
79f5d571 1678 elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
f87b7c21 1679 $error->rethrow if $c->depth > 0;
55424863 1680 }
fbcc39ad 1681 else {
1682 unless ( ref $error ) {
91d08727 1683 no warnings 'uninitialized';
fbcc39ad 1684 chomp $error;
f59def82 1685 my $class = $last->class;
1686 my $name = $last->name;
1687 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 1688 }
fbcc39ad 1689 $c->error($error);
fbcc39ad 1690 }
2688734f 1691 $c->state(0);
fbcc39ad 1692 }
1693 return $c->state;
1694}
1695
7a7d7af5 1696sub _stats_start_execute {
1697 my ( $c, $code ) = @_;
df960201 1698 my $appclass = ref($c) || $c;
a6724a82 1699 return if ( ( $code->name =~ /^_.*/ )
df960201 1700 && ( !$appclass->config->{show_internal_actions} ) );
7a7d7af5 1701
f3414019 1702 my $action_name = $code->reverse();
1703 $c->counter->{$action_name}++;
7a7d7af5 1704
f3414019 1705 my $action = $action_name;
a6724a82 1706 $action = "/$action" unless $action =~ /->/;
1707
7a7d7af5 1708 # determine if the call was the result of a forward
1709 # this is done by walking up the call stack and looking for a calling
1710 # sub of Catalyst::forward before the eval
1711 my $callsub = q{};
1712 for my $index ( 2 .. 11 ) {
1713 last
1714 if ( ( caller($index) )[0] eq 'Catalyst'
1715 && ( caller($index) )[3] eq '(eval)' );
1716
1717 if ( ( caller($index) )[3] =~ /forward$/ ) {
1718 $callsub = ( caller($index) )[3];
1719 $action = "-> $action";
1720 last;
1721 }
1722 }
1723
f3414019 1724 my $uid = $action_name . $c->counter->{$action_name};
74efc144 1725
a6724a82 1726 # is this a root-level call or a forwarded call?
1727 if ( $callsub =~ /forward$/ ) {
91740f34 1728 my $parent = $c->stack->[-1];
a6724a82 1729
1730 # forward, locate the caller
9c74923d 1731 if ( defined $parent && exists $c->counter->{"$parent"} ) {
69d8f33c 1732 $c->stats->profile(
62a6df80 1733 begin => $action,
69d8f33c 1734 parent => "$parent" . $c->counter->{"$parent"},
1735 uid => $uid,
1736 );
7a7d7af5 1737 }
1738 else {
1739
a6724a82 1740 # forward with no caller may come from a plugin
69d8f33c 1741 $c->stats->profile(
1742 begin => $action,
1743 uid => $uid,
1744 );
7a7d7af5 1745 }
1746 }
a6724a82 1747 else {
62a6df80 1748
a6724a82 1749 # root-level call
69d8f33c 1750 $c->stats->profile(
1751 begin => $action,
1752 uid => $uid,
1753 );
a6724a82 1754 }
dc5f035e 1755 return $action;
7a7d7af5 1756
7a7d7af5 1757}
1758
1759sub _stats_finish_execute {
1760 my ( $c, $info ) = @_;
69d8f33c 1761 $c->stats->profile( end => $info );
7a7d7af5 1762}
1763
b5ecfcf0 1764=head2 $c->finalize
fbcc39ad 1765
e7f1cf73 1766Finalizes the request.
fbcc39ad 1767
1768=cut
1769
1770sub finalize {
1771 my $c = shift;
1772
369c09bc 1773 for my $error ( @{ $c->error } ) {
1774 $c->log->error($error);
1775 }
1776
5050d7a7 1777 # Allow engine to handle finalize flow (for POE)
e63bdf38 1778 my $engine = $c->engine;
1779 if ( my $code = $engine->can('finalize') ) {
1780 $engine->$code($c);
fbcc39ad 1781 }
5050d7a7 1782 else {
fbcc39ad 1783
5050d7a7 1784 $c->finalize_uploads;
fbcc39ad 1785
5050d7a7 1786 # Error
1787 if ( $#{ $c->error } >= 0 ) {
1788 $c->finalize_error;
1789 }
1790
89ba65d5 1791 $c->finalize_headers unless $c->response->finalized_headers;
fbcc39ad 1792
5050d7a7 1793 # HEAD request
1794 if ( $c->request->method eq 'HEAD' ) {
1795 $c->response->body('');
1796 }
1797
1798 $c->finalize_body;
1799 }
62a6df80 1800
2bf54936 1801 $c->log_response;
10f204e1 1802
62a6df80 1803 if ($c->use_stats) {
596677b6 1804 my $elapsed = sprintf '%f', $c->stats->elapsed;
12bf12c0 1805 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
908e3d9e 1806 $c->log->info(
62a6df80 1807 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
908e3d9e 1808 }
fbcc39ad 1809
1810 return $c->response->status;
1811}
1812
b5ecfcf0 1813=head2 $c->finalize_body
fbcc39ad 1814
e7f1cf73 1815Finalizes body.
fbcc39ad 1816
1817=cut
1818
1819sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1820
b5ecfcf0 1821=head2 $c->finalize_cookies
fbcc39ad 1822
e7f1cf73 1823Finalizes cookies.
fbcc39ad 1824
1825=cut
1826
147821ea 1827sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 1828
b5ecfcf0 1829=head2 $c->finalize_error
fbcc39ad 1830
e7f1cf73 1831Finalizes error.
fbcc39ad 1832
1833=cut
1834
1835sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1836
b5ecfcf0 1837=head2 $c->finalize_headers
fbcc39ad 1838
e7f1cf73 1839Finalizes headers.
fbcc39ad 1840
1841=cut
1842
1843sub finalize_headers {
1844 my $c = shift;
1845
e63bdf38 1846 my $response = $c->response; #accessor calls can add up?
1847
fbcc39ad 1848 # Check if we already finalized headers
6680c772 1849 return if $response->finalized_headers;
fbcc39ad 1850
1851 # Handle redirects
e63bdf38 1852 if ( my $location = $response->redirect ) {
fbcc39ad 1853 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 1854 $response->header( Location => $location );
a7caa492 1855
02570318 1856 if ( !$response->has_body ) {
39655cdc 1857 # Add a default body if none is already present
9c331634 1858 $response->body(<<"EOF");
1859<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
1860<html xmlns="http://www.w3.org/1999/xhtml">
1861 <head>
1862 <title>Moved</title>
1863 </head>
1864 <body>
1865 <p>This item has moved <a href="$location">here</a>.</p>
1866 </body>
1867</html>
1868EOF
d455230c 1869 $response->content_type('text/html; charset=utf-8');
39655cdc 1870 }
fbcc39ad 1871 }
1872
1873 # Content-Length
ac057d3b 1874 if ( defined $response->body && length $response->body && !$response->content_length ) {
775878ac 1875
8f62c91a 1876 # get the length from a filehandle
9c74923d 1877 if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
197bd788 1878 {
34effbc7 1879 my $size = -s $response->body;
1880 if ( $size ) {
1881 $response->content_length( $size );
8f62c91a 1882 }
1883 else {
775878ac 1884 $c->log->warn('Serving filehandle without a content-length');
8f62c91a 1885 }
1886 }
1887 else {
b5d7a61f 1888 # everything should be bytes at this point, but just in case
5ab21903 1889 $response->content_length( length( $response->body ) );
8f62c91a 1890 }
fbcc39ad 1891 }
1892
1893 # Errors
e63bdf38 1894 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1895 $response->headers->remove_header("Content-Length");
1896 $response->body('');
fbcc39ad 1897 }
1898
1899 $c->finalize_cookies;
1900
89ba65d5 1901 $c->response->finalize_headers();
fbcc39ad 1902
1903 # Done
6680c772 1904 $response->finalized_headers(1);
fbcc39ad 1905}
1906
b5ecfcf0 1907=head2 $c->finalize_output
fbcc39ad 1908
1909An alias for finalize_body.
1910
b5ecfcf0 1911=head2 $c->finalize_read
fbcc39ad 1912
e7f1cf73 1913Finalizes the input after reading is complete.
fbcc39ad 1914
1915=cut
1916
1917sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1918
b5ecfcf0 1919=head2 $c->finalize_uploads
fbcc39ad 1920
ae1e6b59 1921Finalizes uploads. Cleans up any temporary files.
fbcc39ad 1922
1923=cut
1924
1925sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1926
b5ecfcf0 1927=head2 $c->get_action( $action, $namespace )
fbcc39ad 1928
e7f1cf73 1929Gets an action in a given namespace.
fbcc39ad 1930
1931=cut
1932
684d10ed 1933sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 1934
b5ecfcf0 1935=head2 $c->get_actions( $action, $namespace )
a9dc674c 1936
ae1e6b59 1937Gets all actions of a given name in a namespace and all parent
1938namespaces.
a9dc674c 1939
1940=cut
1941
1942sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1943
e5ce5f04 1944=head2 $app->handle_request( @arguments )
fbcc39ad 1945
e7f1cf73 1946Called to handle each HTTP request.
fbcc39ad 1947
1948=cut
1949
1950sub handle_request {
1951 my ( $class, @arguments ) = @_;
1952
1953 # Always expect worst case!
1954 my $status = -1;
3640641e 1955 try {
dea1884f 1956 if ($class->debug) {
908e3d9e 1957 my $secs = time - $START || 1;
1958 my $av = sprintf '%.3f', $COUNT / $secs;
1959 my $time = localtime time;
1960 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 1961 }
908e3d9e 1962
1963 my $c = $class->prepare(@arguments);
1964 $c->dispatch;
62a6df80 1965 $status = $c->finalize;
fbcc39ad 1966 }
3640641e 1967 catch {
1968 chomp(my $error = $_);
1969 $class->log->error(qq/Caught exception in engine "$error"/);
1970 };
fbcc39ad 1971
1972 $COUNT++;
62a6df80 1973
6680c772 1974 if(my $coderef = $class->log->can('_flush')){
1975 $class->log->$coderef();
1976 }
fbcc39ad 1977 return $status;
1978}
1979
d536010b 1980=head2 $class->prepare( @arguments )
fbcc39ad 1981
ae1e6b59 1982Creates a Catalyst context from an engine-specific request (Apache, CGI,
1983etc.).
fbcc39ad 1984
1985=cut
1986
398f13db 1987has _uploadtmp => (
1988 is => 'ro',
1989 predicate => '_has_uploadtmp',
1990);
1991
fbcc39ad 1992sub prepare {
1993 my ( $class, @arguments ) = @_;
1994
6680c772 1995 # XXX
1996 # After the app/ctxt split, this should become an attribute based on something passed
1997 # into the application.
3cec521a 1998 $class->context_class( ref $class || $class ) unless $class->context_class;
62a6df80 1999
398f13db 2000 my $uploadtmp = $class->config->{uploadtmp};
2001 my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
fbcc39ad 2002
258733f1 2003 $c->response->_context($c);
2004
b6d4ee6e 2005 #surely this is not the most efficient way to do things...
dc5f035e 2006 $c->stats($class->stats_class->new)->enable($c->use_stats);
4f0b7cf1 2007 if ( $c->debug || $c->config->{enable_catalyst_header} ) {
62a6df80 2008 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 2009 }
2010
3640641e 2011 try {
2012 # Allow engine to direct the prepare flow (for POE)
2013 if ( my $prepare = $c->engine->can('prepare') ) {
2014 $c->engine->$prepare( $c, @arguments );
2015 }
2016 else {
2017 $c->prepare_request(@arguments);
2018 $c->prepare_connection;
2019 $c->prepare_query_parameters;
41aaa5d6 2020 $c->prepare_headers; # Just hooks, no longer needed - they just
2021 $c->prepare_cookies; # cause the lazy attribute on req to build
3640641e 2022 $c->prepare_path;
2023
2024 # Prepare the body for reading, either by prepare_body
2025 # or the user, if they are using $c->read
2026 $c->prepare_read;
2027
2028 # Parse the body unless the user wants it on-demand
2029 unless ( ref($c)->config->{parse_on_demand} ) {
2030 $c->prepare_body;
2031 }
878b821c 2032 }
676bed72 2033 $c->prepare_action;
5050d7a7 2034 }
3640641e 2035 # VERY ugly and probably shouldn't rely on ->finalize actually working
2036 catch {
2037 # failed prepare is always due to an invalid request, right?
2038 $c->response->status(400);
2039 $c->response->content_type('text/plain');
2040 $c->response->body('Bad Request');
5e25c01f 2041 # Note we call finalize and then die here, which escapes
2042 # finalize being called in the enclosing block..
2043 # It in fact couldn't be called, as we don't return $c..
2044 # This is a mess - but I'm unsure you can fix this without
2045 # breaking compat for people doing crazy things (we should set
2046 # the 400 and just return the ctx here IMO, letting finalize get called
2047 # above...
3640641e 2048 $c->finalize;
2049 die $_;
2050 };
fbcc39ad 2051
10f204e1 2052 $c->log_request;
fbcc39ad 2053
2054 return $c;
2055}
2056
b5ecfcf0 2057=head2 $c->prepare_action
fbcc39ad 2058
b4b01a8a 2059Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 2060
2061=cut
2062
2063sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
2064
b5ecfcf0 2065=head2 $c->prepare_body
fbcc39ad 2066
e7f1cf73 2067Prepares message body.
fbcc39ad 2068
2069=cut
2070
2071sub prepare_body {
2072 my $c = shift;
2073
0f56bbcf 2074 return if $c->request->_has_body;
fbcc39ad 2075
2076 # Initialize on-demand data
2077 $c->engine->prepare_body( $c, @_ );
2078 $c->prepare_parameters;
2079 $c->prepare_uploads;
fbcc39ad 2080}
2081
b5ecfcf0 2082=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 2083
e7f1cf73 2084Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 2085
b4b01a8a 2086See L<Catalyst::Engine>.
2087
4bd82c41 2088=cut
2089
4f5ebacd 2090sub prepare_body_chunk {
2091 my $c = shift;
4bd82c41 2092 $c->engine->prepare_body_chunk( $c, @_ );
2093}
2094
b5ecfcf0 2095=head2 $c->prepare_body_parameters
fbcc39ad 2096
e7f1cf73 2097Prepares body parameters.
fbcc39ad 2098
2099=cut
2100
2101sub prepare_body_parameters {
2102 my $c = shift;
2103 $c->engine->prepare_body_parameters( $c, @_ );
2104}
2105
b5ecfcf0 2106=head2 $c->prepare_connection
fbcc39ad 2107
e7f1cf73 2108Prepares connection.
fbcc39ad 2109
2110=cut
2111
2112sub prepare_connection {
2113 my $c = shift;
ddcd2fc4 2114 # XXX - This is called on the engine (not the request) to maintain
2115 # Engine::PSGI back compat.
2116 $c->engine->prepare_connection($c);
fbcc39ad 2117}
2118
b5ecfcf0 2119=head2 $c->prepare_cookies
fbcc39ad 2120
41aaa5d6 2121Prepares cookies by ensuring that the attribute on the request
2122object has been built.
fbcc39ad 2123
2124=cut
2125
41aaa5d6 2126sub prepare_cookies { my $c = shift; $c->request->cookies }
fbcc39ad 2127
b5ecfcf0 2128=head2 $c->prepare_headers
fbcc39ad 2129
41aaa5d6 2130Prepares request headers by ensuring that the attribute on the request
2131object has been built.
fbcc39ad 2132
2133=cut
2134
41aaa5d6 2135sub prepare_headers { my $c = shift; $c->request->headers }
fbcc39ad 2136
b5ecfcf0 2137=head2 $c->prepare_parameters
fbcc39ad 2138
e7f1cf73 2139Prepares parameters.
fbcc39ad 2140
2141=cut
2142
2143sub prepare_parameters {
2144 my $c = shift;
2145 $c->prepare_body_parameters;
2146 $c->engine->prepare_parameters( $c, @_ );
2147}
2148
b5ecfcf0 2149=head2 $c->prepare_path
fbcc39ad 2150
e7f1cf73 2151Prepares path and base.
fbcc39ad 2152
2153=cut
2154
2155sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2156
b5ecfcf0 2157=head2 $c->prepare_query_parameters
fbcc39ad 2158
e7f1cf73 2159Prepares query parameters.
fbcc39ad 2160
2161=cut
2162
2163sub prepare_query_parameters {
2164 my $c = shift;
2165
2166 $c->engine->prepare_query_parameters( $c, @_ );
10f204e1 2167}
fbcc39ad 2168
10f204e1 2169=head2 $c->log_request
2170
2171Writes information about the request to the debug logs. This includes:
2172
2173=over 4
2174
854e5dcd 2175=item * Request method, path, and remote IP address
10f204e1 2176
2177=item * Query keywords (see L<Catalyst::Request/query_keywords>)
2178
e7cbe1bf 2179=item * Request parameters
10f204e1 2180
2181=item * File uploads
2182
2183=back
fbcc39ad 2184
2185=cut
2186
10f204e1 2187sub log_request {
2188 my $c = shift;
fbcc39ad 2189
10f204e1 2190 return unless $c->debug;
fbcc39ad 2191
2bf54936 2192 my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2193 my $request = $dump->[1];
e7cbe1bf 2194
2195 my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
10f204e1 2196 $method ||= '';
2197 $path = '/' unless length $path;
2198 $address ||= '';
2199 $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2200
3a4abdb3 2201 $c->log_request_headers($request->headers);
e7cbe1bf 2202
2203 if ( my $keywords = $request->query_keywords ) {
10f204e1 2204 $c->log->debug("Query keywords are: $keywords");
fbcc39ad 2205 }
10f204e1 2206
9c74923d 2207 $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
10f204e1 2208
e7cbe1bf 2209 $c->log_request_uploads($request);
fbcc39ad 2210}
2211
10f204e1 2212=head2 $c->log_response
fbcc39ad 2213
75b65816 2214Writes information about the response to the debug logs by calling
2215C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
fbcc39ad 2216
2217=cut
2218
75b65816 2219sub log_response {
2220 my $c = shift;
fbcc39ad 2221
75b65816 2222 return unless $c->debug;
fbcc39ad 2223
75b65816 2224 my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2225 my $response = $dump->[1];
2226
2227 $c->log_response_status_line($response);
2228 $c->log_response_headers($response->headers);
2229}
2230
2231=head2 $c->log_response_status_line($response)
2232
2233Writes one line of information about the response to the debug logs. This includes:
10f204e1 2234
2235=over 4
2236
2237=item * Response status code
2238
3a4abdb3 2239=item * Content-Type header (if present)
2240
2241=item * Content-Length header (if present)
10f204e1 2242
2243=back
fbcc39ad 2244
2245=cut
2246
75b65816 2247sub log_response_status_line {
2248 my ($c, $response) = @_;
fbcc39ad 2249
697bab77 2250 $c->log->debug(
2251 sprintf(
2252 'Response Code: %s; Content-Type: %s; Content-Length: %s',
2253 $response->status || 'unknown',
2254 $response->headers->header('Content-Type') || 'unknown',
2255 $response->headers->header('Content-Length') || 'unknown'
2256 )
2257 );
10f204e1 2258}
fbcc39ad 2259
75b65816 2260=head2 $c->log_response_headers($headers);
2261
8ad6fd58 2262Hook method which can be wrapped by plugins to log the response headers.
75b65816 2263No-op in the default implementation.
fbcc39ad 2264
2265=cut
2266
75b65816 2267sub log_response_headers {}
fbcc39ad 2268
10f204e1 2269=head2 $c->log_request_parameters( query => {}, body => {} )
2270
2271Logs request parameters to debug logs
2272
10f204e1 2273=cut
2274
2275sub log_request_parameters {
2276 my $c = shift;
2277 my %all_params = @_;
2278
2bf54936 2279 return unless $c->debug;
e7cbe1bf 2280
10f204e1 2281 my $column_width = Catalyst::Utils::term_width() - 44;
2282 foreach my $type (qw(query body)) {
2bf54936 2283 my $params = $all_params{$type};
2284 next if ! keys %$params;
10f204e1 2285 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
e7cbe1bf 2286 for my $key ( sort keys %$params ) {
2287 my $param = $params->{$key};
10f204e1 2288 my $value = defined($param) ? $param : '';
2289 $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2290 }
2291 $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2292 }
2293}
2294
2295=head2 $c->log_request_uploads
2296
2297Logs file uploads included in the request to the debug logs.
854e5dcd 2298The parameter name, filename, file type, and file size are all included in
10f204e1 2299the debug logs.
2300
2301=cut
fbcc39ad 2302
10f204e1 2303sub log_request_uploads {
2304 my $c = shift;
2bf54936 2305 my $request = shift;
e7cbe1bf 2306 return unless $c->debug;
2307 my $uploads = $request->uploads;
10f204e1 2308 if ( keys %$uploads ) {
8c113188 2309 my $t = Text::SimpleTable->new(
34d28dfd 2310 [ 12, 'Parameter' ],
2311 [ 26, 'Filename' ],
8c113188 2312 [ 18, 'Type' ],
2313 [ 9, 'Size' ]
2314 );
10f204e1 2315 for my $key ( sort keys %$uploads ) {
2316 my $upload = $uploads->{$key};
fbcc39ad 2317 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 2318 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 2319 }
2320 }
2321 $c->log->debug( "File Uploads are:\n" . $t->draw );
2322 }
2323}
2324
3a4abdb3 2325=head2 $c->log_request_headers($headers);
2326
2327Hook method which can be wrapped by plugins to log the request headers.
2328No-op in the default implementation.
2329
2330=cut
2331
2332sub log_request_headers {}
2333
10f204e1 2334=head2 $c->log_headers($type => $headers)
2335
e7cbe1bf 2336Logs L<HTTP::Headers> (either request or response) to the debug logs.
10f204e1 2337
2338=cut
2339
2340sub log_headers {
2341 my $c = shift;
2342 my $type = shift;
2343 my $headers = shift; # an HTTP::Headers instance
2344
e7cbe1bf 2345 return unless $c->debug;
10f204e1 2346
f0e9921a 2347 my $column_width = Catalyst::Utils::term_width() - 28;
2348 my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
e7cbe1bf 2349 $headers->scan(
10f204e1 2350 sub {
2351 my ( $name, $value ) = @_;
2352 $t->row( $name, $value );
2353 }
2354 );
2355 $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2356}
2357
10f204e1 2358
2359=head2 $c->prepare_read
2360
2361Prepares the input for reading.
2362
2363=cut
2364
2365sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2366
2367=head2 $c->prepare_request
2368
2369Prepares the engine request.
2370
2371=cut
2372
2373sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2374
2375=head2 $c->prepare_uploads
2376
2377Prepares uploads.
2378
2379=cut
2380
2381sub prepare_uploads {
2382 my $c = shift;
2383
2384 $c->engine->prepare_uploads( $c, @_ );
2385}
2386
b5ecfcf0 2387=head2 $c->prepare_write
fbcc39ad 2388
e7f1cf73 2389Prepares the output for writing.
fbcc39ad 2390
2391=cut
2392
2393sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2394
b5ecfcf0 2395=head2 $c->request_class
1f9cb7c1 2396
3f87d500 2397Returns or sets the request class. Defaults to L<Catalyst::Request>.
1f9cb7c1 2398
b5ecfcf0 2399=head2 $c->response_class
1f9cb7c1 2400
3f87d500 2401Returns or sets the response class. Defaults to L<Catalyst::Response>.
1f9cb7c1 2402
b5ecfcf0 2403=head2 $c->read( [$maxlength] )
fbcc39ad 2404
ae1e6b59 2405Reads a chunk of data from the request body. This method is designed to
2406be used in a while loop, reading C<$maxlength> bytes on every call.
2407C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 2408
4600a5a1 2409You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
ae1e6b59 2410directly.
fbcc39ad 2411
878b821c 2412Warning: If you use read(), Catalyst will not process the body,
2413so you will not be able to access POST parameters or file uploads via
2414$c->request. You must handle all body parsing yourself.
2415
fbcc39ad 2416=cut
2417
f083854e 2418sub read { my $c = shift; return $c->request->read( @_ ) }
fbcc39ad 2419
b5ecfcf0 2420=head2 $c->run
fbcc39ad 2421
2422Starts the engine.
2423
2424=cut
2425
0c6352ff 2426sub run {
2427 my $app = shift;
38e43e65 2428 $app->_make_immutable_if_needed;
0c6352ff 2429 $app->engine_loader->needs_psgi_engine_compat_hack ?
2430 $app->engine->run($app, @_) :
2431 $app->engine->run( $app, $app->_finalized_psgi_app, @_ );
2432}
fbcc39ad 2433
38e43e65 2434sub _make_immutable_if_needed {
2435 my $class = shift;
2436 my $meta = Class::MOP::get_metaclass_by_name($class);
2437 my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
2438 if (
2439 $meta->is_immutable
2440 && ! { $meta->immutable_options }->{replace_constructor}
2441 && $isa_ca
2442 ) {
2443 warn("You made your application class ($class) immutable, "
2444 . "but did not inline the\nconstructor. "
2445 . "This will break catalyst, as your app \@ISA "
2446 . "Class::Accessor(::Fast)?\nPlease pass "
2447 . "(replace_constructor => 1)\nwhen making your class immutable.\n");
2448 }
2449 unless ($meta->is_immutable) {
2450 # XXX - FIXME warning here as you should make your app immutable yourself.
2451 $meta->make_immutable(
2452 replace_constructor => 1,
2453 );
2454 }
2455}
2456
b5ecfcf0 2457=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 2458
e7f1cf73 2459Sets an action in a given namespace.
fbcc39ad 2460
2461=cut
2462
2463sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2464
b5ecfcf0 2465=head2 $c->setup_actions($component)
fbcc39ad 2466
e7f1cf73 2467Sets up actions for a component.
fbcc39ad 2468
2469=cut
2470
2471sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2472
b5ecfcf0 2473=head2 $c->setup_components
fbcc39ad 2474
d261d153 2475This method is called internally to set up the application's components.
fbcc39ad 2476
d261d153 2477It finds modules by calling the L<locate_components> method, expands them to
2478package names with the L<expand_component_module> method, and then installs
2479each component into the application.
2480
2481The C<setup_components> config option is passed to both of the above methods.
fbcc39ad 2482
d261d153 2483Installation of each component is performed by the L<setup_component> method,
2484below.
2f381252 2485
fbcc39ad 2486=cut
2487
2488sub setup_components {
2489 my $class = shift;
2490
18de900e 2491 my $config = $class->config->{ setup_components };
62a6df80 2492
69c6b6cb 2493 my @comps = $class->locate_components($config);
b94b200c 2494 my %comps = map { $_ => 1 } @comps;
73e1183e 2495
8f6cebb2 2496 my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
73e1183e 2497 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2498 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
8f6cebb2 2499 ) if $deprecatedcatalyst_component_names;
73e1183e 2500
b94b200c 2501 for my $component ( @comps ) {
dd91afb5 2502
2503 # We pass ignore_loaded here so that overlay files for (e.g.)
2504 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2505 # we know M::P::O found a file on disk so this is safe
2506
f5a4863c 2507 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
196f06d1 2508 }
2509
e7e4c469 2510 for my $component (@comps) {
5d02e790 2511 my $instance = $class->components->{ $component } = $class->setup_component($component);
2512 my @expanded_components = $instance->can('expand_modules')
2513 ? $instance->expand_modules( $component, $config )
2514 : $class->expand_component_module( $component, $config );
2515 for my $component (@expanded_components) {
05887b58 2516 next if $comps{$component};
e7e4c469 2517 $class->components->{ $component } = $class->setup_component($component);
fbcc39ad 2518 }
364d7324 2519 }
2520}
fbcc39ad 2521
d261d153 2522=head2 $c->locate_components( $setup_component_config )
2523
2524This method is meant to provide a list of component modules that should be
2525setup for the application. By default, it will use L<Module::Pluggable>.
2526
2527Specify a C<setup_components> config option to pass additional options directly
2528to L<Module::Pluggable>. To add additional search paths, specify a key named
2529C<search_extra> as an array reference. Items in the array beginning with C<::>
2530will have the application class name prepended to them.
2531
2532=cut
2533
2534sub locate_components {
2535 my $class = shift;
2536 my $config = shift;
2537
2538 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
2539 my $extra = delete $config->{ search_extra } || [];
2540
2541 push @paths, @$extra;
2542
2543 my $locator = Module::Pluggable::Object->new(
2544 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2545 %$config
2546 );
2547
69c6b6cb 2548 # XXX think about ditching this sort entirely
2549 my @comps = sort { length $a <=> length $b } $locator->plugins;
d261d153 2550
2551 return @comps;
2552}
2553
2554=head2 $c->expand_component_module( $component, $setup_component_config )
2555
2556Components found by C<locate_components> will be passed to this method, which
2557is expected to return a list of component (package) names to be set up.
2558
d261d153 2559=cut
2560
2561sub expand_component_module {
2562 my ($class, $module) = @_;
05887b58 2563 return Devel::InnerPackage::list_packages( $module );
d261d153 2564}
2565
364d7324 2566=head2 $c->setup_component
fbcc39ad 2567
364d7324 2568=cut
fbcc39ad 2569
364d7324 2570sub setup_component {
2571 my( $class, $component ) = @_;
fbcc39ad 2572
364d7324 2573 unless ( $component->can( 'COMPONENT' ) ) {
2574 return $component;
2575 }
fbcc39ad 2576
364d7324 2577 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2578 my $config = $class->config->{ $suffix } || {};
8f6cebb2 2579 # Stash catalyst_component_name in the config here, so that custom COMPONENT
d2598ac8 2580 # methods also pass it. local to avoid pointlessly shitting in config
2581 # for the debug screen, as $component is already the key name.
8f6cebb2 2582 local $config->{catalyst_component_name} = $component;
fbcc39ad 2583
364d7324 2584 my $instance = eval { $component->COMPONENT( $class, $config ); };
fbcc39ad 2585
2586 if ( my $error = $@ ) {
fbcc39ad 2587 chomp $error;
fbcc39ad 2588 Catalyst::Exception->throw(
364d7324 2589 message => qq/Couldn't instantiate component "$component", "$error"/
2590 );
fbcc39ad 2591 }
2592
7490de2a 2593 unless (blessed $instance) {
2594 my $metaclass = Moose::Util::find_meta($component);
2595 my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2596 my $component_method_from = $method_meta->associated_metaclass->name;
637fa644 2597 my $value = defined($instance) ? $instance : 'undef';
7490de2a 2598 Catalyst::Exception->throw(
2599 message =>
637fa644 2600 qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
7490de2a 2601 );
2602 }
364d7324 2603 return $instance;
fbcc39ad 2604}
2605
b5ecfcf0 2606=head2 $c->setup_dispatcher
fbcc39ad 2607
ae1e6b59 2608Sets up dispatcher.
2609
fbcc39ad 2610=cut
2611
2612sub setup_dispatcher {
2613 my ( $class, $dispatcher ) = @_;
2614
2615 if ($dispatcher) {
2616 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2617 }
2618
cb69249e 2619 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2620 $dispatcher = 'Catalyst::Dispatcher::' . $env;
fbcc39ad 2621 }
2622
2623 unless ($dispatcher) {
cb0354c6 2624 $dispatcher = $class->dispatcher_class;
fbcc39ad 2625 }
2626
e63bdf38 2627 Class::MOP::load_class($dispatcher);
fbcc39ad 2628
2629 # dispatcher instance
2630 $class->dispatcher( $dispatcher->new );
2631}
2632
b5ecfcf0 2633=head2 $c->setup_engine
fbcc39ad 2634
ae1e6b59 2635Sets up engine.
2636
fbcc39ad 2637=cut
2638
1e5dad00 2639sub engine_class {
a8153308 2640 my ($class, $requested_engine) = @_;
2641
2642 if (!$class->engine_loader || $requested_engine) {
2643 $class->engine_loader(
2644 Catalyst::EngineLoader->new({
2645 application_name => $class,
2646 (defined $requested_engine
65420d46 2647 ? (catalyst_engine_class => $requested_engine) : ()),
a8153308 2648 }),
2649 );
2650 }
65420d46 2651
8ee06de7 2652 $class->engine_loader->catalyst_engine_class;
1e5dad00 2653}
2654
fbcc39ad 2655sub setup_engine {
a26a6adb 2656 my ($class, $requested_engine) = @_;
1085c936 2657
65420d46 2658 my $engine = do {
2659 my $loader = $class->engine_loader;
2660
2661 if (!$loader || $requested_engine) {
2662 $loader = Catalyst::EngineLoader->new({
2663 application_name => $class,
2664 (defined $requested_engine
2665 ? (requested_engine => $requested_engine) : ()),
2666 }),
2667
2668 $class->engine_loader($loader);
2669 }
2670
2671 $loader->catalyst_engine_class;
2672 };
1e5dad00 2673
2e1f92a3 2674 # Don't really setup_engine -- see _setup_psgi_app for explanation.
2675 return if $class->loading_psgi_file;
2676
e63bdf38 2677 Class::MOP::load_class($engine);
0e7f5826 2678
532f0516 2679 if ($ENV{MOD_PERL}) {
1e5dad00 2680 my $apache = $class->engine_loader->auto;
ab4df9f8 2681
2682 my $meta = find_meta($class);
2683 my $was_immutable = $meta->is_immutable;
2684 my %immutable_options = $meta->immutable_options;
2685 $meta->make_mutable if $was_immutable;
2686
2687 $meta->add_method(handler => sub {
9fe15721 2688 my $r = shift;
c7250231 2689 my $psgi_app = $class->_finalized_psgi_app;
1e5dad00 2690 $apache->call_app($r, $psgi_app);
9fe15721 2691 });
ab4df9f8 2692
2693 $meta->make_immutable(%immutable_options) if $was_immutable;
532f0516 2694 }
2695
fbcc39ad 2696 $class->engine( $engine->new );
9fe15721 2697
fcffcb05 2698 return;
2699}
2700
8f076801 2701sub _finalized_psgi_app {
c8f4781e 2702 my ($app) = @_;
a0eec1fb 2703
2704 unless ($app->_psgi_app) {
8f076801 2705 my $psgi_app = $app->_setup_psgi_app;
a0eec1fb 2706 $app->_psgi_app($psgi_app);
2707 }
2708
2709 return $app->_psgi_app;
c8f4781e 2710}
2711
8f076801 2712sub _setup_psgi_app {
fcffcb05 2713 my ($app) = @_;
2714
1085c936 2715 for my $home (Path::Class::Dir->new($app->config->{home})) {
fcffcb05 2716 my $psgi_file = $home->file(
2717 Catalyst::Utils::appprefix($app) . '.psgi',
2718 );
2719
1085c936 2720 next unless -e $psgi_file;
2e1f92a3 2721
2722 # If $psgi_file calls ->setup_engine, it's doing so to load
2723 # Catalyst::Engine::PSGI. But if it does that, we're only going to
2724 # throw away the loaded PSGI-app and load the 5.9 Catalyst::Engine
2725 # anyway. So set a flag (ick) that tells setup_engine not to populate
2726 # $c->engine or do any other things we might regret.
2727
2728 $app->loading_psgi_file(1);
1085c936 2729 my $psgi_app = Plack::Util::load_psgi($psgi_file);
2e1f92a3 2730 $app->loading_psgi_file(0);
1085c936 2731
2732 return $psgi_app
2733 unless $app->engine_loader->needs_psgi_engine_compat_hack;
2734
1085c936 2735 warn <<"EOW";
2736Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}.
2737
2738Its content has been ignored. Please consult the Catalyst::Upgrading
2739documentation on how to upgrade from Catalyst::Engine::PSGI.
2740EOW
fcffcb05 2741 }
2742
f05b654b 2743 return $app->apply_default_middlewares($app->psgi_app);
8f076801 2744}
2745
1316cc64 2746=head2 $c->apply_default_middlewares
2747
2748Adds the following L<Plack> middlewares to your application, since they are
2749useful and commonly needed:
2750
2751L<Plack::Middleware::ReverseProxy>, (conditionally added based on the status
2752of your $ENV{REMOTE_ADDR}, and can be forced on with C<using_frontend_proxy>
2753or forced off with C<ignore_frontend_proxy>), L<Plack::Middleware::LighttpdScriptNameFix>
2754(if you are using Lighttpd), L<Plack::Middleware::IIS6ScriptNameFix> (always
2755applied since this middleware is smart enough to conditionally apply itself).
2756
2757Additionally if we detect we are using Nginx, we add a bit of custom middleware
2758to solve some problems with the way that server handles $ENV{PATH_INFO} and
2759$ENV{SCRIPT_NAME}
2760
2761=cut
2762
f05b654b 2763
2764sub apply_default_middlewares {
c72bc6eb 2765 my ($app, $psgi_app) = @_;
8f076801 2766
d89b863e 2767 $psgi_app = Plack::Middleware::Conditional->wrap(
c72bc6eb 2768 $psgi_app,
fcffcb05 2769 builder => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) },
2770 condition => sub {
2771 my ($env) = @_;
2772