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.80001';
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 no warnings 'recursion';
1484 eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
1486 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1488 my $last = pop( @{ $c->stack } );
1490 if ( my $error = $@ ) {
1491 if ( !ref($error) and $error eq $DETACH ) {
1492 die $DETACH if($c->depth > 1);
1494 elsif ( !ref($error) and $error eq $GO ) {
1495 die $GO if($c->depth > 0);
1498 unless ( ref $error ) {
1499 no warnings 'uninitialized';
1501 my $class = $last->class;
1502 my $name = $last->name;
1503 $error = qq/Caught exception in $class->$name "$error"/;
1512 sub _stats_start_execute {
1513 my ( $c, $code ) = @_;
1515 return if ( ( $code->name =~ /^_.*/ )
1516 && ( !$c->config->{show_internal_actions} ) );
1518 my $action_name = $code->reverse();
1519 $c->counter->{$action_name}++;
1521 my $action = $action_name;
1522 $action = "/$action" unless $action =~ /->/;
1524 # determine if the call was the result of a forward
1525 # this is done by walking up the call stack and looking for a calling
1526 # sub of Catalyst::forward before the eval
1528 for my $index ( 2 .. 11 ) {
1530 if ( ( caller($index) )[0] eq 'Catalyst'
1531 && ( caller($index) )[3] eq '(eval)' );
1533 if ( ( caller($index) )[3] =~ /forward$/ ) {
1534 $callsub = ( caller($index) )[3];
1535 $action = "-> $action";
1540 my $uid = $action_name . $c->counter->{$action_name};
1542 # is this a root-level call or a forwarded call?
1543 if ( $callsub =~ /forward$/ ) {
1545 # forward, locate the caller
1546 if ( my $parent = $c->stack->[-1] ) {
1549 parent => "$parent" . $c->counter->{"$parent"},
1555 # forward with no caller may come from a plugin
1574 sub _stats_finish_execute {
1575 my ( $c, $info ) = @_;
1576 $c->stats->profile( end => $info );
1579 =head2 $c->_localize_fields( sub { }, \%keys );
1583 #Why does this exist? This is no longer safe and WILL NOT WORK.
1584 # it doesnt seem to be used anywhere. can we remove it?
1585 sub _localize_fields {
1586 my ( $c, $localized, $code ) = ( @_ );
1588 my $request = delete $localized->{request} || {};
1589 my $response = delete $localized->{response} || {};
1591 local @{ $c }{ keys %$localized } = values %$localized;
1592 local @{ $c->request }{ keys %$request } = values %$request;
1593 local @{ $c->response }{ keys %$response } = values %$response;
1600 Finalizes the request.
1607 for my $error ( @{ $c->error } ) {
1608 $c->log->error($error);
1611 # Allow engine to handle finalize flow (for POE)
1612 my $engine = $c->engine;
1613 if ( my $code = $engine->can('finalize') ) {
1618 $c->finalize_uploads;
1621 if ( $#{ $c->error } >= 0 ) {
1625 $c->finalize_headers;
1628 if ( $c->request->method eq 'HEAD' ) {
1629 $c->response->body('');
1635 if ($c->use_stats) {
1636 my $elapsed = sprintf '%f', $c->stats->elapsed;
1637 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1639 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1642 return $c->response->status;
1645 =head2 $c->finalize_body
1651 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1653 =head2 $c->finalize_cookies
1659 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1661 =head2 $c->finalize_error
1667 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1669 =head2 $c->finalize_headers
1675 sub finalize_headers {
1678 my $response = $c->response; #accessor calls can add up?
1680 # Check if we already finalized headers
1681 return if $response->finalized_headers;
1684 if ( my $location = $response->redirect ) {
1685 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1686 $response->header( Location => $location );
1688 if ( !$response->has_body ) {
1689 # Add a default body if none is already present
1691 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1697 if ( $response->body && !$response->content_length ) {
1699 # get the length from a filehandle
1700 if ( blessed( $response->body ) && $response->body->can('read') )
1702 my $stat = stat $response->body;
1703 if ( $stat && $stat->size > 0 ) {
1704 $response->content_length( $stat->size );
1707 $c->log->warn('Serving filehandle without a content-length');
1711 # everything should be bytes at this point, but just in case
1712 $response->content_length( bytes::length( $response->body ) );
1717 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1718 $response->headers->remove_header("Content-Length");
1719 $response->body('');
1722 $c->finalize_cookies;
1724 $c->engine->finalize_headers( $c, @_ );
1727 $response->finalized_headers(1);
1730 =head2 $c->finalize_output
1732 An alias for finalize_body.
1734 =head2 $c->finalize_read
1736 Finalizes the input after reading is complete.
1740 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1742 =head2 $c->finalize_uploads
1744 Finalizes uploads. Cleans up any temporary files.
1748 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1750 =head2 $c->get_action( $action, $namespace )
1752 Gets an action in a given namespace.
1756 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1758 =head2 $c->get_actions( $action, $namespace )
1760 Gets all actions of a given name in a namespace and all parent
1765 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1767 =head2 $c->handle_request( $class, @arguments )
1769 Called to handle each HTTP request.
1773 sub handle_request {
1774 my ( $class, @arguments ) = @_;
1776 # Always expect worst case!
1779 if ($class->debug) {
1780 my $secs = time - $START || 1;
1781 my $av = sprintf '%.3f', $COUNT / $secs;
1782 my $time = localtime time;
1783 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1786 my $c = $class->prepare(@arguments);
1788 $status = $c->finalize;
1791 if ( my $error = $@ ) {
1793 $class->log->error(qq/Caught exception in engine "$error"/);
1798 if(my $coderef = $class->log->can('_flush')){
1799 $class->log->$coderef();
1804 =head2 $c->prepare( @arguments )
1806 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1812 my ( $class, @arguments ) = @_;
1815 # After the app/ctxt split, this should become an attribute based on something passed
1816 # into the application.
1817 $class->context_class( ref $class || $class ) unless $class->context_class;
1819 my $c = $class->context_class->new({});
1821 # For on-demand data
1822 $c->request->_context($c);
1823 $c->response->_context($c);
1825 #surely this is not the most efficient way to do things...
1826 $c->stats($class->stats_class->new)->enable($c->use_stats);
1828 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1831 #XXX reuse coderef from can
1832 # Allow engine to direct the prepare flow (for POE)
1833 if ( $c->engine->can('prepare') ) {
1834 $c->engine->prepare( $c, @arguments );
1837 $c->prepare_request(@arguments);
1838 $c->prepare_connection;
1839 $c->prepare_query_parameters;
1840 $c->prepare_headers;
1841 $c->prepare_cookies;
1844 # Prepare the body for reading, either by prepare_body
1845 # or the user, if they are using $c->read
1848 # Parse the body unless the user wants it on-demand
1849 unless ( $c->config->{parse_on_demand} ) {
1854 my $method = $c->req->method || '';
1855 my $path = $c->req->path;
1856 $path = '/' unless length $path;
1857 my $address = $c->req->address || '';
1859 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1867 =head2 $c->prepare_action
1869 Prepares action. See L<Catalyst::Dispatcher>.
1873 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1875 =head2 $c->prepare_body
1877 Prepares message body.
1884 return if $c->request->_has_body;
1886 # Initialize on-demand data
1887 $c->engine->prepare_body( $c, @_ );
1888 $c->prepare_parameters;
1889 $c->prepare_uploads;
1891 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1892 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1893 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1894 my $param = $c->req->body_parameters->{$key};
1895 my $value = defined($param) ? $param : '';
1897 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1899 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1903 =head2 $c->prepare_body_chunk( $chunk )
1905 Prepares a chunk of data before sending it to L<HTTP::Body>.
1907 See L<Catalyst::Engine>.
1911 sub prepare_body_chunk {
1913 $c->engine->prepare_body_chunk( $c, @_ );
1916 =head2 $c->prepare_body_parameters
1918 Prepares body parameters.
1922 sub prepare_body_parameters {
1924 $c->engine->prepare_body_parameters( $c, @_ );
1927 =head2 $c->prepare_connection
1929 Prepares connection.
1933 sub prepare_connection {
1935 $c->engine->prepare_connection( $c, @_ );
1938 =head2 $c->prepare_cookies
1944 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1946 =head2 $c->prepare_headers
1952 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1954 =head2 $c->prepare_parameters
1956 Prepares parameters.
1960 sub prepare_parameters {
1962 $c->prepare_body_parameters;
1963 $c->engine->prepare_parameters( $c, @_ );
1966 =head2 $c->prepare_path
1968 Prepares path and base.
1972 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1974 =head2 $c->prepare_query_parameters
1976 Prepares query parameters.
1980 sub prepare_query_parameters {
1983 $c->engine->prepare_query_parameters( $c, @_ );
1985 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1986 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1987 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1988 my $param = $c->req->query_parameters->{$key};
1989 my $value = defined($param) ? $param : '';
1991 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1993 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1997 =head2 $c->prepare_read
1999 Prepares the input for reading.
2003 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2005 =head2 $c->prepare_request
2007 Prepares the engine request.
2011 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2013 =head2 $c->prepare_uploads
2019 sub prepare_uploads {
2022 $c->engine->prepare_uploads( $c, @_ );
2024 if ( $c->debug && keys %{ $c->request->uploads } ) {
2025 my $t = Text::SimpleTable->new(
2026 [ 12, 'Parameter' ],
2031 for my $key ( sort keys %{ $c->request->uploads } ) {
2032 my $upload = $c->request->uploads->{$key};
2033 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2034 $t->row( $key, $u->filename, $u->type, $u->size );
2037 $c->log->debug( "File Uploads are:\n" . $t->draw );
2041 =head2 $c->prepare_write
2043 Prepares the output for writing.
2047 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2049 =head2 $c->request_class
2051 Returns or sets the request class.
2053 =head2 $c->response_class
2055 Returns or sets the response class.
2057 =head2 $c->read( [$maxlength] )
2059 Reads a chunk of data from the request body. This method is designed to
2060 be used in a while loop, reading C<$maxlength> bytes on every call.
2061 C<$maxlength> defaults to the size of the request if not specified.
2063 You have to set C<< MyApp->config->{parse_on_demand} >> to use this
2066 Warning: If you use read(), Catalyst will not process the body,
2067 so you will not be able to access POST parameters or file uploads via
2068 $c->request. You must handle all body parsing yourself.
2072 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2080 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2082 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2084 Sets an action in a given namespace.
2088 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2090 =head2 $c->setup_actions($component)
2092 Sets up actions for a component.
2096 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2098 =head2 $c->setup_components
2100 Sets up components. Specify a C<setup_components> config option to pass
2101 additional options directly to L<Module::Pluggable>. To add additional
2102 search paths, specify a key named C<search_extra> as an array
2103 reference. Items in the array beginning with C<::> will have the
2104 application class name prepended to them.
2106 All components found will also have any
2107 L<Devel::InnerPackage|inner packages> loaded and set up as components.
2108 Note, that modules which are B<not> an I<inner package> of the main
2109 file namespace loaded will not be instantiated as components.
2113 sub setup_components {
2116 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
2117 my $config = $class->config->{ setup_components };
2118 my $extra = delete $config->{ search_extra } || [];
2120 push @paths, @$extra;
2122 my $locator = Module::Pluggable::Object->new(
2123 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2127 my @comps = sort { length $a <=> length $b } $locator->plugins;
2128 my %comps = map { $_ => 1 } @comps;
2130 my $deprecated_component_names = grep { /::[CMV]::/ } @comps;
2131 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2132 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2133 ) if $deprecated_component_names;
2135 for my $component ( @comps ) {
2137 # We pass ignore_loaded here so that overlay files for (e.g.)
2138 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2139 # we know M::P::O found a file on disk so this is safe
2141 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2142 #Class::MOP::load_class($component);
2144 my $module = $class->setup_component( $component );
2146 $component => $module,
2148 $_ => $class->setup_component( $_ )
2150 not exists $comps{$_}
2151 } Devel::InnerPackage::list_packages( $component )
2154 for my $key ( keys %modules ) {
2155 $class->components->{ $key } = $modules{ $key };
2160 =head2 $c->setup_component
2164 sub setup_component {
2165 my( $class, $component ) = @_;
2167 unless ( $component->can( 'COMPONENT' ) ) {
2171 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2172 my $config = $class->config->{ $suffix } || {};
2174 my $instance = eval { $component->COMPONENT( $class, $config ); };
2176 if ( my $error = $@ ) {
2178 Catalyst::Exception->throw(
2179 message => qq/Couldn't instantiate component "$component", "$error"/
2183 unless (blessed $instance) {
2184 my $metaclass = Moose::Util::find_meta($component);
2185 my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2186 my $component_method_from = $method_meta->associated_metaclass->name;
2187 my $value = defined($instance) ? $instance : 'undef';
2188 Catalyst::Exception->throw(
2190 qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2196 =head2 $c->setup_dispatcher
2202 sub setup_dispatcher {
2203 my ( $class, $dispatcher ) = @_;
2206 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2209 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2210 $dispatcher = 'Catalyst::Dispatcher::' . $env;
2213 unless ($dispatcher) {
2214 $dispatcher = $class->dispatcher_class;
2217 Class::MOP::load_class($dispatcher);
2219 # dispatcher instance
2220 $class->dispatcher( $dispatcher->new );
2223 =head2 $c->setup_engine
2230 my ( $class, $engine ) = @_;
2233 $engine = 'Catalyst::Engine::' . $engine;
2236 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2237 $engine = 'Catalyst::Engine::' . $env;
2240 if ( $ENV{MOD_PERL} ) {
2241 my $meta = Class::MOP::get_metaclass_by_name($class);
2243 # create the apache method
2244 $meta->add_method('apache' => sub { shift->engine->apache });
2246 my ( $software, $version ) =
2247 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2250 $version =~ s/(\.[^.]+)\./$1/g;
2252 if ( $software eq 'mod_perl' ) {
2256 if ( $version >= 1.99922 ) {
2257 $engine = 'Catalyst::Engine::Apache2::MP20';
2260 elsif ( $version >= 1.9901 ) {
2261 $engine = 'Catalyst::Engine::Apache2::MP19';
2264 elsif ( $version >= 1.24 ) {
2265 $engine = 'Catalyst::Engine::Apache::MP13';
2269 Catalyst::Exception->throw( message =>
2270 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2275 # install the correct mod_perl handler
2276 if ( $version >= 1.9901 ) {
2277 *handler = sub : method {
2278 shift->handle_request(@_);
2282 *handler = sub ($$) { shift->handle_request(@_) };
2287 elsif ( $software eq 'Zeus-Perl' ) {
2288 $engine = 'Catalyst::Engine::Zeus';
2292 Catalyst::Exception->throw(
2293 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2298 $engine = $class->engine_class;
2301 Class::MOP::load_class($engine);
2303 # check for old engines that are no longer compatible
2305 if ( $engine->isa('Catalyst::Engine::Apache')
2306 && !Catalyst::Engine::Apache->VERSION )
2311 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2312 && Catalyst::Engine::Server->VERSION le '0.02' )
2317 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2318 && $engine->VERSION eq '0.01' )
2323 elsif ($engine->isa('Catalyst::Engine::Zeus')
2324 && $engine->VERSION eq '0.01' )
2330 Catalyst::Exception->throw( message =>
2331 qq/Engine "$engine" is not supported by this version of Catalyst/
2336 $class->engine( $engine->new );
2339 =head2 $c->setup_home
2341 Sets up the home directory.
2346 my ( $class, $home ) = @_;
2348 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2352 $home ||= Catalyst::Utils::home($class);
2355 #I remember recently being scolded for assigning config values like this
2356 $class->config->{home} ||= $home;
2357 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2361 =head2 $c->setup_log
2363 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2364 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2367 This method also installs a C<debug> method that returns a true value into the
2368 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2369 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2371 Note that if the log has already been setup, by either a previous call to
2372 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2373 that this method won't actually set up the log object.
2378 my ( $class, $levels ) = @_;
2381 $levels =~ s/^\s+//;
2382 $levels =~ s/\s+$//;
2383 my %levels = map { $_ => 1 } split /\s*,\s*/, $levels || '';
2385 unless ( $class->log ) {
2386 $class->log( Catalyst::Log->new(keys %levels) );
2389 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2390 if ( defined($env_debug) or $levels{debug} ) {
2391 Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2392 $class->log->debug('Debug messages enabled');
2396 =head2 $c->setup_plugins
2402 =head2 $c->setup_stats
2404 Sets up timing statistics class.
2409 my ( $class, $stats ) = @_;
2411 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2413 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2414 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2415 Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2416 $class->log->debug('Statistics enabled');
2421 =head2 $c->registered_plugins
2423 Returns a sorted list of the plugins which have either been stated in the
2424 import list or which have been added via C<< MyApp->plugin(@args); >>.
2426 If passed a given plugin name, it will report a boolean value indicating
2427 whether or not that plugin is loaded. A fully qualified name is required if
2428 the plugin name does not begin with C<Catalyst::Plugin::>.
2430 if ($c->registered_plugins('Some::Plugin')) {
2438 sub registered_plugins {
2440 return sort keys %{ $proto->_plugins } unless @_;
2442 return 1 if exists $proto->_plugins->{$plugin};
2443 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2446 sub _register_plugin {
2447 my ( $proto, $plugin, $instant ) = @_;
2448 my $class = ref $proto || $proto;
2450 # no ignore_loaded here, the plugin may already have been
2451 # defined in memory and we don't want to error on "no file" if so
2453 Class::MOP::load_class( $plugin );
2455 $proto->_plugins->{$plugin} = 1;
2458 if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
2459 my @superclasses = ($plugin, $meta->superclasses );
2460 $meta->superclasses(@superclasses);
2462 unshift @{"$class\::ISA"}, $plugin;
2469 my ( $class, $plugins ) = @_;
2471 $class->_plugins( {} ) unless $class->_plugins;
2473 for my $plugin ( reverse @$plugins ) {
2475 unless ( $plugin =~ s/\A\+// ) {
2476 $plugin = "Catalyst::Plugin::$plugin";
2479 $class->_register_plugin($plugin);
2486 Returns an arrayref of the internal execution stack (actions that are
2487 currently executing).
2489 =head2 $c->stats_class
2491 Returns or sets the stats (timing statistics) class.
2493 =head2 $c->use_stats
2495 Returns 1 when stats collection is enabled. Stats collection is enabled
2496 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2497 environment variable is set.
2499 Note that this is a static method, not an accessor and should be overloaded
2500 by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1).
2507 =head2 $c->write( $data )
2509 Writes $data to the output stream. When using this method directly, you
2510 will need to manually set the C<Content-Length> header to the length of
2511 your output data, if known.
2518 # Finalize headers if someone manually writes output
2519 $c->finalize_headers;
2521 return $c->engine->write( $c, @_ );
2526 Returns the Catalyst version number. Mostly useful for "powered by"
2527 messages in template systems.
2531 sub version { return $Catalyst::VERSION }
2533 =head1 INTERNAL ACTIONS
2535 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2536 C<_ACTION>, and C<_END>. These are by default not shown in the private
2537 action table, but you can make them visible with a config parameter.
2539 MyApp->config->{show_internal_actions} = 1;
2541 =head1 CASE SENSITIVITY
2543 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2544 mapped to C</foo/bar>. You can activate case sensitivity with a config
2547 MyApp->config->{case_sensitive} = 1;
2549 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2551 =head1 ON-DEMAND PARSER
2553 The request body is usually parsed at the beginning of a request,
2554 but if you want to handle input yourself, you can enable on-demand
2555 parsing with a config parameter.
2557 MyApp->config->{parse_on_demand} = 1;
2559 =head1 PROXY SUPPORT
2561 Many production servers operate using the common double-server approach,
2562 with a lightweight frontend web server passing requests to a larger
2563 backend server. An application running on the backend server must deal
2564 with two problems: the remote user always appears to be C<127.0.0.1> and
2565 the server's hostname will appear to be C<localhost> regardless of the
2566 virtual host that the user connected through.
2568 Catalyst will automatically detect this situation when you are running
2569 the frontend and backend servers on the same machine. The following
2570 changes are made to the request.
2572 $c->req->address is set to the user's real IP address, as read from
2573 the HTTP X-Forwarded-For header.
2575 The host value for $c->req->base and $c->req->uri is set to the real
2576 host, as read from the HTTP X-Forwarded-Host header.
2578 Obviously, your web server must support these headers for this to work.
2580 In a more complex server farm environment where you may have your
2581 frontend proxy server(s) on different machines, you will need to set a
2582 configuration option to tell Catalyst to read the proxied data from the
2585 MyApp->config->{using_frontend_proxy} = 1;
2587 If you do not wish to use the proxy support at all, you may set:
2589 MyApp->config->{ignore_frontend_proxy} = 1;
2591 =head1 THREAD SAFETY
2593 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2594 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2595 believe the Catalyst core to be thread-safe.
2597 If you plan to operate in a threaded environment, remember that all other
2598 modules you are using must also be thread-safe. Some modules, most notably
2599 L<DBD::SQLite>, are not thread-safe.
2605 Join #catalyst on irc.perl.org.
2609 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2610 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
2614 http://catalyst.perl.org
2618 http://dev.catalyst.perl.org
2622 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2624 =head2 L<Catalyst::Manual> - The Catalyst Manual
2626 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
2628 =head2 L<Catalyst::Engine> - Core engine
2630 =head2 L<Catalyst::Log> - Log class.
2632 =head2 L<Catalyst::Request> - Request object
2634 =head2 L<Catalyst::Response> - Response object
2636 =head2 L<Catalyst::Test> - The test suite.
2638 =head1 PROJECT FOUNDER
2640 sri: Sebastian Riedel <sri@cpan.org>
2646 acme: Leon Brocard <leon@astray.com>
2654 andyg: Andy Grundman <andy@hybridized.org>
2656 audreyt: Audrey Tang
2658 bricas: Brian Cassidy <bricas@cpan.org>
2660 Caelum: Rafael Kitover <rkitover@io.com>
2662 chansen: Christian Hansen
2664 chicks: Christopher Hicks
2668 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
2672 esskar: Sascha Kiefer
2674 fireartist: Carl Franks <cfranks@cpan.org>
2676 gabb: Danijel Milicevic
2682 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2684 jcamacho: Juan Camacho
2686 jhannah: Jay Hannah <jay@jays.net>
2692 jon: Jon Schutz <jjschutz@cpan.org>
2694 marcus: Marcus Ramberg <mramberg@cpan.org>
2696 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
2698 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
2702 naughton: David Naughton
2704 ningu: David Kamholz <dkamholz@cpan.org>
2706 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
2708 numa: Dan Sully <daniel@cpan.org>
2712 omega: Andreas Marienborg
2714 Oleg Kostyuk <cub.uanic@gmail.com>
2716 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
2718 rafl: Florian Ragwitz <rafl@debian.org>
2722 the_jester: Jesse Sheidlower
2724 t0m: Tomas Doran <bobtfish@bobtfish.net>
2728 willert: Sebastian Willert <willert@cpan.org>
2732 This library is free software, you can redistribute it and/or modify it under
2733 the same terms as Perl itself.
2739 __PACKAGE__->meta->make_immutable;