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;
27 use Carp qw/croak carp shortmess/;
29 BEGIN { require 5.008001; }
31 has stack => (is => 'ro', default => sub { [] });
32 has stash => (is => 'rw', default => sub { {} });
33 has state => (is => 'rw', default => 0);
34 has stats => (is => 'rw');
35 has action => (is => 'rw');
36 has counter => (is => 'rw', default => sub { {} });
37 has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
38 has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
39 has namespace => (is => 'rw');
41 sub depth { scalar @{ shift->stack || [] }; }
42 sub comp { shift->component(@_) }
45 # carp "the use of req() is deprecated in favour of request()";
46 my $self = shift; return $self->request(@_);
49 # carp "the use of res() is deprecated in favour of response()";
50 my $self = shift; return $self->response(@_);
53 # For backwards compatibility
54 sub finalize_output { shift->finalize_body(@_) };
59 our $RECURSION = 1000;
60 our $DETACH = "catalyst_detach\n";
61 our $GO = "catalyst_go\n";
63 #I imagine that very few of these really need to be class variables. if any.
64 #maybe we should just make them attributes with a default?
65 __PACKAGE__->mk_classdata($_)
66 for qw/components arguments dispatcher engine log dispatcher_class
67 engine_class context_class request_class response_class stats_class
70 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
71 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
72 __PACKAGE__->request_class('Catalyst::Request');
73 __PACKAGE__->response_class('Catalyst::Response');
74 __PACKAGE__->stats_class('Catalyst::Stats');
76 # Remember to update this in Catalyst::Runtime as well!
78 our $VERSION = '5.8000_06';
81 my ( $class, @arguments ) = @_;
83 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
85 return unless $class eq 'Catalyst';
87 my $caller = caller();
88 return if $caller eq 'main';
89 my $meta = Moose::Meta::Class->initialize($caller);
90 #Moose->import({ into => $caller }); #do we want to do this?
92 unless ( $caller->isa('Catalyst') ) {
93 my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
94 $meta->superclasses(@superclasses);
96 unless( $meta->has_method('meta') ){
97 $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
100 $caller->arguments( [@arguments] );
106 Catalyst - The Elegant MVC Web Application Framework
110 See the L<Catalyst::Manual> distribution for comprehensive
111 documentation and tutorials.
113 # Install Catalyst::Devel for helpers and other development tools
114 # use the helper to create a new application
117 # add models, views, controllers
118 script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
119 script/myapp_create.pl view MyTemplate TT
120 script/myapp_create.pl controller Search
122 # built in testserver -- use -r to restart automatically on changes
123 # --help to see all available options
124 script/myapp_server.pl
126 # command line testing interface
127 script/myapp_test.pl /yada
130 use Catalyst qw/-Debug/; # include plugins here as well
132 ### In lib/MyApp/Controller/Root.pm (autocreated)
133 sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
134 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
135 $c->stash->{template} = 'foo.tt'; # set the template
136 # lookup something from db -- stash vars are passed to TT
138 $c->model('Database::Foo')->search( { country => $args[0] } );
139 if ( $c->req->params->{bar} ) { # access GET or POST parameters
140 $c->forward( 'bar' ); # process another action
141 # do something else after forward returns
145 # The foo.tt TT template can use the stash data from the database
146 [% WHILE (item = data.next) %]
150 # called for /bar/of/soap, /bar/of/soap/10, etc.
151 sub bar : Path('/bar/of/soap') { ... }
153 # called for all actions, from the top-most controller downwards
155 my ( $self, $c ) = @_;
156 if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
157 $c->res->redirect( '/login' ); # require login
158 return 0; # abort request and go immediately to end()
160 return 1; # success; carry on to next action
163 # called after all actions are finished
165 my ( $self, $c ) = @_;
166 if ( scalar @{ $c->error } ) { ... } # handle errors
167 return if $c->res->body; # already have a response
168 $c->forward( 'MyApp::View::TT' ); # render template
171 ### in MyApp/Controller/Foo.pm
172 # called for /foo/bar
173 sub bar : Local { ... }
175 # called for /blargle
176 sub blargle : Global { ... }
178 # an index action matches /foo, but not /foo/1, etc.
179 sub index : Private { ... }
181 ### in MyApp/Controller/Foo/Bar.pm
182 # called for /foo/bar/baz
183 sub baz : Local { ... }
185 # first Root auto is called, then Foo auto, then this
186 sub auto : Private { ... }
188 # powerful regular expression paths are also possible
189 sub details : Regex('^product/(\w+)/details$') {
190 my ( $self, $c ) = @_;
191 # extract the (\w+) from the URI
192 my $product = $c->req->captures->[0];
195 See L<Catalyst::Manual::Intro> for additional information.
199 Catalyst is a modern framework for making web applications without the
200 pain usually associated with this process. This document is a reference
201 to the main Catalyst application. If you are a new user, we suggest you
202 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
204 See L<Catalyst::Manual> for more documentation.
206 Catalyst plugins can be loaded by naming them as arguments to the "use
207 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
208 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
211 use Catalyst qw/My::Module/;
213 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
214 fully qualify the name by using a unary plus:
218 +Fully::Qualified::Plugin::Name
221 Special flags like C<-Debug> and C<-Engine> can also be specified as
222 arguments when Catalyst is loaded:
224 use Catalyst qw/-Debug My::Module/;
226 The position of plugins and flags in the chain is important, because
227 they are loaded in the order in which they appear.
229 The following flags are supported:
233 Enables debug output. You can also force this setting from the system
234 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
235 settings override the application, with <MYAPP>_DEBUG having the highest
240 Forces Catalyst to use a specific engine. Omit the
241 C<Catalyst::Engine::> prefix of the engine name, i.e.:
243 use Catalyst qw/-Engine=CGI/;
247 Forces Catalyst to use a specific home directory, e.g.:
249 use Catalyst qw[-Home=/usr/mst];
251 This can also be done in the shell environment by setting either the
252 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
253 is replaced with the uppercased name of your application, any "::" in
254 the name will be replaced with underscores, e.g. MyApp::Web should use
255 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
259 use Catalyst '-Log=warn,fatal,error';
261 Specifies a comma-delimited list of log levels.
265 Enables statistics collection and reporting. You can also force this setting
266 from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
267 environment settings override the application, with <MYAPP>_STATS having the
272 use Catalyst qw/-Stats=1/
276 =head2 INFORMATION ABOUT THE CURRENT REQUEST
280 Returns a L<Catalyst::Action> object for the current action, which
281 stringifies to the action name. See L<Catalyst::Action>.
285 Returns the namespace of the current action, i.e., the URI prefix
286 corresponding to the controller of the current action. For example:
288 # in Controller::Foo::Bar
289 $c->namespace; # returns 'foo/bar';
295 Returns the current L<Catalyst::Request> object, giving access to
296 information about the current client request (including parameters,
297 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
299 =head2 REQUEST FLOW HANDLING
301 =head2 $c->forward( $action [, \@arguments ] )
303 =head2 $c->forward( $class, $method, [, \@arguments ] )
305 Forwards processing to another action, by its private name. If you give a
306 class name but no method, C<process()> is called. You may also optionally
307 pass arguments in an arrayref. The action will receive the arguments in
308 C<@_> and C<< $c->req->args >>. Upon returning from the function,
309 C<< $c->req->args >> will be restored to the previous values.
311 Any data C<return>ed from the action forwarded to, will be returned by the
314 my $foodata = $c->forward('/foo');
315 $c->forward('index');
316 $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
317 $c->forward('MyApp::View::TT');
319 Note that forward implies an C<<eval { }>> around the call (actually
320 C<execute> does), thus de-fatalizing all 'dies' within the called
321 action. If you want C<die> to propagate you need to do something like:
324 die $c->error if $c->error;
326 Or make sure to always return true values from your actions and write
329 $c->forward('foo') || return;
333 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
335 =head2 $c->detach( $action [, \@arguments ] )
337 =head2 $c->detach( $class, $method, [, \@arguments ] )
341 The same as C<forward>, but doesn't return to the previous action when
342 processing is finished.
344 When called with no arguments it escapes the processing chain entirely.
348 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
350 =head2 $c->visit( $action [, \@arguments ] )
352 =head2 $c->visit( $class, $method, [, \@arguments ] )
354 Almost the same as C<forward>, but does a full dispatch, instead of just
355 calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
356 C<auto> and the method you go to are called, just like a new request.
358 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
359 This means, for example, that $c->action methods such as C<name>, C<class> and
360 C<reverse> return information for the visited action when they are invoked
361 within the visited action. This is different from the behavior of C<forward>
362 which continues to use the $c->action object from the caller action even when
363 invoked from the callee.
365 C<$c-E<gt>stash> is kept unchanged.
367 In effect, C<visit> allows you to "wrap" another action, just as it
368 would have been called by dispatching from a URL, while the analogous
369 C<go> allows you to transfer control to another action as if it had
370 been reached directly from a URL.
374 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
376 =head2 $c->go( $action [, \@arguments ] )
378 =head2 $c->go( $class, $method, [, \@arguments ] )
380 Almost the same as C<detach>, but does a full dispatch like C<visit>,
381 instead of just calling the new C<$action> /
382 C<$class-E<gt>$method>. This means that C<begin>, C<auto> and the
383 method you visit are called, just like a new request.
385 C<$c-E<gt>stash> is kept unchanged.
389 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
395 Returns the current L<Catalyst::Response> object, see there for details.
399 Returns a hashref to the stash, which may be used to store data and pass
400 it between components during a request. You can also set hash keys by
401 passing arguments. The stash is automatically sent to the view. The
402 stash is cleared at the end of a request; it cannot be used for
403 persistent storage (for this you must use a session; see
404 L<Catalyst::Plugin::Session> for a complete system integrated with
407 $c->stash->{foo} = $bar;
408 $c->stash( { moose => 'majestic', qux => 0 } );
409 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
411 # stash is automatically passed to the view for use in a template
412 $c->forward( 'MyApp::View::TT' );
416 around stash => sub {
419 my $stash = $orig->($c);
421 my $new_stash = @_ > 1 ? {@_} : $_[0];
422 croak('stash takes a hash or hashref') unless ref $new_stash;
423 foreach my $key ( keys %$new_stash ) {
424 $stash->{$key} = $new_stash->{$key};
434 =head2 $c->error($error, ...)
436 =head2 $c->error($arrayref)
438 Returns an arrayref containing error messages. If Catalyst encounters an
439 error while processing a request, it stores the error in $c->error. This
440 method should only be used to store fatal error messages.
442 my @error = @{ $c->error };
446 $c->error('Something bad happened');
453 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
454 croak @$error unless ref $c;
455 push @{ $c->{error} }, @$error;
457 elsif ( defined $_[0] ) { $c->{error} = undef }
458 return $c->{error} || [];
464 Contains the return value of the last executed action.
466 =head2 $c->clear_errors
468 Clear errors. You probably don't want to clear the errors unless you are
469 implementing a custom error screen.
471 This is equivalent to running
482 # search components given a name and some prefixes
483 sub _comp_search_prefixes {
484 my ( $c, $name, @prefixes ) = @_;
485 my $appclass = ref $c || $c;
486 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
488 # map the original component name to the sub part that we will search against
489 my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
490 grep { /$filter/ } keys %{ $c->components };
492 # undef for a name will return all
493 return keys %eligible if !defined $name;
495 my $query = ref $name ? $name : qr/^$name$/i;
496 my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
498 return map { $c->components->{ $_ } } @result if @result;
500 # if we were given a regexp to search against, we're done.
505 @result = map { $c->components->{ $_ } } grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
507 # no results? try against full names
509 @result = map { $c->components->{ $_ } } grep { m{$query} } keys %eligible;
512 # don't warn if we didn't find any results, it just might not exist
514 my $msg = "Used regexp fallback for \$c->model('${name}'), which found '" .
515 (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
516 "component resolution is unreliable and unsafe.";
517 my $short = $result[0];
518 $short =~ s/.*?Model:://;
519 my $shortmess = Carp::shortmess('');
520 if ($shortmess =~ m#Catalyst/Plugin#) {
521 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
523 } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
524 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
525 "component's config";
527 $msg .= " You probably meant \$c->model('$short') instead of \$c->model{'${name}'}, " .
528 "but if you really wanted to search, pass in a regexp as the argument " .
529 "like so: \$c->model(qr/${name}/)";
531 $c->log->warn( "${msg}$shortmess" );
537 # Find possible names for a prefix
539 my ( $c, @prefixes ) = @_;
540 my $appclass = ref $c || $c;
542 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
544 my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes );
548 # Filter a component before returning by calling ACCEPT_CONTEXT if available
549 sub _filter_component {
550 my ( $c, $comp, @args ) = @_;
552 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
553 return $comp->ACCEPT_CONTEXT( $c, @args );
559 =head2 COMPONENT ACCESSORS
561 =head2 $c->controller($name)
563 Gets a L<Catalyst::Controller> instance by name.
565 $c->controller('Foo')->do_stuff;
567 If the name is omitted, will return the controller for the dispatched
570 If you want to search for controllers, pass in a regexp as the argument.
572 # find all controllers that start with Foo
573 my @foo_controllers = $c->controller(qr{^Foo});
579 my ( $c, $name, @args ) = @_;
582 my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
583 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
584 return $c->_filter_component( $result[ 0 ], @args );
587 return $c->component( $c->action->class );
590 =head2 $c->model($name)
592 Gets a L<Catalyst::Model> instance by name.
594 $c->model('Foo')->do_stuff;
596 Any extra arguments are directly passed to ACCEPT_CONTEXT.
598 If the name is omitted, it will look for
599 - a model object in $c->stash->{current_model_instance}, then
600 - a model name in $c->stash->{current_model}, then
601 - a config setting 'default_model', or
602 - check if there is only one model, and return it if that's the case.
604 If you want to search for models, pass in a regexp as the argument.
606 # find all models that start with Foo
607 my @foo_models = $c->model(qr{^Foo});
612 my ( $c, $name, @args ) = @_;
615 my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
616 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
617 return $c->_filter_component( $result[ 0 ], @args );
621 return $c->stash->{current_model_instance}
622 if $c->stash->{current_model_instance};
623 return $c->model( $c->stash->{current_model} )
624 if $c->stash->{current_model};
626 return $c->model( $c->config->{default_model} )
627 if $c->config->{default_model};
629 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
632 $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
633 $c->log->warn( '* $c->config->{default_model} # the name of the default model to use' );
634 $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
635 $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
636 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
639 return $c->_filter_component( $comp );
643 =head2 $c->view($name)
645 Gets a L<Catalyst::View> instance by name.
647 $c->view('Foo')->do_stuff;
649 Any extra arguments are directly passed to ACCEPT_CONTEXT.
651 If the name is omitted, it will look for
652 - a view object in $c->stash->{current_view_instance}, then
653 - a view name in $c->stash->{current_view}, then
654 - a config setting 'default_view', or
655 - check if there is only one view, and return it if that's the case.
657 If you want to search for views, pass in a regexp as the argument.
659 # find all views that start with Foo
660 my @foo_views = $c->view(qr{^Foo});
665 my ( $c, $name, @args ) = @_;
668 my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
669 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
670 return $c->_filter_component( $result[ 0 ], @args );
674 return $c->stash->{current_view_instance}
675 if $c->stash->{current_view_instance};
676 return $c->view( $c->stash->{current_view} )
677 if $c->stash->{current_view};
679 return $c->view( $c->config->{default_view} )
680 if $c->config->{default_view};
682 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
685 $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
686 $c->log->warn( '* $c->config->{default_view} # the name of the default view to use' );
687 $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
688 $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
689 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
692 return $c->_filter_component( $comp );
695 =head2 $c->controllers
697 Returns the available names which can be passed to $c->controller
703 return $c->_comp_names(qw/Controller C/);
708 Returns the available names which can be passed to $c->model
714 return $c->_comp_names(qw/Model M/);
720 Returns the available names which can be passed to $c->view
726 return $c->_comp_names(qw/View V/);
729 =head2 $c->comp($name)
731 =head2 $c->component($name)
733 Gets a component object by name. This method is not recommended,
734 unless you want to get a specific component by full
735 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
736 should be used instead.
738 If C<$name> is a regexp, a list of components matched against the full
739 component name will be returned.
744 my ( $c, $name, @args ) = @_;
747 my $comps = $c->components;
750 # is it the exact name?
751 return $c->_filter_component( $comps->{ $name }, @args )
752 if exists $comps->{ $name };
754 # perhaps we just omitted "MyApp"?
755 my $composed = ( ref $c || $c ) . "::${name}";
756 return $c->_filter_component( $comps->{ $composed }, @args )
757 if exists $comps->{ $composed };
759 # search all of the models, views and controllers
760 my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
761 return $c->_filter_component( $comp, @args ) if $comp;
764 # This is here so $c->comp( '::M::' ) works
765 my $query = ref $name ? $name : qr{$name}i;
767 my @result = grep { m{$query} } keys %{ $c->components };
768 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
771 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
772 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
773 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
774 return $c->_filter_component( $result[ 0 ], @args );
777 # I would expect to return an empty list here, but that breaks back-compat
781 return sort keys %{ $c->components };
784 =head2 CLASS DATA AND HELPER CLASSES
788 Returns or takes a hashref containing the application's configuration.
790 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
792 You can also use a C<YAML>, C<XML> or C<Config::General> config file
793 like myapp.yml in your applications home directory. See
794 L<Catalyst::Plugin::ConfigLoader>.
797 db: dsn:SQLite:foo.db
802 around config => sub {
806 croak('Setting config after setup has been run is not allowed.')
807 if ( @_ and $c->setup_finished );
814 Returns the logging object instance. Unless it is already set, Catalyst
815 sets this up with a L<Catalyst::Log> object. To use your own log class,
816 set the logger with the C<< __PACKAGE__->log >> method prior to calling
817 C<< __PACKAGE__->setup >>.
819 __PACKAGE__->log( MyLogger->new );
824 $c->log->info( 'Now logging with my own logger!' );
826 Your log class should implement the methods described in
832 Overload to enable debug messages (same as -Debug option).
834 Note that this is a static method, not an accessor and should be overloaded
835 by declaring "sub debug { 1 }" in your MyApp.pm, not by calling $c->debug(1).
841 =head2 $c->dispatcher
843 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
847 Returns the engine instance. See L<Catalyst::Engine>.
850 =head2 UTILITY METHODS
852 =head2 $c->path_to(@path)
854 Merges C<@path> with C<< $c->config->{home} >> and returns a
855 L<Path::Class::Dir> object.
859 $c->path_to( 'db', 'sqlite.db' );
864 my ( $c, @path ) = @_;
865 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
866 if ( -d $path ) { return $path }
867 else { return Path::Class::File->new( $c->config->{home}, @path ) }
870 =head2 $c->plugin( $name, $class, @args )
872 Helper method for plugins. It creates a class data accessor/mutator and
873 loads and instantiates the given class.
875 MyApp->plugin( 'prototype', 'HTML::Prototype' );
877 $c->prototype->define_javascript_functions;
879 B<Note:> This method of adding plugins is deprecated. The ability
880 to add plugins like this B<will be removed> in a Catalyst 5.9.
881 Please do not use this functionality in new code.
886 my ( $class, $name, $plugin, @args ) = @_;
888 # See block comment in t/unit_core_plugin.t
889 $class->log->debug(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.9/);
891 $class->_register_plugin( $plugin, 1 );
893 eval { $plugin->import };
894 $class->mk_classdata($name);
896 eval { $obj = $plugin->new(@args) };
899 Catalyst::Exception->throw( message =>
900 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
904 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
910 Initializes the dispatcher and engine, loads any plugins, and loads the
911 model, view, and controller components. You may also specify an array
912 of plugins to load here, if you choose to not load them in the C<use
916 MyApp->setup( qw/-Debug/ );
921 my ( $class, @arguments ) = @_;
922 croak('Running setup more than once')
923 if ( $class->setup_finished );
925 unless ( $class->isa('Catalyst') ) {
927 Catalyst::Exception->throw(
928 message => qq/'$class' does not inherit from Catalyst/ );
931 if ( $class->arguments ) {
932 @arguments = ( @arguments, @{ $class->arguments } );
938 foreach (@arguments) {
942 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
944 elsif (/^-(\w+)=?(.*)$/) {
945 $flags->{ lc $1 } = $2;
948 push @{ $flags->{plugins} }, $_;
952 $class->setup_home( delete $flags->{home} );
954 $class->setup_log( delete $flags->{log} );
955 $class->setup_plugins( delete $flags->{plugins} );
956 $class->setup_dispatcher( delete $flags->{dispatcher} );
957 $class->setup_engine( delete $flags->{engine} );
958 $class->setup_stats( delete $flags->{stats} );
960 for my $flag ( sort keys %{$flags} ) {
962 if ( my $code = $class->can( 'setup_' . $flag ) ) {
963 &$code( $class, delete $flags->{$flag} );
966 $class->log->warn(qq/Unknown flag "$flag"/);
970 eval { require Catalyst::Devel; };
971 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
972 $class->log->warn(<<"EOF");
973 You are running an old script!
975 Please update by running (this will overwrite existing files):
976 catalyst.pl -force -scripts $class
978 or (this will not overwrite existing files):
979 catalyst.pl -scripts $class
984 if ( $class->debug ) {
985 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
988 my $column_width = Catalyst::Utils::term_width() - 6;
989 my $t = Text::SimpleTable->new($column_width);
990 $t->row($_) for @plugins;
991 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
994 my $dispatcher = $class->dispatcher;
995 my $engine = $class->engine;
996 my $home = $class->config->{home};
998 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
999 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1003 ? $class->log->debug(qq/Found home "$home"/)
1004 : $class->log->debug(qq/Home "$home" doesn't exist/)
1005 : $class->log->debug(q/Couldn't find home/);
1008 # Call plugins setup, this is stupid and evil.
1010 no warnings qw/redefine/;
1011 local *setup = sub { };
1015 # Initialize our data structure
1016 $class->components( {} );
1018 $class->setup_components;
1020 if ( $class->debug ) {
1021 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1022 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1023 for my $comp ( sort keys %{ $class->components } ) {
1024 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1025 $t->row( $comp, $type );
1027 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1028 if ( keys %{ $class->components } );
1031 # Add our self to components, since we are also a component
1032 if( $class->isa('Catalyst::Controller') ){
1033 $class->components->{$class} = $class;
1036 $class->setup_actions;
1038 if ( $class->debug ) {
1039 my $name = $class->config->{name} || 'Application';
1040 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1042 $class->log->_flush() if $class->log->can('_flush');
1044 # Make sure that the application class becomes immutable at this point,
1045 # which ensures that it gets an inlined constructor. This means that it
1046 # works even if the user has added a plugin which contains a new method.
1047 # Note however that we have to do the work on scope end, so that method
1048 # modifiers work correctly in MyApp (as you have to call setup _before_
1049 # applying modifiers).
1050 Scope::Upper::reap(sub {
1051 my $meta = Class::MOP::get_metaclass_by_name($class);
1052 $meta->make_immutable unless $meta->is_immutable;
1053 }, Scope::Upper::SCOPE(1));
1055 $class->setup_finalize;
1059 =head2 $app->setup_finalize
1061 A hook to attach modifiers to.
1062 Using C< after setup => sub{}; > doesn't work, because of quirky things done for plugin setup.
1063 Also better than C< setup_finished(); >, as that is a getter method.
1065 sub setup_finalize {
1069 ## do stuff, i.e., determine a primary key column for sessions stored in a DB
1071 $app->next::method(@_);
1078 sub setup_finalize {
1080 $class->setup_finished(1);
1083 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1085 =head2 $c->uri_for( $path, @args?, \%query_values? )
1091 A Catalyst::Action object representing the Catalyst action you want to
1092 create a URI for. To get one for an action in the current controller,
1093 use C<< $c->action('someactionname') >>. To get one from different
1094 controller, fetch the controller using C<< $c->controller() >>, then
1095 call C<action_for> on it.
1097 You can maintain the arguments captured by an action (e.g.: Regex, Chained)
1098 using C<< $c->req->captures >>.
1100 # For the current action
1101 $c->uri_for($c->action, $c->req->captures);
1103 # For the Foo action in the Bar controller
1104 $c->uri_for($c->controller->('Bar')->action_for('Foo'), $c->req->captures);
1111 my ( $c, $path, @args ) = @_;
1113 if ( blessed($path) ) { # action object
1114 my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
1117 $path = $c->dispatcher->uri_for_action($path, $captures);
1118 return undef unless defined($path);
1119 $path = '/' if $path eq '';
1122 undef($path) if (defined $path && $path eq '');
1125 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1127 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1128 s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
1130 unshift(@args, $path);
1132 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1133 my $namespace = $c->namespace;
1134 if (defined $path) { # cheesy hack to handle path '../foo'
1135 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1137 unshift(@args, $namespace || '');
1140 # join args with '/', or a blank string
1141 my $args = join('/', grep { defined($_) } @args);
1142 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1144 my $base = $c->req->base;
1145 my $class = ref($base);
1146 $base =~ s{(?<!/)$}{/};
1150 if (my @keys = keys %$params) {
1151 # somewhat lifted from URI::_query's query_form
1152 $query = '?'.join('&', map {
1153 my $val = $params->{$_};
1154 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1157 $val = '' unless defined $val;
1160 utf8::encode( $_ ) if utf8::is_utf8($_);
1161 # using the URI::Escape pattern here so utf8 chars survive
1162 s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1164 "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1168 my $res = bless(\"${base}${args}${query}", $class);
1172 =head2 $c->welcome_message
1174 Returns the Catalyst welcome HTML page.
1178 sub welcome_message {
1180 my $name = $c->config->{name};
1181 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1182 my $prefix = Catalyst::Utils::appprefix( ref $c );
1183 $c->response->content_type('text/html; charset=utf-8');
1185 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1186 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1187 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1189 <meta http-equiv="Content-Language" content="en" />
1190 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1191 <title>$name on Catalyst $VERSION</title>
1192 <style type="text/css">
1195 background-color: #eee;
1202 margin-bottom: 10px;
1204 background-color: #ccc;
1205 border: 1px solid #aaa;
1210 font-family: verdana, tahoma, sans-serif;
1213 font-family: verdana, tahoma, sans-serif;
1216 text-decoration: none;
1218 border-bottom: 1px dotted #bbb;
1220 :link:hover, :visited:hover {
1233 background-color: #fff;
1234 border: 1px solid #aaa;
1238 font-weight: normal;
1260 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1265 <img src="$logo" alt="Catalyst Logo" />
1267 <p>Welcome to the world of Catalyst.
1268 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1269 framework will make web development something you had
1270 never expected it to be: Fun, rewarding, and quick.</p>
1271 <h2>What to do now?</h2>
1272 <p>That really depends on what <b>you</b> want to do.
1273 We do, however, provide you with a few starting points.</p>
1274 <p>If you want to jump right into web development with Catalyst
1275 you might want to start with a tutorial.</p>
1276 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1278 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1280 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1281 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1283 <h2>What to do next?</h2>
1284 <p>Next it's time to write an actual application. Use the
1285 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
1286 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a>, and
1287 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>;
1288 they can save you a lot of work.</p>
1289 <pre><code>script/${prefix}_create.pl -help</code></pre>
1290 <p>Also, be sure to check out the vast and growing
1291 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>;
1292 you are likely to find what you need there.
1296 <p>Catalyst has a very active community. Here are the main places to
1297 get in touch with us.</p>
1300 <a href="http://dev.catalyst.perl.org">Wiki</a>
1303 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1306 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1309 <h2>In conclusion</h2>
1310 <p>The Catalyst team hopes you will enjoy using Catalyst as much
1311 as we enjoyed making it. Please contact us if you have ideas
1312 for improvement or other feedback.</p>
1320 =head1 INTERNAL METHODS
1322 These methods are not meant to be used by end users.
1324 =head2 $c->components
1326 Returns a hash of components.
1328 =head2 $c->context_class
1330 Returns or sets the context class.
1334 Returns a hashref containing coderefs and execution counts (needed for
1335 deep recursion detection).
1339 Returns the number of actions on the current internal execution stack.
1343 Dispatches a request to actions.
1347 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1349 =head2 $c->dispatcher_class
1351 Returns or sets the dispatcher class.
1353 =head2 $c->dump_these
1355 Returns a list of 2-element array references (name, structure) pairs
1356 that will be dumped on the error page in debug mode.
1362 [ Request => $c->req ],
1363 [ Response => $c->res ],
1364 [ Stash => $c->stash ],
1365 [ Config => $c->config ];
1368 =head2 $c->engine_class
1370 Returns or sets the engine class.
1372 =head2 $c->execute( $class, $coderef )
1374 Execute a coderef in given class and catch exceptions. Errors are available
1380 my ( $c, $class, $code ) = @_;
1381 $class = $c->component($class) || $class;
1384 if ( $c->depth >= $RECURSION ) {
1385 my $action = $code->reverse();
1386 $action = "/$action" unless $action =~ /->/;
1387 my $error = qq/Deep recursion detected calling "${action}"/;
1388 $c->log->error($error);
1394 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1396 push( @{ $c->stack }, $code );
1398 eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
1400 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1402 my $last = pop( @{ $c->stack } );
1404 if ( my $error = $@ ) {
1405 if ( !ref($error) and $error eq $DETACH ) {
1406 die $DETACH if($c->depth > 1);
1408 elsif ( !ref($error) and $error eq $GO ) {
1409 die $GO if($c->depth > 0);
1412 unless ( ref $error ) {
1413 no warnings 'uninitialized';
1415 my $class = $last->class;
1416 my $name = $last->name;
1417 $error = qq/Caught exception in $class->$name "$error"/;
1426 sub _stats_start_execute {
1427 my ( $c, $code ) = @_;
1429 return if ( ( $code->name =~ /^_.*/ )
1430 && ( !$c->config->{show_internal_actions} ) );
1432 my $action_name = $code->reverse();
1433 $c->counter->{$action_name}++;
1435 my $action = $action_name;
1436 $action = "/$action" unless $action =~ /->/;
1438 # determine if the call was the result of a forward
1439 # this is done by walking up the call stack and looking for a calling
1440 # sub of Catalyst::forward before the eval
1442 for my $index ( 2 .. 11 ) {
1444 if ( ( caller($index) )[0] eq 'Catalyst'
1445 && ( caller($index) )[3] eq '(eval)' );
1447 if ( ( caller($index) )[3] =~ /forward$/ ) {
1448 $callsub = ( caller($index) )[3];
1449 $action = "-> $action";
1454 my $uid = $action_name . $c->counter->{$action_name};
1456 # is this a root-level call or a forwarded call?
1457 if ( $callsub =~ /forward$/ ) {
1459 # forward, locate the caller
1460 if ( my $parent = $c->stack->[-1] ) {
1463 parent => "$parent" . $c->counter->{"$parent"},
1469 # forward with no caller may come from a plugin
1488 sub _stats_finish_execute {
1489 my ( $c, $info ) = @_;
1490 $c->stats->profile( end => $info );
1493 =head2 $c->_localize_fields( sub { }, \%keys );
1497 #Why does this exist? This is no longer safe and WILL NOT WORK.
1498 # it doesnt seem to be used anywhere. can we remove it?
1499 sub _localize_fields {
1500 my ( $c, $localized, $code ) = ( @_ );
1502 my $request = delete $localized->{request} || {};
1503 my $response = delete $localized->{response} || {};
1505 local @{ $c }{ keys %$localized } = values %$localized;
1506 local @{ $c->request }{ keys %$request } = values %$request;
1507 local @{ $c->response }{ keys %$response } = values %$response;
1514 Finalizes the request.
1521 for my $error ( @{ $c->error } ) {
1522 $c->log->error($error);
1525 # Allow engine to handle finalize flow (for POE)
1526 my $engine = $c->engine;
1527 if ( my $code = $engine->can('finalize') ) {
1532 $c->finalize_uploads;
1535 if ( $#{ $c->error } >= 0 ) {
1539 $c->finalize_headers;
1542 if ( $c->request->method eq 'HEAD' ) {
1543 $c->response->body('');
1549 if ($c->use_stats) {
1550 my $elapsed = sprintf '%f', $c->stats->elapsed;
1551 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1553 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1556 return $c->response->status;
1559 =head2 $c->finalize_body
1565 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1567 =head2 $c->finalize_cookies
1573 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1575 =head2 $c->finalize_error
1581 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1583 =head2 $c->finalize_headers
1589 sub finalize_headers {
1592 my $response = $c->response; #accessor calls can add up?
1594 # Check if we already finalized headers
1595 return if $response->finalized_headers;
1598 if ( my $location = $response->redirect ) {
1599 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1600 $response->header( Location => $location );
1602 if ( !$response->has_body ) {
1603 # Add a default body if none is already present
1605 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1611 if ( $response->body && !$response->content_length ) {
1613 # get the length from a filehandle
1614 if ( blessed( $response->body ) && $response->body->can('read') )
1616 my $stat = stat $response->body;
1617 if ( $stat && $stat->size > 0 ) {
1618 $response->content_length( $stat->size );
1621 $c->log->warn('Serving filehandle without a content-length');
1625 # everything should be bytes at this point, but just in case
1626 $response->content_length( bytes::length( $response->body ) );
1631 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1632 $response->headers->remove_header("Content-Length");
1633 $response->body('');
1636 $c->finalize_cookies;
1638 $c->engine->finalize_headers( $c, @_ );
1641 $response->finalized_headers(1);
1644 =head2 $c->finalize_output
1646 An alias for finalize_body.
1648 =head2 $c->finalize_read
1650 Finalizes the input after reading is complete.
1654 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1656 =head2 $c->finalize_uploads
1658 Finalizes uploads. Cleans up any temporary files.
1662 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1664 =head2 $c->get_action( $action, $namespace )
1666 Gets an action in a given namespace.
1670 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1672 =head2 $c->get_actions( $action, $namespace )
1674 Gets all actions of a given name in a namespace and all parent
1679 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1681 =head2 $c->handle_request( $class, @arguments )
1683 Called to handle each HTTP request.
1687 sub handle_request {
1688 my ( $class, @arguments ) = @_;
1690 # Always expect worst case!
1693 if ($class->debug) {
1694 my $secs = time - $START || 1;
1695 my $av = sprintf '%.3f', $COUNT / $secs;
1696 my $time = localtime time;
1697 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1700 my $c = $class->prepare(@arguments);
1702 $status = $c->finalize;
1705 if ( my $error = $@ ) {
1707 $class->log->error(qq/Caught exception in engine "$error"/);
1712 if(my $coderef = $class->log->can('_flush')){
1713 $class->log->$coderef();
1718 =head2 $c->prepare( @arguments )
1720 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1726 my ( $class, @arguments ) = @_;
1729 # After the app/ctxt split, this should become an attribute based on something passed
1730 # into the application.
1731 $class->context_class( ref $class || $class ) unless $class->context_class;
1733 my $c = $class->context_class->new({});
1735 # For on-demand data
1736 $c->request->_context($c);
1737 $c->response->_context($c);
1739 #surely this is not the most efficient way to do things...
1740 $c->stats($class->stats_class->new)->enable($c->use_stats);
1742 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1745 #XXX reuse coderef from can
1746 # Allow engine to direct the prepare flow (for POE)
1747 if ( $c->engine->can('prepare') ) {
1748 $c->engine->prepare( $c, @arguments );
1751 $c->prepare_request(@arguments);
1752 $c->prepare_connection;
1753 $c->prepare_query_parameters;
1754 $c->prepare_headers;
1755 $c->prepare_cookies;
1758 # Prepare the body for reading, either by prepare_body
1759 # or the user, if they are using $c->read
1762 # Parse the body unless the user wants it on-demand
1763 unless ( $c->config->{parse_on_demand} ) {
1768 my $method = $c->req->method || '';
1769 my $path = $c->req->path;
1770 $path = '/' unless length $path;
1771 my $address = $c->req->address || '';
1773 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1781 =head2 $c->prepare_action
1783 Prepares action. See L<Catalyst::Dispatcher>.
1787 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1789 =head2 $c->prepare_body
1791 Prepares message body.
1798 return if $c->request->_has_body;
1800 # Initialize on-demand data
1801 $c->engine->prepare_body( $c, @_ );
1802 $c->prepare_parameters;
1803 $c->prepare_uploads;
1805 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1806 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1807 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1808 my $param = $c->req->body_parameters->{$key};
1809 my $value = defined($param) ? $param : '';
1811 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1813 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1817 =head2 $c->prepare_body_chunk( $chunk )
1819 Prepares a chunk of data before sending it to L<HTTP::Body>.
1821 See L<Catalyst::Engine>.
1825 sub prepare_body_chunk {
1827 $c->engine->prepare_body_chunk( $c, @_ );
1830 =head2 $c->prepare_body_parameters
1832 Prepares body parameters.
1836 sub prepare_body_parameters {
1838 $c->engine->prepare_body_parameters( $c, @_ );
1841 =head2 $c->prepare_connection
1843 Prepares connection.
1847 sub prepare_connection {
1849 $c->engine->prepare_connection( $c, @_ );
1852 =head2 $c->prepare_cookies
1858 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1860 =head2 $c->prepare_headers
1866 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1868 =head2 $c->prepare_parameters
1870 Prepares parameters.
1874 sub prepare_parameters {
1876 $c->prepare_body_parameters;
1877 $c->engine->prepare_parameters( $c, @_ );
1880 =head2 $c->prepare_path
1882 Prepares path and base.
1886 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1888 =head2 $c->prepare_query_parameters
1890 Prepares query parameters.
1894 sub prepare_query_parameters {
1897 $c->engine->prepare_query_parameters( $c, @_ );
1899 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1900 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1901 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1902 my $param = $c->req->query_parameters->{$key};
1903 my $value = defined($param) ? $param : '';
1905 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1907 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1911 =head2 $c->prepare_read
1913 Prepares the input for reading.
1917 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1919 =head2 $c->prepare_request
1921 Prepares the engine request.
1925 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1927 =head2 $c->prepare_uploads
1933 sub prepare_uploads {
1936 $c->engine->prepare_uploads( $c, @_ );
1938 if ( $c->debug && keys %{ $c->request->uploads } ) {
1939 my $t = Text::SimpleTable->new(
1940 [ 12, 'Parameter' ],
1945 for my $key ( sort keys %{ $c->request->uploads } ) {
1946 my $upload = $c->request->uploads->{$key};
1947 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1948 $t->row( $key, $u->filename, $u->type, $u->size );
1951 $c->log->debug( "File Uploads are:\n" . $t->draw );
1955 =head2 $c->prepare_write
1957 Prepares the output for writing.
1961 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1963 =head2 $c->request_class
1965 Returns or sets the request class.
1967 =head2 $c->response_class
1969 Returns or sets the response class.
1971 =head2 $c->read( [$maxlength] )
1973 Reads a chunk of data from the request body. This method is designed to
1974 be used in a while loop, reading C<$maxlength> bytes on every call.
1975 C<$maxlength> defaults to the size of the request if not specified.
1977 You have to set C<< MyApp->config->{parse_on_demand} >> to use this
1980 Warning: If you use read(), Catalyst will not process the body,
1981 so you will not be able to access POST parameters or file uploads via
1982 $c->request. You must handle all body parsing yourself.
1986 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1994 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1996 =head2 $c->set_action( $action, $code, $namespace, $attrs )
1998 Sets an action in a given namespace.
2002 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2004 =head2 $c->setup_actions($component)
2006 Sets up actions for a component.
2010 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2012 =head2 $c->setup_components
2014 Sets up components. Specify a C<setup_components> config option to pass
2015 additional options directly to L<Module::Pluggable>. To add additional
2016 search paths, specify a key named C<search_extra> as an array
2017 reference. Items in the array beginning with C<::> will have the
2018 application class name prepended to them.
2020 All components found will also have any
2021 L<Devel::InnerPackage|inner packages> loaded and set up as components.
2022 Note, that modules which are B<not> an I<inner package> of the main
2023 file namespace loaded will not be instantiated as components.
2027 sub setup_components {
2030 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
2031 my $config = $class->config->{ setup_components };
2032 my $extra = delete $config->{ search_extra } || [];
2034 push @paths, @$extra;
2036 my $locator = Module::Pluggable::Object->new(
2037 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2041 my @comps = sort { length $a <=> length $b } $locator->plugins;
2042 my %comps = map { $_ => 1 } @comps;
2044 for my $component ( @comps ) {
2046 # We pass ignore_loaded here so that overlay files for (e.g.)
2047 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2048 # we know M::P::O found a file on disk so this is safe
2050 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2051 #Class::MOP::load_class($component);
2053 my $module = $class->setup_component( $component );
2055 $component => $module,
2057 $_ => $class->setup_component( $_ )
2059 not exists $comps{$_}
2060 } Devel::InnerPackage::list_packages( $component )
2063 for my $key ( keys %modules ) {
2064 $class->components->{ $key } = $modules{ $key };
2069 =head2 $c->setup_component
2073 sub setup_component {
2074 my( $class, $component ) = @_;
2076 unless ( $component->can( 'COMPONENT' ) ) {
2080 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2081 my $config = $class->config->{ $suffix } || {};
2083 my $instance = eval { $component->COMPONENT( $class, $config ); };
2085 if ( my $error = $@ ) {
2087 Catalyst::Exception->throw(
2088 message => qq/Couldn't instantiate component "$component", "$error"/
2092 Catalyst::Exception->throw(
2094 qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
2095 ) unless blessed($instance);
2100 =head2 $c->setup_dispatcher
2106 sub setup_dispatcher {
2107 my ( $class, $dispatcher ) = @_;
2110 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2113 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2114 $dispatcher = 'Catalyst::Dispatcher::' . $env;
2117 unless ($dispatcher) {
2118 $dispatcher = $class->dispatcher_class;
2121 Class::MOP::load_class($dispatcher);
2123 # dispatcher instance
2124 $class->dispatcher( $dispatcher->new );
2127 =head2 $c->setup_engine
2134 my ( $class, $engine ) = @_;
2137 $engine = 'Catalyst::Engine::' . $engine;
2140 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2141 $engine = 'Catalyst::Engine::' . $env;
2144 if ( $ENV{MOD_PERL} ) {
2145 my $meta = Class::MOP::get_metaclass_by_name($class);
2147 # create the apache method
2148 $meta->add_method('apache' => sub { shift->engine->apache });
2150 my ( $software, $version ) =
2151 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2154 $version =~ s/(\.[^.]+)\./$1/g;
2156 if ( $software eq 'mod_perl' ) {
2160 if ( $version >= 1.99922 ) {
2161 $engine = 'Catalyst::Engine::Apache2::MP20';
2164 elsif ( $version >= 1.9901 ) {
2165 $engine = 'Catalyst::Engine::Apache2::MP19';
2168 elsif ( $version >= 1.24 ) {
2169 $engine = 'Catalyst::Engine::Apache::MP13';
2173 Catalyst::Exception->throw( message =>
2174 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2179 # install the correct mod_perl handler
2180 if ( $version >= 1.9901 ) {
2181 *handler = sub : method {
2182 shift->handle_request(@_);
2186 *handler = sub ($$) { shift->handle_request(@_) };
2191 elsif ( $software eq 'Zeus-Perl' ) {
2192 $engine = 'Catalyst::Engine::Zeus';
2196 Catalyst::Exception->throw(
2197 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2202 $engine = $class->engine_class;
2205 Class::MOP::load_class($engine);
2207 # check for old engines that are no longer compatible
2209 if ( $engine->isa('Catalyst::Engine::Apache')
2210 && !Catalyst::Engine::Apache->VERSION )
2215 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2216 && Catalyst::Engine::Server->VERSION le '0.02' )
2221 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2222 && $engine->VERSION eq '0.01' )
2227 elsif ($engine->isa('Catalyst::Engine::Zeus')
2228 && $engine->VERSION eq '0.01' )
2234 Catalyst::Exception->throw( message =>
2235 qq/Engine "$engine" is not supported by this version of Catalyst/
2240 $class->engine( $engine->new );
2243 =head2 $c->setup_home
2245 Sets up the home directory.
2250 my ( $class, $home ) = @_;
2252 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2256 $home ||= Catalyst::Utils::home($class);
2259 #I remember recently being scolded for assigning config values like this
2260 $class->config->{home} ||= $home;
2261 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2265 =head2 $c->setup_log
2267 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2268 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2271 This method also installs a C<debug> method that returns a true value into the
2272 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2273 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2275 Note that if the log has already been setup, by either a previous call to
2276 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2277 that this method won't actually set up the log object.
2282 my ( $class, $levels ) = @_;
2285 $levels =~ s/^\s+//;
2286 $levels =~ s/\s+$//;
2287 my %levels = map { $_ => 1 } split /\s*,\s*/, $levels || '';
2289 unless ( $class->log ) {
2290 $class->log( Catalyst::Log->new(keys %levels) );
2293 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2294 if ( defined($env_debug) or $levels{debug} ) {
2295 Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2296 $class->log->debug('Debug messages enabled');
2300 =head2 $c->setup_plugins
2306 =head2 $c->setup_stats
2308 Sets up timing statistics class.
2313 my ( $class, $stats ) = @_;
2315 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2317 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2318 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2319 Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2320 $class->log->debug('Statistics enabled');
2325 =head2 $c->registered_plugins
2327 Returns a sorted list of the plugins which have either been stated in the
2328 import list or which have been added via C<< MyApp->plugin(@args); >>.
2330 If passed a given plugin name, it will report a boolean value indicating
2331 whether or not that plugin is loaded. A fully qualified name is required if
2332 the plugin name does not begin with C<Catalyst::Plugin::>.
2334 if ($c->registered_plugins('Some::Plugin')) {
2342 sub registered_plugins {
2344 return sort keys %{ $proto->_plugins } unless @_;
2346 return 1 if exists $proto->_plugins->{$plugin};
2347 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2350 sub _register_plugin {
2351 my ( $proto, $plugin, $instant ) = @_;
2352 my $class = ref $proto || $proto;
2354 # no ignore_loaded here, the plugin may already have been
2355 # defined in memory and we don't want to error on "no file" if so
2357 Class::MOP::load_class( $plugin );
2359 $proto->_plugins->{$plugin} = 1;
2362 if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
2363 my @superclasses = ($plugin, $meta->superclasses );
2364 $meta->superclasses(@superclasses);
2366 unshift @{"$class\::ISA"}, $plugin;
2373 my ( $class, $plugins ) = @_;
2375 $class->_plugins( {} ) unless $class->_plugins;
2377 for my $plugin ( reverse @$plugins ) {
2379 unless ( $plugin =~ s/\A\+// ) {
2380 $plugin = "Catalyst::Plugin::$plugin";
2383 $class->_register_plugin($plugin);
2390 Returns an arrayref of the internal execution stack (actions that are
2391 currently executing).
2393 =head2 $c->stats_class
2395 Returns or sets the stats (timing statistics) class.
2397 =head2 $c->use_stats
2399 Returns 1 when stats collection is enabled. Stats collection is enabled
2400 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2401 environment variable is set.
2403 Note that this is a static method, not an accessor and should be overloaded
2404 by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1).
2411 =head2 $c->write( $data )
2413 Writes $data to the output stream. When using this method directly, you
2414 will need to manually set the C<Content-Length> header to the length of
2415 your output data, if known.
2422 # Finalize headers if someone manually writes output
2423 $c->finalize_headers;
2425 return $c->engine->write( $c, @_ );
2430 Returns the Catalyst version number. Mostly useful for "powered by"
2431 messages in template systems.
2435 sub version { return $Catalyst::VERSION }
2437 =head1 INTERNAL ACTIONS
2439 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2440 C<_ACTION>, and C<_END>. These are by default not shown in the private
2441 action table, but you can make them visible with a config parameter.
2443 MyApp->config->{show_internal_actions} = 1;
2445 =head1 CASE SENSITIVITY
2447 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2448 mapped to C</foo/bar>. You can activate case sensitivity with a config
2451 MyApp->config->{case_sensitive} = 1;
2453 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2455 =head1 ON-DEMAND PARSER
2457 The request body is usually parsed at the beginning of a request,
2458 but if you want to handle input yourself, you can enable on-demand
2459 parsing with a config parameter.
2461 MyApp->config->{parse_on_demand} = 1;
2463 =head1 PROXY SUPPORT
2465 Many production servers operate using the common double-server approach,
2466 with a lightweight frontend web server passing requests to a larger
2467 backend server. An application running on the backend server must deal
2468 with two problems: the remote user always appears to be C<127.0.0.1> and
2469 the server's hostname will appear to be C<localhost> regardless of the
2470 virtual host that the user connected through.
2472 Catalyst will automatically detect this situation when you are running
2473 the frontend and backend servers on the same machine. The following
2474 changes are made to the request.
2476 $c->req->address is set to the user's real IP address, as read from
2477 the HTTP X-Forwarded-For header.
2479 The host value for $c->req->base and $c->req->uri is set to the real
2480 host, as read from the HTTP X-Forwarded-Host header.
2482 Obviously, your web server must support these headers for this to work.
2484 In a more complex server farm environment where you may have your
2485 frontend proxy server(s) on different machines, you will need to set a
2486 configuration option to tell Catalyst to read the proxied data from the
2489 MyApp->config->{using_frontend_proxy} = 1;
2491 If you do not wish to use the proxy support at all, you may set:
2493 MyApp->config->{ignore_frontend_proxy} = 1;
2495 =head1 THREAD SAFETY
2497 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2498 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2499 believe the Catalyst core to be thread-safe.
2501 If you plan to operate in a threaded environment, remember that all other
2502 modules you are using must also be thread-safe. Some modules, most notably
2503 L<DBD::SQLite>, are not thread-safe.
2509 Join #catalyst on irc.perl.org.
2513 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2514 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
2518 http://catalyst.perl.org
2522 http://dev.catalyst.perl.org
2526 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2528 =head2 L<Catalyst::Manual> - The Catalyst Manual
2530 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
2532 =head2 L<Catalyst::Engine> - Core engine
2534 =head2 L<Catalyst::Log> - Log class.
2536 =head2 L<Catalyst::Request> - Request object
2538 =head2 L<Catalyst::Response> - Response object
2540 =head2 L<Catalyst::Test> - The test suite.
2542 =head1 PROJECT FOUNDER
2544 sri: Sebastian Riedel <sri@cpan.org>
2550 acme: Leon Brocard <leon@astray.com>
2558 andyg: Andy Grundman <andy@hybridized.org>
2560 audreyt: Audrey Tang
2562 bricas: Brian Cassidy <bricas@cpan.org>
2564 Caelum: Rafael Kitover <rkitover@io.com>
2566 chansen: Christian Hansen
2568 chicks: Christopher Hicks
2572 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
2576 esskar: Sascha Kiefer
2578 fireartist: Carl Franks <cfranks@cpan.org>
2580 gabb: Danijel Milicevic
2586 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2588 jcamacho: Juan Camacho
2590 jhannah: Jay Hannah <jay@jays.net>
2596 jon: Jon Schutz <jjschutz@cpan.org>
2598 marcus: Marcus Ramberg <mramberg@cpan.org>
2600 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
2602 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
2606 naughton: David Naughton
2608 ningu: David Kamholz <dkamholz@cpan.org>
2610 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
2612 numa: Dan Sully <daniel@cpan.org>
2616 omega: Andreas Marienborg
2618 Oleg Kostyuk <cub.uanic@gmail.com>
2620 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
2622 rafl: Florian Ragwitz <rafl@debian.org>
2626 the_jester: Jesse Sheidlower
2628 t0m: Tomas Doran <bobtfish@bobtfish.net>
2632 willert: Sebastian Willert <willert@cpan.org>
2636 This library is free software, you can redistribute it and/or modify it under
2637 the same terms as Perl itself.
2643 __PACKAGE__->meta->make_immutable;