4 extends 'Catalyst::Component';
7 use Catalyst::Exception;
10 use Catalyst::Request::Upload;
11 use Catalyst::Response;
13 use Catalyst::Controller;
14 use Devel::InnerPackage ();
16 use Module::Pluggable::Object ();
17 use Text::SimpleTable ();
18 use Path::Class::Dir ();
19 use Path::Class::File ();
23 use Tree::Simple qw/use_weak_refs/;
24 use Tree::Simple::Visitor::FindByUID;
25 use Class::C3::Adopt::NEXT;
28 use Carp qw/croak carp shortmess/;
30 BEGIN { require 5.008001; }
32 has stack => (is => 'ro', default => sub { [] });
33 has stash => (is => 'rw', default => sub { {} });
34 has state => (is => 'rw', default => 0);
35 has stats => (is => 'rw');
36 has action => (is => 'rw');
37 has counter => (is => 'rw', default => sub { {} });
38 has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
39 has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
40 has namespace => (is => 'rw');
42 sub depth { scalar @{ shift->stack || [] }; }
43 sub comp { shift->component(@_) }
46 my $self = shift; return $self->request(@_);
49 my $self = shift; return $self->response(@_);
52 # For backwards compatibility
53 sub finalize_output { shift->finalize_body(@_) };
58 our $RECURSION = 1000;
59 our $DETACH = "catalyst_detach\n";
60 our $GO = "catalyst_go\n";
62 #I imagine that very few of these really need to be class variables. if any.
63 #maybe we should just make them attributes with a default?
64 __PACKAGE__->mk_classdata($_)
65 for qw/components arguments dispatcher engine log dispatcher_class
66 engine_class context_class request_class response_class stats_class
69 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
70 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
71 __PACKAGE__->request_class('Catalyst::Request');
72 __PACKAGE__->response_class('Catalyst::Response');
73 __PACKAGE__->stats_class('Catalyst::Stats');
75 # Remember to update this in Catalyst::Runtime as well!
77 our $VERSION = '5.8000_07';
80 my $dev_version = $VERSION =~ /_\d{2}$/;
81 *_IS_DEVELOPMENT_VERSION = sub () { $dev_version };
84 $VERSION = eval $VERSION;
87 my ( $class, @arguments ) = @_;
89 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
91 return unless $class eq 'Catalyst';
93 my $caller = caller();
94 return if $caller eq 'main';
96 # Kill Adopt::NEXT warnings if we're a non-RC version
97 unless (_IS_DEVELOPMENT_VERSION()) {
98 Class::C3::Adopt::NEXT->unimport(qr/^Catalyst::/);
101 my $meta = Moose::Meta::Class->initialize($caller);
102 #Moose->import({ into => $caller }); #do we want to do this?
104 unless ( $caller->isa('Catalyst') ) {
105 my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
106 $meta->superclasses(@superclasses);
108 unless( $meta->has_method('meta') ){
109 $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
112 $caller->arguments( [@arguments] );
118 Catalyst - The Elegant MVC Web Application Framework
122 See the L<Catalyst::Manual> distribution for comprehensive
123 documentation and tutorials.
125 # Install Catalyst::Devel for helpers and other development tools
126 # use the helper to create a new application
129 # add models, views, controllers
130 script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
131 script/myapp_create.pl view MyTemplate TT
132 script/myapp_create.pl controller Search
134 # built in testserver -- use -r to restart automatically on changes
135 # --help to see all available options
136 script/myapp_server.pl
138 # command line testing interface
139 script/myapp_test.pl /yada
142 use Catalyst qw/-Debug/; # include plugins here as well
144 ### In lib/MyApp/Controller/Root.pm (autocreated)
145 sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
146 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
147 $c->stash->{template} = 'foo.tt'; # set the template
148 # lookup something from db -- stash vars are passed to TT
150 $c->model('Database::Foo')->search( { country => $args[0] } );
151 if ( $c->req->params->{bar} ) { # access GET or POST parameters
152 $c->forward( 'bar' ); # process another action
153 # do something else after forward returns
157 # The foo.tt TT template can use the stash data from the database
158 [% WHILE (item = data.next) %]
162 # called for /bar/of/soap, /bar/of/soap/10, etc.
163 sub bar : Path('/bar/of/soap') { ... }
165 # called for all actions, from the top-most controller downwards
167 my ( $self, $c ) = @_;
168 if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
169 $c->res->redirect( '/login' ); # require login
170 return 0; # abort request and go immediately to end()
172 return 1; # success; carry on to next action
175 # called after all actions are finished
177 my ( $self, $c ) = @_;
178 if ( scalar @{ $c->error } ) { ... } # handle errors
179 return if $c->res->body; # already have a response
180 $c->forward( 'MyApp::View::TT' ); # render template
183 ### in MyApp/Controller/Foo.pm
184 # called for /foo/bar
185 sub bar : Local { ... }
187 # called for /blargle
188 sub blargle : Global { ... }
190 # an index action matches /foo, but not /foo/1, etc.
191 sub index : Private { ... }
193 ### in MyApp/Controller/Foo/Bar.pm
194 # called for /foo/bar/baz
195 sub baz : Local { ... }
197 # first Root auto is called, then Foo auto, then this
198 sub auto : Private { ... }
200 # powerful regular expression paths are also possible
201 sub details : Regex('^product/(\w+)/details$') {
202 my ( $self, $c ) = @_;
203 # extract the (\w+) from the URI
204 my $product = $c->req->captures->[0];
207 See L<Catalyst::Manual::Intro> for additional information.
211 Catalyst is a modern framework for making web applications without the
212 pain usually associated with this process. This document is a reference
213 to the main Catalyst application. If you are a new user, we suggest you
214 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
216 See L<Catalyst::Manual> for more documentation.
218 Catalyst plugins can be loaded by naming them as arguments to the "use
219 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
220 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
223 use Catalyst qw/My::Module/;
225 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
226 fully qualify the name by using a unary plus:
230 +Fully::Qualified::Plugin::Name
233 Special flags like C<-Debug> and C<-Engine> can also be specified as
234 arguments when Catalyst is loaded:
236 use Catalyst qw/-Debug My::Module/;
238 The position of plugins and flags in the chain is important, because
239 they are loaded in the order in which they appear.
241 The following flags are supported:
245 Enables debug output. You can also force this setting from the system
246 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
247 settings override the application, with <MYAPP>_DEBUG having the highest
252 Forces Catalyst to use a specific engine. Omit the
253 C<Catalyst::Engine::> prefix of the engine name, i.e.:
255 use Catalyst qw/-Engine=CGI/;
259 Forces Catalyst to use a specific home directory, e.g.:
261 use Catalyst qw[-Home=/usr/mst];
263 This can also be done in the shell environment by setting either the
264 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
265 is replaced with the uppercased name of your application, any "::" in
266 the name will be replaced with underscores, e.g. MyApp::Web should use
267 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
271 use Catalyst '-Log=warn,fatal,error';
273 Specifies a comma-delimited list of log levels.
277 Enables statistics collection and reporting. You can also force this setting
278 from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
279 environment settings override the application, with <MYAPP>_STATS having the
284 use Catalyst qw/-Stats=1/
288 =head2 INFORMATION ABOUT THE CURRENT REQUEST
292 Returns a L<Catalyst::Action> object for the current action, which
293 stringifies to the action name. See L<Catalyst::Action>.
297 Returns the namespace of the current action, i.e., the URI prefix
298 corresponding to the controller of the current action. For example:
300 # in Controller::Foo::Bar
301 $c->namespace; # returns 'foo/bar';
307 Returns the current L<Catalyst::Request> object, giving access to
308 information about the current client request (including parameters,
309 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
311 =head2 REQUEST FLOW HANDLING
313 =head2 $c->forward( $action [, \@arguments ] )
315 =head2 $c->forward( $class, $method, [, \@arguments ] )
317 Forwards processing to another action, by its private name. If you give a
318 class name but no method, C<process()> is called. You may also optionally
319 pass arguments in an arrayref. The action will receive the arguments in
320 C<@_> and C<< $c->req->args >>. Upon returning from the function,
321 C<< $c->req->args >> will be restored to the previous values.
323 Any data C<return>ed from the action forwarded to, will be returned by the
326 my $foodata = $c->forward('/foo');
327 $c->forward('index');
328 $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
329 $c->forward('MyApp::View::TT');
331 Note that forward implies an C<<eval { }>> around the call (actually
332 C<execute> does), thus de-fatalizing all 'dies' within the called
333 action. If you want C<die> to propagate you need to do something like:
336 die $c->error if $c->error;
338 Or make sure to always return true values from your actions and write
341 $c->forward('foo') || return;
345 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
347 =head2 $c->detach( $action [, \@arguments ] )
349 =head2 $c->detach( $class, $method, [, \@arguments ] )
353 The same as C<forward>, but doesn't return to the previous action when
354 processing is finished.
356 When called with no arguments it escapes the processing chain entirely.
360 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
362 =head2 $c->visit( $action [, \@captures, \@arguments ] )
364 =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
366 Almost the same as C<forward>, but does a full dispatch, instead of just
367 calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
368 C<auto> and the method you go to are called, just like a new request.
370 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
371 This means, for example, that $c->action methods such as C<name>, C<class> and
372 C<reverse> return information for the visited action when they are invoked
373 within the visited action. This is different from the behavior of C<forward>
374 which continues to use the $c->action object from the caller action even when
375 invoked from the callee.
377 C<$c-E<gt>stash> is kept unchanged.
379 In effect, C<visit> allows you to "wrap" another action, just as it
380 would have been called by dispatching from a URL, while the analogous
381 C<go> allows you to transfer control to another action as if it had
382 been reached directly from a URL.
386 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
388 =head2 $c->go( $action [, \@captures, \@arguments ] )
390 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
392 Almost the same as C<detach>, but does a full dispatch like C<visit>,
393 instead of just calling the new C<$action> /
394 C<$class-E<gt>$method>. This means that C<begin>, C<auto> and the
395 method you visit are called, just like a new request.
397 C<$c-E<gt>stash> is kept unchanged.
401 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
407 Returns the current L<Catalyst::Response> object, see there for details.
411 Returns a hashref to the stash, which may be used to store data and pass
412 it between components during a request. You can also set hash keys by
413 passing arguments. The stash is automatically sent to the view. The
414 stash is cleared at the end of a request; it cannot be used for
415 persistent storage (for this you must use a session; see
416 L<Catalyst::Plugin::Session> for a complete system integrated with
419 $c->stash->{foo} = $bar;
420 $c->stash( { moose => 'majestic', qux => 0 } );
421 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
423 # stash is automatically passed to the view for use in a template
424 $c->forward( 'MyApp::View::TT' );
428 around stash => sub {
431 my $stash = $orig->($c);
433 my $new_stash = @_ > 1 ? {@_} : $_[0];
434 croak('stash takes a hash or hashref') unless ref $new_stash;
435 foreach my $key ( keys %$new_stash ) {
436 $stash->{$key} = $new_stash->{$key};
446 =head2 $c->error($error, ...)
448 =head2 $c->error($arrayref)
450 Returns an arrayref containing error messages. If Catalyst encounters an
451 error while processing a request, it stores the error in $c->error. This
452 method should only be used to store fatal error messages.
454 my @error = @{ $c->error };
458 $c->error('Something bad happened');
465 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
466 croak @$error unless ref $c;
467 push @{ $c->{error} }, @$error;
469 elsif ( defined $_[0] ) { $c->{error} = undef }
470 return $c->{error} || [];
476 Contains the return value of the last executed action.
478 =head2 $c->clear_errors
480 Clear errors. You probably don't want to clear the errors unless you are
481 implementing a custom error screen.
483 This is equivalent to running
494 # search components given a name and some prefixes
495 sub _comp_search_prefixes {
496 my ( $c, $name, @prefixes ) = @_;
497 my $appclass = ref $c || $c;
498 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
499 $filter = qr/$filter/; # Compile regex now rather than once per loop
501 # map the original component name to the sub part that we will search against
502 my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
503 grep { /$filter/ } keys %{ $c->components };
505 # undef for a name will return all
506 return keys %eligible if !defined $name;
508 my $query = ref $name ? $name : qr/^$name$/i;
509 my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
511 return map { $c->components->{ $_ } } @result if @result;
513 # if we were given a regexp to search against, we're done.
518 @result = map { $c->components->{ $_ } } grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
520 # no results? try against full names
522 @result = map { $c->components->{ $_ } } grep { m{$query} } keys %eligible;
525 # don't warn if we didn't find any results, it just might not exist
527 # Disgusting hack to work out correct method name
528 my $warn_for = lc $prefixes[0];
529 my $msg = "Used regexp fallback for \$c->{$warn_for}('${name}'), which found '" .
530 (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
531 "component resolution is unreliable and unsafe.";
532 my $short = $result[0];
533 $short =~ s/.*?Model:://;
534 my $shortmess = Carp::shortmess('');
535 if ($shortmess =~ m#Catalyst/Plugin#) {
536 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
538 } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
539 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
540 "component's config";
542 $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}({'${name}'}), " .
543 "but if you really wanted to search, pass in a regexp as the argument " .
544 "like so: \$c->${warn_for}(qr/${name}/)";
546 $c->log->warn( "${msg}$shortmess" );
552 # Find possible names for a prefix
554 my ( $c, @prefixes ) = @_;
555 my $appclass = ref $c || $c;
557 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
559 my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes );
563 # Filter a component before returning by calling ACCEPT_CONTEXT if available
564 sub _filter_component {
565 my ( $c, $comp, @args ) = @_;
567 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
568 return $comp->ACCEPT_CONTEXT( $c, @args );
574 =head2 COMPONENT ACCESSORS
576 =head2 $c->controller($name)
578 Gets a L<Catalyst::Controller> instance by name.
580 $c->controller('Foo')->do_stuff;
582 If the name is omitted, will return the controller for the dispatched
585 If you want to search for controllers, pass in a regexp as the argument.
587 # find all controllers that start with Foo
588 my @foo_controllers = $c->controller(qr{^Foo});
594 my ( $c, $name, @args ) = @_;
597 my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
598 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
599 return $c->_filter_component( $result[ 0 ], @args );
602 return $c->component( $c->action->class );
605 =head2 $c->model($name)
607 Gets a L<Catalyst::Model> instance by name.
609 $c->model('Foo')->do_stuff;
611 Any extra arguments are directly passed to ACCEPT_CONTEXT.
613 If the name is omitted, it will look for
614 - a model object in $c->stash->{current_model_instance}, then
615 - a model name in $c->stash->{current_model}, then
616 - a config setting 'default_model', or
617 - check if there is only one model, and return it if that's the case.
619 If you want to search for models, pass in a regexp as the argument.
621 # find all models that start with Foo
622 my @foo_models = $c->model(qr{^Foo});
627 my ( $c, $name, @args ) = @_;
630 my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
631 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
632 return $c->_filter_component( $result[ 0 ], @args );
636 return $c->stash->{current_model_instance}
637 if $c->stash->{current_model_instance};
638 return $c->model( $c->stash->{current_model} )
639 if $c->stash->{current_model};
641 return $c->model( $c->config->{default_model} )
642 if $c->config->{default_model};
644 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
647 $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
648 $c->log->warn( '* $c->config->{default_model} # the name of the default model to use' );
649 $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
650 $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
651 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
654 return $c->_filter_component( $comp );
658 =head2 $c->view($name)
660 Gets a L<Catalyst::View> instance by name.
662 $c->view('Foo')->do_stuff;
664 Any extra arguments are directly passed to ACCEPT_CONTEXT.
666 If the name is omitted, it will look for
667 - a view object in $c->stash->{current_view_instance}, then
668 - a view name in $c->stash->{current_view}, then
669 - a config setting 'default_view', or
670 - check if there is only one view, and return it if that's the case.
672 If you want to search for views, pass in a regexp as the argument.
674 # find all views that start with Foo
675 my @foo_views = $c->view(qr{^Foo});
680 my ( $c, $name, @args ) = @_;
683 my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
684 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
685 return $c->_filter_component( $result[ 0 ], @args );
689 return $c->stash->{current_view_instance}
690 if $c->stash->{current_view_instance};
691 return $c->view( $c->stash->{current_view} )
692 if $c->stash->{current_view};
694 return $c->view( $c->config->{default_view} )
695 if $c->config->{default_view};
697 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
700 $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
701 $c->log->warn( '* $c->config->{default_view} # the name of the default view to use' );
702 $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
703 $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
704 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
707 return $c->_filter_component( $comp );
710 =head2 $c->controllers
712 Returns the available names which can be passed to $c->controller
718 return $c->_comp_names(qw/Controller C/);
723 Returns the available names which can be passed to $c->model
729 return $c->_comp_names(qw/Model M/);
735 Returns the available names which can be passed to $c->view
741 return $c->_comp_names(qw/View V/);
744 =head2 $c->comp($name)
746 =head2 $c->component($name)
748 Gets a component object by name. This method is not recommended,
749 unless you want to get a specific component by full
750 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
751 should be used instead.
753 If C<$name> is a regexp, a list of components matched against the full
754 component name will be returned.
759 my ( $c, $name, @args ) = @_;
762 my $comps = $c->components;
765 # is it the exact name?
766 return $c->_filter_component( $comps->{ $name }, @args )
767 if exists $comps->{ $name };
769 # perhaps we just omitted "MyApp"?
770 my $composed = ( ref $c || $c ) . "::${name}";
771 return $c->_filter_component( $comps->{ $composed }, @args )
772 if exists $comps->{ $composed };
774 # search all of the models, views and controllers
775 my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
776 return $c->_filter_component( $comp, @args ) if $comp;
779 # This is here so $c->comp( '::M::' ) works
780 my $query = ref $name ? $name : qr{$name}i;
782 my @result = grep { m{$query} } keys %{ $c->components };
783 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
786 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
787 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
788 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
789 return $c->_filter_component( $result[ 0 ], @args );
792 # I would expect to return an empty list here, but that breaks back-compat
796 return sort keys %{ $c->components };
799 =head2 CLASS DATA AND HELPER CLASSES
803 Returns or takes a hashref containing the application's configuration.
805 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
807 You can also use a C<YAML>, C<XML> or C<Config::General> config file
808 like myapp.conf in your applications home directory. See
809 L<Catalyst::Plugin::ConfigLoader>.
811 =head3 Cascading configuration.
813 The config method is present on all Catalyst components, and configuration
814 will be merged when an application is started. Configuration loaded with
815 L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
816 followed by configuration in your top level C<MyApp> class. These two
817 configurations are merged, and then configuration data whos hash key matches a
818 component name is merged with configuration for that component.
820 The configuration for a component is then passed to the C<new> method when a
821 component is constructed.
825 MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
826 MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
828 will mean that C<MyApp::Model::Foo> receives the following data when
831 MyApp::Model::Foo->new({
839 around config => sub {
843 croak('Setting config after setup has been run is not allowed.')
844 if ( @_ and $c->setup_finished );
851 Returns the logging object instance. Unless it is already set, Catalyst
852 sets this up with a L<Catalyst::Log> object. To use your own log class,
853 set the logger with the C<< __PACKAGE__->log >> method prior to calling
854 C<< __PACKAGE__->setup >>.
856 __PACKAGE__->log( MyLogger->new );
861 $c->log->info( 'Now logging with my own logger!' );
863 Your log class should implement the methods described in
869 Returns 1 if debug mode is enabled, 0 otherwise.
871 You can enable debug mode in several ways:
875 =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
877 =item The -Debug option in your MyApp.pm
879 =item By declaring "sub debug { 1 }" in your MyApp.pm.
883 Calling $c->debug(1) has no effect.
889 =head2 $c->dispatcher
891 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
895 Returns the engine instance. See L<Catalyst::Engine>.
898 =head2 UTILITY METHODS
900 =head2 $c->path_to(@path)
902 Merges C<@path> with C<< $c->config->{home} >> and returns a
903 L<Path::Class::Dir> object.
907 $c->path_to( 'db', 'sqlite.db' );
912 my ( $c, @path ) = @_;
913 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
914 if ( -d $path ) { return $path }
915 else { return Path::Class::File->new( $c->config->{home}, @path ) }
918 =head2 $c->plugin( $name, $class, @args )
920 Helper method for plugins. It creates a class data accessor/mutator and
921 loads and instantiates the given class.
923 MyApp->plugin( 'prototype', 'HTML::Prototype' );
925 $c->prototype->define_javascript_functions;
927 B<Note:> This method of adding plugins is deprecated. The ability
928 to add plugins like this B<will be removed> in a Catalyst 5.81.
929 Please do not use this functionality in new code.
934 my ( $class, $name, $plugin, @args ) = @_;
936 # See block comment in t/unit_core_plugin.t
937 $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
939 $class->_register_plugin( $plugin, 1 );
941 eval { $plugin->import };
942 $class->mk_classdata($name);
944 eval { $obj = $plugin->new(@args) };
947 Catalyst::Exception->throw( message =>
948 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
952 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
958 Initializes the dispatcher and engine, loads any plugins, and loads the
959 model, view, and controller components. You may also specify an array
960 of plugins to load here, if you choose to not load them in the C<use
964 MyApp->setup( qw/-Debug/ );
969 my ( $class, @arguments ) = @_;
970 croak('Running setup more than once')
971 if ( $class->setup_finished );
973 unless ( $class->isa('Catalyst') ) {
975 Catalyst::Exception->throw(
976 message => qq/'$class' does not inherit from Catalyst/ );
979 if ( $class->arguments ) {
980 @arguments = ( @arguments, @{ $class->arguments } );
986 foreach (@arguments) {
990 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
992 elsif (/^-(\w+)=?(.*)$/) {
993 $flags->{ lc $1 } = $2;
996 push @{ $flags->{plugins} }, $_;
1000 $class->setup_home( delete $flags->{home} );
1002 $class->setup_log( delete $flags->{log} );
1003 $class->setup_plugins( delete $flags->{plugins} );
1004 $class->setup_dispatcher( delete $flags->{dispatcher} );
1005 $class->setup_engine( delete $flags->{engine} );
1006 $class->setup_stats( delete $flags->{stats} );
1008 for my $flag ( sort keys %{$flags} ) {
1010 if ( my $code = $class->can( 'setup_' . $flag ) ) {
1011 &$code( $class, delete $flags->{$flag} );
1014 $class->log->warn(qq/Unknown flag "$flag"/);
1018 eval { require Catalyst::Devel; };
1019 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1020 $class->log->warn(<<"EOF");
1021 You are running an old script!
1023 Please update by running (this will overwrite existing files):
1024 catalyst.pl -force -scripts $class
1026 or (this will not overwrite existing files):
1027 catalyst.pl -scripts $class
1032 if ( $class->debug ) {
1033 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
1036 my $column_width = Catalyst::Utils::term_width() - 6;
1037 my $t = Text::SimpleTable->new($column_width);
1038 $t->row($_) for @plugins;
1039 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
1042 my $dispatcher = $class->dispatcher;
1043 my $engine = $class->engine;
1044 my $home = $class->config->{home};
1046 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1047 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1051 ? $class->log->debug(qq/Found home "$home"/)
1052 : $class->log->debug(qq/Home "$home" doesn't exist/)
1053 : $class->log->debug(q/Couldn't find home/);
1056 # Call plugins setup, this is stupid and evil.
1058 no warnings qw/redefine/;
1059 local *setup = sub { };
1063 # Initialize our data structure
1064 $class->components( {} );
1066 $class->setup_components;
1068 if ( $class->debug ) {
1069 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1070 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1071 for my $comp ( sort keys %{ $class->components } ) {
1072 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1073 $t->row( $comp, $type );
1075 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1076 if ( keys %{ $class->components } );
1079 # Add our self to components, since we are also a component
1080 if( $class->isa('Catalyst::Controller') ){
1081 $class->components->{$class} = $class;
1084 $class->setup_actions;
1086 if ( $class->debug ) {
1087 my $name = $class->config->{name} || 'Application';
1088 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1090 $class->log->_flush() if $class->log->can('_flush');
1092 # Make sure that the application class becomes immutable at this point,
1093 # which ensures that it gets an inlined constructor. This means that it
1094 # works even if the user has added a plugin which contains a new method.
1095 # Note however that we have to do the work on scope end, so that method
1096 # modifiers work correctly in MyApp (as you have to call setup _before_
1097 # applying modifiers).
1098 Scope::Upper::reap(sub {
1099 my $meta = Class::MOP::get_metaclass_by_name($class);
1100 $meta->make_immutable unless $meta->is_immutable;
1101 }, Scope::Upper::SCOPE(1));
1103 $class->setup_finalize;
1107 =head2 $app->setup_finalize
1109 A hook to attach modifiers to.
1110 Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup.
1111 Also better than C< setup_finished(); >, as that is a getter method.
1113 sub setup_finalize {
1117 ## do stuff, i.e., determine a primary key column for sessions stored in a DB
1119 $app->next::method(@_);
1126 sub setup_finalize {
1128 $class->setup_finished(1);
1131 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1133 =head2 $c->uri_for( $path, @args?, \%query_values? )
1139 A Catalyst::Action object representing the Catalyst action you want to
1140 create a URI for. To get one for an action in the current controller,
1141 use C<< $c->action('someactionname') >>. To get one from different
1142 controller, fetch the controller using C<< $c->controller() >>, then
1143 call C<action_for> on it.
1145 You can maintain the arguments captured by an action (e.g.: Regex, Chained)
1146 using C<< $c->req->captures >>.
1148 # For the current action
1149 $c->uri_for($c->action, $c->req->captures);
1151 # For the Foo action in the Bar controller
1152 $c->uri_for($c->controller->('Bar')->action_for('Foo'), $c->req->captures);
1159 my ( $c, $path, @args ) = @_;
1161 if ( blessed($path) ) { # action object
1162 my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
1166 $path = $c->dispatcher->uri_for_action($action, $captures);
1167 if (not defined $path) {
1168 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1172 $path = '/' if $path eq '';
1175 undef($path) if (defined $path && $path eq '');
1178 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1180 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1181 s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
1183 unshift(@args, $path);
1185 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1186 my $namespace = $c->namespace;
1187 if (defined $path) { # cheesy hack to handle path '../foo'
1188 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1190 unshift(@args, $namespace || '');
1193 # join args with '/', or a blank string
1194 my $args = join('/', grep { defined($_) } @args);
1195 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1197 my $base = $c->req->base;
1198 my $class = ref($base);
1199 $base =~ s{(?<!/)$}{/};
1203 if (my @keys = keys %$params) {
1204 # somewhat lifted from URI::_query's query_form
1205 $query = '?'.join('&', map {
1206 my $val = $params->{$_};
1207 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1210 $val = '' unless defined $val;
1213 utf8::encode( $_ ) if utf8::is_utf8($_);
1214 # using the URI::Escape pattern here so utf8 chars survive
1215 s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1217 "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1221 my $res = bless(\"${base}${args}${query}", $class);
1225 =head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
1227 =head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
1233 A private path to the Catalyst action you want to create a URI for.
1235 This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1236 >> and passing the resulting C<$action> and the remaining arguments to C<<
1239 You can also pass in a Catalyst::Action object, in which case it is passed to
1246 sub uri_for_action {
1247 my ( $c, $path, @args ) = @_;
1248 my $action = blessed($path)
1250 : $c->dispatcher->get_action_by_path($path);
1251 unless (defined $action) {
1252 croak "Can't find action for path '$path'";
1254 return $c->uri_for( $action, @args );
1257 =head2 $c->welcome_message
1259 Returns the Catalyst welcome HTML page.
1263 sub welcome_message {
1265 my $name = $c->config->{name};
1266 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1267 my $prefix = Catalyst::Utils::appprefix( ref $c );
1268 $c->response->content_type('text/html; charset=utf-8');
1270 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1271 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1272 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1274 <meta http-equiv="Content-Language" content="en" />
1275 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1276 <title>$name on Catalyst $VERSION</title>
1277 <style type="text/css">
1280 background-color: #eee;
1287 margin-bottom: 10px;
1289 background-color: #ccc;
1290 border: 1px solid #aaa;
1295 font-family: verdana, tahoma, sans-serif;
1298 font-family: verdana, tahoma, sans-serif;
1301 text-decoration: none;
1303 border-bottom: 1px dotted #bbb;
1305 :link:hover, :visited:hover {
1318 background-color: #fff;
1319 border: 1px solid #aaa;
1323 font-weight: normal;
1345 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1350 <img src="$logo" alt="Catalyst Logo" />
1352 <p>Welcome to the world of Catalyst.
1353 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1354 framework will make web development something you had
1355 never expected it to be: Fun, rewarding, and quick.</p>
1356 <h2>What to do now?</h2>
1357 <p>That really depends on what <b>you</b> want to do.
1358 We do, however, provide you with a few starting points.</p>
1359 <p>If you want to jump right into web development with Catalyst
1360 you might want to start with a tutorial.</p>
1361 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1363 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1365 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1366 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1368 <h2>What to do next?</h2>
1369 <p>Next it's time to write an actual application. Use the
1370 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
1371 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a>, and
1372 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>;
1373 they can save you a lot of work.</p>
1374 <pre><code>script/${prefix}_create.pl -help</code></pre>
1375 <p>Also, be sure to check out the vast and growing
1376 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1377 you are likely to find what you need there.
1381 <p>Catalyst has a very active community. Here are the main places to
1382 get in touch with us.</p>
1385 <a href="http://dev.catalyst.perl.org">Wiki</a>
1388 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1391 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1394 <h2>In conclusion</h2>
1395 <p>The Catalyst team hopes you will enjoy using Catalyst as much
1396 as we enjoyed making it. Please contact us if you have ideas
1397 for improvement or other feedback.</p>
1405 =head1 INTERNAL METHODS
1407 These methods are not meant to be used by end users.
1409 =head2 $c->components
1411 Returns a hash of components.
1413 =head2 $c->context_class
1415 Returns or sets the context class.
1419 Returns a hashref containing coderefs and execution counts (needed for
1420 deep recursion detection).
1424 Returns the number of actions on the current internal execution stack.
1428 Dispatches a request to actions.
1432 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1434 =head2 $c->dispatcher_class
1436 Returns or sets the dispatcher class.
1438 =head2 $c->dump_these
1440 Returns a list of 2-element array references (name, structure) pairs
1441 that will be dumped on the error page in debug mode.
1447 [ Request => $c->req ],
1448 [ Response => $c->res ],
1449 [ Stash => $c->stash ],
1450 [ Config => $c->config ];
1453 =head2 $c->engine_class
1455 Returns or sets the engine class.
1457 =head2 $c->execute( $class, $coderef )
1459 Execute a coderef in given class and catch exceptions. Errors are available
1465 my ( $c, $class, $code ) = @_;
1466 $class = $c->component($class) || $class;
1469 if ( $c->depth >= $RECURSION ) {
1470 my $action = $code->reverse();
1471 $action = "/$action" unless $action =~ /->/;
1472 my $error = qq/Deep recursion detected calling "${action}"/;
1473 $c->log->error($error);
1479 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1481 push( @{ $c->stack }, $code );
1483 eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
1485 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1487 my $last = pop( @{ $c->stack } );
1489 if ( my $error = $@ ) {
1490 if ( !ref($error) and $error eq $DETACH ) {
1491 die $DETACH if($c->depth > 1);
1493 elsif ( !ref($error) and $error eq $GO ) {
1494 die $GO if($c->depth > 0);
1497 unless ( ref $error ) {
1498 no warnings 'uninitialized';
1500 my $class = $last->class;
1501 my $name = $last->name;
1502 $error = qq/Caught exception in $class->$name "$error"/;
1511 sub _stats_start_execute {
1512 my ( $c, $code ) = @_;
1514 return if ( ( $code->name =~ /^_.*/ )
1515 && ( !$c->config->{show_internal_actions} ) );
1517 my $action_name = $code->reverse();
1518 $c->counter->{$action_name}++;
1520 my $action = $action_name;
1521 $action = "/$action" unless $action =~ /->/;
1523 # determine if the call was the result of a forward
1524 # this is done by walking up the call stack and looking for a calling
1525 # sub of Catalyst::forward before the eval
1527 for my $index ( 2 .. 11 ) {
1529 if ( ( caller($index) )[0] eq 'Catalyst'
1530 && ( caller($index) )[3] eq '(eval)' );
1532 if ( ( caller($index) )[3] =~ /forward$/ ) {
1533 $callsub = ( caller($index) )[3];
1534 $action = "-> $action";
1539 my $uid = $action_name . $c->counter->{$action_name};
1541 # is this a root-level call or a forwarded call?
1542 if ( $callsub =~ /forward$/ ) {
1544 # forward, locate the caller
1545 if ( my $parent = $c->stack->[-1] ) {
1548 parent => "$parent" . $c->counter->{"$parent"},
1554 # forward with no caller may come from a plugin
1573 sub _stats_finish_execute {
1574 my ( $c, $info ) = @_;
1575 $c->stats->profile( end => $info );
1578 =head2 $c->_localize_fields( sub { }, \%keys );
1582 #Why does this exist? This is no longer safe and WILL NOT WORK.
1583 # it doesnt seem to be used anywhere. can we remove it?
1584 sub _localize_fields {
1585 my ( $c, $localized, $code ) = ( @_ );
1587 my $request = delete $localized->{request} || {};
1588 my $response = delete $localized->{response} || {};
1590 local @{ $c }{ keys %$localized } = values %$localized;
1591 local @{ $c->request }{ keys %$request } = values %$request;
1592 local @{ $c->response }{ keys %$response } = values %$response;
1599 Finalizes the request.
1606 for my $error ( @{ $c->error } ) {
1607 $c->log->error($error);
1610 # Allow engine to handle finalize flow (for POE)
1611 my $engine = $c->engine;
1612 if ( my $code = $engine->can('finalize') ) {
1617 $c->finalize_uploads;
1620 if ( $#{ $c->error } >= 0 ) {
1624 $c->finalize_headers;
1627 if ( $c->request->method eq 'HEAD' ) {
1628 $c->response->body('');
1634 if ($c->use_stats) {
1635 my $elapsed = sprintf '%f', $c->stats->elapsed;
1636 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1638 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1641 return $c->response->status;
1644 =head2 $c->finalize_body
1650 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1652 =head2 $c->finalize_cookies
1658 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1660 =head2 $c->finalize_error
1666 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1668 =head2 $c->finalize_headers
1674 sub finalize_headers {
1677 my $response = $c->response; #accessor calls can add up?
1679 # Check if we already finalized headers
1680 return if $response->finalized_headers;
1683 if ( my $location = $response->redirect ) {
1684 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1685 $response->header( Location => $location );
1687 if ( !$response->has_body ) {
1688 # Add a default body if none is already present
1690 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1696 if ( $response->body && !$response->content_length ) {
1698 # get the length from a filehandle
1699 if ( blessed( $response->body ) && $response->body->can('read') )
1701 my $stat = stat $response->body;
1702 if ( $stat && $stat->size > 0 ) {
1703 $response->content_length( $stat->size );
1706 $c->log->warn('Serving filehandle without a content-length');
1710 # everything should be bytes at this point, but just in case
1711 $response->content_length( bytes::length( $response->body ) );
1716 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1717 $response->headers->remove_header("Content-Length");
1718 $response->body('');
1721 $c->finalize_cookies;
1723 $c->engine->finalize_headers( $c, @_ );
1726 $response->finalized_headers(1);
1729 =head2 $c->finalize_output
1731 An alias for finalize_body.
1733 =head2 $c->finalize_read
1735 Finalizes the input after reading is complete.
1739 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1741 =head2 $c->finalize_uploads
1743 Finalizes uploads. Cleans up any temporary files.
1747 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1749 =head2 $c->get_action( $action, $namespace )
1751 Gets an action in a given namespace.
1755 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1757 =head2 $c->get_actions( $action, $namespace )
1759 Gets all actions of a given name in a namespace and all parent
1764 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1766 =head2 $c->handle_request( $class, @arguments )
1768 Called to handle each HTTP request.
1772 sub handle_request {
1773 my ( $class, @arguments ) = @_;
1775 # Always expect worst case!
1778 if ($class->debug) {
1779 my $secs = time - $START || 1;
1780 my $av = sprintf '%.3f', $COUNT / $secs;
1781 my $time = localtime time;
1782 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1785 my $c = $class->prepare(@arguments);
1787 $status = $c->finalize;
1790 if ( my $error = $@ ) {
1792 $class->log->error(qq/Caught exception in engine "$error"/);
1797 if(my $coderef = $class->log->can('_flush')){
1798 $class->log->$coderef();
1803 =head2 $c->prepare( @arguments )
1805 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1811 my ( $class, @arguments ) = @_;
1814 # After the app/ctxt split, this should become an attribute based on something passed
1815 # into the application.
1816 $class->context_class( ref $class || $class ) unless $class->context_class;
1818 my $c = $class->context_class->new({});
1820 # For on-demand data
1821 $c->request->_context($c);
1822 $c->response->_context($c);
1824 #surely this is not the most efficient way to do things...
1825 $c->stats($class->stats_class->new)->enable($c->use_stats);
1827 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1830 #XXX reuse coderef from can
1831 # Allow engine to direct the prepare flow (for POE)
1832 if ( $c->engine->can('prepare') ) {
1833 $c->engine->prepare( $c, @arguments );
1836 $c->prepare_request(@arguments);
1837 $c->prepare_connection;
1838 $c->prepare_query_parameters;
1839 $c->prepare_headers;
1840 $c->prepare_cookies;
1843 # Prepare the body for reading, either by prepare_body
1844 # or the user, if they are using $c->read
1847 # Parse the body unless the user wants it on-demand
1848 unless ( $c->config->{parse_on_demand} ) {
1853 my $method = $c->req->method || '';
1854 my $path = $c->req->path;
1855 $path = '/' unless length $path;
1856 my $address = $c->req->address || '';
1858 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1866 =head2 $c->prepare_action
1868 Prepares action. See L<Catalyst::Dispatcher>.
1872 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1874 =head2 $c->prepare_body
1876 Prepares message body.
1883 return if $c->request->_has_body;
1885 # Initialize on-demand data
1886 $c->engine->prepare_body( $c, @_ );
1887 $c->prepare_parameters;
1888 $c->prepare_uploads;
1890 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1891 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1892 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1893 my $param = $c->req->body_parameters->{$key};
1894 my $value = defined($param) ? $param : '';
1896 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1898 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1902 =head2 $c->prepare_body_chunk( $chunk )
1904 Prepares a chunk of data before sending it to L<HTTP::Body>.
1906 See L<Catalyst::Engine>.
1910 sub prepare_body_chunk {
1912 $c->engine->prepare_body_chunk( $c, @_ );
1915 =head2 $c->prepare_body_parameters
1917 Prepares body parameters.
1921 sub prepare_body_parameters {
1923 $c->engine->prepare_body_parameters( $c, @_ );
1926 =head2 $c->prepare_connection
1928 Prepares connection.
1932 sub prepare_connection {
1934 $c->engine->prepare_connection( $c, @_ );
1937 =head2 $c->prepare_cookies
1943 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1945 =head2 $c->prepare_headers
1951 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1953 =head2 $c->prepare_parameters
1955 Prepares parameters.
1959 sub prepare_parameters {
1961 $c->prepare_body_parameters;
1962 $c->engine->prepare_parameters( $c, @_ );
1965 =head2 $c->prepare_path
1967 Prepares path and base.
1971 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1973 =head2 $c->prepare_query_parameters
1975 Prepares query parameters.
1979 sub prepare_query_parameters {
1982 $c->engine->prepare_query_parameters( $c, @_ );
1984 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1985 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1986 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1987 my $param = $c->req->query_parameters->{$key};
1988 my $value = defined($param) ? $param : '';
1990 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1992 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1996 =head2 $c->prepare_read
1998 Prepares the input for reading.
2002 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2004 =head2 $c->prepare_request
2006 Prepares the engine request.
2010 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2012 =head2 $c->prepare_uploads
2018 sub prepare_uploads {
2021 $c->engine->prepare_uploads( $c, @_ );
2023 if ( $c->debug && keys %{ $c->request->uploads } ) {
2024 my $t = Text::SimpleTable->new(
2025 [ 12, 'Parameter' ],
2030 for my $key ( sort keys %{ $c->request->uploads } ) {
2031 my $upload = $c->request->uploads->{$key};
2032 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2033 $t->row( $key, $u->filename, $u->type, $u->size );
2036 $c->log->debug( "File Uploads are:\n" . $t->draw );
2040 =head2 $c->prepare_write
2042 Prepares the output for writing.
2046 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2048 =head2 $c->request_class
2050 Returns or sets the request class.
2052 =head2 $c->response_class
2054 Returns or sets the response class.
2056 =head2 $c->read( [$maxlength] )
2058 Reads a chunk of data from the request body. This method is designed to
2059 be used in a while loop, reading C<$maxlength> bytes on every call.
2060 C<$maxlength> defaults to the size of the request if not specified.
2062 You have to set C<< MyApp->config->{parse_on_demand} >> to use this
2065 Warning: If you use read(), Catalyst will not process the body,
2066 so you will not be able to access POST parameters or file uploads via
2067 $c->request. You must handle all body parsing yourself.
2071 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2079 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2081 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2083 Sets an action in a given namespace.
2087 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2089 =head2 $c->setup_actions($component)
2091 Sets up actions for a component.
2095 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2097 =head2 $c->setup_components
2099 Sets up components. Specify a C<setup_components> config option to pass
2100 additional options directly to L<Module::Pluggable>. To add additional
2101 search paths, specify a key named C<search_extra> as an array
2102 reference. Items in the array beginning with C<::> will have the
2103 application class name prepended to them.
2105 All components found will also have any
2106 L<Devel::InnerPackage|inner packages> loaded and set up as components.
2107 Note, that modules which are B<not> an I<inner package> of the main
2108 file namespace loaded will not be instantiated as components.
2112 sub setup_components {
2115 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
2116 my $config = $class->config->{ setup_components };
2117 my $extra = delete $config->{ search_extra } || [];
2119 push @paths, @$extra;
2121 my $locator = Module::Pluggable::Object->new(
2122 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2126 my @comps = sort { length $a <=> length $b } $locator->plugins;
2127 my %comps = map { $_ => 1 } @comps;
2129 my $deprecated_component_names = grep { /::[CMV]::/ } @comps;
2130 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2131 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2132 ) if $deprecated_component_names;
2134 for my $component ( @comps ) {
2136 # We pass ignore_loaded here so that overlay files for (e.g.)
2137 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2138 # we know M::P::O found a file on disk so this is safe
2140 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2141 #Class::MOP::load_class($component);
2143 my $module = $class->setup_component( $component );
2145 $component => $module,
2147 $_ => $class->setup_component( $_ )
2149 not exists $comps{$_}
2150 } Devel::InnerPackage::list_packages( $component )
2153 for my $key ( keys %modules ) {
2154 $class->components->{ $key } = $modules{ $key };
2159 =head2 $c->setup_component
2163 sub setup_component {
2164 my( $class, $component ) = @_;
2166 unless ( $component->can( 'COMPONENT' ) ) {
2170 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2171 my $config = $class->config->{ $suffix } || {};
2173 my $instance = eval { $component->COMPONENT( $class, $config ); };
2175 if ( my $error = $@ ) {
2177 Catalyst::Exception->throw(
2178 message => qq/Couldn't instantiate component "$component", "$error"/
2182 unless (blessed $instance) {
2183 my $metaclass = Moose::Util::find_meta($component);
2184 my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2185 my $component_method_from = $method_meta->associated_metaclass->name;
2186 my $value = defined($instance) ? $instance : 'undef';
2187 Catalyst::Exception->throw(
2189 qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2195 =head2 $c->setup_dispatcher
2201 sub setup_dispatcher {
2202 my ( $class, $dispatcher ) = @_;
2205 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2208 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2209 $dispatcher = 'Catalyst::Dispatcher::' . $env;
2212 unless ($dispatcher) {
2213 $dispatcher = $class->dispatcher_class;
2216 Class::MOP::load_class($dispatcher);
2218 # dispatcher instance
2219 $class->dispatcher( $dispatcher->new );
2222 =head2 $c->setup_engine
2229 my ( $class, $engine ) = @_;
2232 $engine = 'Catalyst::Engine::' . $engine;
2235 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2236 $engine = 'Catalyst::Engine::' . $env;
2239 if ( $ENV{MOD_PERL} ) {
2240 my $meta = Class::MOP::get_metaclass_by_name($class);
2242 # create the apache method
2243 $meta->add_method('apache' => sub { shift->engine->apache });
2245 my ( $software, $version ) =
2246 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2249 $version =~ s/(\.[^.]+)\./$1/g;
2251 if ( $software eq 'mod_perl' ) {
2255 if ( $version >= 1.99922 ) {
2256 $engine = 'Catalyst::Engine::Apache2::MP20';
2259 elsif ( $version >= 1.9901 ) {
2260 $engine = 'Catalyst::Engine::Apache2::MP19';
2263 elsif ( $version >= 1.24 ) {
2264 $engine = 'Catalyst::Engine::Apache::MP13';
2268 Catalyst::Exception->throw( message =>
2269 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2274 # install the correct mod_perl handler
2275 if ( $version >= 1.9901 ) {
2276 *handler = sub : method {
2277 shift->handle_request(@_);
2281 *handler = sub ($$) { shift->handle_request(@_) };
2286 elsif ( $software eq 'Zeus-Perl' ) {
2287 $engine = 'Catalyst::Engine::Zeus';
2291 Catalyst::Exception->throw(
2292 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2297 $engine = $class->engine_class;
2300 Class::MOP::load_class($engine);
2302 # check for old engines that are no longer compatible
2304 if ( $engine->isa('Catalyst::Engine::Apache')
2305 && !Catalyst::Engine::Apache->VERSION )
2310 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2311 && Catalyst::Engine::Server->VERSION le '0.02' )
2316 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2317 && $engine->VERSION eq '0.01' )
2322 elsif ($engine->isa('Catalyst::Engine::Zeus')
2323 && $engine->VERSION eq '0.01' )
2329 Catalyst::Exception->throw( message =>
2330 qq/Engine "$engine" is not supported by this version of Catalyst/
2335 $class->engine( $engine->new );
2338 =head2 $c->setup_home
2340 Sets up the home directory.
2345 my ( $class, $home ) = @_;
2347 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2351 $home ||= Catalyst::Utils::home($class);
2354 #I remember recently being scolded for assigning config values like this
2355 $class->config->{home} ||= $home;
2356 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2360 =head2 $c->setup_log
2362 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2363 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2366 This method also installs a C<debug> method that returns a true value into the
2367 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2368 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2370 Note that if the log has already been setup, by either a previous call to
2371 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2372 that this method won't actually set up the log object.
2377 my ( $class, $levels ) = @_;
2380 $levels =~ s/^\s+//;
2381 $levels =~ s/\s+$//;
2382 my %levels = map { $_ => 1 } split /\s*,\s*/, $levels || '';
2384 unless ( $class->log ) {
2385 $class->log( Catalyst::Log->new(keys %levels) );
2388 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2389 if ( defined($env_debug) or $levels{debug} ) {
2390 Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2391 $class->log->debug('Debug messages enabled');
2395 =head2 $c->setup_plugins
2401 =head2 $c->setup_stats
2403 Sets up timing statistics class.
2408 my ( $class, $stats ) = @_;
2410 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2412 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2413 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2414 Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2415 $class->log->debug('Statistics enabled');
2420 =head2 $c->registered_plugins
2422 Returns a sorted list of the plugins which have either been stated in the
2423 import list or which have been added via C<< MyApp->plugin(@args); >>.
2425 If passed a given plugin name, it will report a boolean value indicating
2426 whether or not that plugin is loaded. A fully qualified name is required if
2427 the plugin name does not begin with C<Catalyst::Plugin::>.
2429 if ($c->registered_plugins('Some::Plugin')) {
2437 sub registered_plugins {
2439 return sort keys %{ $proto->_plugins } unless @_;
2441 return 1 if exists $proto->_plugins->{$plugin};
2442 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2445 sub _register_plugin {
2446 my ( $proto, $plugin, $instant ) = @_;
2447 my $class = ref $proto || $proto;
2449 # no ignore_loaded here, the plugin may already have been
2450 # defined in memory and we don't want to error on "no file" if so
2452 Class::MOP::load_class( $plugin );
2454 $proto->_plugins->{$plugin} = 1;
2457 if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
2458 my @superclasses = ($plugin, $meta->superclasses );
2459 $meta->superclasses(@superclasses);
2461 unshift @{"$class\::ISA"}, $plugin;
2468 my ( $class, $plugins ) = @_;
2470 $class->_plugins( {} ) unless $class->_plugins;
2472 for my $plugin ( reverse @$plugins ) {
2474 unless ( $plugin =~ s/\A\+// ) {
2475 $plugin = "Catalyst::Plugin::$plugin";
2478 $class->_register_plugin($plugin);
2485 Returns an arrayref of the internal execution stack (actions that are
2486 currently executing).
2488 =head2 $c->stats_class
2490 Returns or sets the stats (timing statistics) class.
2492 =head2 $c->use_stats
2494 Returns 1 when stats collection is enabled. Stats collection is enabled
2495 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2496 environment variable is set.
2498 Note that this is a static method, not an accessor and should be overloaded
2499 by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1).
2506 =head2 $c->write( $data )
2508 Writes $data to the output stream. When using this method directly, you
2509 will need to manually set the C<Content-Length> header to the length of
2510 your output data, if known.
2517 # Finalize headers if someone manually writes output
2518 $c->finalize_headers;
2520 return $c->engine->write( $c, @_ );
2525 Returns the Catalyst version number. Mostly useful for "powered by"
2526 messages in template systems.
2530 sub version { return $Catalyst::VERSION }
2532 =head1 INTERNAL ACTIONS
2534 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2535 C<_ACTION>, and C<_END>. These are by default not shown in the private
2536 action table, but you can make them visible with a config parameter.
2538 MyApp->config->{show_internal_actions} = 1;
2540 =head1 CASE SENSITIVITY
2542 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2543 mapped to C</foo/bar>. You can activate case sensitivity with a config
2546 MyApp->config->{case_sensitive} = 1;
2548 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2550 =head1 ON-DEMAND PARSER
2552 The request body is usually parsed at the beginning of a request,
2553 but if you want to handle input yourself, you can enable on-demand
2554 parsing with a config parameter.
2556 MyApp->config->{parse_on_demand} = 1;
2558 =head1 PROXY SUPPORT
2560 Many production servers operate using the common double-server approach,
2561 with a lightweight frontend web server passing requests to a larger
2562 backend server. An application running on the backend server must deal
2563 with two problems: the remote user always appears to be C<127.0.0.1> and
2564 the server's hostname will appear to be C<localhost> regardless of the
2565 virtual host that the user connected through.
2567 Catalyst will automatically detect this situation when you are running
2568 the frontend and backend servers on the same machine. The following
2569 changes are made to the request.
2571 $c->req->address is set to the user's real IP address, as read from
2572 the HTTP X-Forwarded-For header.
2574 The host value for $c->req->base and $c->req->uri is set to the real
2575 host, as read from the HTTP X-Forwarded-Host header.
2577 Obviously, your web server must support these headers for this to work.
2579 In a more complex server farm environment where you may have your
2580 frontend proxy server(s) on different machines, you will need to set a
2581 configuration option to tell Catalyst to read the proxied data from the
2584 MyApp->config->{using_frontend_proxy} = 1;
2586 If you do not wish to use the proxy support at all, you may set:
2588 MyApp->config->{ignore_frontend_proxy} = 1;
2590 =head1 THREAD SAFETY
2592 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2593 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2594 believe the Catalyst core to be thread-safe.
2596 If you plan to operate in a threaded environment, remember that all other
2597 modules you are using must also be thread-safe. Some modules, most notably
2598 L<DBD::SQLite>, are not thread-safe.
2604 Join #catalyst on irc.perl.org.
2608 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2609 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
2613 http://catalyst.perl.org
2617 http://dev.catalyst.perl.org
2621 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2623 =head2 L<Catalyst::Manual> - The Catalyst Manual
2625 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
2627 =head2 L<Catalyst::Engine> - Core engine
2629 =head2 L<Catalyst::Log> - Log class.
2631 =head2 L<Catalyst::Request> - Request object
2633 =head2 L<Catalyst::Response> - Response object
2635 =head2 L<Catalyst::Test> - The test suite.
2637 =head1 PROJECT FOUNDER
2639 sri: Sebastian Riedel <sri@cpan.org>
2645 acme: Leon Brocard <leon@astray.com>
2653 andyg: Andy Grundman <andy@hybridized.org>
2655 audreyt: Audrey Tang
2657 bricas: Brian Cassidy <bricas@cpan.org>
2659 Caelum: Rafael Kitover <rkitover@io.com>
2661 chansen: Christian Hansen
2663 chicks: Christopher Hicks
2667 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
2671 esskar: Sascha Kiefer
2673 fireartist: Carl Franks <cfranks@cpan.org>
2675 gabb: Danijel Milicevic
2681 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2683 jcamacho: Juan Camacho
2685 jhannah: Jay Hannah <jay@jays.net>
2691 jon: Jon Schutz <jjschutz@cpan.org>
2693 marcus: Marcus Ramberg <mramberg@cpan.org>
2695 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
2697 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
2701 naughton: David Naughton
2703 ningu: David Kamholz <dkamholz@cpan.org>
2705 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
2707 numa: Dan Sully <daniel@cpan.org>
2711 omega: Andreas Marienborg
2713 Oleg Kostyuk <cub.uanic@gmail.com>
2715 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
2717 rafl: Florian Ragwitz <rafl@debian.org>
2721 the_jester: Jesse Sheidlower
2723 t0m: Tomas Doran <bobtfish@bobtfish.net>
2727 willert: Sebastian Willert <willert@cpan.org>
2731 This library is free software, you can redistribute it and/or modify it under
2732 the same terms as Perl itself.
2738 __PACKAGE__->meta->make_immutable;