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}
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 ) = @_;
2089 #warn("Component $component has meta " . $component->meta);
2090 unless ( $component->can( 'COMPONENT' ) ) {
2094 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2095 my $config = $class->config->{ $suffix } || {};
2097 my $instance = eval { $component->COMPONENT( $class, $config ); };
2099 if ( my $error = $@ ) {
2101 Catalyst::Exception->throw(
2102 message => qq/Couldn't instantiate component "$component", "$error"/
2106 Catalyst::Exception->throw(
2108 qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
2109 ) unless blessed($instance);
2114 =head2 $c->setup_dispatcher
2120 sub setup_dispatcher {
2121 my ( $class, $dispatcher ) = @_;
2124 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2127 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2128 $dispatcher = 'Catalyst::Dispatcher::' . $env;
2131 unless ($dispatcher) {
2132 $dispatcher = $class->dispatcher_class;
2135 Class::MOP::load_class($dispatcher);
2137 # dispatcher instance
2138 $class->dispatcher( $dispatcher->new );
2141 =head2 $c->setup_engine
2148 my ( $class, $engine ) = @_;
2151 $engine = 'Catalyst::Engine::' . $engine;
2154 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2155 $engine = 'Catalyst::Engine::' . $env;
2158 if ( $ENV{MOD_PERL} ) {
2159 my $meta = Class::MOP::get_metaclass_by_name($class);
2161 # create the apache method
2162 $meta->add_method('apache' => sub { shift->engine->apache });
2164 my ( $software, $version ) =
2165 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2168 $version =~ s/(\.[^.]+)\./$1/g;
2170 if ( $software eq 'mod_perl' ) {
2174 if ( $version >= 1.99922 ) {
2175 $engine = 'Catalyst::Engine::Apache2::MP20';
2178 elsif ( $version >= 1.9901 ) {
2179 $engine = 'Catalyst::Engine::Apache2::MP19';
2182 elsif ( $version >= 1.24 ) {
2183 $engine = 'Catalyst::Engine::Apache::MP13';
2187 Catalyst::Exception->throw( message =>
2188 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2193 # install the correct mod_perl handler
2194 if ( $version >= 1.9901 ) {
2195 *handler = sub : method {
2196 shift->handle_request(@_);
2200 *handler = sub ($$) { shift->handle_request(@_) };
2205 elsif ( $software eq 'Zeus-Perl' ) {
2206 $engine = 'Catalyst::Engine::Zeus';
2210 Catalyst::Exception->throw(
2211 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2216 $engine = $class->engine_class;
2219 Class::MOP::load_class($engine);
2221 # check for old engines that are no longer compatible
2223 if ( $engine->isa('Catalyst::Engine::Apache')
2224 && !Catalyst::Engine::Apache->VERSION )
2229 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2230 && Catalyst::Engine::Server->VERSION le '0.02' )
2235 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2236 && $engine->VERSION eq '0.01' )
2241 elsif ($engine->isa('Catalyst::Engine::Zeus')
2242 && $engine->VERSION eq '0.01' )
2248 Catalyst::Exception->throw( message =>
2249 qq/Engine "$engine" is not supported by this version of Catalyst/
2254 $class->engine( $engine->new );
2257 =head2 $c->setup_home
2259 Sets up the home directory.
2264 my ( $class, $home ) = @_;
2266 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2270 $home ||= Catalyst::Utils::home($class);
2273 #I remember recently being scolded for assigning config values like this
2274 $class->config->{home} ||= $home;
2275 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2279 =head2 $c->setup_log
2281 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2282 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2285 This method also installs a C<debug> method that returns a true value into the
2286 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2287 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2289 Note that if the log has already been setup, by either a previous call to
2290 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2291 that this method won't actually set up the log object.
2296 my ( $class, $levels ) = @_;
2299 $levels =~ s/^\s+//;
2300 $levels =~ s/\s+$//;
2301 my %levels = map { $_ => 1 } split /\s*,\s*/, $levels || '';
2303 unless ( $class->log ) {
2304 $class->log( Catalyst::Log->new(keys %levels) );
2307 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2308 if ( defined($env_debug) or $levels{debug} ) {
2309 Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2310 $class->log->debug('Debug messages enabled');
2314 =head2 $c->setup_plugins
2320 =head2 $c->setup_stats
2322 Sets up timing statistics class.
2327 my ( $class, $stats ) = @_;
2329 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2331 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2332 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2333 Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2334 $class->log->debug('Statistics enabled');
2339 =head2 $c->registered_plugins
2341 Returns a sorted list of the plugins which have either been stated in the
2342 import list or which have been added via C<< MyApp->plugin(@args); >>.
2344 If passed a given plugin name, it will report a boolean value indicating
2345 whether or not that plugin is loaded. A fully qualified name is required if
2346 the plugin name does not begin with C<Catalyst::Plugin::>.
2348 if ($c->registered_plugins('Some::Plugin')) {
2356 sub registered_plugins {
2358 return sort keys %{ $proto->_plugins } unless @_;
2360 return 1 if exists $proto->_plugins->{$plugin};
2361 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2364 sub _register_plugin {
2365 my ( $proto, $plugin, $instant ) = @_;
2366 my $class = ref $proto || $proto;
2368 # no ignore_loaded here, the plugin may already have been
2369 # defined in memory and we don't want to error on "no file" if so
2371 Class::MOP::load_class( $plugin );
2373 $proto->_plugins->{$plugin} = 1;
2376 if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
2377 my @superclasses = ($plugin, $meta->superclasses );
2378 $meta->superclasses(@superclasses);
2380 unshift @{"$class\::ISA"}, $plugin;
2387 my ( $class, $plugins ) = @_;
2389 $class->_plugins( {} ) unless $class->_plugins;
2391 for my $plugin ( reverse @$plugins ) {
2393 unless ( $plugin =~ s/\A\+// ) {
2394 $plugin = "Catalyst::Plugin::$plugin";
2397 $class->_register_plugin($plugin);
2404 Returns an arrayref of the internal execution stack (actions that are
2405 currently executing).
2407 =head2 $c->stats_class
2409 Returns or sets the stats (timing statistics) class.
2411 =head2 $c->use_stats
2413 Returns 1 when stats collection is enabled. Stats collection is enabled
2414 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2415 environment variable is set.
2417 Note that this is a static method, not an accessor and should be overloaded
2418 by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1).
2425 =head2 $c->write( $data )
2427 Writes $data to the output stream. When using this method directly, you
2428 will need to manually set the C<Content-Length> header to the length of
2429 your output data, if known.
2436 # Finalize headers if someone manually writes output
2437 $c->finalize_headers;
2439 return $c->engine->write( $c, @_ );
2444 Returns the Catalyst version number. Mostly useful for "powered by"
2445 messages in template systems.
2449 sub version { return $Catalyst::VERSION }
2451 =head1 INTERNAL ACTIONS
2453 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2454 C<_ACTION>, and C<_END>. These are by default not shown in the private
2455 action table, but you can make them visible with a config parameter.
2457 MyApp->config->{show_internal_actions} = 1;
2459 =head1 CASE SENSITIVITY
2461 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2462 mapped to C</foo/bar>. You can activate case sensitivity with a config
2465 MyApp->config->{case_sensitive} = 1;
2467 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2469 =head1 ON-DEMAND PARSER
2471 The request body is usually parsed at the beginning of a request,
2472 but if you want to handle input yourself, you can enable on-demand
2473 parsing with a config parameter.
2475 MyApp->config->{parse_on_demand} = 1;
2477 =head1 PROXY SUPPORT
2479 Many production servers operate using the common double-server approach,
2480 with a lightweight frontend web server passing requests to a larger
2481 backend server. An application running on the backend server must deal
2482 with two problems: the remote user always appears to be C<127.0.0.1> and
2483 the server's hostname will appear to be C<localhost> regardless of the
2484 virtual host that the user connected through.
2486 Catalyst will automatically detect this situation when you are running
2487 the frontend and backend servers on the same machine. The following
2488 changes are made to the request.
2490 $c->req->address is set to the user's real IP address, as read from
2491 the HTTP X-Forwarded-For header.
2493 The host value for $c->req->base and $c->req->uri is set to the real
2494 host, as read from the HTTP X-Forwarded-Host header.
2496 Obviously, your web server must support these headers for this to work.
2498 In a more complex server farm environment where you may have your
2499 frontend proxy server(s) on different machines, you will need to set a
2500 configuration option to tell Catalyst to read the proxied data from the
2503 MyApp->config->{using_frontend_proxy} = 1;
2505 If you do not wish to use the proxy support at all, you may set:
2507 MyApp->config->{ignore_frontend_proxy} = 1;
2509 =head1 THREAD SAFETY
2511 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2512 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2513 believe the Catalyst core to be thread-safe.
2515 If you plan to operate in a threaded environment, remember that all other
2516 modules you are using must also be thread-safe. Some modules, most notably
2517 L<DBD::SQLite>, are not thread-safe.
2523 Join #catalyst on irc.perl.org.
2527 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2528 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
2532 http://catalyst.perl.org
2536 http://dev.catalyst.perl.org
2540 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2542 =head2 L<Catalyst::Manual> - The Catalyst Manual
2544 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
2546 =head2 L<Catalyst::Engine> - Core engine
2548 =head2 L<Catalyst::Log> - Log class.
2550 =head2 L<Catalyst::Request> - Request object
2552 =head2 L<Catalyst::Response> - Response object
2554 =head2 L<Catalyst::Test> - The test suite.
2556 =head1 PROJECT FOUNDER
2558 sri: Sebastian Riedel <sri@cpan.org>
2564 acme: Leon Brocard <leon@astray.com>
2572 andyg: Andy Grundman <andy@hybridized.org>
2574 audreyt: Audrey Tang
2576 bricas: Brian Cassidy <bricas@cpan.org>
2578 Caelum: Rafael Kitover <rkitover@io.com>
2580 chansen: Christian Hansen
2582 chicks: Christopher Hicks
2586 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
2590 esskar: Sascha Kiefer
2592 fireartist: Carl Franks <cfranks@cpan.org>
2594 gabb: Danijel Milicevic
2600 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2602 jcamacho: Juan Camacho
2604 jhannah: Jay Hannah <jay@jays.net>
2610 jon: Jon Schutz <jjschutz@cpan.org>
2612 marcus: Marcus Ramberg <mramberg@cpan.org>
2614 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
2616 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
2620 naughton: David Naughton
2622 ningu: David Kamholz <dkamholz@cpan.org>
2624 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
2626 numa: Dan Sully <daniel@cpan.org>
2630 omega: Andreas Marienborg
2632 Oleg Kostyuk <cub.uanic@gmail.com>
2634 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
2636 rafl: Florian Ragwitz <rafl@debian.org>
2640 the_jester: Jesse Sheidlower
2642 t0m: Tomas Doran <bobtfish@bobtfish.net>
2646 willert: Sebastian Willert <willert@cpan.org>
2650 This library is free software, you can redistribute it and/or modify it under
2651 the same terms as Perl itself.
2657 __PACKAGE__->meta->make_immutable;