4 use Moose::Meta::Class ();
5 extends 'Catalyst::Component';
6 use Moose::Util qw/find_meta/;
8 use B::Hooks::EndOfScope ();
9 use Catalyst::Exception;
10 use Catalyst::Exception::Detach;
11 use Catalyst::Exception::Go;
13 use Catalyst::Request;
14 use Catalyst::Request::Upload;
15 use Catalyst::Response;
17 use Catalyst::Controller;
18 use Devel::InnerPackage ();
20 use Module::Pluggable::Object ();
21 use Text::SimpleTable ();
22 use Path::Class::Dir ();
23 use Path::Class::File ();
27 use Tree::Simple qw/use_weak_refs/;
28 use Tree::Simple::Visitor::FindByUID;
29 use Class::C3::Adopt::NEXT;
32 use Carp qw/croak carp shortmess/;
34 BEGIN { require 5.008001; }
36 has stack => (is => 'ro', default => sub { [] });
37 has stash => (is => 'rw', default => sub { {} });
38 has state => (is => 'rw', default => 0);
39 has stats => (is => 'rw');
40 has action => (is => 'rw');
41 has counter => (is => 'rw', default => sub { {} });
42 has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
43 has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
44 has namespace => (is => 'rw');
46 sub depth { scalar @{ shift->stack || [] }; }
47 sub comp { shift->component(@_) }
50 my $self = shift; return $self->request(@_);
53 my $self = shift; return $self->response(@_);
56 # For backwards compatibility
57 sub finalize_output { shift->finalize_body(@_) };
62 our $RECURSION = 1000;
63 our $DETACH = Catalyst::Exception::Detach->new;
64 our $GO = Catalyst::Exception::Go->new;
66 #I imagine that very few of these really need to be class variables. if any.
67 #maybe we should just make them attributes with a default?
68 __PACKAGE__->mk_classdata($_)
69 for qw/components arguments dispatcher engine log dispatcher_class
70 engine_class context_class request_class response_class stats_class
73 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
74 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
75 __PACKAGE__->request_class('Catalyst::Request');
76 __PACKAGE__->response_class('Catalyst::Response');
77 __PACKAGE__->stats_class('Catalyst::Stats');
79 # Remember to update this in Catalyst::Runtime as well!
81 our $VERSION = '5.80006';
84 my $dev_version = $VERSION =~ /_\d{2}$/;
85 *_IS_DEVELOPMENT_VERSION = sub () { $dev_version };
88 $VERSION = eval $VERSION;
91 my ( $class, @arguments ) = @_;
93 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
95 return unless $class eq 'Catalyst';
97 my $caller = caller();
98 return if $caller eq 'main';
100 # Kill Adopt::NEXT warnings if we're a non-RC version
101 unless (_IS_DEVELOPMENT_VERSION()) {
102 Class::C3::Adopt::NEXT->unimport(qr/^Catalyst::/);
105 my $meta = Moose::Meta::Class->initialize($caller);
106 #Moose->import({ into => $caller }); #do we want to do this?
108 unless ( $caller->isa('Catalyst') ) {
109 my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
110 $meta->superclasses(@superclasses);
112 unless( $meta->has_method('meta') ){
113 $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
116 $caller->arguments( [@arguments] );
120 sub _application { $_[0] }
124 Catalyst - The Elegant MVC Web Application Framework
128 See the L<Catalyst::Manual> distribution for comprehensive
129 documentation and tutorials.
131 # Install Catalyst::Devel for helpers and other development tools
132 # use the helper to create a new application
135 # add models, views, controllers
136 script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
137 script/myapp_create.pl view MyTemplate TT
138 script/myapp_create.pl controller Search
140 # built in testserver -- use -r to restart automatically on changes
141 # --help to see all available options
142 script/myapp_server.pl
144 # command line testing interface
145 script/myapp_test.pl /yada
148 use Catalyst qw/-Debug/; # include plugins here as well
150 ### In lib/MyApp/Controller/Root.pm (autocreated)
151 sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
152 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
153 $c->stash->{template} = 'foo.tt'; # set the template
154 # lookup something from db -- stash vars are passed to TT
156 $c->model('Database::Foo')->search( { country => $args[0] } );
157 if ( $c->req->params->{bar} ) { # access GET or POST parameters
158 $c->forward( 'bar' ); # process another action
159 # do something else after forward returns
163 # The foo.tt TT template can use the stash data from the database
164 [% WHILE (item = data.next) %]
168 # called for /bar/of/soap, /bar/of/soap/10, etc.
169 sub bar : Path('/bar/of/soap') { ... }
171 # called for all actions, from the top-most controller downwards
173 my ( $self, $c ) = @_;
174 if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
175 $c->res->redirect( '/login' ); # require login
176 return 0; # abort request and go immediately to end()
178 return 1; # success; carry on to next action
181 # called after all actions are finished
183 my ( $self, $c ) = @_;
184 if ( scalar @{ $c->error } ) { ... } # handle errors
185 return if $c->res->body; # already have a response
186 $c->forward( 'MyApp::View::TT' ); # render template
189 ### in MyApp/Controller/Foo.pm
190 # called for /foo/bar
191 sub bar : Local { ... }
193 # called for /blargle
194 sub blargle : Global { ... }
196 # an index action matches /foo, but not /foo/1, etc.
197 sub index : Private { ... }
199 ### in MyApp/Controller/Foo/Bar.pm
200 # called for /foo/bar/baz
201 sub baz : Local { ... }
203 # first Root auto is called, then Foo auto, then this
204 sub auto : Private { ... }
206 # powerful regular expression paths are also possible
207 sub details : Regex('^product/(\w+)/details$') {
208 my ( $self, $c ) = @_;
209 # extract the (\w+) from the URI
210 my $product = $c->req->captures->[0];
213 See L<Catalyst::Manual::Intro> for additional information.
217 Catalyst is a modern framework for making web applications without the
218 pain usually associated with this process. This document is a reference
219 to the main Catalyst application. If you are a new user, we suggest you
220 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
222 See L<Catalyst::Manual> for more documentation.
224 Catalyst plugins can be loaded by naming them as arguments to the "use
225 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
226 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
229 use Catalyst qw/My::Module/;
231 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
232 fully qualify the name by using a unary plus:
236 +Fully::Qualified::Plugin::Name
239 Special flags like C<-Debug> and C<-Engine> can also be specified as
240 arguments when Catalyst is loaded:
242 use Catalyst qw/-Debug My::Module/;
244 The position of plugins and flags in the chain is important, because
245 they are loaded in the order in which they appear.
247 The following flags are supported:
251 Enables debug output. You can also force this setting from the system
252 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
253 settings override the application, with <MYAPP>_DEBUG having the highest
258 Forces Catalyst to use a specific engine. Omit the
259 C<Catalyst::Engine::> prefix of the engine name, i.e.:
261 use Catalyst qw/-Engine=CGI/;
265 Forces Catalyst to use a specific home directory, e.g.:
267 use Catalyst qw[-Home=/usr/mst];
269 This can also be done in the shell environment by setting either the
270 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
271 is replaced with the uppercased name of your application, any "::" in
272 the name will be replaced with underscores, e.g. MyApp::Web should use
273 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
277 use Catalyst '-Log=warn,fatal,error';
279 Specifies a comma-delimited list of log levels.
283 Enables statistics collection and reporting. You can also force this setting
284 from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
285 environment settings override the application, with <MYAPP>_STATS having the
290 use Catalyst qw/-Stats=1/
294 =head2 INFORMATION ABOUT THE CURRENT REQUEST
298 Returns a L<Catalyst::Action> object for the current action, which
299 stringifies to the action name. See L<Catalyst::Action>.
303 Returns the namespace of the current action, i.e., the URI prefix
304 corresponding to the controller of the current action. For example:
306 # in Controller::Foo::Bar
307 $c->namespace; # returns 'foo/bar';
313 Returns the current L<Catalyst::Request> object, giving access to
314 information about the current client request (including parameters,
315 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
317 =head2 REQUEST FLOW HANDLING
319 =head2 $c->forward( $action [, \@arguments ] )
321 =head2 $c->forward( $class, $method, [, \@arguments ] )
323 Forwards processing to another action, by its private name. If you give a
324 class name but no method, C<process()> is called. You may also optionally
325 pass arguments in an arrayref. The action will receive the arguments in
326 C<@_> and C<< $c->req->args >>. Upon returning from the function,
327 C<< $c->req->args >> will be restored to the previous values.
329 Any data C<return>ed from the action forwarded to, will be returned by the
332 my $foodata = $c->forward('/foo');
333 $c->forward('index');
334 $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
335 $c->forward('MyApp::View::TT');
337 Note that forward implies an C<<eval { }>> around the call (actually
338 C<execute> does), thus de-fatalizing all 'dies' within the called
339 action. If you want C<die> to propagate you need to do something like:
342 die $c->error if $c->error;
344 Or make sure to always return true values from your actions and write
347 $c->forward('foo') || return;
351 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
353 =head2 $c->detach( $action [, \@arguments ] )
355 =head2 $c->detach( $class, $method, [, \@arguments ] )
359 The same as C<forward>, but doesn't return to the previous action when
360 processing is finished.
362 When called with no arguments it escapes the processing chain entirely.
366 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
368 =head2 $c->visit( $action [, \@captures, \@arguments ] )
370 =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
372 Almost the same as C<forward>, but does a full dispatch, instead of just
373 calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
374 C<auto> and the method you go to are called, just like a new request.
376 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
377 This means, for example, that $c->action methods such as C<name>, C<class> and
378 C<reverse> return information for the visited action when they are invoked
379 within the visited action. This is different from the behavior of C<forward>
380 which continues to use the $c->action object from the caller action even when
381 invoked from the callee.
383 C<$c-E<gt>stash> is kept unchanged.
385 In effect, C<visit> allows you to "wrap" another action, just as it
386 would have been called by dispatching from a URL, while the analogous
387 C<go> allows you to transfer control to another action as if it had
388 been reached directly from a URL.
392 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
394 =head2 $c->go( $action [, \@captures, \@arguments ] )
396 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
398 Almost the same as C<detach>, but does a full dispatch like C<visit>,
399 instead of just calling the new C<$action> /
400 C<$class-E<gt>$method>. This means that C<begin>, C<auto> and the
401 method you visit are called, just like a new request.
403 C<$c-E<gt>stash> is kept unchanged.
407 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
413 Returns the current L<Catalyst::Response> object, see there for details.
417 Returns a hashref to the stash, which may be used to store data and pass
418 it between components during a request. You can also set hash keys by
419 passing arguments. The stash is automatically sent to the view. The
420 stash is cleared at the end of a request; it cannot be used for
421 persistent storage (for this you must use a session; see
422 L<Catalyst::Plugin::Session> for a complete system integrated with
425 $c->stash->{foo} = $bar;
426 $c->stash( { moose => 'majestic', qux => 0 } );
427 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
429 # stash is automatically passed to the view for use in a template
430 $c->forward( 'MyApp::View::TT' );
434 around stash => sub {
437 my $stash = $orig->($c);
439 my $new_stash = @_ > 1 ? {@_} : $_[0];
440 croak('stash takes a hash or hashref') unless ref $new_stash;
441 foreach my $key ( keys %$new_stash ) {
442 $stash->{$key} = $new_stash->{$key};
452 =head2 $c->error($error, ...)
454 =head2 $c->error($arrayref)
456 Returns an arrayref containing error messages. If Catalyst encounters an
457 error while processing a request, it stores the error in $c->error. This
458 method should only be used to store fatal error messages.
460 my @error = @{ $c->error };
464 $c->error('Something bad happened');
471 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
472 croak @$error unless ref $c;
473 push @{ $c->{error} }, @$error;
475 elsif ( defined $_[0] ) { $c->{error} = undef }
476 return $c->{error} || [];
482 Contains the return value of the last executed action.
484 =head2 $c->clear_errors
486 Clear errors. You probably don't want to clear the errors unless you are
487 implementing a custom error screen.
489 This is equivalent to running
500 sub _comp_search_prefixes {
502 return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
505 # search components given a name and some prefixes
506 sub _comp_names_search_prefixes {
507 my ( $c, $name, @prefixes ) = @_;
508 my $appclass = ref $c || $c;
509 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
510 $filter = qr/$filter/; # Compile regex now rather than once per loop
512 # map the original component name to the sub part that we will search against
513 my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
514 grep { /$filter/ } keys %{ $c->components };
516 # undef for a name will return all
517 return keys %eligible if !defined $name;
519 my $query = ref $name ? $name : qr/^$name$/i;
520 my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
522 return @result if @result;
524 # if we were given a regexp to search against, we're done.
529 @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
531 # no results? try against full names
533 @result = grep { m{$query} } keys %eligible;
536 # don't warn if we didn't find any results, it just might not exist
538 # Disgusting hack to work out correct method name
539 my $warn_for = lc $prefixes[0];
540 my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
541 (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
542 "component resolution is unreliable and unsafe.";
543 my $short = $result[0];
544 $short =~ s/.*?Model:://;
545 my $shortmess = Carp::shortmess('');
546 if ($shortmess =~ m#Catalyst/Plugin#) {
547 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
549 } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
550 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
551 "component's config";
553 $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}({'${name}'}), " .
554 "but if you really wanted to search, pass in a regexp as the argument " .
555 "like so: \$c->${warn_for}(qr/${name}/)";
557 $c->log->warn( "${msg}$shortmess" );
563 # Find possible names for a prefix
565 my ( $c, @prefixes ) = @_;
566 my $appclass = ref $c || $c;
568 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
570 my @names = map { s{$filter}{}; $_; }
571 $c->_comp_names_search_prefixes( undef, @prefixes );
576 # Filter a component before returning by calling ACCEPT_CONTEXT if available
577 sub _filter_component {
578 my ( $c, $comp, @args ) = @_;
580 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
581 return $comp->ACCEPT_CONTEXT( $c, @args );
587 =head2 COMPONENT ACCESSORS
589 =head2 $c->controller($name)
591 Gets a L<Catalyst::Controller> instance by name.
593 $c->controller('Foo')->do_stuff;
595 If the name is omitted, will return the controller for the dispatched
598 If you want to search for controllers, pass in a regexp as the argument.
600 # find all controllers that start with Foo
601 my @foo_controllers = $c->controller(qr{^Foo});
607 my ( $c, $name, @args ) = @_;
610 my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
611 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
612 return $c->_filter_component( $result[ 0 ], @args );
615 return $c->component( $c->action->class );
618 =head2 $c->model($name)
620 Gets a L<Catalyst::Model> instance by name.
622 $c->model('Foo')->do_stuff;
624 Any extra arguments are directly passed to ACCEPT_CONTEXT.
626 If the name is omitted, it will look for
627 - a model object in $c->stash->{current_model_instance}, then
628 - a model name in $c->stash->{current_model}, then
629 - a config setting 'default_model', or
630 - check if there is only one model, and return it if that's the case.
632 If you want to search for models, pass in a regexp as the argument.
634 # find all models that start with Foo
635 my @foo_models = $c->model(qr{^Foo});
640 my ( $c, $name, @args ) = @_;
643 my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
644 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
645 return $c->_filter_component( $result[ 0 ], @args );
649 return $c->stash->{current_model_instance}
650 if $c->stash->{current_model_instance};
651 return $c->model( $c->stash->{current_model} )
652 if $c->stash->{current_model};
654 return $c->model( $c->config->{default_model} )
655 if $c->config->{default_model};
657 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
660 $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
661 $c->log->warn( '* $c->config->{default_model} # the name of the default model to use' );
662 $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
663 $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
664 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
667 return $c->_filter_component( $comp );
671 =head2 $c->view($name)
673 Gets a L<Catalyst::View> instance by name.
675 $c->view('Foo')->do_stuff;
677 Any extra arguments are directly passed to ACCEPT_CONTEXT.
679 If the name is omitted, it will look for
680 - a view object in $c->stash->{current_view_instance}, then
681 - a view name in $c->stash->{current_view}, then
682 - a config setting 'default_view', or
683 - check if there is only one view, and return it if that's the case.
685 If you want to search for views, pass in a regexp as the argument.
687 # find all views that start with Foo
688 my @foo_views = $c->view(qr{^Foo});
693 my ( $c, $name, @args ) = @_;
696 my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
697 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
698 return $c->_filter_component( $result[ 0 ], @args );
702 return $c->stash->{current_view_instance}
703 if $c->stash->{current_view_instance};
704 return $c->view( $c->stash->{current_view} )
705 if $c->stash->{current_view};
707 return $c->view( $c->config->{default_view} )
708 if $c->config->{default_view};
710 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
713 $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
714 $c->log->warn( '* $c->config->{default_view} # the name of the default view to use' );
715 $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
716 $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
717 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
720 return $c->_filter_component( $comp );
723 =head2 $c->controllers
725 Returns the available names which can be passed to $c->controller
731 return $c->_comp_names(qw/Controller C/);
736 Returns the available names which can be passed to $c->model
742 return $c->_comp_names(qw/Model M/);
748 Returns the available names which can be passed to $c->view
754 return $c->_comp_names(qw/View V/);
757 =head2 $c->comp($name)
759 =head2 $c->component($name)
761 Gets a component object by name. This method is not recommended,
762 unless you want to get a specific component by full
763 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
764 should be used instead.
766 If C<$name> is a regexp, a list of components matched against the full
767 component name will be returned.
772 my ( $c, $name, @args ) = @_;
775 my $comps = $c->components;
778 # is it the exact name?
779 return $c->_filter_component( $comps->{ $name }, @args )
780 if exists $comps->{ $name };
782 # perhaps we just omitted "MyApp"?
783 my $composed = ( ref $c || $c ) . "::${name}";
784 return $c->_filter_component( $comps->{ $composed }, @args )
785 if exists $comps->{ $composed };
787 # search all of the models, views and controllers
788 my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
789 return $c->_filter_component( $comp, @args ) if $comp;
792 # This is here so $c->comp( '::M::' ) works
793 my $query = ref $name ? $name : qr{$name}i;
795 my @result = grep { m{$query} } keys %{ $c->components };
796 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
799 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
800 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
801 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
802 return $c->_filter_component( $result[ 0 ], @args );
805 # I would expect to return an empty list here, but that breaks back-compat
809 return sort keys %{ $c->components };
812 =head2 CLASS DATA AND HELPER CLASSES
816 Returns or takes a hashref containing the application's configuration.
818 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
820 You can also use a C<YAML>, C<XML> or C<Config::General> config file
821 like myapp.conf in your applications home directory. See
822 L<Catalyst::Plugin::ConfigLoader>.
824 =head3 Cascading configuration.
826 The config method is present on all Catalyst components, and configuration
827 will be merged when an application is started. Configuration loaded with
828 L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
829 followed by configuration in your top level C<MyApp> class. These two
830 configurations are merged, and then configuration data whose hash key matches a
831 component name is merged with configuration for that component.
833 The configuration for a component is then passed to the C<new> method when a
834 component is constructed.
838 MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
839 MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
841 will mean that C<MyApp::Model::Foo> receives the following data when
844 MyApp::Model::Foo->new({
852 around config => sub {
856 croak('Setting config after setup has been run is not allowed.')
857 if ( @_ and $c->setup_finished );
864 Returns the logging object instance. Unless it is already set, Catalyst
865 sets this up with a L<Catalyst::Log> object. To use your own log class,
866 set the logger with the C<< __PACKAGE__->log >> method prior to calling
867 C<< __PACKAGE__->setup >>.
869 __PACKAGE__->log( MyLogger->new );
874 $c->log->info( 'Now logging with my own logger!' );
876 Your log class should implement the methods described in
882 Returns 1 if debug mode is enabled, 0 otherwise.
884 You can enable debug mode in several ways:
888 =item By calling myapp_server.pl with the -d flag
890 =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
892 =item The -Debug option in your MyApp.pm
894 =item By declaring C<sub debug { 1 }> in your MyApp.pm.
898 Calling C<< $c->debug(1) >> has no effect.
904 =head2 $c->dispatcher
906 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
910 Returns the engine instance. See L<Catalyst::Engine>.
913 =head2 UTILITY METHODS
915 =head2 $c->path_to(@path)
917 Merges C<@path> with C<< $c->config->{home} >> and returns a
918 L<Path::Class::Dir> object. Note you can usually use this object as
919 a filename, but sometimes you will have to explicitly stringify it
920 yourself by calling the C<<->stringify>> method.
924 $c->path_to( 'db', 'sqlite.db' );
929 my ( $c, @path ) = @_;
930 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
931 if ( -d $path ) { return $path }
932 else { return Path::Class::File->new( $c->config->{home}, @path ) }
935 =head2 $c->plugin( $name, $class, @args )
937 Helper method for plugins. It creates a class data accessor/mutator and
938 loads and instantiates the given class.
940 MyApp->plugin( 'prototype', 'HTML::Prototype' );
942 $c->prototype->define_javascript_functions;
944 B<Note:> This method of adding plugins is deprecated. The ability
945 to add plugins like this B<will be removed> in a Catalyst 5.81.
946 Please do not use this functionality in new code.
951 my ( $class, $name, $plugin, @args ) = @_;
953 # See block comment in t/unit_core_plugin.t
954 $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
956 $class->_register_plugin( $plugin, 1 );
958 eval { $plugin->import };
959 $class->mk_classdata($name);
961 eval { $obj = $plugin->new(@args) };
964 Catalyst::Exception->throw( message =>
965 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
969 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
975 Initializes the dispatcher and engine, loads any plugins, and loads the
976 model, view, and controller components. You may also specify an array
977 of plugins to load here, if you choose to not load them in the C<use
981 MyApp->setup( qw/-Debug/ );
986 my ( $class, @arguments ) = @_;
987 croak('Running setup more than once')
988 if ( $class->setup_finished );
990 unless ( $class->isa('Catalyst') ) {
992 Catalyst::Exception->throw(
993 message => qq/'$class' does not inherit from Catalyst/ );
996 if ( $class->arguments ) {
997 @arguments = ( @arguments, @{ $class->arguments } );
1003 foreach (@arguments) {
1007 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
1009 elsif (/^-(\w+)=?(.*)$/) {
1010 $flags->{ lc $1 } = $2;
1013 push @{ $flags->{plugins} }, $_;
1017 $class->setup_home( delete $flags->{home} );
1019 $class->setup_log( delete $flags->{log} );
1020 $class->setup_plugins( delete $flags->{plugins} );
1021 $class->setup_dispatcher( delete $flags->{dispatcher} );
1022 $class->setup_engine( delete $flags->{engine} );
1023 $class->setup_stats( delete $flags->{stats} );
1025 for my $flag ( sort keys %{$flags} ) {
1027 if ( my $code = $class->can( 'setup_' . $flag ) ) {
1028 &$code( $class, delete $flags->{$flag} );
1031 $class->log->warn(qq/Unknown flag "$flag"/);
1035 eval { require Catalyst::Devel; };
1036 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1037 $class->log->warn(<<"EOF");
1038 You are running an old script!
1040 Please update by running (this will overwrite existing files):
1041 catalyst.pl -force -scripts $class
1043 or (this will not overwrite existing files):
1044 catalyst.pl -scripts $class
1049 if ( $class->debug ) {
1050 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
1053 my $column_width = Catalyst::Utils::term_width() - 6;
1054 my $t = Text::SimpleTable->new($column_width);
1055 $t->row($_) for @plugins;
1056 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
1059 my $dispatcher = $class->dispatcher;
1060 my $engine = $class->engine;
1061 my $home = $class->config->{home};
1063 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1064 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1068 ? $class->log->debug(qq/Found home "$home"/)
1069 : $class->log->debug(qq/Home "$home" doesn't exist/)
1070 : $class->log->debug(q/Couldn't find home/);
1073 # Call plugins setup, this is stupid and evil.
1074 # Also screws C3 badly on 5.10, hack to avoid.
1076 no warnings qw/redefine/;
1077 local *setup = sub { };
1078 $class->setup unless $Catalyst::__AM_RESTARTING;
1081 # Initialize our data structure
1082 $class->components( {} );
1084 $class->setup_components;
1086 if ( $class->debug ) {
1087 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1088 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1089 for my $comp ( sort keys %{ $class->components } ) {
1090 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1091 $t->row( $comp, $type );
1093 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1094 if ( keys %{ $class->components } );
1097 # Add our self to components, since we are also a component
1098 if( $class->isa('Catalyst::Controller') ){
1099 $class->components->{$class} = $class;
1102 $class->setup_actions;
1104 if ( $class->debug ) {
1105 my $name = $class->config->{name} || 'Application';
1106 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1108 $class->log->_flush() if $class->log->can('_flush');
1110 # Make sure that the application class becomes immutable at this point,
1111 # which ensures that it gets an inlined constructor. This means that it
1112 # works even if the user has added a plugin which contains a new method.
1113 # Note however that we have to do the work on scope end, so that method
1114 # modifiers work correctly in MyApp (as you have to call setup _before_
1115 # applying modifiers).
1116 B::Hooks::EndOfScope::on_scope_end {
1118 my $meta = Class::MOP::get_metaclass_by_name($class);
1119 if ( $meta->is_immutable && ! { $meta->immutable_options }->{inline_constructor} ) {
1120 warn "You made your application class ($class) immutable, "
1121 . "but did not inline the constructor.\n"
1122 . "This will break catalyst, please pass "
1123 . "(replace_constructor => 1) when making your class immutable.\n";
1125 $meta->make_immutable(replace_constructor => 1) unless $meta->is_immutable;
1128 $class->setup_finalize;
1132 =head2 $app->setup_finalize
1134 A hook to attach modifiers to.
1135 Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup.
1136 Also better than C< setup_finished(); >, as that is a getter method.
1138 sub setup_finalize {
1142 ## do stuff, i.e., determine a primary key column for sessions stored in a DB
1144 $app->next::method(@_);
1151 sub setup_finalize {
1153 $class->setup_finished(1);
1156 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1158 =head2 $c->uri_for( $path, @args?, \%query_values? )
1164 A Catalyst::Action object representing the Catalyst action you want to
1165 create a URI for. To get one for an action in the current controller,
1166 use C<< $c->action('someactionname') >>. To get one from different
1167 controller, fetch the controller using C<< $c->controller() >>, then
1168 call C<action_for> on it.
1170 You can maintain the arguments captured by an action (e.g.: Regex, Chained)
1171 using C<< $c->req->captures >>.
1173 # For the current action
1174 $c->uri_for($c->action, $c->req->captures);
1176 # For the Foo action in the Bar controller
1177 $c->uri_for($c->controller('Bar')->action_for('Foo'), $c->req->captures);
1184 my ( $c, $path, @args ) = @_;
1186 if ( blessed($path) ) { # action object
1187 my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
1191 $path = $c->dispatcher->uri_for_action($action, $captures);
1192 if (not defined $path) {
1193 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1197 $path = '/' if $path eq '';
1200 undef($path) if (defined $path && $path eq '');
1203 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1205 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1206 s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
1208 unshift(@args, $path);
1210 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1211 my $namespace = $c->namespace;
1212 if (defined $path) { # cheesy hack to handle path '../foo'
1213 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1215 unshift(@args, $namespace || '');
1218 # join args with '/', or a blank string
1219 my $args = join('/', grep { defined($_) } @args);
1220 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1222 my $base = $c->req->base;
1223 my $class = ref($base);
1224 $base =~ s{(?<!/)$}{/};
1228 if (my @keys = keys %$params) {
1229 # somewhat lifted from URI::_query's query_form
1230 $query = '?'.join('&', map {
1231 my $val = $params->{$_};
1232 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1235 $val = '' unless defined $val;
1238 utf8::encode( $param ) if utf8::is_utf8($param);
1239 # using the URI::Escape pattern here so utf8 chars survive
1240 $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1242 "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1246 my $res = bless(\"${base}${args}${query}", $class);
1250 =head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
1252 =head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
1258 A private path to the Catalyst action you want to create a URI for.
1260 This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1261 >> and passing the resulting C<$action> and the remaining arguments to C<<
1264 You can also pass in a Catalyst::Action object, in which case it is passed to
1271 sub uri_for_action {
1272 my ( $c, $path, @args ) = @_;
1273 my $action = blessed($path)
1275 : $c->dispatcher->get_action_by_path($path);
1276 unless (defined $action) {
1277 croak "Can't find action for path '$path'";
1279 return $c->uri_for( $action, @args );
1282 =head2 $c->welcome_message
1284 Returns the Catalyst welcome HTML page.
1288 sub welcome_message {
1290 my $name = $c->config->{name};
1291 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1292 my $prefix = Catalyst::Utils::appprefix( ref $c );
1293 $c->response->content_type('text/html; charset=utf-8');
1295 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1296 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1297 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1299 <meta http-equiv="Content-Language" content="en" />
1300 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1301 <title>$name on Catalyst $VERSION</title>
1302 <style type="text/css">
1305 background-color: #eee;
1312 margin-bottom: 10px;
1314 background-color: #ccc;
1315 border: 1px solid #aaa;
1320 font-family: verdana, tahoma, sans-serif;
1323 font-family: verdana, tahoma, sans-serif;
1326 text-decoration: none;
1328 border-bottom: 1px dotted #bbb;
1330 :link:hover, :visited:hover {
1343 background-color: #fff;
1344 border: 1px solid #aaa;
1348 font-weight: normal;
1370 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1375 <img src="$logo" alt="Catalyst Logo" />
1377 <p>Welcome to the world of Catalyst.
1378 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1379 framework will make web development something you had
1380 never expected it to be: Fun, rewarding, and quick.</p>
1381 <h2>What to do now?</h2>
1382 <p>That really depends on what <b>you</b> want to do.
1383 We do, however, provide you with a few starting points.</p>
1384 <p>If you want to jump right into web development with Catalyst
1385 you might want to start with a tutorial.</p>
1386 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1388 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1390 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1391 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1393 <h2>What to do next?</h2>
1394 <p>Next it's time to write an actual application. Use the
1395 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
1396 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a>, and
1397 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>;
1398 they can save you a lot of work.</p>
1399 <pre><code>script/${prefix}_create.pl -help</code></pre>
1400 <p>Also, be sure to check out the vast and growing
1401 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1402 you are likely to find what you need there.
1406 <p>Catalyst has a very active community. Here are the main places to
1407 get in touch with us.</p>
1410 <a href="http://dev.catalyst.perl.org">Wiki</a>
1413 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1416 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1419 <h2>In conclusion</h2>
1420 <p>The Catalyst team hopes you will enjoy using Catalyst as much
1421 as we enjoyed making it. Please contact us if you have ideas
1422 for improvement or other feedback.</p>
1430 =head1 INTERNAL METHODS
1432 These methods are not meant to be used by end users.
1434 =head2 $c->components
1436 Returns a hash of components.
1438 =head2 $c->context_class
1440 Returns or sets the context class.
1444 Returns a hashref containing coderefs and execution counts (needed for
1445 deep recursion detection).
1449 Returns the number of actions on the current internal execution stack.
1453 Dispatches a request to actions.
1457 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1459 =head2 $c->dispatcher_class
1461 Returns or sets the dispatcher class.
1463 =head2 $c->dump_these
1465 Returns a list of 2-element array references (name, structure) pairs
1466 that will be dumped on the error page in debug mode.
1472 [ Request => $c->req ],
1473 [ Response => $c->res ],
1474 [ Stash => $c->stash ],
1475 [ Config => $c->config ];
1478 =head2 $c->engine_class
1480 Returns or sets the engine class.
1482 =head2 $c->execute( $class, $coderef )
1484 Execute a coderef in given class and catch exceptions. Errors are available
1490 my ( $c, $class, $code ) = @_;
1491 $class = $c->component($class) || $class;
1494 if ( $c->depth >= $RECURSION ) {
1495 my $action = $code->reverse();
1496 $action = "/$action" unless $action =~ /->/;
1497 my $error = qq/Deep recursion detected calling "${action}"/;
1498 $c->log->error($error);
1504 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1506 push( @{ $c->stack }, $code );
1508 no warnings 'recursion';
1509 eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
1511 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1513 my $last = pop( @{ $c->stack } );
1515 if ( my $error = $@ ) {
1516 if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
1517 $error->rethrow if $c->depth > 1;
1519 elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
1520 $error->rethrow if $c->depth > 0;
1523 unless ( ref $error ) {
1524 no warnings 'uninitialized';
1526 my $class = $last->class;
1527 my $name = $last->name;
1528 $error = qq/Caught exception in $class->$name "$error"/;
1537 sub _stats_start_execute {
1538 my ( $c, $code ) = @_;
1540 return if ( ( $code->name =~ /^_.*/ )
1541 && ( !$c->config->{show_internal_actions} ) );
1543 my $action_name = $code->reverse();
1544 $c->counter->{$action_name}++;
1546 my $action = $action_name;
1547 $action = "/$action" unless $action =~ /->/;
1549 # determine if the call was the result of a forward
1550 # this is done by walking up the call stack and looking for a calling
1551 # sub of Catalyst::forward before the eval
1553 for my $index ( 2 .. 11 ) {
1555 if ( ( caller($index) )[0] eq 'Catalyst'
1556 && ( caller($index) )[3] eq '(eval)' );
1558 if ( ( caller($index) )[3] =~ /forward$/ ) {
1559 $callsub = ( caller($index) )[3];
1560 $action = "-> $action";
1565 my $uid = $action_name . $c->counter->{$action_name};
1567 # is this a root-level call or a forwarded call?
1568 if ( $callsub =~ /forward$/ ) {
1570 # forward, locate the caller
1571 if ( my $parent = $c->stack->[-1] ) {
1574 parent => "$parent" . $c->counter->{"$parent"},
1580 # forward with no caller may come from a plugin
1599 sub _stats_finish_execute {
1600 my ( $c, $info ) = @_;
1601 $c->stats->profile( end => $info );
1604 =head2 $c->_localize_fields( sub { }, \%keys );
1608 #Why does this exist? This is no longer safe and WILL NOT WORK.
1609 # it doesnt seem to be used anywhere. can we remove it?
1610 sub _localize_fields {
1611 my ( $c, $localized, $code ) = ( @_ );
1613 my $request = delete $localized->{request} || {};
1614 my $response = delete $localized->{response} || {};
1616 local @{ $c }{ keys %$localized } = values %$localized;
1617 local @{ $c->request }{ keys %$request } = values %$request;
1618 local @{ $c->response }{ keys %$response } = values %$response;
1625 Finalizes the request.
1632 for my $error ( @{ $c->error } ) {
1633 $c->log->error($error);
1636 # Allow engine to handle finalize flow (for POE)
1637 my $engine = $c->engine;
1638 if ( my $code = $engine->can('finalize') ) {
1643 $c->finalize_uploads;
1646 if ( $#{ $c->error } >= 0 ) {
1650 $c->finalize_headers;
1653 if ( $c->request->method eq 'HEAD' ) {
1654 $c->response->body('');
1660 if ($c->use_stats) {
1661 my $elapsed = sprintf '%f', $c->stats->elapsed;
1662 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1664 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1667 return $c->response->status;
1670 =head2 $c->finalize_body
1676 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1678 =head2 $c->finalize_cookies
1684 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1686 =head2 $c->finalize_error
1692 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1694 =head2 $c->finalize_headers
1700 sub finalize_headers {
1703 my $response = $c->response; #accessor calls can add up?
1705 # Check if we already finalized headers
1706 return if $response->finalized_headers;
1709 if ( my $location = $response->redirect ) {
1710 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1711 $response->header( Location => $location );
1713 if ( !$response->has_body ) {
1714 # Add a default body if none is already present
1716 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1722 if ( $response->body && !$response->content_length ) {
1724 # get the length from a filehandle
1725 if ( blessed( $response->body ) && $response->body->can('read') )
1727 my $stat = stat $response->body;
1728 if ( $stat && $stat->size > 0 ) {
1729 $response->content_length( $stat->size );
1732 $c->log->warn('Serving filehandle without a content-length');
1736 # everything should be bytes at this point, but just in case
1737 $response->content_length( bytes::length( $response->body ) );
1742 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1743 $response->headers->remove_header("Content-Length");
1744 $response->body('');
1747 $c->finalize_cookies;
1749 $c->engine->finalize_headers( $c, @_ );
1752 $response->finalized_headers(1);
1755 =head2 $c->finalize_output
1757 An alias for finalize_body.
1759 =head2 $c->finalize_read
1761 Finalizes the input after reading is complete.
1765 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1767 =head2 $c->finalize_uploads
1769 Finalizes uploads. Cleans up any temporary files.
1773 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1775 =head2 $c->get_action( $action, $namespace )
1777 Gets an action in a given namespace.
1781 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1783 =head2 $c->get_actions( $action, $namespace )
1785 Gets all actions of a given name in a namespace and all parent
1790 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1792 =head2 $c->handle_request( $class, @arguments )
1794 Called to handle each HTTP request.
1798 sub handle_request {
1799 my ( $class, @arguments ) = @_;
1801 # Always expect worst case!
1804 if ($class->debug) {
1805 my $secs = time - $START || 1;
1806 my $av = sprintf '%.3f', $COUNT / $secs;
1807 my $time = localtime time;
1808 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1811 my $c = $class->prepare(@arguments);
1813 $status = $c->finalize;
1816 if ( my $error = $@ ) {
1818 $class->log->error(qq/Caught exception in engine "$error"/);
1823 if(my $coderef = $class->log->can('_flush')){
1824 $class->log->$coderef();
1829 =head2 $c->prepare( @arguments )
1831 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1837 my ( $class, @arguments ) = @_;
1840 # After the app/ctxt split, this should become an attribute based on something passed
1841 # into the application.
1842 $class->context_class( ref $class || $class ) unless $class->context_class;
1844 my $c = $class->context_class->new({});
1846 # For on-demand data
1847 $c->request->_context($c);
1848 $c->response->_context($c);
1850 #surely this is not the most efficient way to do things...
1851 $c->stats($class->stats_class->new)->enable($c->use_stats);
1853 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1856 #XXX reuse coderef from can
1857 # Allow engine to direct the prepare flow (for POE)
1858 if ( $c->engine->can('prepare') ) {
1859 $c->engine->prepare( $c, @arguments );
1862 $c->prepare_request(@arguments);
1863 $c->prepare_connection;
1864 $c->prepare_query_parameters;
1865 $c->prepare_headers;
1866 $c->prepare_cookies;
1869 # Prepare the body for reading, either by prepare_body
1870 # or the user, if they are using $c->read
1873 # Parse the body unless the user wants it on-demand
1874 unless ( $c->config->{parse_on_demand} ) {
1879 my $method = $c->req->method || '';
1880 my $path = $c->req->path;
1881 $path = '/' unless length $path;
1882 my $address = $c->req->address || '';
1884 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1892 =head2 $c->prepare_action
1894 Prepares action. See L<Catalyst::Dispatcher>.
1898 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1900 =head2 $c->prepare_body
1902 Prepares message body.
1909 return if $c->request->_has_body;
1911 # Initialize on-demand data
1912 $c->engine->prepare_body( $c, @_ );
1913 $c->prepare_parameters;
1914 $c->prepare_uploads;
1916 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1917 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1918 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1919 my $param = $c->req->body_parameters->{$key};
1920 my $value = defined($param) ? $param : '';
1922 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1924 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1928 =head2 $c->prepare_body_chunk( $chunk )
1930 Prepares a chunk of data before sending it to L<HTTP::Body>.
1932 See L<Catalyst::Engine>.
1936 sub prepare_body_chunk {
1938 $c->engine->prepare_body_chunk( $c, @_ );
1941 =head2 $c->prepare_body_parameters
1943 Prepares body parameters.
1947 sub prepare_body_parameters {
1949 $c->engine->prepare_body_parameters( $c, @_ );
1952 =head2 $c->prepare_connection
1954 Prepares connection.
1958 sub prepare_connection {
1960 $c->engine->prepare_connection( $c, @_ );
1963 =head2 $c->prepare_cookies
1969 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1971 =head2 $c->prepare_headers
1977 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1979 =head2 $c->prepare_parameters
1981 Prepares parameters.
1985 sub prepare_parameters {
1987 $c->prepare_body_parameters;
1988 $c->engine->prepare_parameters( $c, @_ );
1991 =head2 $c->prepare_path
1993 Prepares path and base.
1997 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1999 =head2 $c->prepare_query_parameters
2001 Prepares query parameters.
2005 sub prepare_query_parameters {
2008 $c->engine->prepare_query_parameters( $c, @_ );
2010 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
2011 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
2012 for my $key ( sort keys %{ $c->req->query_parameters } ) {
2013 my $param = $c->req->query_parameters->{$key};
2014 my $value = defined($param) ? $param : '';
2016 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2018 $c->log->debug( "Query Parameters are:\n" . $t->draw );
2022 =head2 $c->prepare_read
2024 Prepares the input for reading.
2028 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2030 =head2 $c->prepare_request
2032 Prepares the engine request.
2036 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2038 =head2 $c->prepare_uploads
2044 sub prepare_uploads {
2047 $c->engine->prepare_uploads( $c, @_ );
2049 if ( $c->debug && keys %{ $c->request->uploads } ) {
2050 my $t = Text::SimpleTable->new(
2051 [ 12, 'Parameter' ],
2056 for my $key ( sort keys %{ $c->request->uploads } ) {
2057 my $upload = $c->request->uploads->{$key};
2058 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2059 $t->row( $key, $u->filename, $u->type, $u->size );
2062 $c->log->debug( "File Uploads are:\n" . $t->draw );
2066 =head2 $c->prepare_write
2068 Prepares the output for writing.
2072 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2074 =head2 $c->request_class
2076 Returns or sets the request class.
2078 =head2 $c->response_class
2080 Returns or sets the response class.
2082 =head2 $c->read( [$maxlength] )
2084 Reads a chunk of data from the request body. This method is designed to
2085 be used in a while loop, reading C<$maxlength> bytes on every call.
2086 C<$maxlength> defaults to the size of the request if not specified.
2088 You have to set C<< MyApp->config->{parse_on_demand} >> to use this
2091 Warning: If you use read(), Catalyst will not process the body,
2092 so you will not be able to access POST parameters or file uploads via
2093 $c->request. You must handle all body parsing yourself.
2097 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2105 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2107 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2109 Sets an action in a given namespace.
2113 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2115 =head2 $c->setup_actions($component)
2117 Sets up actions for a component.
2121 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2123 =head2 $c->setup_components
2125 Sets up components. Specify a C<setup_components> config option to pass
2126 additional options directly to L<Module::Pluggable>. To add additional
2127 search paths, specify a key named C<search_extra> as an array
2128 reference. Items in the array beginning with C<::> will have the
2129 application class name prepended to them.
2131 All components found will also have any
2132 L<Devel::InnerPackage|inner packages> loaded and set up as components.
2133 Note, that modules which are B<not> an I<inner package> of the main
2134 file namespace loaded will not be instantiated as components.
2138 sub setup_components {
2141 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
2142 my $config = $class->config->{ setup_components };
2143 my $extra = delete $config->{ search_extra } || [];
2145 push @paths, @$extra;
2147 my $locator = Module::Pluggable::Object->new(
2148 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2152 my @comps = sort { length $a <=> length $b } $locator->plugins;
2153 my %comps = map { $_ => 1 } @comps;
2155 my $deprecated_component_names = grep { /::[CMV]::/ } @comps;
2156 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2157 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2158 ) if $deprecated_component_names;
2160 for my $component ( @comps ) {
2162 # We pass ignore_loaded here so that overlay files for (e.g.)
2163 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2164 # we know M::P::O found a file on disk so this is safe
2166 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2167 #Class::MOP::load_class($component);
2169 my $module = $class->setup_component( $component );
2171 $component => $module,
2173 $_ => $class->setup_component( $_ )
2175 not exists $comps{$_}
2176 } Devel::InnerPackage::list_packages( $component )
2179 for my $key ( keys %modules ) {
2180 $class->components->{ $key } = $modules{ $key };
2185 =head2 $c->setup_component
2189 sub _controller_init_base_classes {
2190 my ($app_class, $component) = @_;
2191 foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) {
2192 Moose::Meta::Class->initialize( $class )
2193 unless find_meta($class);
2197 sub setup_component {
2198 my( $class, $component ) = @_;
2200 unless ( $component->can( 'COMPONENT' ) ) {
2204 # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
2205 # nearest to Catalyst::Controller first, no matter what order stuff happens
2206 # to be loaded. There are TODO tests in Moose for this, see
2207 # f2391d17574eff81d911b97be15ea51080500003
2208 if ($component->isa('Catalyst::Controller')) {
2209 $class->_controller_init_base_classes($component);
2212 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2213 my $config = $class->config->{ $suffix } || {};
2215 my $instance = eval { $component->COMPONENT( $class, $config ); };
2217 if ( my $error = $@ ) {
2219 Catalyst::Exception->throw(
2220 message => qq/Couldn't instantiate component "$component", "$error"/
2224 unless (blessed $instance) {
2225 my $metaclass = Moose::Util::find_meta($component);
2226 my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2227 my $component_method_from = $method_meta->associated_metaclass->name;
2228 my $value = defined($instance) ? $instance : 'undef';
2229 Catalyst::Exception->throw(
2231 qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2237 =head2 $c->setup_dispatcher
2243 sub setup_dispatcher {
2244 my ( $class, $dispatcher ) = @_;
2247 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2250 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2251 $dispatcher = 'Catalyst::Dispatcher::' . $env;
2254 unless ($dispatcher) {
2255 $dispatcher = $class->dispatcher_class;
2258 Class::MOP::load_class($dispatcher);
2260 # dispatcher instance
2261 $class->dispatcher( $dispatcher->new );
2264 =head2 $c->setup_engine
2271 my ( $class, $engine ) = @_;
2274 $engine = 'Catalyst::Engine::' . $engine;
2277 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2278 $engine = 'Catalyst::Engine::' . $env;
2281 if ( $ENV{MOD_PERL} ) {
2282 my $meta = Class::MOP::get_metaclass_by_name($class);
2284 # create the apache method
2285 $meta->add_method('apache' => sub { shift->engine->apache });
2287 my ( $software, $version ) =
2288 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2291 $version =~ s/(\.[^.]+)\./$1/g;
2293 if ( $software eq 'mod_perl' ) {
2297 if ( $version >= 1.99922 ) {
2298 $engine = 'Catalyst::Engine::Apache2::MP20';
2301 elsif ( $version >= 1.9901 ) {
2302 $engine = 'Catalyst::Engine::Apache2::MP19';
2305 elsif ( $version >= 1.24 ) {
2306 $engine = 'Catalyst::Engine::Apache::MP13';
2310 Catalyst::Exception->throw( message =>
2311 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2316 # install the correct mod_perl handler
2317 if ( $version >= 1.9901 ) {
2318 *handler = sub : method {
2319 shift->handle_request(@_);
2323 *handler = sub ($$) { shift->handle_request(@_) };
2328 elsif ( $software eq 'Zeus-Perl' ) {
2329 $engine = 'Catalyst::Engine::Zeus';
2333 Catalyst::Exception->throw(
2334 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2339 $engine = $class->engine_class;
2342 Class::MOP::load_class($engine);
2344 # check for old engines that are no longer compatible
2346 if ( $engine->isa('Catalyst::Engine::Apache')
2347 && !Catalyst::Engine::Apache->VERSION )
2352 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2353 && Catalyst::Engine::Server->VERSION le '0.02' )
2358 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2359 && $engine->VERSION eq '0.01' )
2364 elsif ($engine->isa('Catalyst::Engine::Zeus')
2365 && $engine->VERSION eq '0.01' )
2371 Catalyst::Exception->throw( message =>
2372 qq/Engine "$engine" is not supported by this version of Catalyst/
2377 $class->engine( $engine->new );
2380 =head2 $c->setup_home
2382 Sets up the home directory.
2387 my ( $class, $home ) = @_;
2389 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2393 $home ||= Catalyst::Utils::home($class);
2396 #I remember recently being scolded for assigning config values like this
2397 $class->config->{home} ||= $home;
2398 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2402 =head2 $c->setup_log
2404 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2405 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2408 This method also installs a C<debug> method that returns a true value into the
2409 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2410 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2412 Note that if the log has already been setup, by either a previous call to
2413 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2414 that this method won't actually set up the log object.
2419 my ( $class, $levels ) = @_;
2422 $levels =~ s/^\s+//;
2423 $levels =~ s/\s+$//;
2424 my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
2426 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2427 if ( defined $env_debug ) {
2428 $levels{debug} = 1 if $env_debug; # Ugly!
2429 delete($levels{debug}) unless $env_debug;
2432 unless ( $class->log ) {
2433 $class->log( Catalyst::Log->new(keys %levels) );
2436 if ( $levels{debug} ) {
2437 Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2438 $class->log->debug('Debug messages enabled');
2442 =head2 $c->setup_plugins
2448 =head2 $c->setup_stats
2450 Sets up timing statistics class.
2455 my ( $class, $stats ) = @_;
2457 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2459 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2460 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2461 Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2462 $class->log->debug('Statistics enabled');
2467 =head2 $c->registered_plugins
2469 Returns a sorted list of the plugins which have either been stated in the
2470 import list or which have been added via C<< MyApp->plugin(@args); >>.
2472 If passed a given plugin name, it will report a boolean value indicating
2473 whether or not that plugin is loaded. A fully qualified name is required if
2474 the plugin name does not begin with C<Catalyst::Plugin::>.
2476 if ($c->registered_plugins('Some::Plugin')) {
2484 sub registered_plugins {
2486 return sort keys %{ $proto->_plugins } unless @_;
2488 return 1 if exists $proto->_plugins->{$plugin};
2489 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2492 sub _register_plugin {
2493 my ( $proto, $plugin, $instant ) = @_;
2494 my $class = ref $proto || $proto;
2496 Class::MOP::load_class( $plugin );
2498 $proto->_plugins->{$plugin} = 1;
2501 if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
2502 my @superclasses = ($plugin, $meta->superclasses );
2503 $meta->superclasses(@superclasses);
2505 unshift @{"$class\::ISA"}, $plugin;
2512 my ( $class, $plugins ) = @_;
2514 $class->_plugins( {} ) unless $class->_plugins;
2517 my @plugins = Catalyst::Utils::resolve_namespace($class . '::Plugin', 'Catalyst::Plugin', @$plugins);
2519 for my $plugin ( reverse @plugins ) {
2520 Class::MOP::load_class($plugin);
2521 my $meta = find_meta($plugin);
2522 next if $meta && $meta->isa('Moose::Meta::Role');
2524 $class->_register_plugin($plugin);
2529 grep { $_ && blessed($_) && $_->isa('Moose::Meta::Role') }
2530 map { find_meta($_) }
2533 Moose::Util::apply_all_roles(
2541 Returns an arrayref of the internal execution stack (actions that are
2542 currently executing).
2544 =head2 $c->stats_class
2546 Returns or sets the stats (timing statistics) class.
2548 =head2 $c->use_stats
2550 Returns 1 when stats collection is enabled. Stats collection is enabled
2551 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2552 environment variable is set.
2554 Note that this is a static method, not an accessor and should be overridden
2555 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
2562 =head2 $c->write( $data )
2564 Writes $data to the output stream. When using this method directly, you
2565 will need to manually set the C<Content-Length> header to the length of
2566 your output data, if known.
2573 # Finalize headers if someone manually writes output
2574 $c->finalize_headers;
2576 return $c->engine->write( $c, @_ );
2581 Returns the Catalyst version number. Mostly useful for "powered by"
2582 messages in template systems.
2586 sub version { return $Catalyst::VERSION }
2588 =head1 INTERNAL ACTIONS
2590 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2591 C<_ACTION>, and C<_END>. These are by default not shown in the private
2592 action table, but you can make them visible with a config parameter.
2594 MyApp->config->{show_internal_actions} = 1;
2596 =head1 CASE SENSITIVITY
2598 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2599 mapped to C</foo/bar>. You can activate case sensitivity with a config
2602 MyApp->config->{case_sensitive} = 1;
2604 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2606 =head1 ON-DEMAND PARSER
2608 The request body is usually parsed at the beginning of a request,
2609 but if you want to handle input yourself, you can enable on-demand
2610 parsing with a config parameter.
2612 MyApp->config->{parse_on_demand} = 1;
2614 =head1 PROXY SUPPORT
2616 Many production servers operate using the common double-server approach,
2617 with a lightweight frontend web server passing requests to a larger
2618 backend server. An application running on the backend server must deal
2619 with two problems: the remote user always appears to be C<127.0.0.1> and
2620 the server's hostname will appear to be C<localhost> regardless of the
2621 virtual host that the user connected through.
2623 Catalyst will automatically detect this situation when you are running
2624 the frontend and backend servers on the same machine. The following
2625 changes are made to the request.
2627 $c->req->address is set to the user's real IP address, as read from
2628 the HTTP X-Forwarded-For header.
2630 The host value for $c->req->base and $c->req->uri is set to the real
2631 host, as read from the HTTP X-Forwarded-Host header.
2633 Obviously, your web server must support these headers for this to work.
2635 In a more complex server farm environment where you may have your
2636 frontend proxy server(s) on different machines, you will need to set a
2637 configuration option to tell Catalyst to read the proxied data from the
2640 MyApp->config->{using_frontend_proxy} = 1;
2642 If you do not wish to use the proxy support at all, you may set:
2644 MyApp->config->{ignore_frontend_proxy} = 1;
2646 =head1 THREAD SAFETY
2648 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2649 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2650 believe the Catalyst core to be thread-safe.
2652 If you plan to operate in a threaded environment, remember that all other
2653 modules you are using must also be thread-safe. Some modules, most notably
2654 L<DBD::SQLite>, are not thread-safe.
2660 Join #catalyst on irc.perl.org.
2664 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2665 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
2669 http://catalyst.perl.org
2673 http://dev.catalyst.perl.org
2677 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2679 =head2 L<Catalyst::Manual> - The Catalyst Manual
2681 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
2683 =head2 L<Catalyst::Engine> - Core engine
2685 =head2 L<Catalyst::Log> - Log class.
2687 =head2 L<Catalyst::Request> - Request object
2689 =head2 L<Catalyst::Response> - Response object
2691 =head2 L<Catalyst::Test> - The test suite.
2693 =head1 PROJECT FOUNDER
2695 sri: Sebastian Riedel <sri@cpan.org>
2701 acme: Leon Brocard <leon@astray.com>
2709 andyg: Andy Grundman <andy@hybridized.org>
2711 audreyt: Audrey Tang
2713 bricas: Brian Cassidy <bricas@cpan.org>
2715 Caelum: Rafael Kitover <rkitover@io.com>
2717 chansen: Christian Hansen
2719 chicks: Christopher Hicks
2723 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
2727 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
2729 esskar: Sascha Kiefer
2731 fireartist: Carl Franks <cfranks@cpan.org>
2733 gabb: Danijel Milicevic
2739 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2741 jcamacho: Juan Camacho
2743 jhannah: Jay Hannah <jay@jays.net>
2749 jon: Jon Schutz <jjschutz@cpan.org>
2751 marcus: Marcus Ramberg <mramberg@cpan.org>
2753 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
2755 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
2759 naughton: David Naughton
2761 ningu: David Kamholz <dkamholz@cpan.org>
2763 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
2765 numa: Dan Sully <daniel@cpan.org>
2769 omega: Andreas Marienborg
2771 Oleg Kostyuk <cub.uanic@gmail.com>
2773 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
2775 rafl: Florian Ragwitz <rafl@debian.org>
2777 random: Roland Lammel <lammel@cpan.org>
2781 the_jester: Jesse Sheidlower
2783 t0m: Tomas Doran <bobtfish@bobtfish.net>
2787 willert: Sebastian Willert <willert@cpan.org>
2791 This library is free software. You can redistribute it and/or modify it under
2792 the same terms as Perl itself.
2798 __PACKAGE__->meta->make_immutable;