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