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 # carp "the use of req() is deprecated in favour of request()";
47 my $self = shift; return $self->request(@_);
50 # carp "the use of res() is deprecated in favour of response()";
51 my $self = shift; return $self->response(@_);
54 # For backwards compatibility
55 sub finalize_output { shift->finalize_body(@_) };
60 our $RECURSION = 1000;
61 our $DETACH = "catalyst_detach\n";
62 our $GO = "catalyst_go\n";
64 #I imagine that very few of these really need to be class variables. if any.
65 #maybe we should just make them attributes with a default?
66 __PACKAGE__->mk_classdata($_)
67 for qw/components arguments dispatcher engine log dispatcher_class
68 engine_class context_class request_class response_class stats_class
71 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
72 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
73 __PACKAGE__->request_class('Catalyst::Request');
74 __PACKAGE__->response_class('Catalyst::Response');
75 __PACKAGE__->stats_class('Catalyst::Stats');
77 # Remember to update this in Catalyst::Runtime as well!
79 our $VERSION = '5.8000_06';
82 my ( $class, @arguments ) = @_;
84 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
86 return unless $class eq 'Catalyst';
88 my $caller = caller();
89 return if $caller eq 'main';
91 # Kill Adopt::NEXT warnings if we're a non-RC version
92 if ($VERSION !~ /_\d{2}$/) {
93 Class::C3::Adopt::NEXT->unimport(qr/^Catalyst::/);
96 my $meta = Moose::Meta::Class->initialize($caller);
97 #Moose->import({ into => $caller }); #do we want to do this?
99 unless ( $caller->isa('Catalyst') ) {
100 my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
101 $meta->superclasses(@superclasses);
103 unless( $meta->has_method('meta') ){
104 $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
107 $caller->arguments( [@arguments] );
113 Catalyst - The Elegant MVC Web Application Framework
117 See the L<Catalyst::Manual> distribution for comprehensive
118 documentation and tutorials.
120 # Install Catalyst::Devel for helpers and other development tools
121 # use the helper to create a new application
124 # add models, views, controllers
125 script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
126 script/myapp_create.pl view MyTemplate TT
127 script/myapp_create.pl controller Search
129 # built in testserver -- use -r to restart automatically on changes
130 # --help to see all available options
131 script/myapp_server.pl
133 # command line testing interface
134 script/myapp_test.pl /yada
137 use Catalyst qw/-Debug/; # include plugins here as well
139 ### In lib/MyApp/Controller/Root.pm (autocreated)
140 sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
141 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
142 $c->stash->{template} = 'foo.tt'; # set the template
143 # lookup something from db -- stash vars are passed to TT
145 $c->model('Database::Foo')->search( { country => $args[0] } );
146 if ( $c->req->params->{bar} ) { # access GET or POST parameters
147 $c->forward( 'bar' ); # process another action
148 # do something else after forward returns
152 # The foo.tt TT template can use the stash data from the database
153 [% WHILE (item = data.next) %]
157 # called for /bar/of/soap, /bar/of/soap/10, etc.
158 sub bar : Path('/bar/of/soap') { ... }
160 # called for all actions, from the top-most controller downwards
162 my ( $self, $c ) = @_;
163 if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
164 $c->res->redirect( '/login' ); # require login
165 return 0; # abort request and go immediately to end()
167 return 1; # success; carry on to next action
170 # called after all actions are finished
172 my ( $self, $c ) = @_;
173 if ( scalar @{ $c->error } ) { ... } # handle errors
174 return if $c->res->body; # already have a response
175 $c->forward( 'MyApp::View::TT' ); # render template
178 ### in MyApp/Controller/Foo.pm
179 # called for /foo/bar
180 sub bar : Local { ... }
182 # called for /blargle
183 sub blargle : Global { ... }
185 # an index action matches /foo, but not /foo/1, etc.
186 sub index : Private { ... }
188 ### in MyApp/Controller/Foo/Bar.pm
189 # called for /foo/bar/baz
190 sub baz : Local { ... }
192 # first Root auto is called, then Foo auto, then this
193 sub auto : Private { ... }
195 # powerful regular expression paths are also possible
196 sub details : Regex('^product/(\w+)/details$') {
197 my ( $self, $c ) = @_;
198 # extract the (\w+) from the URI
199 my $product = $c->req->captures->[0];
202 See L<Catalyst::Manual::Intro> for additional information.
206 Catalyst is a modern framework for making web applications without the
207 pain usually associated with this process. This document is a reference
208 to the main Catalyst application. If you are a new user, we suggest you
209 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
211 See L<Catalyst::Manual> for more documentation.
213 Catalyst plugins can be loaded by naming them as arguments to the "use
214 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
215 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
218 use Catalyst qw/My::Module/;
220 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
221 fully qualify the name by using a unary plus:
225 +Fully::Qualified::Plugin::Name
228 Special flags like C<-Debug> and C<-Engine> can also be specified as
229 arguments when Catalyst is loaded:
231 use Catalyst qw/-Debug My::Module/;
233 The position of plugins and flags in the chain is important, because
234 they are loaded in the order in which they appear.
236 The following flags are supported:
240 Enables debug output. You can also force this setting from the system
241 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
242 settings override the application, with <MYAPP>_DEBUG having the highest
247 Forces Catalyst to use a specific engine. Omit the
248 C<Catalyst::Engine::> prefix of the engine name, i.e.:
250 use Catalyst qw/-Engine=CGI/;
254 Forces Catalyst to use a specific home directory, e.g.:
256 use Catalyst qw[-Home=/usr/mst];
258 This can also be done in the shell environment by setting either the
259 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
260 is replaced with the uppercased name of your application, any "::" in
261 the name will be replaced with underscores, e.g. MyApp::Web should use
262 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
266 use Catalyst '-Log=warn,fatal,error';
268 Specifies a comma-delimited list of log levels.
272 Enables statistics collection and reporting. You can also force this setting
273 from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
274 environment settings override the application, with <MYAPP>_STATS having the
279 use Catalyst qw/-Stats=1/
283 =head2 INFORMATION ABOUT THE CURRENT REQUEST
287 Returns a L<Catalyst::Action> object for the current action, which
288 stringifies to the action name. See L<Catalyst::Action>.
292 Returns the namespace of the current action, i.e., the URI prefix
293 corresponding to the controller of the current action. For example:
295 # in Controller::Foo::Bar
296 $c->namespace; # returns 'foo/bar';
302 Returns the current L<Catalyst::Request> object, giving access to
303 information about the current client request (including parameters,
304 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
306 =head2 REQUEST FLOW HANDLING
308 =head2 $c->forward( $action [, \@arguments ] )
310 =head2 $c->forward( $class, $method, [, \@arguments ] )
312 Forwards processing to another action, by its private name. If you give a
313 class name but no method, C<process()> is called. You may also optionally
314 pass arguments in an arrayref. The action will receive the arguments in
315 C<@_> and C<< $c->req->args >>. Upon returning from the function,
316 C<< $c->req->args >> will be restored to the previous values.
318 Any data C<return>ed from the action forwarded to, will be returned by the
321 my $foodata = $c->forward('/foo');
322 $c->forward('index');
323 $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
324 $c->forward('MyApp::View::TT');
326 Note that forward implies an C<<eval { }>> around the call (actually
327 C<execute> does), thus de-fatalizing all 'dies' within the called
328 action. If you want C<die> to propagate you need to do something like:
331 die $c->error if $c->error;
333 Or make sure to always return true values from your actions and write
336 $c->forward('foo') || return;
340 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
342 =head2 $c->detach( $action [, \@arguments ] )
344 =head2 $c->detach( $class, $method, [, \@arguments ] )
348 The same as C<forward>, but doesn't return to the previous action when
349 processing is finished.
351 When called with no arguments it escapes the processing chain entirely.
355 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
357 =head2 $c->visit( $action [, \@arguments ] )
359 =head2 $c->visit( $class, $method, [, \@arguments ] )
361 Almost the same as C<forward>, but does a full dispatch, instead of just
362 calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
363 C<auto> and the method you go to are called, just like a new request.
365 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
366 This means, for example, that $c->action methods such as C<name>, C<class> and
367 C<reverse> return information for the visited action when they are invoked
368 within the visited action. This is different from the behavior of C<forward>
369 which continues to use the $c->action object from the caller action even when
370 invoked from the callee.
372 C<$c-E<gt>stash> is kept unchanged.
374 In effect, C<visit> allows you to "wrap" another action, just as it
375 would have been called by dispatching from a URL, while the analogous
376 C<go> allows you to transfer control to another action as if it had
377 been reached directly from a URL.
381 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
383 =head2 $c->go( $action [, \@arguments ] )
385 =head2 $c->go( $class, $method, [, \@arguments ] )
387 Almost the same as C<detach>, but does a full dispatch like C<visit>,
388 instead of just calling the new C<$action> /
389 C<$class-E<gt>$method>. This means that C<begin>, C<auto> and the
390 method you visit are called, just like a new request.
392 C<$c-E<gt>stash> is kept unchanged.
396 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
402 Returns the current L<Catalyst::Response> object, see there for details.
406 Returns a hashref to the stash, which may be used to store data and pass
407 it between components during a request. You can also set hash keys by
408 passing arguments. The stash is automatically sent to the view. The
409 stash is cleared at the end of a request; it cannot be used for
410 persistent storage (for this you must use a session; see
411 L<Catalyst::Plugin::Session> for a complete system integrated with
414 $c->stash->{foo} = $bar;
415 $c->stash( { moose => 'majestic', qux => 0 } );
416 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
418 # stash is automatically passed to the view for use in a template
419 $c->forward( 'MyApp::View::TT' );
423 around stash => sub {
426 my $stash = $orig->($c);
428 my $new_stash = @_ > 1 ? {@_} : $_[0];
429 croak('stash takes a hash or hashref') unless ref $new_stash;
430 foreach my $key ( keys %$new_stash ) {
431 $stash->{$key} = $new_stash->{$key};
441 =head2 $c->error($error, ...)
443 =head2 $c->error($arrayref)
445 Returns an arrayref containing error messages. If Catalyst encounters an
446 error while processing a request, it stores the error in $c->error. This
447 method should only be used to store fatal error messages.
449 my @error = @{ $c->error };
453 $c->error('Something bad happened');
460 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
461 croak @$error unless ref $c;
462 push @{ $c->{error} }, @$error;
464 elsif ( defined $_[0] ) { $c->{error} = undef }
465 return $c->{error} || [];
471 Contains the return value of the last executed action.
473 =head2 $c->clear_errors
475 Clear errors. You probably don't want to clear the errors unless you are
476 implementing a custom error screen.
478 This is equivalent to running
489 # search components given a name and some prefixes
490 sub _comp_search_prefixes {
491 my ( $c, $name, @prefixes ) = @_;
492 my $appclass = ref $c || $c;
493 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
495 # map the original component name to the sub part that we will search against
496 my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
497 grep { /$filter/ } keys %{ $c->components };
499 # undef for a name will return all
500 return keys %eligible if !defined $name;
502 my $query = ref $name ? $name : qr/^$name$/i;
503 my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
505 return map { $c->components->{ $_ } } @result if @result;
507 # if we were given a regexp to search against, we're done.
512 @result = map { $c->components->{ $_ } } grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
514 # no results? try against full names
516 @result = map { $c->components->{ $_ } } grep { m{$query} } keys %eligible;
519 # don't warn if we didn't find any results, it just might not exist
521 my $msg = "Used regexp fallback for \$c->model('${name}'), which found '" .
522 (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
523 "component resolution is unreliable and unsafe.";
524 my $short = $result[0];
525 $short =~ s/.*?Model:://;
526 my $shortmess = Carp::shortmess('');
527 if ($shortmess =~ m#Catalyst/Plugin#) {
528 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
530 } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
531 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
532 "component's config";
534 $msg .= " You probably meant \$c->model('$short') instead of \$c->model{'${name}'}, " .
535 "but if you really wanted to search, pass in a regexp as the argument " .
536 "like so: \$c->model(qr/${name}/)";
538 $c->log->warn( "${msg}$shortmess" );
544 # Find possible names for a prefix
546 my ( $c, @prefixes ) = @_;
547 my $appclass = ref $c || $c;
549 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
551 my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes );
555 # Filter a component before returning by calling ACCEPT_CONTEXT if available
556 sub _filter_component {
557 my ( $c, $comp, @args ) = @_;
559 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
560 return $comp->ACCEPT_CONTEXT( $c, @args );
566 =head2 COMPONENT ACCESSORS
568 =head2 $c->controller($name)
570 Gets a L<Catalyst::Controller> instance by name.
572 $c->controller('Foo')->do_stuff;
574 If the name is omitted, will return the controller for the dispatched
577 If you want to search for controllers, pass in a regexp as the argument.
579 # find all controllers that start with Foo
580 my @foo_controllers = $c->controller(qr{^Foo});
586 my ( $c, $name, @args ) = @_;
589 my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
590 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
591 return $c->_filter_component( $result[ 0 ], @args );
594 return $c->component( $c->action->class );
597 =head2 $c->model($name)
599 Gets a L<Catalyst::Model> instance by name.
601 $c->model('Foo')->do_stuff;
603 Any extra arguments are directly passed to ACCEPT_CONTEXT.
605 If the name is omitted, it will look for
606 - a model object in $c->stash->{current_model_instance}, then
607 - a model name in $c->stash->{current_model}, then
608 - a config setting 'default_model', or
609 - check if there is only one model, and return it if that's the case.
611 If you want to search for models, pass in a regexp as the argument.
613 # find all models that start with Foo
614 my @foo_models = $c->model(qr{^Foo});
619 my ( $c, $name, @args ) = @_;
622 my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
623 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
624 return $c->_filter_component( $result[ 0 ], @args );
628 return $c->stash->{current_model_instance}
629 if $c->stash->{current_model_instance};
630 return $c->model( $c->stash->{current_model} )
631 if $c->stash->{current_model};
633 return $c->model( $c->config->{default_model} )
634 if $c->config->{default_model};
636 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
639 $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
640 $c->log->warn( '* $c->config->{default_model} # the name of the default model to use' );
641 $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
642 $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
643 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
646 return $c->_filter_component( $comp );
650 =head2 $c->view($name)
652 Gets a L<Catalyst::View> instance by name.
654 $c->view('Foo')->do_stuff;
656 Any extra arguments are directly passed to ACCEPT_CONTEXT.
658 If the name is omitted, it will look for
659 - a view object in $c->stash->{current_view_instance}, then
660 - a view name in $c->stash->{current_view}, then
661 - a config setting 'default_view', or
662 - check if there is only one view, and return it if that's the case.
664 If you want to search for views, pass in a regexp as the argument.
666 # find all views that start with Foo
667 my @foo_views = $c->view(qr{^Foo});
672 my ( $c, $name, @args ) = @_;
675 my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
676 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
677 return $c->_filter_component( $result[ 0 ], @args );
681 return $c->stash->{current_view_instance}
682 if $c->stash->{current_view_instance};
683 return $c->view( $c->stash->{current_view} )
684 if $c->stash->{current_view};
686 return $c->view( $c->config->{default_view} )
687 if $c->config->{default_view};
689 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
692 $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
693 $c->log->warn( '* $c->config->{default_view} # the name of the default view to use' );
694 $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
695 $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
696 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
699 return $c->_filter_component( $comp );
702 =head2 $c->controllers
704 Returns the available names which can be passed to $c->controller
710 return $c->_comp_names(qw/Controller C/);
715 Returns the available names which can be passed to $c->model
721 return $c->_comp_names(qw/Model M/);
727 Returns the available names which can be passed to $c->view
733 return $c->_comp_names(qw/View V/);
736 =head2 $c->comp($name)
738 =head2 $c->component($name)
740 Gets a component object by name. This method is not recommended,
741 unless you want to get a specific component by full
742 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
743 should be used instead.
745 If C<$name> is a regexp, a list of components matched against the full
746 component name will be returned.
751 my ( $c, $name, @args ) = @_;
754 my $comps = $c->components;
757 # is it the exact name?
758 return $c->_filter_component( $comps->{ $name }, @args )
759 if exists $comps->{ $name };
761 # perhaps we just omitted "MyApp"?
762 my $composed = ( ref $c || $c ) . "::${name}";
763 return $c->_filter_component( $comps->{ $composed }, @args )
764 if exists $comps->{ $composed };
766 # search all of the models, views and controllers
767 my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
768 return $c->_filter_component( $comp, @args ) if $comp;
771 # This is here so $c->comp( '::M::' ) works
772 my $query = ref $name ? $name : qr{$name}i;
774 my @result = grep { m{$query} } keys %{ $c->components };
775 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
778 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
779 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
780 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
781 return $c->_filter_component( $result[ 0 ], @args );
784 # I would expect to return an empty list here, but that breaks back-compat
788 return sort keys %{ $c->components };
791 =head2 CLASS DATA AND HELPER CLASSES
795 Returns or takes a hashref containing the application's configuration.
797 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
799 You can also use a C<YAML>, C<XML> or C<Config::General> config file
800 like myapp.yml in your applications home directory. See
801 L<Catalyst::Plugin::ConfigLoader>.
804 db: dsn:SQLite:foo.db
809 around config => sub {
813 croak('Setting config after setup has been run is not allowed.')
814 if ( @_ and $c->setup_finished );
821 Returns the logging object instance. Unless it is already set, Catalyst
822 sets this up with a L<Catalyst::Log> object. To use your own log class,
823 set the logger with the C<< __PACKAGE__->log >> method prior to calling
824 C<< __PACKAGE__->setup >>.
826 __PACKAGE__->log( MyLogger->new );
831 $c->log->info( 'Now logging with my own logger!' );
833 Your log class should implement the methods described in
839 Overload to enable debug messages (same as -Debug option).
841 Note that this is a static method, not an accessor and should be overloaded
842 by declaring "sub debug { 1 }" in your MyApp.pm, not by calling $c->debug(1).
848 =head2 $c->dispatcher
850 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
854 Returns the engine instance. See L<Catalyst::Engine>.
857 =head2 UTILITY METHODS
859 =head2 $c->path_to(@path)
861 Merges C<@path> with C<< $c->config->{home} >> and returns a
862 L<Path::Class::Dir> object.
866 $c->path_to( 'db', 'sqlite.db' );
871 my ( $c, @path ) = @_;
872 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
873 if ( -d $path ) { return $path }
874 else { return Path::Class::File->new( $c->config->{home}, @path ) }
877 =head2 $c->plugin( $name, $class, @args )
879 Helper method for plugins. It creates a class data accessor/mutator and
880 loads and instantiates the given class.
882 MyApp->plugin( 'prototype', 'HTML::Prototype' );
884 $c->prototype->define_javascript_functions;
886 B<Note:> This method of adding plugins is deprecated. The ability
887 to add plugins like this B<will be removed> in a Catalyst 5.9.
888 Please do not use this functionality in new code.
893 my ( $class, $name, $plugin, @args ) = @_;
895 # See block comment in t/unit_core_plugin.t
896 $class->log->debug(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.9/);
898 $class->_register_plugin( $plugin, 1 );
900 eval { $plugin->import };
901 $class->mk_classdata($name);
903 eval { $obj = $plugin->new(@args) };
906 Catalyst::Exception->throw( message =>
907 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
911 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
917 Initializes the dispatcher and engine, loads any plugins, and loads the
918 model, view, and controller components. You may also specify an array
919 of plugins to load here, if you choose to not load them in the C<use
923 MyApp->setup( qw/-Debug/ );
928 my ( $class, @arguments ) = @_;
929 croak('Running setup more than once')
930 if ( $class->setup_finished );
932 unless ( $class->isa('Catalyst') ) {
934 Catalyst::Exception->throw(
935 message => qq/'$class' does not inherit from Catalyst/ );
938 if ( $class->arguments ) {
939 @arguments = ( @arguments, @{ $class->arguments } );
945 foreach (@arguments) {
949 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
951 elsif (/^-(\w+)=?(.*)$/) {
952 $flags->{ lc $1 } = $2;
955 push @{ $flags->{plugins} }, $_;
959 $class->setup_home( delete $flags->{home} );
961 $class->setup_log( delete $flags->{log} );
962 $class->setup_plugins( delete $flags->{plugins} );
963 $class->setup_dispatcher( delete $flags->{dispatcher} );
964 $class->setup_engine( delete $flags->{engine} );
965 $class->setup_stats( delete $flags->{stats} );
967 for my $flag ( sort keys %{$flags} ) {
969 if ( my $code = $class->can( 'setup_' . $flag ) ) {
970 &$code( $class, delete $flags->{$flag} );
973 $class->log->warn(qq/Unknown flag "$flag"/);
977 eval { require Catalyst::Devel; };
978 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
979 $class->log->warn(<<"EOF");
980 You are running an old script!
982 Please update by running (this will overwrite existing files):
983 catalyst.pl -force -scripts $class
985 or (this will not overwrite existing files):
986 catalyst.pl -scripts $class
991 if ( $class->debug ) {
992 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
995 my $column_width = Catalyst::Utils::term_width() - 6;
996 my $t = Text::SimpleTable->new($column_width);
997 $t->row($_) for @plugins;
998 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
1001 my $dispatcher = $class->dispatcher;
1002 my $engine = $class->engine;
1003 my $home = $class->config->{home};
1005 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1006 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1010 ? $class->log->debug(qq/Found home "$home"/)
1011 : $class->log->debug(qq/Home "$home" doesn't exist/)
1012 : $class->log->debug(q/Couldn't find home/);
1015 # Call plugins setup, this is stupid and evil.
1017 no warnings qw/redefine/;
1018 local *setup = sub { };
1022 # Initialize our data structure
1023 $class->components( {} );
1025 $class->setup_components;
1027 if ( $class->debug ) {
1028 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1029 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1030 for my $comp ( sort keys %{ $class->components } ) {
1031 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1032 $t->row( $comp, $type );
1034 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1035 if ( keys %{ $class->components } );
1038 # Add our self to components, since we are also a component
1039 if( $class->isa('Catalyst::Controller') ){
1040 $class->components->{$class} = $class;
1043 $class->setup_actions;
1045 if ( $class->debug ) {
1046 my $name = $class->config->{name} || 'Application';
1047 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1049 $class->log->_flush() if $class->log->can('_flush');
1051 # Make sure that the application class becomes immutable at this point,
1052 # which ensures that it gets an inlined constructor. This means that it
1053 # works even if the user has added a plugin which contains a new method.
1054 # Note however that we have to do the work on scope end, so that method
1055 # modifiers work correctly in MyApp (as you have to call setup _before_
1056 # applying modifiers).
1057 Scope::Upper::reap(sub {
1058 my $meta = Class::MOP::get_metaclass_by_name($class);
1059 $meta->make_immutable unless $meta->is_immutable;
1060 }, Scope::Upper::SCOPE(1));
1062 $class->setup_finalize;
1066 =head2 $app->setup_finalize
1068 A hook to attach modifiers to.
1069 Using C< after setup => sub{}; > doesn't work, because of quirky things done for plugin setup.
1070 Also better than C< setup_finished(); >, as that is a getter method.
1072 sub setup_finalize {
1076 ## do stuff, i.e., determine a primary key column for sessions stored in a DB
1078 $app->next::method(@_);
1085 sub setup_finalize {
1087 $class->setup_finished(1);
1090 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1092 =head2 $c->uri_for( $path, @args?, \%query_values? )
1098 A Catalyst::Action object representing the Catalyst action you want to
1099 create a URI for. To get one for an action in the current controller,
1100 use C<< $c->action('someactionname') >>. To get one from different
1101 controller, fetch the controller using C<< $c->controller() >>, then
1102 call C<action_for> on it.
1104 You can maintain the arguments captured by an action (e.g.: Regex, Chained)
1105 using C<< $c->req->captures >>.
1107 # For the current action
1108 $c->uri_for($c->action, $c->req->captures);
1110 # For the Foo action in the Bar controller
1111 $c->uri_for($c->controller->('Bar')->action_for('Foo'), $c->req->captures);
1118 my ( $c, $path, @args ) = @_;
1120 if ( blessed($path) ) { # action object
1121 my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
1124 $path = $c->dispatcher->uri_for_action($path, $captures);
1125 return undef unless defined($path);
1126 $path = '/' if $path eq '';
1129 undef($path) if (defined $path && $path eq '');
1132 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1134 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1135 s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
1137 unshift(@args, $path);
1139 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1140 my $namespace = $c->namespace;
1141 if (defined $path) { # cheesy hack to handle path '../foo'
1142 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1144 unshift(@args, $namespace || '');
1147 # join args with '/', or a blank string
1148 my $args = join('/', grep { defined($_) } @args);
1149 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1151 my $base = $c->req->base;
1152 my $class = ref($base);
1153 $base =~ s{(?<!/)$}{/};
1157 if (my @keys = keys %$params) {
1158 # somewhat lifted from URI::_query's query_form
1159 $query = '?'.join('&', map {
1160 my $val = $params->{$_};
1161 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1164 $val = '' unless defined $val;
1167 utf8::encode( $_ ) if utf8::is_utf8($_);
1168 # using the URI::Escape pattern here so utf8 chars survive
1169 s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1171 "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1175 my $res = bless(\"${base}${args}${query}", $class);
1179 =head2 $c->welcome_message
1181 Returns the Catalyst welcome HTML page.
1185 sub welcome_message {
1187 my $name = $c->config->{name};
1188 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1189 my $prefix = Catalyst::Utils::appprefix( ref $c );
1190 $c->response->content_type('text/html; charset=utf-8');
1192 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1193 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1194 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1196 <meta http-equiv="Content-Language" content="en" />
1197 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1198 <title>$name on Catalyst $VERSION</title>
1199 <style type="text/css">
1202 background-color: #eee;
1209 margin-bottom: 10px;
1211 background-color: #ccc;
1212 border: 1px solid #aaa;
1217 font-family: verdana, tahoma, sans-serif;
1220 font-family: verdana, tahoma, sans-serif;
1223 text-decoration: none;
1225 border-bottom: 1px dotted #bbb;
1227 :link:hover, :visited:hover {
1240 background-color: #fff;
1241 border: 1px solid #aaa;
1245 font-weight: normal;
1267 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1272 <img src="$logo" alt="Catalyst Logo" />
1274 <p>Welcome to the world of Catalyst.
1275 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1276 framework will make web development something you had
1277 never expected it to be: Fun, rewarding, and quick.</p>
1278 <h2>What to do now?</h2>
1279 <p>That really depends on what <b>you</b> want to do.
1280 We do, however, provide you with a few starting points.</p>
1281 <p>If you want to jump right into web development with Catalyst
1282 you might want to start with a tutorial.</p>
1283 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1285 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1287 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1288 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1290 <h2>What to do next?</h2>
1291 <p>Next it's time to write an actual application. Use the
1292 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
1293 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a>, and
1294 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>;
1295 they can save you a lot of work.</p>
1296 <pre><code>script/${prefix}_create.pl -help</code></pre>
1297 <p>Also, be sure to check out the vast and growing
1298 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>;
1299 you are likely to find what you need there.
1303 <p>Catalyst has a very active community. Here are the main places to
1304 get in touch with us.</p>
1307 <a href="http://dev.catalyst.perl.org">Wiki</a>
1310 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1313 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1316 <h2>In conclusion</h2>
1317 <p>The Catalyst team hopes you will enjoy using Catalyst as much
1318 as we enjoyed making it. Please contact us if you have ideas
1319 for improvement or other feedback.</p>
1327 =head1 INTERNAL METHODS
1329 These methods are not meant to be used by end users.
1331 =head2 $c->components
1333 Returns a hash of components.
1335 =head2 $c->context_class
1337 Returns or sets the context class.
1341 Returns a hashref containing coderefs and execution counts (needed for
1342 deep recursion detection).
1346 Returns the number of actions on the current internal execution stack.
1350 Dispatches a request to actions.
1354 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1356 =head2 $c->dispatcher_class
1358 Returns or sets the dispatcher class.
1360 =head2 $c->dump_these
1362 Returns a list of 2-element array references (name, structure) pairs
1363 that will be dumped on the error page in debug mode.
1369 [ Request => $c->req ],
1370 [ Response => $c->res ],
1371 [ Stash => $c->stash ],
1372 [ Config => $c->config ];
1375 =head2 $c->engine_class
1377 Returns or sets the engine class.
1379 =head2 $c->execute( $class, $coderef )
1381 Execute a coderef in given class and catch exceptions. Errors are available
1387 my ( $c, $class, $code ) = @_;
1388 $class = $c->component($class) || $class;
1391 if ( $c->depth >= $RECURSION ) {
1392 my $action = $code->reverse();
1393 $action = "/$action" unless $action =~ /->/;
1394 my $error = qq/Deep recursion detected calling "${action}"/;
1395 $c->log->error($error);
1401 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1403 push( @{ $c->stack }, $code );
1405 eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
1407 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1409 my $last = pop( @{ $c->stack } );
1411 if ( my $error = $@ ) {
1412 if ( !ref($error) and $error eq $DETACH ) {
1413 die $DETACH if($c->depth > 1);
1415 elsif ( !ref($error) and $error eq $GO ) {
1416 die $GO if($c->depth > 0);
1419 unless ( ref $error ) {
1420 no warnings 'uninitialized';
1422 my $class = $last->class;
1423 my $name = $last->name;
1424 $error = qq/Caught exception in $class->$name "$error"/;
1433 sub _stats_start_execute {
1434 my ( $c, $code ) = @_;
1436 return if ( ( $code->name =~ /^_.*/ )
1437 && ( !$c->config->{show_internal_actions} ) );
1439 my $action_name = $code->reverse();
1440 $c->counter->{$action_name}++;
1442 my $action = $action_name;
1443 $action = "/$action" unless $action =~ /->/;
1445 # determine if the call was the result of a forward
1446 # this is done by walking up the call stack and looking for a calling
1447 # sub of Catalyst::forward before the eval
1449 for my $index ( 2 .. 11 ) {
1451 if ( ( caller($index) )[0] eq 'Catalyst'
1452 && ( caller($index) )[3] eq '(eval)' );
1454 if ( ( caller($index) )[3] =~ /forward$/ ) {
1455 $callsub = ( caller($index) )[3];
1456 $action = "-> $action";
1461 my $uid = $action_name . $c->counter->{$action_name};
1463 # is this a root-level call or a forwarded call?
1464 if ( $callsub =~ /forward$/ ) {
1466 # forward, locate the caller
1467 if ( my $parent = $c->stack->[-1] ) {
1470 parent => "$parent" . $c->counter->{"$parent"},
1476 # forward with no caller may come from a plugin
1495 sub _stats_finish_execute {
1496 my ( $c, $info ) = @_;
1497 $c->stats->profile( end => $info );
1500 =head2 $c->_localize_fields( sub { }, \%keys );
1504 #Why does this exist? This is no longer safe and WILL NOT WORK.
1505 # it doesnt seem to be used anywhere. can we remove it?
1506 sub _localize_fields {
1507 my ( $c, $localized, $code ) = ( @_ );
1509 my $request = delete $localized->{request} || {};
1510 my $response = delete $localized->{response} || {};
1512 local @{ $c }{ keys %$localized } = values %$localized;
1513 local @{ $c->request }{ keys %$request } = values %$request;
1514 local @{ $c->response }{ keys %$response } = values %$response;
1521 Finalizes the request.
1528 for my $error ( @{ $c->error } ) {
1529 $c->log->error($error);
1532 # Allow engine to handle finalize flow (for POE)
1533 my $engine = $c->engine;
1534 if ( my $code = $engine->can('finalize') ) {
1539 $c->finalize_uploads;
1542 if ( $#{ $c->error } >= 0 ) {
1546 $c->finalize_headers;
1549 if ( $c->request->method eq 'HEAD' ) {
1550 $c->response->body('');
1556 if ($c->use_stats) {
1557 my $elapsed = sprintf '%f', $c->stats->elapsed;
1558 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1560 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1563 return $c->response->status;
1566 =head2 $c->finalize_body
1572 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1574 =head2 $c->finalize_cookies
1580 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1582 =head2 $c->finalize_error
1588 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1590 =head2 $c->finalize_headers
1596 sub finalize_headers {
1599 my $response = $c->response; #accessor calls can add up?
1601 # Check if we already finalized headers
1602 return if $response->finalized_headers;
1605 if ( my $location = $response->redirect ) {
1606 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1607 $response->header( Location => $location );
1609 if ( !$response->has_body ) {
1610 # Add a default body if none is already present
1612 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1618 if ( $response->body && !$response->content_length ) {
1620 # get the length from a filehandle
1621 if ( blessed( $response->body ) && $response->body->can('read') )
1623 my $stat = stat $response->body;
1624 if ( $stat && $stat->size > 0 ) {
1625 $response->content_length( $stat->size );
1628 $c->log->warn('Serving filehandle without a content-length');
1632 # everything should be bytes at this point, but just in case
1633 $response->content_length( bytes::length( $response->body ) );
1638 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1639 $response->headers->remove_header("Content-Length");
1640 $response->body('');
1643 $c->finalize_cookies;
1645 $c->engine->finalize_headers( $c, @_ );
1648 $response->finalized_headers(1);
1651 =head2 $c->finalize_output
1653 An alias for finalize_body.
1655 =head2 $c->finalize_read
1657 Finalizes the input after reading is complete.
1661 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1663 =head2 $c->finalize_uploads
1665 Finalizes uploads. Cleans up any temporary files.
1669 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1671 =head2 $c->get_action( $action, $namespace )
1673 Gets an action in a given namespace.
1677 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1679 =head2 $c->get_actions( $action, $namespace )
1681 Gets all actions of a given name in a namespace and all parent
1686 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1688 =head2 $c->handle_request( $class, @arguments )
1690 Called to handle each HTTP request.
1694 sub handle_request {
1695 my ( $class, @arguments ) = @_;
1697 # Always expect worst case!
1700 if ($class->debug) {
1701 my $secs = time - $START || 1;
1702 my $av = sprintf '%.3f', $COUNT / $secs;
1703 my $time = localtime time;
1704 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1707 my $c = $class->prepare(@arguments);
1709 $status = $c->finalize;
1712 if ( my $error = $@ ) {
1714 $class->log->error(qq/Caught exception in engine "$error"/);
1719 if(my $coderef = $class->log->can('_flush')){
1720 $class->log->$coderef();
1725 =head2 $c->prepare( @arguments )
1727 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1733 my ( $class, @arguments ) = @_;
1736 # After the app/ctxt split, this should become an attribute based on something passed
1737 # into the application.
1738 $class->context_class( ref $class || $class ) unless $class->context_class;
1740 my $c = $class->context_class->new({});
1742 # For on-demand data
1743 $c->request->_context($c);
1744 $c->response->_context($c);
1746 #surely this is not the most efficient way to do things...
1747 $c->stats($class->stats_class->new)->enable($c->use_stats);
1749 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1752 #XXX reuse coderef from can
1753 # Allow engine to direct the prepare flow (for POE)
1754 if ( $c->engine->can('prepare') ) {
1755 $c->engine->prepare( $c, @arguments );
1758 $c->prepare_request(@arguments);
1759 $c->prepare_connection;
1760 $c->prepare_query_parameters;
1761 $c->prepare_headers;
1762 $c->prepare_cookies;
1765 # Prepare the body for reading, either by prepare_body
1766 # or the user, if they are using $c->read
1769 # Parse the body unless the user wants it on-demand
1770 unless ( $c->config->{parse_on_demand} ) {
1775 my $method = $c->req->method || '';
1776 my $path = $c->req->path;
1777 $path = '/' unless length $path;
1778 my $address = $c->req->address || '';
1780 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1788 =head2 $c->prepare_action
1790 Prepares action. See L<Catalyst::Dispatcher>.
1794 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1796 =head2 $c->prepare_body
1798 Prepares message body.
1805 return if $c->request->_has_body;
1807 # Initialize on-demand data
1808 $c->engine->prepare_body( $c, @_ );
1809 $c->prepare_parameters;
1810 $c->prepare_uploads;
1812 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1813 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1814 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1815 my $param = $c->req->body_parameters->{$key};
1816 my $value = defined($param) ? $param : '';
1818 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1820 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1824 =head2 $c->prepare_body_chunk( $chunk )
1826 Prepares a chunk of data before sending it to L<HTTP::Body>.
1828 See L<Catalyst::Engine>.
1832 sub prepare_body_chunk {
1834 $c->engine->prepare_body_chunk( $c, @_ );
1837 =head2 $c->prepare_body_parameters
1839 Prepares body parameters.
1843 sub prepare_body_parameters {
1845 $c->engine->prepare_body_parameters( $c, @_ );
1848 =head2 $c->prepare_connection
1850 Prepares connection.
1854 sub prepare_connection {
1856 $c->engine->prepare_connection( $c, @_ );
1859 =head2 $c->prepare_cookies
1865 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1867 =head2 $c->prepare_headers
1873 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1875 =head2 $c->prepare_parameters
1877 Prepares parameters.
1881 sub prepare_parameters {
1883 $c->prepare_body_parameters;
1884 $c->engine->prepare_parameters( $c, @_ );
1887 =head2 $c->prepare_path
1889 Prepares path and base.
1893 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1895 =head2 $c->prepare_query_parameters
1897 Prepares query parameters.
1901 sub prepare_query_parameters {
1904 $c->engine->prepare_query_parameters( $c, @_ );
1906 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1907 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1908 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1909 my $param = $c->req->query_parameters->{$key};
1910 my $value = defined($param) ? $param : '';
1912 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1914 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1918 =head2 $c->prepare_read
1920 Prepares the input for reading.
1924 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1926 =head2 $c->prepare_request
1928 Prepares the engine request.
1932 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1934 =head2 $c->prepare_uploads
1940 sub prepare_uploads {
1943 $c->engine->prepare_uploads( $c, @_ );
1945 if ( $c->debug && keys %{ $c->request->uploads } ) {
1946 my $t = Text::SimpleTable->new(
1947 [ 12, 'Parameter' ],
1952 for my $key ( sort keys %{ $c->request->uploads } ) {
1953 my $upload = $c->request->uploads->{$key};
1954 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1955 $t->row( $key, $u->filename, $u->type, $u->size );
1958 $c->log->debug( "File Uploads are:\n" . $t->draw );
1962 =head2 $c->prepare_write
1964 Prepares the output for writing.
1968 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1970 =head2 $c->request_class
1972 Returns or sets the request class.
1974 =head2 $c->response_class
1976 Returns or sets the response class.
1978 =head2 $c->read( [$maxlength] )
1980 Reads a chunk of data from the request body. This method is designed to
1981 be used in a while loop, reading C<$maxlength> bytes on every call.
1982 C<$maxlength> defaults to the size of the request if not specified.
1984 You have to set C<< MyApp->config->{parse_on_demand} >> to use this
1987 Warning: If you use read(), Catalyst will not process the body,
1988 so you will not be able to access POST parameters or file uploads via
1989 $c->request. You must handle all body parsing yourself.
1993 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2001 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2003 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2005 Sets an action in a given namespace.
2009 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2011 =head2 $c->setup_actions($component)
2013 Sets up actions for a component.
2017 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2019 =head2 $c->setup_components
2021 Sets up components. Specify a C<setup_components> config option to pass
2022 additional options directly to L<Module::Pluggable>. To add additional
2023 search paths, specify a key named C<search_extra> as an array
2024 reference. Items in the array beginning with C<::> will have the
2025 application class name prepended to them.
2027 All components found will also have any
2028 L<Devel::InnerPackage|inner packages> loaded and set up as components.
2029 Note, that modules which are B<not> an I<inner package> of the main
2030 file namespace loaded will not be instantiated as components.
2034 sub setup_components {
2037 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
2038 my $config = $class->config->{ setup_components };
2039 my $extra = delete $config->{ search_extra } || [];
2041 push @paths, @$extra;
2043 my $locator = Module::Pluggable::Object->new(
2044 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2048 my @comps = sort { length $a <=> length $b } $locator->plugins;
2049 my %comps = map { $_ => 1 } @comps;
2051 my $deprecated_component_names = grep { /::[CMV]::/ } @comps;
2052 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2053 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2054 ) if $deprecated_component_names;
2056 for my $component ( @comps ) {
2058 # We pass ignore_loaded here so that overlay files for (e.g.)
2059 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2060 # we know M::P::O found a file on disk so this is safe
2062 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2063 #Class::MOP::load_class($component);
2065 my $module = $class->setup_component( $component );
2067 $component => $module,
2069 $_ => $class->setup_component( $_ )
2071 not exists $comps{$_}
2072 } Devel::InnerPackage::list_packages( $component )
2075 for my $key ( keys %modules ) {
2076 $class->components->{ $key } = $modules{ $key };
2081 =head2 $c->setup_component
2085 sub setup_component {
2086 my( $class, $component ) = @_;
2088 unless ( $component->can( 'COMPONENT' ) ) {
2092 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2093 my $config = $class->config->{ $suffix } || {};
2095 my $instance = eval { $component->COMPONENT( $class, $config ); };
2097 if ( my $error = $@ ) {
2099 Catalyst::Exception->throw(
2100 message => qq/Couldn't instantiate component "$component", "$error"/
2104 Catalyst::Exception->throw(
2106 qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
2107 ) unless blessed($instance);
2112 =head2 $c->setup_dispatcher
2118 sub setup_dispatcher {
2119 my ( $class, $dispatcher ) = @_;
2122 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2125 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2126 $dispatcher = 'Catalyst::Dispatcher::' . $env;
2129 unless ($dispatcher) {
2130 $dispatcher = $class->dispatcher_class;
2133 Class::MOP::load_class($dispatcher);
2135 # dispatcher instance
2136 $class->dispatcher( $dispatcher->new );
2139 =head2 $c->setup_engine
2146 my ( $class, $engine ) = @_;
2149 $engine = 'Catalyst::Engine::' . $engine;
2152 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2153 $engine = 'Catalyst::Engine::' . $env;
2156 if ( $ENV{MOD_PERL} ) {
2157 my $meta = Class::MOP::get_metaclass_by_name($class);
2159 # create the apache method
2160 $meta->add_method('apache' => sub { shift->engine->apache });
2162 my ( $software, $version ) =
2163 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2166 $version =~ s/(\.[^.]+)\./$1/g;
2168 if ( $software eq 'mod_perl' ) {
2172 if ( $version >= 1.99922 ) {
2173 $engine = 'Catalyst::Engine::Apache2::MP20';
2176 elsif ( $version >= 1.9901 ) {
2177 $engine = 'Catalyst::Engine::Apache2::MP19';
2180 elsif ( $version >= 1.24 ) {
2181 $engine = 'Catalyst::Engine::Apache::MP13';
2185 Catalyst::Exception->throw( message =>
2186 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2191 # install the correct mod_perl handler
2192 if ( $version >= 1.9901 ) {
2193 *handler = sub : method {
2194 shift->handle_request(@_);
2198 *handler = sub ($$) { shift->handle_request(@_) };
2203 elsif ( $software eq 'Zeus-Perl' ) {
2204 $engine = 'Catalyst::Engine::Zeus';
2208 Catalyst::Exception->throw(
2209 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2214 $engine = $class->engine_class;
2217 Class::MOP::load_class($engine);
2219 # check for old engines that are no longer compatible
2221 if ( $engine->isa('Catalyst::Engine::Apache')
2222 && !Catalyst::Engine::Apache->VERSION )
2227 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2228 && Catalyst::Engine::Server->VERSION le '0.02' )
2233 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2234 && $engine->VERSION eq '0.01' )
2239 elsif ($engine->isa('Catalyst::Engine::Zeus')
2240 && $engine->VERSION eq '0.01' )
2246 Catalyst::Exception->throw( message =>
2247 qq/Engine "$engine" is not supported by this version of Catalyst/
2252 $class->engine( $engine->new );
2255 =head2 $c->setup_home
2257 Sets up the home directory.
2262 my ( $class, $home ) = @_;
2264 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2268 $home ||= Catalyst::Utils::home($class);
2271 #I remember recently being scolded for assigning config values like this
2272 $class->config->{home} ||= $home;
2273 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2277 =head2 $c->setup_log
2279 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2280 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2283 This method also installs a C<debug> method that returns a true value into the
2284 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2285 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2287 Note that if the log has already been setup, by either a previous call to
2288 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2289 that this method won't actually set up the log object.
2294 my ( $class, $levels ) = @_;
2297 $levels =~ s/^\s+//;
2298 $levels =~ s/\s+$//;
2299 my %levels = map { $_ => 1 } split /\s*,\s*/, $levels || '';
2301 unless ( $class->log ) {
2302 $class->log( Catalyst::Log->new(keys %levels) );
2305 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2306 if ( defined($env_debug) or $levels{debug} ) {
2307 Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2308 $class->log->debug('Debug messages enabled');
2312 =head2 $c->setup_plugins
2318 =head2 $c->setup_stats
2320 Sets up timing statistics class.
2325 my ( $class, $stats ) = @_;
2327 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2329 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2330 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2331 Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2332 $class->log->debug('Statistics enabled');
2337 =head2 $c->registered_plugins
2339 Returns a sorted list of the plugins which have either been stated in the
2340 import list or which have been added via C<< MyApp->plugin(@args); >>.
2342 If passed a given plugin name, it will report a boolean value indicating
2343 whether or not that plugin is loaded. A fully qualified name is required if
2344 the plugin name does not begin with C<Catalyst::Plugin::>.
2346 if ($c->registered_plugins('Some::Plugin')) {
2354 sub registered_plugins {
2356 return sort keys %{ $proto->_plugins } unless @_;
2358 return 1 if exists $proto->_plugins->{$plugin};
2359 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2362 sub _register_plugin {
2363 my ( $proto, $plugin, $instant ) = @_;
2364 my $class = ref $proto || $proto;
2366 # no ignore_loaded here, the plugin may already have been
2367 # defined in memory and we don't want to error on "no file" if so
2369 Class::MOP::load_class( $plugin );
2371 $proto->_plugins->{$plugin} = 1;
2374 if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
2375 my @superclasses = ($plugin, $meta->superclasses );
2376 $meta->superclasses(@superclasses);
2378 unshift @{"$class\::ISA"}, $plugin;
2385 my ( $class, $plugins ) = @_;
2387 $class->_plugins( {} ) unless $class->_plugins;
2389 for my $plugin ( reverse @$plugins ) {
2391 unless ( $plugin =~ s/\A\+// ) {
2392 $plugin = "Catalyst::Plugin::$plugin";
2395 $class->_register_plugin($plugin);
2402 Returns an arrayref of the internal execution stack (actions that are
2403 currently executing).
2405 =head2 $c->stats_class
2407 Returns or sets the stats (timing statistics) class.
2409 =head2 $c->use_stats
2411 Returns 1 when stats collection is enabled. Stats collection is enabled
2412 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2413 environment variable is set.
2415 Note that this is a static method, not an accessor and should be overloaded
2416 by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1).
2423 =head2 $c->write( $data )
2425 Writes $data to the output stream. When using this method directly, you
2426 will need to manually set the C<Content-Length> header to the length of
2427 your output data, if known.
2434 # Finalize headers if someone manually writes output
2435 $c->finalize_headers;
2437 return $c->engine->write( $c, @_ );
2442 Returns the Catalyst version number. Mostly useful for "powered by"
2443 messages in template systems.
2447 sub version { return $Catalyst::VERSION }
2449 =head1 INTERNAL ACTIONS
2451 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2452 C<_ACTION>, and C<_END>. These are by default not shown in the private
2453 action table, but you can make them visible with a config parameter.
2455 MyApp->config->{show_internal_actions} = 1;
2457 =head1 CASE SENSITIVITY
2459 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2460 mapped to C</foo/bar>. You can activate case sensitivity with a config
2463 MyApp->config->{case_sensitive} = 1;
2465 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2467 =head1 ON-DEMAND PARSER
2469 The request body is usually parsed at the beginning of a request,
2470 but if you want to handle input yourself, you can enable on-demand
2471 parsing with a config parameter.
2473 MyApp->config->{parse_on_demand} = 1;
2475 =head1 PROXY SUPPORT
2477 Many production servers operate using the common double-server approach,
2478 with a lightweight frontend web server passing requests to a larger
2479 backend server. An application running on the backend server must deal
2480 with two problems: the remote user always appears to be C<127.0.0.1> and
2481 the server's hostname will appear to be C<localhost> regardless of the
2482 virtual host that the user connected through.
2484 Catalyst will automatically detect this situation when you are running
2485 the frontend and backend servers on the same machine. The following
2486 changes are made to the request.
2488 $c->req->address is set to the user's real IP address, as read from
2489 the HTTP X-Forwarded-For header.
2491 The host value for $c->req->base and $c->req->uri is set to the real
2492 host, as read from the HTTP X-Forwarded-Host header.
2494 Obviously, your web server must support these headers for this to work.
2496 In a more complex server farm environment where you may have your
2497 frontend proxy server(s) on different machines, you will need to set a
2498 configuration option to tell Catalyst to read the proxied data from the
2501 MyApp->config->{using_frontend_proxy} = 1;
2503 If you do not wish to use the proxy support at all, you may set:
2505 MyApp->config->{ignore_frontend_proxy} = 1;
2507 =head1 THREAD SAFETY
2509 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2510 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2511 believe the Catalyst core to be thread-safe.
2513 If you plan to operate in a threaded environment, remember that all other
2514 modules you are using must also be thread-safe. Some modules, most notably
2515 L<DBD::SQLite>, are not thread-safe.
2521 Join #catalyst on irc.perl.org.
2525 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2526 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
2530 http://catalyst.perl.org
2534 http://dev.catalyst.perl.org
2538 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2540 =head2 L<Catalyst::Manual> - The Catalyst Manual
2542 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
2544 =head2 L<Catalyst::Engine> - Core engine
2546 =head2 L<Catalyst::Log> - Log class.
2548 =head2 L<Catalyst::Request> - Request object
2550 =head2 L<Catalyst::Response> - Response object
2552 =head2 L<Catalyst::Test> - The test suite.
2554 =head1 PROJECT FOUNDER
2556 sri: Sebastian Riedel <sri@cpan.org>
2562 acme: Leon Brocard <leon@astray.com>
2570 andyg: Andy Grundman <andy@hybridized.org>
2572 audreyt: Audrey Tang
2574 bricas: Brian Cassidy <bricas@cpan.org>
2576 Caelum: Rafael Kitover <rkitover@io.com>
2578 chansen: Christian Hansen
2580 chicks: Christopher Hicks
2584 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
2588 esskar: Sascha Kiefer
2590 fireartist: Carl Franks <cfranks@cpan.org>
2592 gabb: Danijel Milicevic
2598 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2600 jcamacho: Juan Camacho
2602 jhannah: Jay Hannah <jay@jays.net>
2608 jon: Jon Schutz <jjschutz@cpan.org>
2610 marcus: Marcus Ramberg <mramberg@cpan.org>
2612 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
2614 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
2618 naughton: David Naughton
2620 ningu: David Kamholz <dkamholz@cpan.org>
2622 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
2624 numa: Dan Sully <daniel@cpan.org>
2628 omega: Andreas Marienborg
2630 Oleg Kostyuk <cub.uanic@gmail.com>
2632 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
2634 rafl: Florian Ragwitz <rafl@debian.org>
2638 the_jester: Jesse Sheidlower
2640 t0m: Tomas Doran <bobtfish@bobtfish.net>
2644 willert: Sebastian Willert <willert@cpan.org>
2648 This library is free software, you can redistribute it and/or modify it under
2649 the same terms as Perl itself.
2655 __PACKAGE__->meta->make_immutable;