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