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