win32 compatibility patch for live_engine_request_env.t
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
CommitLineData
fc7ec1d9 1package Catalyst;
2
a7caa492 3use Moose;
c98492ae 4use Moose::Meta::Class ();
60eabdaf 5extends 'Catalyst::Component';
2f5cb070 6use Moose::Util qw/find_meta/;
fbcc39ad 7use bytes;
acca8cd5 8use B::Hooks::EndOfScope ();
a2f2cde9 9use Catalyst::Exception;
fc7ec1d9 10use Catalyst::Log;
fbcc39ad 11use Catalyst::Request;
12use Catalyst::Request::Upload;
13use Catalyst::Response;
812a28c9 14use Catalyst::Utils;
31375184 15use Catalyst::Controller;
364d7324 16use Devel::InnerPackage ();
8f62c91a 17use File::stat;
c50f595c 18use Module::Pluggable::Object ();
c50f595c 19use Text::SimpleTable ();
20use Path::Class::Dir ();
21use Path::Class::File ();
c50f595c 22use URI ();
933ba403 23use URI::http;
24use URI::https;
5513038d 25use Tree::Simple qw/use_weak_refs/;
26use Tree::Simple::Visitor::FindByUID;
269408a4 27use Class::C3::Adopt::NEXT;
261c571e 28use attributes;
5789a3d8 29use utf8;
108201b5 30use Carp qw/croak carp shortmess/;
fc7ec1d9 31
f63c03e4 32BEGIN { require 5.008001; }
33
8a440eba 34has stack => (is => 'ro', default => sub { [] });
6680c772 35has stash => (is => 'rw', default => sub { {} });
36has state => (is => 'rw', default => 0);
b6d4ee6e 37has stats => (is => 'rw');
38has action => (is => 'rw');
6680c772 39has counter => (is => 'rw', default => sub { {} });
40has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
41has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
e63bdf38 42has namespace => (is => 'rw');
43
8767c5a3 44sub depth { scalar @{ shift->stack || [] }; }
0fc2d522 45sub comp { shift->component(@_) }
6680c772 46
47sub req {
6680c772 48 my $self = shift; return $self->request(@_);
49}
50sub res {
6680c772 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
62a6df80 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
92435154 79our $VERSION = '5.80004';
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
62a6df80 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
62a6df80 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
62a6df80 155 # do something else after forward returns
0ef52a96 156 }
157 }
62a6df80 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 %]
62a6df80 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
62a6df80 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 }
62a6df80 176
ae1e6b59 177 # called after all actions are finished
62a6df80 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 { ... }
62a6df80 188
5400c668 189 # called for /blargle
190 sub blargle : Global { ... }
62a6df80 191
5400c668 192 # an index action matches /foo, but not /foo/1, etc.
193 sub index : Private { ... }
62a6df80 194
0ef52a96 195 ### in MyApp/Controller/Foo/Bar.pm
196 # called for /foo/bar/baz
197 sub baz : Local { ... }
62a6df80 198
b4b01a8a 199 # first Root auto is called, then Foo auto, then this
0ef52a96 200 sub auto : Private { ... }
62a6df80 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';
62a6df80 274
0fa676a7 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
62a6df80 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
62a6df80 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
62a6df80 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];
e260802a 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
62a6df80 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 }
62a6df80 572
2f381252 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
62a6df80 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) {
62a6df80 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
62a6df80 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) {
62a6df80 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,
62a6df80 818followed by configuration in your top level C<MyApp> class. These two
a51d14ff 819configurations are merged, and then configuration data whose hash key matches a
b3542016 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' });
62a6df80 829
830will mean that C<MyApp::Model::Foo> receives the following data when
b3542016 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
62a6df80 877=item By calling myapp_server.pl with the -d flag
878
7e5c67f2 879=item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
880
881=item The -Debug option in your MyApp.pm
882
8eae92ad 883=item By declaring C<sub debug { 1 }> in your MyApp.pm.
7e5c67f2 884
885=back
c74d3f0c 886
8eae92ad 887Calling C<< $c->debug(1) >> has no effect.
e80e8542 888
af3ff00e 889=cut
890
b4b01a8a 891sub debug { 0 }
892
893=head2 $c->dispatcher
894
2887a7f1 895Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
b4b01a8a 896
897=head2 $c->engine
898
2887a7f1 899Returns the engine instance. See L<Catalyst::Engine>.
b4b01a8a 900
901
f7b672ef 902=head2 UTILITY METHODS
66e28e3f 903
b5ecfcf0 904=head2 $c->path_to(@path)
01033d73 905
cc95842f 906Merges C<@path> with C<< $c->config->{home} >> and returns a
afbb9aa3 907L<Path::Class::Dir> object.
01033d73 908
909For example:
910
911 $c->path_to( 'db', 'sqlite.db' );
912
913=cut
914
915sub path_to {
916 my ( $c, @path ) = @_;
a738ab68 917 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
01033d73 918 if ( -d $path ) { return $path }
a738ab68 919 else { return Path::Class::File->new( $c->config->{home}, @path ) }
01033d73 920}
921
b5ecfcf0 922=head2 $c->plugin( $name, $class, @args )
0ef52a96 923
10011c19 924Helper method for plugins. It creates a class data accessor/mutator and
ae1e6b59 925loads and instantiates the given class.
0ef52a96 926
927 MyApp->plugin( 'prototype', 'HTML::Prototype' );
928
929 $c->prototype->define_javascript_functions;
4e68badc 930
6b2a933b 931B<Note:> This method of adding plugins is deprecated. The ability
4e68badc 932to add plugins like this B<will be removed> in a Catalyst 5.81.
6b2a933b 933Please do not use this functionality in new code.
0ef52a96 934
935=cut
936
937sub plugin {
938 my ( $class, $name, $plugin, @args ) = @_;
6b2a933b 939
4e68badc 940 # See block comment in t/unit_core_plugin.t
b3542016 941 $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
4e68badc 942
97b58e17 943 $class->_register_plugin( $plugin, 1 );
0ef52a96 944
945 eval { $plugin->import };
946 $class->mk_classdata($name);
947 my $obj;
948 eval { $obj = $plugin->new(@args) };
949
950 if ($@) {
951 Catalyst::Exception->throw( message =>
952 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
953 }
954
955 $class->$name($obj);
956 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
957 if $class->debug;
958}
959
b5ecfcf0 960=head2 MyApp->setup
fbcc39ad 961
e7f1cf73 962Initializes the dispatcher and engine, loads any plugins, and loads the
ae1e6b59 963model, view, and controller components. You may also specify an array
964of plugins to load here, if you choose to not load them in the C<use
965Catalyst> line.
fbcc39ad 966
0ef52a96 967 MyApp->setup;
968 MyApp->setup( qw/-Debug/ );
fbcc39ad 969
970=cut
971
972sub setup {
0319a12c 973 my ( $class, @arguments ) = @_;
c2f3cc1b 974 croak('Running setup more than once')
975 if ( $class->setup_finished );
5168a5fc 976
fbcc39ad 977 unless ( $class->isa('Catalyst') ) {
953b0e15 978
fbcc39ad 979 Catalyst::Exception->throw(
980 message => qq/'$class' does not inherit from Catalyst/ );
1c99e125 981 }
0319a12c 982
fbcc39ad 983 if ( $class->arguments ) {
984 @arguments = ( @arguments, @{ $class->arguments } );
985 }
986
987 # Process options
988 my $flags = {};
989
990 foreach (@arguments) {
991
992 if (/^-Debug$/) {
993 $flags->{log} =
994 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
995 }
996 elsif (/^-(\w+)=?(.*)$/) {
997 $flags->{ lc $1 } = $2;
998 }
999 else {
1000 push @{ $flags->{plugins} }, $_;
1001 }
1002 }
1003
99f187d6 1004 $class->setup_home( delete $flags->{home} );
1005
fbcc39ad 1006 $class->setup_log( delete $flags->{log} );
1007 $class->setup_plugins( delete $flags->{plugins} );
1008 $class->setup_dispatcher( delete $flags->{dispatcher} );
1009 $class->setup_engine( delete $flags->{engine} );
dc5f035e 1010 $class->setup_stats( delete $flags->{stats} );
fbcc39ad 1011
1012 for my $flag ( sort keys %{$flags} ) {
1013
1014 if ( my $code = $class->can( 'setup_' . $flag ) ) {
1015 &$code( $class, delete $flags->{$flag} );
1016 }
1017 else {
1018 $class->log->warn(qq/Unknown flag "$flag"/);
1019 }
1020 }
1021
0eb4af72 1022 eval { require Catalyst::Devel; };
1023 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1024 $class->log->warn(<<"EOF");
4ff0d824 1025You are running an old script!
1026
34a83d89 1027 Please update by running (this will overwrite existing files):
1028 catalyst.pl -force -scripts $class
1029
1030 or (this will not overwrite existing files):
1031 catalyst.pl -scripts $class
1cf0345b 1032
4ff0d824 1033EOF
0eb4af72 1034 }
62a6df80 1035
fbcc39ad 1036 if ( $class->debug ) {
6601f2ad 1037 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
fbcc39ad 1038
1039 if (@plugins) {
39fc2ce1 1040 my $column_width = Catalyst::Utils::term_width() - 6;
1041 my $t = Text::SimpleTable->new($column_width);
8c113188 1042 $t->row($_) for @plugins;
1cf0345b 1043 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
fbcc39ad 1044 }
1045
1046 my $dispatcher = $class->dispatcher;
1047 my $engine = $class->engine;
1048 my $home = $class->config->{home};
1049
01ce7075 1050 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1051 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
fbcc39ad 1052
1053 $home
1054 ? ( -d $home )
1055 ? $class->log->debug(qq/Found home "$home"/)
1056 : $class->log->debug(qq/Home "$home" doesn't exist/)
1057 : $class->log->debug(q/Couldn't find home/);
1058 }
1059
54f4bfef 1060 # Call plugins setup, this is stupid and evil.
16b7c476 1061 # Also screws C3 badly on 5.10, hack to avoid.
fbcc39ad 1062 {
1063 no warnings qw/redefine/;
1064 local *setup = sub { };
16b7c476 1065 $class->setup unless $Catalyst::__AM_RESTARTING;
fbcc39ad 1066 }
1067
1068 # Initialize our data structure
1069 $class->components( {} );
1070
1071 $class->setup_components;
1072
1073 if ( $class->debug ) {
39fc2ce1 1074 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1075 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
684d10ed 1076 for my $comp ( sort keys %{ $class->components } ) {
1077 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1078 $t->row( $comp, $type );
1079 }
1cf0345b 1080 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
8c113188 1081 if ( keys %{ $class->components } );
fbcc39ad 1082 }
1083
1084 # Add our self to components, since we are also a component
96d8d513 1085 if( $class->isa('Catalyst::Controller') ){
1086 $class->components->{$class} = $class;
1087 }
fbcc39ad 1088
1089 $class->setup_actions;
1090
1091 if ( $class->debug ) {
1092 my $name = $class->config->{name} || 'Application';
1093 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1094 }
1095 $class->log->_flush() if $class->log->can('_flush');
3643e890 1096
62a6df80 1097 # Make sure that the application class becomes immutable at this point,
1098 # which ensures that it gets an inlined constructor. This means that it
3d041c32 1099 # works even if the user has added a plugin which contains a new method.
1100 # Note however that we have to do the work on scope end, so that method
62a6df80 1101 # modifiers work correctly in MyApp (as you have to call setup _before_
3d041c32 1102 # applying modifiers).
acca8cd5 1103 B::Hooks::EndOfScope::on_scope_end {
df861f8e 1104 return if $@;
e106a59f 1105 my $meta = Class::MOP::get_metaclass_by_name($class);
6e5505d4 1106 if ( $meta->is_immutable && ! { $meta->immutable_options }->{inline_constructor} ) {
81ef9afd 1107 warn "You made your application class ($class) immutable, "
6e5505d4 1108 . "but did not inline the constructor.\n"
1109 . "This will break catalyst, please pass "
1110 . "(replace_constructor => 1) when making your class immutable.\n";
1111 }
05d79b22 1112 $meta->make_immutable(replace_constructor => 1) unless $meta->is_immutable;
acca8cd5 1113 };
3d041c32 1114
a5d07d29 1115 $class->setup_finalize;
1116}
1117
23c63a17 1118
1119=head2 $app->setup_finalize
1120
1121A hook to attach modifiers to.
4bc471c9 1122Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup.
23c63a17 1123Also better than C< setup_finished(); >, as that is a getter method.
1124
1125 sub setup_finalize {
1126
1127 my $app = shift;
1128
1129 ## do stuff, i.e., determine a primary key column for sessions stored in a DB
1130
1131 $app->next::method(@_);
1132
1133
1134 }
1135
1136=cut
1137
a5d07d29 1138sub setup_finalize {
1139 my ($class) = @_;
3643e890 1140 $class->setup_finished(1);
fbcc39ad 1141}
1142
8a27f860 1143=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1144
73664287 1145=head2 $c->uri_for( $path, @args?, \%query_values? )
fbcc39ad 1146
8a27f860 1147=over
fbcc39ad 1148
8a27f860 1149=item $action
8dc69021 1150
8a27f860 1151A Catalyst::Action object representing the Catalyst action you want to
1152create a URI for. To get one for an action in the current controller,
1153use C<< $c->action('someactionname') >>. To get one from different
1154controller, fetch the controller using C<< $c->controller() >>, then
1155call C<action_for> on it.
ea0e58d9 1156
9df7c5d9 1157You can maintain the arguments captured by an action (e.g.: Regex, Chained)
62a6df80 1158using C<< $c->req->captures >>.
9df7c5d9 1159
1160 # For the current action
1161 $c->uri_for($c->action, $c->req->captures);
62a6df80 1162
9df7c5d9 1163 # For the Foo action in the Bar controller
1164 $c->uri_for($c->controller->('Bar')->action_for('Foo'), $c->req->captures);
1165
d5e3d528 1166=back
1167
4cf1dd00 1168=cut
1169
fbcc39ad 1170sub uri_for {
00e6a2b7 1171 my ( $c, $path, @args ) = @_;
00e6a2b7 1172
7e95ba12 1173 if ( blessed($path) ) { # action object
ea0e58d9 1174 my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
1175 ? shift(@args)
1176 : [] );
aa7e913e 1177 my $action = $path;
1178 $path = $c->dispatcher->uri_for_action($action, $captures);
1179 if (not defined $path) {
1180 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1181 if $c->debug;
1182 return undef;
1183 }
81e75875 1184 $path = '/' if $path eq '';
ea0e58d9 1185 }
1186
51674a63 1187 undef($path) if (defined $path && $path eq '');
00e6a2b7 1188
97b58e17 1189 my $params =
1190 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
8327e2e2 1191
cbb93105 1192 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
6ab73369 1193 s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go for @args;
51674a63 1194
1195 unshift(@args, $path);
1196
1197 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1198 my $namespace = $c->namespace;
1199 if (defined $path) { # cheesy hack to handle path '../foo'
1200 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 1201 }
51674a63 1202 unshift(@args, $namespace || '');
1203 }
62a6df80 1204
189e2a51 1205 # join args with '/', or a blank string
51674a63 1206 my $args = join('/', grep { defined($_) } @args);
1207 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
7a2295bc 1208 $args =~ s!^/+!!;
51674a63 1209 my $base = $c->req->base;
1210 my $class = ref($base);
1211 $base =~ s{(?<!/)$}{/};
1212
1213 my $query = '';
1214
1215 if (my @keys = keys %$params) {
1216 # somewhat lifted from URI::_query's query_form
1217 $query = '?'.join('&', map {
2f381252 1218 my $val = $params->{$_};
51674a63 1219 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1220 s/ /+/g;
1221 my $key = $_;
51674a63 1222 $val = '' unless defined $val;
1223 (map {
1224 $_ = "$_";
0ce485e9 1225 utf8::encode( $_ ) if utf8::is_utf8($_);
51674a63 1226 # using the URI::Escape pattern here so utf8 chars survive
6ab73369 1227 s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go;
51674a63 1228 s/ /+/g;
1229 "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1230 } @keys);
1231 }
1232
1233 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1234 $res;
fbcc39ad 1235}
1236
833b385e 1237=head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
1238
1239=head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
1240
1241=over
1242
1243=item $path
1244
1245A private path to the Catalyst action you want to create a URI for.
1246
1247This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1248>> and passing the resulting C<$action> and the remaining arguments to C<<
1249$c->uri_for >>.
1250
1251You can also pass in a Catalyst::Action object, in which case it is passed to
1252C<< $c->uri_for >>.
1253
1254=back
1255
1256=cut
1257
1258sub uri_for_action {
1259 my ( $c, $path, @args ) = @_;
62a6df80 1260 my $action = blessed($path)
1261 ? $path
833b385e 1262 : $c->dispatcher->get_action_by_path($path);
4ac0b9cb 1263 unless (defined $action) {
1264 croak "Can't find action for path '$path'";
1265 }
833b385e 1266 return $c->uri_for( $action, @args );
1267}
1268
b5ecfcf0 1269=head2 $c->welcome_message
ab2374d3 1270
1271Returns the Catalyst welcome HTML page.
1272
1273=cut
1274
1275sub welcome_message {
bf1f2c60 1276 my $c = shift;
1277 my $name = $c->config->{name};
1278 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1279 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1280 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1281 return <<"EOF";
80cdbbff 1282<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1283 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1284<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1285 <head>
85d9fce6 1286 <meta http-equiv="Content-Language" content="en" />
1287 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1288 <title>$name on Catalyst $VERSION</title>
1289 <style type="text/css">
1290 body {
ab2374d3 1291 color: #000;
1292 background-color: #eee;
1293 }
1294 div#content {
1295 width: 640px;
80cdbbff 1296 margin-left: auto;
1297 margin-right: auto;
ab2374d3 1298 margin-top: 10px;
1299 margin-bottom: 10px;
1300 text-align: left;
1301 background-color: #ccc;
1302 border: 1px solid #aaa;
ab2374d3 1303 }
d84c4dab 1304 p, h1, h2 {
ab2374d3 1305 margin-left: 20px;
1306 margin-right: 20px;
16215972 1307 font-family: verdana, tahoma, sans-serif;
ab2374d3 1308 }
d84c4dab 1309 a {
1310 font-family: verdana, tahoma, sans-serif;
1311 }
d114e033 1312 :link, :visited {
1313 text-decoration: none;
1314 color: #b00;
1315 border-bottom: 1px dotted #bbb;
1316 }
1317 :link:hover, :visited:hover {
d114e033 1318 color: #555;
1319 }
ab2374d3 1320 div#topbar {
1321 margin: 0px;
1322 }
3e82a295 1323 pre {
3e82a295 1324 margin: 10px;
1325 padding: 8px;
1326 }
ab2374d3 1327 div#answers {
1328 padding: 8px;
1329 margin: 10px;
d114e033 1330 background-color: #fff;
ab2374d3 1331 border: 1px solid #aaa;
ab2374d3 1332 }
1333 h1 {
33108eaf 1334 font-size: 0.9em;
1335 font-weight: normal;
ab2374d3 1336 text-align: center;
1337 }
1338 h2 {
1339 font-size: 1.0em;
1340 }
1341 p {
1342 font-size: 0.9em;
1343 }
ae7c5252 1344 p img {
1345 float: right;
1346 margin-left: 10px;
1347 }
9619f23c 1348 span#appname {
1349 font-weight: bold;
33108eaf 1350 font-size: 1.6em;
ab2374d3 1351 }
1352 </style>
1353 </head>
1354 <body>
1355 <div id="content">
1356 <div id="topbar">
9619f23c 1357 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1358 $VERSION</h1>
ab2374d3 1359 </div>
1360 <div id="answers">
ae7c5252 1361 <p>
80cdbbff 1362 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1363 </p>
596aaffe 1364 <p>Welcome to the world of Catalyst.
f92fd545 1365 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1366 framework will make web development something you had
60dd6e1d 1367 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1368 <h2>What to do now?</h2>
4b8cb778 1369 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1370 We do, however, provide you with a few starting points.</p>
1371 <p>If you want to jump right into web development with Catalyst
2f381252 1372 you might want to start with a tutorial.</p>
b607f8a0 1373<pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
596aaffe 1374</pre>
1375<p>Afterwards you can go on to check out a more complete look at our features.</p>
1376<pre>
b607f8a0 1377<code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1378<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1379</code></pre>
ab2374d3 1380 <h2>What to do next?</h2>
f5681c92 1381 <p>Next it's time to write an actual application. Use the
80cdbbff 1382 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
60dd6e1d 1383 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1384 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
bf1f2c60 1385 they can save you a lot of work.</p>
1386 <pre><code>script/${prefix}_create.pl -help</code></pre>
1387 <p>Also, be sure to check out the vast and growing
802bf2cb 1388 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
bf1f2c60 1389 you are likely to find what you need there.
f5681c92 1390 </p>
1391
82245cc4 1392 <h2>Need help?</h2>
f5681c92 1393 <p>Catalyst has a very active community. Here are the main places to
1394 get in touch with us.</p>
16215972 1395 <ul>
1396 <li>
2b9a7d76 1397 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1398 </li>
1399 <li>
6d4c3368 1400 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1401 </li>
1402 <li>
4eaf7c88 1403 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1404 </li>
1405 </ul>
ab2374d3 1406 <h2>In conclusion</h2>
62a6df80 1407 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1408 as we enjoyed making it. Please contact us if you have ideas
1409 for improvement or other feedback.</p>
ab2374d3 1410 </div>
1411 </div>
1412 </body>
1413</html>
1414EOF
1415}
1416
fbcc39ad 1417=head1 INTERNAL METHODS
1418
ae1e6b59 1419These methods are not meant to be used by end users.
1420
b5ecfcf0 1421=head2 $c->components
fbcc39ad 1422
e7f1cf73 1423Returns a hash of components.
fbcc39ad 1424
b5ecfcf0 1425=head2 $c->context_class
1f9cb7c1 1426
e7f1cf73 1427Returns or sets the context class.
1f9cb7c1 1428
b5ecfcf0 1429=head2 $c->counter
fbcc39ad 1430
ae1e6b59 1431Returns a hashref containing coderefs and execution counts (needed for
1432deep recursion detection).
fbcc39ad 1433
b5ecfcf0 1434=head2 $c->depth
fbcc39ad 1435
e7f1cf73 1436Returns the number of actions on the current internal execution stack.
fbcc39ad 1437
b5ecfcf0 1438=head2 $c->dispatch
fbcc39ad 1439
e7f1cf73 1440Dispatches a request to actions.
fbcc39ad 1441
1442=cut
1443
1444sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1445
b5ecfcf0 1446=head2 $c->dispatcher_class
1f9cb7c1 1447
e7f1cf73 1448Returns or sets the dispatcher class.
1f9cb7c1 1449
b5ecfcf0 1450=head2 $c->dump_these
7f92deef 1451
ae1e6b59 1452Returns a list of 2-element array references (name, structure) pairs
1453that will be dumped on the error page in debug mode.
7f92deef 1454
1455=cut
1456
1457sub dump_these {
1458 my $c = shift;
62a6df80 1459 [ Request => $c->req ],
1460 [ Response => $c->res ],
052a2d89 1461 [ Stash => $c->stash ],
1462 [ Config => $c->config ];
7f92deef 1463}
1464
b5ecfcf0 1465=head2 $c->engine_class
1f9cb7c1 1466
e7f1cf73 1467Returns or sets the engine class.
1f9cb7c1 1468
b5ecfcf0 1469=head2 $c->execute( $class, $coderef )
fbcc39ad 1470
0ef52a96 1471Execute a coderef in given class and catch exceptions. Errors are available
1472via $c->error.
fbcc39ad 1473
1474=cut
1475
1476sub execute {
1477 my ( $c, $class, $code ) = @_;
858828dd 1478 $class = $c->component($class) || $class;
fbcc39ad 1479 $c->state(0);
a0eca838 1480
197bd788 1481 if ( $c->depth >= $RECURSION ) {
f3414019 1482 my $action = $code->reverse();
91d08727 1483 $action = "/$action" unless $action =~ /->/;
f3414019 1484 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 1485 $c->log->error($error);
1486 $c->error($error);
1487 $c->state(0);
1488 return $c->state;
1489 }
1490
dc5f035e 1491 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 1492
8767c5a3 1493 push( @{ $c->stack }, $code );
62a6df80 1494
6f3df815 1495 no warnings 'recursion';
f3414019 1496 eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
22247e54 1497
dc5f035e 1498 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
62a6df80 1499
a6724a82 1500 my $last = pop( @{ $c->stack } );
fbcc39ad 1501
1502 if ( my $error = $@ ) {
2f381252 1503 if ( !ref($error) and $error eq $DETACH ) {
1504 die $DETACH if($c->depth > 1);
1505 }
55424863 1506 elsif ( !ref($error) and $error eq $GO ) {
1507 die $GO if($c->depth > 0);
1508 }
fbcc39ad 1509 else {
1510 unless ( ref $error ) {
91d08727 1511 no warnings 'uninitialized';
fbcc39ad 1512 chomp $error;
f59def82 1513 my $class = $last->class;
1514 my $name = $last->name;
1515 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 1516 }
fbcc39ad 1517 $c->error($error);
1518 $c->state(0);
1519 }
1520 }
1521 return $c->state;
1522}
1523
7a7d7af5 1524sub _stats_start_execute {
1525 my ( $c, $code ) = @_;
1526
a6724a82 1527 return if ( ( $code->name =~ /^_.*/ )
1528 && ( !$c->config->{show_internal_actions} ) );
7a7d7af5 1529
f3414019 1530 my $action_name = $code->reverse();
1531 $c->counter->{$action_name}++;
7a7d7af5 1532
f3414019 1533 my $action = $action_name;
a6724a82 1534 $action = "/$action" unless $action =~ /->/;
1535
7a7d7af5 1536 # determine if the call was the result of a forward
1537 # this is done by walking up the call stack and looking for a calling
1538 # sub of Catalyst::forward before the eval
1539 my $callsub = q{};
1540 for my $index ( 2 .. 11 ) {
1541 last
1542 if ( ( caller($index) )[0] eq 'Catalyst'
1543 && ( caller($index) )[3] eq '(eval)' );
1544
1545 if ( ( caller($index) )[3] =~ /forward$/ ) {
1546 $callsub = ( caller($index) )[3];
1547 $action = "-> $action";
1548 last;
1549 }
1550 }
1551
f3414019 1552 my $uid = $action_name . $c->counter->{$action_name};
74efc144 1553
a6724a82 1554 # is this a root-level call or a forwarded call?
1555 if ( $callsub =~ /forward$/ ) {
1556
1557 # forward, locate the caller
1558 if ( my $parent = $c->stack->[-1] ) {
69d8f33c 1559 $c->stats->profile(
62a6df80 1560 begin => $action,
69d8f33c 1561 parent => "$parent" . $c->counter->{"$parent"},
1562 uid => $uid,
1563 );
7a7d7af5 1564 }
1565 else {
1566
a6724a82 1567 # forward with no caller may come from a plugin
69d8f33c 1568 $c->stats->profile(
1569 begin => $action,
1570 uid => $uid,
1571 );
7a7d7af5 1572 }
1573 }
a6724a82 1574 else {
62a6df80 1575
a6724a82 1576 # root-level call
69d8f33c 1577 $c->stats->profile(
1578 begin => $action,
1579 uid => $uid,
1580 );
a6724a82 1581 }
dc5f035e 1582 return $action;
7a7d7af5 1583
7a7d7af5 1584}
1585
1586sub _stats_finish_execute {
1587 my ( $c, $info ) = @_;
69d8f33c 1588 $c->stats->profile( end => $info );
7a7d7af5 1589}
1590
3d0d6d21 1591=head2 $c->_localize_fields( sub { }, \%keys );
1592
1593=cut
1594
e63bdf38 1595#Why does this exist? This is no longer safe and WILL NOT WORK.
1596# it doesnt seem to be used anywhere. can we remove it?
3d0d6d21 1597sub _localize_fields {
1598 my ( $c, $localized, $code ) = ( @_ );
1599
1600 my $request = delete $localized->{request} || {};
1601 my $response = delete $localized->{response} || {};
62a6df80 1602
3d0d6d21 1603 local @{ $c }{ keys %$localized } = values %$localized;
1604 local @{ $c->request }{ keys %$request } = values %$request;
1605 local @{ $c->response }{ keys %$response } = values %$response;
1606
1607 $code->();
1608}
1609
b5ecfcf0 1610=head2 $c->finalize
fbcc39ad 1611
e7f1cf73 1612Finalizes the request.
fbcc39ad 1613
1614=cut
1615
1616sub finalize {
1617 my $c = shift;
1618
369c09bc 1619 for my $error ( @{ $c->error } ) {
1620 $c->log->error($error);
1621 }
1622
5050d7a7 1623 # Allow engine to handle finalize flow (for POE)
e63bdf38 1624 my $engine = $c->engine;
1625 if ( my $code = $engine->can('finalize') ) {
1626 $engine->$code($c);
fbcc39ad 1627 }
5050d7a7 1628 else {
fbcc39ad 1629
5050d7a7 1630 $c->finalize_uploads;
fbcc39ad 1631
5050d7a7 1632 # Error
1633 if ( $#{ $c->error } >= 0 ) {
1634 $c->finalize_error;
1635 }
1636
1637 $c->finalize_headers;
fbcc39ad 1638
5050d7a7 1639 # HEAD request
1640 if ( $c->request->method eq 'HEAD' ) {
1641 $c->response->body('');
1642 }
1643
1644 $c->finalize_body;
1645 }
62a6df80 1646
1647 if ($c->use_stats) {
596677b6 1648 my $elapsed = sprintf '%f', $c->stats->elapsed;
12bf12c0 1649 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
908e3d9e 1650 $c->log->info(
62a6df80 1651 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
908e3d9e 1652 }
fbcc39ad 1653
1654 return $c->response->status;
1655}
1656
b5ecfcf0 1657=head2 $c->finalize_body
fbcc39ad 1658
e7f1cf73 1659Finalizes body.
fbcc39ad 1660
1661=cut
1662
1663sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1664
b5ecfcf0 1665=head2 $c->finalize_cookies
fbcc39ad 1666
e7f1cf73 1667Finalizes cookies.
fbcc39ad 1668
1669=cut
1670
147821ea 1671sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 1672
b5ecfcf0 1673=head2 $c->finalize_error
fbcc39ad 1674
e7f1cf73 1675Finalizes error.
fbcc39ad 1676
1677=cut
1678
1679sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1680
b5ecfcf0 1681=head2 $c->finalize_headers
fbcc39ad 1682
e7f1cf73 1683Finalizes headers.
fbcc39ad 1684
1685=cut
1686
1687sub finalize_headers {
1688 my $c = shift;
1689
e63bdf38 1690 my $response = $c->response; #accessor calls can add up?
1691
fbcc39ad 1692 # Check if we already finalized headers
6680c772 1693 return if $response->finalized_headers;
fbcc39ad 1694
1695 # Handle redirects
e63bdf38 1696 if ( my $location = $response->redirect ) {
fbcc39ad 1697 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 1698 $response->header( Location => $location );
a7caa492 1699
02570318 1700 if ( !$response->has_body ) {
39655cdc 1701 # Add a default body if none is already present
e63bdf38 1702 $response->body(
e422816e 1703 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
39655cdc 1704 );
1705 }
fbcc39ad 1706 }
1707
1708 # Content-Length
e63bdf38 1709 if ( $response->body && !$response->content_length ) {
775878ac 1710
8f62c91a 1711 # get the length from a filehandle
e63bdf38 1712 if ( blessed( $response->body ) && $response->body->can('read') )
197bd788 1713 {
e63bdf38 1714 my $stat = stat $response->body;
3b6a1db1 1715 if ( $stat && $stat->size > 0 ) {
e63bdf38 1716 $response->content_length( $stat->size );
8f62c91a 1717 }
1718 else {
775878ac 1719 $c->log->warn('Serving filehandle without a content-length');
8f62c91a 1720 }
1721 }
1722 else {
b5d7a61f 1723 # everything should be bytes at this point, but just in case
e63bdf38 1724 $response->content_length( bytes::length( $response->body ) );
8f62c91a 1725 }
fbcc39ad 1726 }
1727
1728 # Errors
e63bdf38 1729 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1730 $response->headers->remove_header("Content-Length");
1731 $response->body('');
fbcc39ad 1732 }
1733
1734 $c->finalize_cookies;
1735
1736 $c->engine->finalize_headers( $c, @_ );
1737
1738 # Done
6680c772 1739 $response->finalized_headers(1);
fbcc39ad 1740}
1741
b5ecfcf0 1742=head2 $c->finalize_output
fbcc39ad 1743
1744An alias for finalize_body.
1745
b5ecfcf0 1746=head2 $c->finalize_read
fbcc39ad 1747
e7f1cf73 1748Finalizes the input after reading is complete.
fbcc39ad 1749
1750=cut
1751
1752sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1753
b5ecfcf0 1754=head2 $c->finalize_uploads
fbcc39ad 1755
ae1e6b59 1756Finalizes uploads. Cleans up any temporary files.
fbcc39ad 1757
1758=cut
1759
1760sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1761
b5ecfcf0 1762=head2 $c->get_action( $action, $namespace )
fbcc39ad 1763
e7f1cf73 1764Gets an action in a given namespace.
fbcc39ad 1765
1766=cut
1767
684d10ed 1768sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 1769
b5ecfcf0 1770=head2 $c->get_actions( $action, $namespace )
a9dc674c 1771
ae1e6b59 1772Gets all actions of a given name in a namespace and all parent
1773namespaces.
a9dc674c 1774
1775=cut
1776
1777sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1778
f7b672ef 1779=head2 $c->handle_request( $class, @arguments )
fbcc39ad 1780
e7f1cf73 1781Called to handle each HTTP request.
fbcc39ad 1782
1783=cut
1784
1785sub handle_request {
1786 my ( $class, @arguments ) = @_;
1787
1788 # Always expect worst case!
1789 my $status = -1;
1790 eval {
dea1884f 1791 if ($class->debug) {
908e3d9e 1792 my $secs = time - $START || 1;
1793 my $av = sprintf '%.3f', $COUNT / $secs;
1794 my $time = localtime time;
1795 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 1796 }
908e3d9e 1797
1798 my $c = $class->prepare(@arguments);
1799 $c->dispatch;
62a6df80 1800 $status = $c->finalize;
fbcc39ad 1801 };
1802
1803 if ( my $error = $@ ) {
1804 chomp $error;
1805 $class->log->error(qq/Caught exception in engine "$error"/);
1806 }
1807
1808 $COUNT++;
62a6df80 1809
6680c772 1810 if(my $coderef = $class->log->can('_flush')){
1811 $class->log->$coderef();
1812 }
fbcc39ad 1813 return $status;
1814}
1815
b5ecfcf0 1816=head2 $c->prepare( @arguments )
fbcc39ad 1817
ae1e6b59 1818Creates a Catalyst context from an engine-specific request (Apache, CGI,
1819etc.).
fbcc39ad 1820
1821=cut
1822
1823sub prepare {
1824 my ( $class, @arguments ) = @_;
1825
6680c772 1826 # XXX
1827 # After the app/ctxt split, this should become an attribute based on something passed
1828 # into the application.
3cec521a 1829 $class->context_class( ref $class || $class ) unless $class->context_class;
62a6df80 1830
6680c772 1831 my $c = $class->context_class->new({});
1832
1833 # For on-demand data
1834 $c->request->_context($c);
1835 $c->response->_context($c);
fbcc39ad 1836
b6d4ee6e 1837 #surely this is not the most efficient way to do things...
dc5f035e 1838 $c->stats($class->stats_class->new)->enable($c->use_stats);
908e3d9e 1839 if ( $c->debug ) {
62a6df80 1840 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 1841 }
1842
e63bdf38 1843 #XXX reuse coderef from can
5050d7a7 1844 # Allow engine to direct the prepare flow (for POE)
1845 if ( $c->engine->can('prepare') ) {
1846 $c->engine->prepare( $c, @arguments );
1847 }
1848 else {
1849 $c->prepare_request(@arguments);
1850 $c->prepare_connection;
1851 $c->prepare_query_parameters;
1852 $c->prepare_headers;
1853 $c->prepare_cookies;
1854 $c->prepare_path;
1855
878b821c 1856 # Prepare the body for reading, either by prepare_body
1857 # or the user, if they are using $c->read
1858 $c->prepare_read;
62a6df80 1859
878b821c 1860 # Parse the body unless the user wants it on-demand
1861 unless ( $c->config->{parse_on_demand} ) {
1862 $c->prepare_body;
1863 }
5050d7a7 1864 }
fbcc39ad 1865
fbcc39ad 1866 my $method = $c->req->method || '';
2f381252 1867 my $path = $c->req->path;
1868 $path = '/' unless length $path;
fbcc39ad 1869 my $address = $c->req->address || '';
1870
e3a13771 1871 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
fbcc39ad 1872 if $c->debug;
1873
e3a13771 1874 $c->prepare_action;
1875
fbcc39ad 1876 return $c;
1877}
1878
b5ecfcf0 1879=head2 $c->prepare_action
fbcc39ad 1880
b4b01a8a 1881Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 1882
1883=cut
1884
1885sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1886
b5ecfcf0 1887=head2 $c->prepare_body
fbcc39ad 1888
e7f1cf73 1889Prepares message body.
fbcc39ad 1890
1891=cut
1892
1893sub prepare_body {
1894 my $c = shift;
1895
0f56bbcf 1896 return if $c->request->_has_body;
fbcc39ad 1897
1898 # Initialize on-demand data
1899 $c->engine->prepare_body( $c, @_ );
1900 $c->prepare_parameters;
1901 $c->prepare_uploads;
1902
0584323b 1903 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1904 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1905 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1906 my $param = $c->req->body_parameters->{$key};
1907 my $value = defined($param) ? $param : '';
1908 $t->row( $key,
1909 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1910 }
1911 $c->log->debug( "Body Parameters are:\n" . $t->draw );
fbcc39ad 1912 }
1913}
1914
b5ecfcf0 1915=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 1916
e7f1cf73 1917Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 1918
b4b01a8a 1919See L<Catalyst::Engine>.
1920
4bd82c41 1921=cut
1922
4f5ebacd 1923sub prepare_body_chunk {
1924 my $c = shift;
4bd82c41 1925 $c->engine->prepare_body_chunk( $c, @_ );
1926}
1927
b5ecfcf0 1928=head2 $c->prepare_body_parameters
fbcc39ad 1929
e7f1cf73 1930Prepares body parameters.
fbcc39ad 1931
1932=cut
1933
1934sub prepare_body_parameters {
1935 my $c = shift;
1936 $c->engine->prepare_body_parameters( $c, @_ );
1937}
1938
b5ecfcf0 1939=head2 $c->prepare_connection
fbcc39ad 1940
e7f1cf73 1941Prepares connection.
fbcc39ad 1942
1943=cut
1944
1945sub prepare_connection {
1946 my $c = shift;
1947 $c->engine->prepare_connection( $c, @_ );
1948}
1949
b5ecfcf0 1950=head2 $c->prepare_cookies
fbcc39ad 1951
e7f1cf73 1952Prepares cookies.
fbcc39ad 1953
1954=cut
1955
1956sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1957
b5ecfcf0 1958=head2 $c->prepare_headers
fbcc39ad 1959
e7f1cf73 1960Prepares headers.
fbcc39ad 1961
1962=cut
1963
1964sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1965
b5ecfcf0 1966=head2 $c->prepare_parameters
fbcc39ad 1967
e7f1cf73 1968Prepares parameters.
fbcc39ad 1969
1970=cut
1971
1972sub prepare_parameters {
1973 my $c = shift;
1974 $c->prepare_body_parameters;
1975 $c->engine->prepare_parameters( $c, @_ );
1976}
1977
b5ecfcf0 1978=head2 $c->prepare_path
fbcc39ad 1979
e7f1cf73 1980Prepares path and base.
fbcc39ad 1981
1982=cut
1983
1984sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1985
b5ecfcf0 1986=head2 $c->prepare_query_parameters
fbcc39ad 1987
e7f1cf73 1988Prepares query parameters.
fbcc39ad 1989
1990=cut
1991
1992sub prepare_query_parameters {
1993 my $c = shift;
1994
1995 $c->engine->prepare_query_parameters( $c, @_ );
1996
0584323b 1997 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1998 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1999 for my $key ( sort keys %{ $c->req->query_parameters } ) {
2000 my $param = $c->req->query_parameters->{$key};
fbcc39ad 2001 my $value = defined($param) ? $param : '';
8c113188 2002 $t->row( $key,
fbcc39ad 2003 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2004 }
0584323b 2005 $c->log->debug( "Query Parameters are:\n" . $t->draw );
fbcc39ad 2006 }
2007}
2008
b5ecfcf0 2009=head2 $c->prepare_read
fbcc39ad 2010
e7f1cf73 2011Prepares the input for reading.
fbcc39ad 2012
2013=cut
2014
2015sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2016
b5ecfcf0 2017=head2 $c->prepare_request
fbcc39ad 2018
e7f1cf73 2019Prepares the engine request.
fbcc39ad 2020
2021=cut
2022
2023sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2024
b5ecfcf0 2025=head2 $c->prepare_uploads
fbcc39ad 2026
e7f1cf73 2027Prepares uploads.
fbcc39ad 2028
2029=cut
2030
2031sub prepare_uploads {
2032 my $c = shift;
2033
2034 $c->engine->prepare_uploads( $c, @_ );
2035
2036 if ( $c->debug && keys %{ $c->request->uploads } ) {
8c113188 2037 my $t = Text::SimpleTable->new(
34d28dfd 2038 [ 12, 'Parameter' ],
2039 [ 26, 'Filename' ],
8c113188 2040 [ 18, 'Type' ],
2041 [ 9, 'Size' ]
2042 );
fbcc39ad 2043 for my $key ( sort keys %{ $c->request->uploads } ) {
2044 my $upload = $c->request->uploads->{$key};
2045 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 2046 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 2047 }
2048 }
2049 $c->log->debug( "File Uploads are:\n" . $t->draw );
2050 }
2051}
2052
b5ecfcf0 2053=head2 $c->prepare_write
fbcc39ad 2054
e7f1cf73 2055Prepares the output for writing.
fbcc39ad 2056
2057=cut
2058
2059sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2060
b5ecfcf0 2061=head2 $c->request_class
1f9cb7c1 2062
e7f1cf73 2063Returns or sets the request class.
1f9cb7c1 2064
b5ecfcf0 2065=head2 $c->response_class
1f9cb7c1 2066
e7f1cf73 2067Returns or sets the response class.
1f9cb7c1 2068
b5ecfcf0 2069=head2 $c->read( [$maxlength] )
fbcc39ad 2070
ae1e6b59 2071Reads a chunk of data from the request body. This method is designed to
2072be used in a while loop, reading C<$maxlength> bytes on every call.
2073C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 2074
cc95842f 2075You have to set C<< MyApp->config->{parse_on_demand} >> to use this
ae1e6b59 2076directly.
fbcc39ad 2077
878b821c 2078Warning: If you use read(), Catalyst will not process the body,
2079so you will not be able to access POST parameters or file uploads via
2080$c->request. You must handle all body parsing yourself.
2081
fbcc39ad 2082=cut
2083
2084sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2085
b5ecfcf0 2086=head2 $c->run
fbcc39ad 2087
2088Starts the engine.
2089
2090=cut
2091
2092sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2093
b5ecfcf0 2094=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 2095
e7f1cf73 2096Sets an action in a given namespace.
fbcc39ad 2097
2098=cut
2099
2100sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2101
b5ecfcf0 2102=head2 $c->setup_actions($component)
fbcc39ad 2103
e7f1cf73 2104Sets up actions for a component.
fbcc39ad 2105
2106=cut
2107
2108sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2109
b5ecfcf0 2110=head2 $c->setup_components
fbcc39ad 2111
86418559 2112Sets up components. Specify a C<setup_components> config option to pass
2113additional options directly to L<Module::Pluggable>. To add additional
2114search paths, specify a key named C<search_extra> as an array
2115reference. Items in the array beginning with C<::> will have the
18de900e 2116application class name prepended to them.
fbcc39ad 2117
62a6df80 2118All components found will also have any
2f381252 2119L<Devel::InnerPackage|inner packages> loaded and set up as components.
2120Note, that modules which are B<not> an I<inner package> of the main
2121file namespace loaded will not be instantiated as components.
2122
fbcc39ad 2123=cut
2124
2125sub setup_components {
2126 my $class = shift;
2127
18de900e 2128 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
2129 my $config = $class->config->{ setup_components };
2130 my $extra = delete $config->{ search_extra } || [];
62a6df80 2131
18de900e 2132 push @paths, @$extra;
62a6df80 2133
364d7324 2134 my $locator = Module::Pluggable::Object->new(
18de900e 2135 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2136 %$config
364d7324 2137 );
b94b200c 2138
2139 my @comps = sort { length $a <=> length $b } $locator->plugins;
2140 my %comps = map { $_ => 1 } @comps;
73e1183e 2141
2142 my $deprecated_component_names = grep { /::[CMV]::/ } @comps;
2143 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2144 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
19a24dbb 2145 ) if $deprecated_component_names;
73e1183e 2146
b94b200c 2147 for my $component ( @comps ) {
dd91afb5 2148
2149 # We pass ignore_loaded here so that overlay files for (e.g.)
2150 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2151 # we know M::P::O found a file on disk so this is safe
2152
f5a4863c 2153 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2154 #Class::MOP::load_class($component);
364d7324 2155
2156 my $module = $class->setup_component( $component );
2157 my %modules = (
2158 $component => $module,
2159 map {
2160 $_ => $class->setup_component( $_ )
62a6df80 2161 } grep {
b94b200c 2162 not exists $comps{$_}
364d7324 2163 } Devel::InnerPackage::list_packages( $component )
2164 );
62a6df80 2165
364d7324 2166 for my $key ( keys %modules ) {
2167 $class->components->{ $key } = $modules{ $key };
fbcc39ad 2168 }
364d7324 2169 }
2170}
fbcc39ad 2171
364d7324 2172=head2 $c->setup_component
fbcc39ad 2173
364d7324 2174=cut
fbcc39ad 2175
2f5cb070 2176sub _controller_init_base_classes {
84848664 2177 my ($app_class, $component) = @_;
2f5cb070 2178 foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) {
c98492ae 2179 Moose::Meta::Class->initialize( $class )
2f5cb070 2180 unless find_meta($class);
2181 }
2182}
2183
364d7324 2184sub setup_component {
2185 my( $class, $component ) = @_;
fbcc39ad 2186
364d7324 2187 unless ( $component->can( 'COMPONENT' ) ) {
2188 return $component;
2189 }
fbcc39ad 2190
2f5cb070 2191 # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
2192 # nearest to Catalyst::Controller first, no matter what order stuff happens
2193 # to be loaded. There are TODO tests in Moose for this, see
2194 # f2391d17574eff81d911b97be15ea51080500003
2195 if ($component->isa('Catalyst::Controller')) {
2196 $class->_controller_init_base_classes($component);
2197 }
62a6df80 2198
364d7324 2199 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2200 my $config = $class->config->{ $suffix } || {};
fbcc39ad 2201
364d7324 2202 my $instance = eval { $component->COMPONENT( $class, $config ); };
fbcc39ad 2203
2204 if ( my $error = $@ ) {
fbcc39ad 2205 chomp $error;
fbcc39ad 2206 Catalyst::Exception->throw(
364d7324 2207 message => qq/Couldn't instantiate component "$component", "$error"/
2208 );
fbcc39ad 2209 }
2210
7490de2a 2211 unless (blessed $instance) {
2212 my $metaclass = Moose::Util::find_meta($component);
2213 my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2214 my $component_method_from = $method_meta->associated_metaclass->name;
637fa644 2215 my $value = defined($instance) ? $instance : 'undef';
7490de2a 2216 Catalyst::Exception->throw(
2217 message =>
637fa644 2218 qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
7490de2a 2219 );
2220 }
364d7324 2221 return $instance;
fbcc39ad 2222}
2223
b5ecfcf0 2224=head2 $c->setup_dispatcher
fbcc39ad 2225
ae1e6b59 2226Sets up dispatcher.
2227
fbcc39ad 2228=cut
2229
2230sub setup_dispatcher {
2231 my ( $class, $dispatcher ) = @_;
2232
2233 if ($dispatcher) {
2234 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2235 }
2236
cb69249e 2237 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2238 $dispatcher = 'Catalyst::Dispatcher::' . $env;
fbcc39ad 2239 }
2240
2241 unless ($dispatcher) {
cb0354c6 2242 $dispatcher = $class->dispatcher_class;
fbcc39ad 2243 }
2244
e63bdf38 2245 Class::MOP::load_class($dispatcher);
fbcc39ad 2246
2247 # dispatcher instance
2248 $class->dispatcher( $dispatcher->new );
2249}
2250
b5ecfcf0 2251=head2 $c->setup_engine
fbcc39ad 2252
ae1e6b59 2253Sets up engine.
2254
fbcc39ad 2255=cut
2256
2257sub setup_engine {
2258 my ( $class, $engine ) = @_;
2259
2260 if ($engine) {
2261 $engine = 'Catalyst::Engine::' . $engine;
2262 }
2263
cb69249e 2264 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2265 $engine = 'Catalyst::Engine::' . $env;
fbcc39ad 2266 }
2267
9b0a3e0f 2268 if ( $ENV{MOD_PERL} ) {
e106a59f 2269 my $meta = Class::MOP::get_metaclass_by_name($class);
62a6df80 2270
fbcc39ad 2271 # create the apache method
74c89dea 2272 $meta->add_method('apache' => sub { shift->engine->apache });
fbcc39ad 2273
2274 my ( $software, $version ) =
2275 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2276
2277 $version =~ s/_//g;
2278 $version =~ s/(\.[^.]+)\./$1/g;
2279
2280 if ( $software eq 'mod_perl' ) {
2281
9b0a3e0f 2282 if ( !$engine ) {
22247e54 2283
9b0a3e0f 2284 if ( $version >= 1.99922 ) {
2285 $engine = 'Catalyst::Engine::Apache2::MP20';
2286 }
22247e54 2287
9b0a3e0f 2288 elsif ( $version >= 1.9901 ) {
2289 $engine = 'Catalyst::Engine::Apache2::MP19';
2290 }
22247e54 2291
9b0a3e0f 2292 elsif ( $version >= 1.24 ) {
2293 $engine = 'Catalyst::Engine::Apache::MP13';
2294 }
22247e54 2295
9b0a3e0f 2296 else {
2297 Catalyst::Exception->throw( message =>
2298 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2299 }
fbcc39ad 2300
fbcc39ad 2301 }
2302
2303 # install the correct mod_perl handler
2304 if ( $version >= 1.9901 ) {
2305 *handler = sub : method {
2306 shift->handle_request(@_);
2307 };
2308 }
2309 else {
2310 *handler = sub ($$) { shift->handle_request(@_) };
2311 }
2312
2313 }
2314
2315 elsif ( $software eq 'Zeus-Perl' ) {
2316 $engine = 'Catalyst::Engine::Zeus';
2317 }
2318
2319 else {
2320 Catalyst::Exception->throw(
2321 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2322 }
2323 }
2324
2325 unless ($engine) {
cb0354c6 2326 $engine = $class->engine_class;
fbcc39ad 2327 }
2328
e63bdf38 2329 Class::MOP::load_class($engine);
0e7f5826 2330
d54484bf 2331 # check for old engines that are no longer compatible
2332 my $old_engine;
0e7f5826 2333 if ( $engine->isa('Catalyst::Engine::Apache')
2334 && !Catalyst::Engine::Apache->VERSION )
d54484bf 2335 {
2336 $old_engine = 1;
2337 }
0e7f5826 2338
d54484bf 2339 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
0e7f5826 2340 && Catalyst::Engine::Server->VERSION le '0.02' )
d54484bf 2341 {
2342 $old_engine = 1;
2343 }
0e7f5826 2344
2345 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2346 && $engine->VERSION eq '0.01' )
d54484bf 2347 {
2348 $old_engine = 1;
2349 }
0e7f5826 2350
2351 elsif ($engine->isa('Catalyst::Engine::Zeus')
2352 && $engine->VERSION eq '0.01' )
d54484bf 2353 {
2354 $old_engine = 1;
2355 }
fbcc39ad 2356
d54484bf 2357 if ($old_engine) {
2358 Catalyst::Exception->throw( message =>
0e7f5826 2359 qq/Engine "$engine" is not supported by this version of Catalyst/
d54484bf 2360 );
2361 }
0e7f5826 2362
fbcc39ad 2363 # engine instance
2364 $class->engine( $engine->new );
2365}
2366
b5ecfcf0 2367=head2 $c->setup_home
fbcc39ad 2368
ae1e6b59 2369Sets up the home directory.
2370
fbcc39ad 2371=cut
2372
2373sub setup_home {
2374 my ( $class, $home ) = @_;
2375
cb69249e 2376 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2377 $home = $env;
fbcc39ad 2378 }
2379
b6d4ee6e 2380 $home ||= Catalyst::Utils::home($class);
fbcc39ad 2381
2382 if ($home) {
e63bdf38 2383 #I remember recently being scolded for assigning config values like this
fbcc39ad 2384 $class->config->{home} ||= $home;
a738ab68 2385 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
fbcc39ad 2386 }
2387}
2388
b5ecfcf0 2389=head2 $c->setup_log
fbcc39ad 2390
0fa676a7 2391Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2392passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2393log to.
62a6df80 2394
0fa676a7 2395This method also installs a C<debug> method that returns a true value into the
2396catalyst subclass if the "debug" level is passed in the comma-delimited list,
2397or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2398
2399Note that if the log has already been setup, by either a previous call to
2400C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
5baa3bbc 2401that this method won't actually set up the log object.
ae1e6b59 2402
fbcc39ad 2403=cut
2404
2405sub setup_log {
0fa676a7 2406 my ( $class, $levels ) = @_;
fbcc39ad 2407
5baa3bbc 2408 $levels ||= '';
2409 $levels =~ s/^\s+//;
2410 $levels =~ s/\s+$//;
abf65c2a 2411 my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
2412
2413 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2414 if ( defined $env_debug ) {
2415 $levels{debug} = 1 if $env_debug; # Ugly!
2416 delete($levels{debug}) unless $env_debug;
2417 }
2418
fbcc39ad 2419 unless ( $class->log ) {
0fa676a7 2420 $class->log( Catalyst::Log->new(keys %levels) );
fbcc39ad 2421 }
af3ff00e 2422
abf65c2a 2423 if ( $levels{debug} ) {
e106a59f 2424 Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
fbcc39ad 2425 $class->log->debug('Debug messages enabled');
2426 }
2427}
2428
b5ecfcf0 2429=head2 $c->setup_plugins
fbcc39ad 2430
ae1e6b59 2431Sets up plugins.
2432
fbcc39ad 2433=cut
2434
dc5f035e 2435=head2 $c->setup_stats
2436
2437Sets up timing statistics class.
2438
2439=cut
2440
2441sub setup_stats {
2442 my ( $class, $stats ) = @_;
2443
2444 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2445
2446 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2447 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
e106a59f 2448 Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
b01f0c69 2449 $class->log->debug('Statistics enabled');
dc5f035e 2450 }
2451}
2452
2453
62a6df80 2454=head2 $c->registered_plugins
836e1134 2455
2456Returns a sorted list of the plugins which have either been stated in the
2457import list or which have been added via C<< MyApp->plugin(@args); >>.
2458
2459If passed a given plugin name, it will report a boolean value indicating
2460whether or not that plugin is loaded. A fully qualified name is required if
2461the plugin name does not begin with C<Catalyst::Plugin::>.
2462
2463 if ($c->registered_plugins('Some::Plugin')) {
2464 ...
2465 }
2466
2467=cut
fbcc39ad 2468
836e1134 2469{
97b58e17 2470
2471 sub registered_plugins {
836e1134 2472 my $proto = shift;
197bd788 2473 return sort keys %{ $proto->_plugins } unless @_;
836e1134 2474 my $plugin = shift;
d0d4d785 2475 return 1 if exists $proto->_plugins->{$plugin};
2476 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
836e1134 2477 }
fbcc39ad 2478
836e1134 2479 sub _register_plugin {
2480 my ( $proto, $plugin, $instant ) = @_;
2481 my $class = ref $proto || $proto;
fbcc39ad 2482
b6d4ee6e 2483 Class::MOP::load_class( $plugin );
fbcc39ad 2484
197bd788 2485 $proto->_plugins->{$plugin} = 1;
836e1134 2486 unless ($instant) {
fbcc39ad 2487 no strict 'refs';
e106a59f 2488 if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
74c89dea 2489 my @superclasses = ($plugin, $meta->superclasses );
2490 $meta->superclasses(@superclasses);
5fb67d52 2491 } else {
2492 unshift @{"$class\::ISA"}, $plugin;
2493 }
fbcc39ad 2494 }
836e1134 2495 return $class;
2496 }
2497
2498 sub setup_plugins {
2499 my ( $class, $plugins ) = @_;
2500
d0d4d785 2501 $class->_plugins( {} ) unless $class->_plugins;
836e1134 2502 $plugins ||= [];
836e1134 2503
e5210a95 2504 my @plugins = map { s/\A\+// ? $_ : "Catalyst::Plugin::$_" } @$plugins;
2505
2506 Class::MOP::load_class($_) for @plugins;
2507
2508 for my $plugin ( reverse @plugins ) {
2509 my $meta = find_meta($plugin);
2510 next if $meta && $meta->isa('Moose::Meta::Role');
836e1134 2511
2512 $class->_register_plugin($plugin);
2513 }
e5210a95 2514
2515 my @roles =
2516 map { $_->name }
2517 grep { $_ && blessed($_) && $_->isa('Moose::Meta::Role') }
2518 map { find_meta($_) }
2519 @plugins;
2520
2521 Moose::Util::apply_all_roles(
2522 $class => @roles
2523 ) if @roles;
fbcc39ad 2524 }
2525}
2526
b5ecfcf0 2527=head2 $c->stack
8767c5a3 2528
86418559 2529Returns an arrayref of the internal execution stack (actions that are
2530currently executing).
8767c5a3 2531
dc5f035e 2532=head2 $c->stats_class
2533
2534Returns or sets the stats (timing statistics) class.
2535
2536=head2 $c->use_stats
2537
2538Returns 1 when stats collection is enabled. Stats collection is enabled
2539when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2540environment variable is set.
2541
8eae92ad 2542Note that this is a static method, not an accessor and should be overridden
2543by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
dc5f035e 2544
2545=cut
2546
2547sub use_stats { 0 }
2548
2549
b5ecfcf0 2550=head2 $c->write( $data )
fbcc39ad 2551
ae1e6b59 2552Writes $data to the output stream. When using this method directly, you
2553will need to manually set the C<Content-Length> header to the length of
2554your output data, if known.
fbcc39ad 2555
2556=cut
2557
4f5ebacd 2558sub write {
2559 my $c = shift;
2560
2561 # Finalize headers if someone manually writes output
2562 $c->finalize_headers;
2563
2564 return $c->engine->write( $c, @_ );
2565}
fbcc39ad 2566
b5ecfcf0 2567=head2 version
bf88a181 2568
ae1e6b59 2569Returns the Catalyst version number. Mostly useful for "powered by"
2570messages in template systems.
bf88a181 2571
2572=cut
2573
2574sub version { return $Catalyst::VERSION }
2575
b0bb11ec 2576=head1 INTERNAL ACTIONS
2577
ae1e6b59 2578Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2579C<_ACTION>, and C<_END>. These are by default not shown in the private
3e705254 2580action table, but you can make them visible with a config parameter.
b0bb11ec 2581
2582 MyApp->config->{show_internal_actions} = 1;
2583
d2ee9760 2584=head1 CASE SENSITIVITY
2585
3e705254 2586By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
ae1e6b59 2587mapped to C</foo/bar>. You can activate case sensitivity with a config
3e705254 2588parameter.
d2ee9760 2589
2590 MyApp->config->{case_sensitive} = 1;
2591
3e705254 2592This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
fbcc39ad 2593
2594=head1 ON-DEMAND PARSER
2595
2596The request body is usually parsed at the beginning of a request,
878b821c 2597but if you want to handle input yourself, you can enable on-demand
2598parsing with a config parameter.
fbcc39ad 2599
2600 MyApp->config->{parse_on_demand} = 1;
62a6df80 2601
fbcc39ad 2602=head1 PROXY SUPPORT
2603
ae1e6b59 2604Many production servers operate using the common double-server approach,
2605with a lightweight frontend web server passing requests to a larger
2606backend server. An application running on the backend server must deal
2607with two problems: the remote user always appears to be C<127.0.0.1> and
2608the server's hostname will appear to be C<localhost> regardless of the
2609virtual host that the user connected through.
fbcc39ad 2610
ae1e6b59 2611Catalyst will automatically detect this situation when you are running
2612the frontend and backend servers on the same machine. The following
2613changes are made to the request.
fbcc39ad 2614
62a6df80 2615 $c->req->address is set to the user's real IP address, as read from
ae1e6b59 2616 the HTTP X-Forwarded-For header.
62a6df80 2617
ae1e6b59 2618 The host value for $c->req->base and $c->req->uri is set to the real
2619 host, as read from the HTTP X-Forwarded-Host header.
fbcc39ad 2620
3e705254 2621Obviously, your web server must support these headers for this to work.
fbcc39ad 2622
ae1e6b59 2623In a more complex server farm environment where you may have your
2624frontend proxy server(s) on different machines, you will need to set a
2625configuration option to tell Catalyst to read the proxied data from the
2626headers.
fbcc39ad 2627
2628 MyApp->config->{using_frontend_proxy} = 1;
62a6df80 2629
fbcc39ad 2630If you do not wish to use the proxy support at all, you may set:
d1a31ac6 2631
fbcc39ad 2632 MyApp->config->{ignore_frontend_proxy} = 1;
2633
2634=head1 THREAD SAFETY
2635
86418559 2636Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2637C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2638believe the Catalyst core to be thread-safe.
fbcc39ad 2639
2640If you plan to operate in a threaded environment, remember that all other
3e705254 2641modules you are using must also be thread-safe. Some modules, most notably
2642L<DBD::SQLite>, are not thread-safe.
d1a31ac6 2643
3cb1db8c 2644=head1 SUPPORT
2645
2646IRC:
2647
4eaf7c88 2648 Join #catalyst on irc.perl.org.
3cb1db8c 2649
3e705254 2650Mailing Lists:
3cb1db8c 2651
6d4c3368 2652 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2653 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
1985c30b 2654
432d507d 2655Web:
2656
2657 http://catalyst.perl.org
2658
0ef52a96 2659Wiki:
2660
2661 http://dev.catalyst.perl.org
2662
fc7ec1d9 2663=head1 SEE ALSO
2664
829a28ca 2665=head2 L<Task::Catalyst> - All you need to start with Catalyst
2666
b5ecfcf0 2667=head2 L<Catalyst::Manual> - The Catalyst Manual
e7f1cf73 2668
b5ecfcf0 2669=head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
61b1e958 2670
b5ecfcf0 2671=head2 L<Catalyst::Engine> - Core engine
61b1e958 2672
b5ecfcf0 2673=head2 L<Catalyst::Log> - Log class.
61b1e958 2674
b5ecfcf0 2675=head2 L<Catalyst::Request> - Request object
61b1e958 2676
b5ecfcf0 2677=head2 L<Catalyst::Response> - Response object
61b1e958 2678
b5ecfcf0 2679=head2 L<Catalyst::Test> - The test suite.
fc7ec1d9 2680
2f381252 2681=head1 PROJECT FOUNDER
2682
2683sri: Sebastian Riedel <sri@cpan.org>
fc7ec1d9 2684
2f381252 2685=head1 CONTRIBUTORS
15f0b5b7 2686
2f381252 2687abw: Andy Wardley
fbcc39ad 2688
2f381252 2689acme: Leon Brocard <leon@astray.com>
33108eaf 2690
f4a57de4 2691Andrew Bramble
2692
15f0b5b7 2693Andrew Ford
2694
2695Andrew Ruthven
2696
2f381252 2697andyg: Andy Grundman <andy@hybridized.org>
fbcc39ad 2698
2f381252 2699audreyt: Audrey Tang
15f0b5b7 2700
2f381252 2701bricas: Brian Cassidy <bricas@cpan.org>
0cf56dbc 2702
e31b525c 2703Caelum: Rafael Kitover <rkitover@io.com>
2704
2f381252 2705chansen: Christian Hansen
6aaa1c60 2706
2f381252 2707chicks: Christopher Hicks
15f0b5b7 2708
0fa676a7 2709David E. Wheeler
2710
2f381252 2711dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
15f0b5b7 2712
2f381252 2713Drew Taylor
15f0b5b7 2714
8026359e 2715dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
2716
2f381252 2717esskar: Sascha Kiefer
0ef52a96 2718
2f381252 2719fireartist: Carl Franks <cfranks@cpan.org>
15f0b5b7 2720
2f381252 2721gabb: Danijel Milicevic
61bef238 2722
15f0b5b7 2723Gary Ashton Jones
2724
2725Geoff Richards
2726
e4cc83b2 2727ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2728
2f381252 2729jcamacho: Juan Camacho
fbcc39ad 2730
108201b5 2731jhannah: Jay Hannah <jay@jays.net>
2732
15f0b5b7 2733Jody Belka
2734
2735Johan Lindstrom
2736
2f381252 2737jon: Jon Schutz <jjschutz@cpan.org>
15f0b5b7 2738
2f381252 2739marcus: Marcus Ramberg <mramberg@cpan.org>
15f0b5b7 2740
2f381252 2741miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
15f0b5b7 2742
2f381252 2743mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
15f0b5b7 2744
2f381252 2745mugwump: Sam Vilain
71c3bcc3 2746
2f381252 2747naughton: David Naughton
a727119f 2748
2f381252 2749ningu: David Kamholz <dkamholz@cpan.org>
1cf1c56a 2750
2f381252 2751nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
9c71d51d 2752
2f381252 2753numa: Dan Sully <daniel@cpan.org>
fc7ec1d9 2754
2f381252 2755obra: Jesse Vincent
2756
2757omega: Andreas Marienborg
51f0308d 2758
39fc2ce1 2759Oleg Kostyuk <cub.uanic@gmail.com>
2760
2f381252 2761phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
bdcb95ef 2762
6dae3eef 2763rafl: Florian Ragwitz <rafl@debian.org>
2764
637be086 2765random: Roland Lammel <lammel@cpan.org>
2766
2f381252