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