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