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