4 #use MooseX::ClassAttribute;
5 extends 'Catalyst::Component';
8 use Catalyst::Exception;
10 use Catalyst::Request;
11 use Catalyst::Request::Upload;
12 use Catalyst::Response;
14 use Catalyst::Controller;
15 use Devel::InnerPackage ();
17 use Module::Pluggable::Object ();
19 use Text::SimpleTable ();
20 use Path::Class::Dir ();
21 use Path::Class::File ();
22 use Time::HiRes qw/gettimeofday tv_interval/;
26 use Scalar::Util qw/weaken blessed/;
27 use Tree::Simple qw/use_weak_refs/;
28 use Tree::Simple::Visitor::FindByUID;
31 use Carp qw/croak carp/;
33 BEGIN { require 5.008001; }
35 has counter => ( is => 'rw');
36 has request => ( is => 'rw');
37 has response => ( is => 'rw');
38 has state => ( is => 'rw');
39 has action => ( is => 'rw');
40 has stack => ( is => 'rw');
41 has namespace => ( is => 'rw');
42 has stats => ( is => 'rw');
45 attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
47 sub depth { scalar @{ shift->stack || [] }; }
54 # For backwards compatibility
55 *finalize_output = \&finalize_body;
60 our $RECURSION = 1000;
61 our $DETACH = "catalyst_detach\n";
63 # class_has components => (is => 'rw');
64 # class_has arguments => (is => 'rw');
65 # class_has dispatcher => (is => 'rw');
66 # class_has engine => (is => 'rw');
67 # class_has log => (is => 'rw');
68 # class_has dispatcher_class => (is => 'rw', required => 1, default => sub {'Catalyst::Dispatcher'});
69 # class_has engine_class => (is => 'rw', required => 1, default => sub {'Catalyst::Engine::CGI'});
70 # class_has context_class => (is => 'rw');
71 # class_has request_class => (is => 'rw', required => 1, default => sub {'Catalyst::Request'});
72 # class_has response_class => (is => 'rw', required => 1, default => sub {'Catalyst::Response'});
73 # class_has stats_class => (is => 'rw', required => 1, default => sub {'Catalyst::Stats'});
74 # class_has setup_finished => (is => 'rw');
76 __PACKAGE__->mk_classdata($_)
77 for qw/components arguments dispatcher engine log dispatcher_class
78 engine_class context_class request_class response_class stats_class
81 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
82 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
83 __PACKAGE__->request_class('Catalyst::Request');
84 __PACKAGE__->response_class('Catalyst::Response');
85 __PACKAGE__->stats_class('Catalyst::Stats');
87 # Remember to update this in Catalyst::Runtime as well!
89 our $VERSION = '5.7013';
92 my ( $class, @arguments ) = @_;
94 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
96 return unless $class eq 'Catalyst';
98 my $caller = caller(0);
100 unless ( $caller->isa('Catalyst') ) {
102 push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
103 #my $caller_meta = $caller->meta;
104 #my @isa = $caller_meta->superclasses;
105 #$caller_meta->superclasses(@isa, $class, 'Catalyst::Controller');
108 $caller->arguments( [@arguments] );
114 Catalyst - The Elegant MVC Web Application Framework
118 See the L<Catalyst::Manual> distribution for comprehensive
119 documentation and tutorials.
121 # Install Catalyst::Devel for helpers and other development tools
122 # use the helper to create a new application
125 # add models, views, controllers
126 script/myapp_create.pl model MyDatabase DBIC::Schema create=dynamic dbi:SQLite:/path/to/db
127 script/myapp_create.pl view MyTemplate TT
128 script/myapp_create.pl controller Search
130 # built in testserver -- use -r to restart automatically on changes
131 # --help to see all available options
132 script/myapp_server.pl
134 # command line testing interface
135 script/myapp_test.pl /yada
138 use Catalyst qw/-Debug/; # include plugins here as well
140 ### In lib/MyApp/Controller/Root.pm (autocreated)
141 sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
142 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
143 $c->stash->{template} = 'foo.tt'; # set the template
144 # lookup something from db -- stash vars are passed to TT
146 $c->model('Database::Foo')->search( { country => $args[0] } );
147 if ( $c->req->params->{bar} ) { # access GET or POST parameters
148 $c->forward( 'bar' ); # process another action
149 # do something else after forward returns
153 # The foo.tt TT template can use the stash data from the database
154 [% WHILE (item = data.next) %]
158 # called for /bar/of/soap, /bar/of/soap/10, etc.
159 sub bar : Path('/bar/of/soap') { ... }
161 # called for all actions, from the top-most controller downwards
163 my ( $self, $c ) = @_;
164 if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
165 $c->res->redirect( '/login' ); # require login
166 return 0; # abort request and go immediately to end()
168 return 1; # success; carry on to next action
171 # called after all actions are finished
173 my ( $self, $c ) = @_;
174 if ( scalar @{ $c->error } ) { ... } # handle errors
175 return if $c->res->body; # already have a response
176 $c->forward( 'MyApp::View::TT' ); # render template
179 ### in MyApp/Controller/Foo.pm
180 # called for /foo/bar
181 sub bar : Local { ... }
183 # called for /blargle
184 sub blargle : Global { ... }
186 # an index action matches /foo, but not /foo/1, etc.
187 sub index : Private { ... }
189 ### in MyApp/Controller/Foo/Bar.pm
190 # called for /foo/bar/baz
191 sub baz : Local { ... }
193 # first Root auto is called, then Foo auto, then this
194 sub auto : Private { ... }
196 # powerful regular expression paths are also possible
197 sub details : Regex('^product/(\w+)/details$') {
198 my ( $self, $c ) = @_;
199 # extract the (\w+) from the URI
200 my $product = $c->req->captures->[0];
203 See L<Catalyst::Manual::Intro> for additional information.
207 Catalyst is a modern framework for making web applications without the
208 pain usually associated with this process. This document is a reference
209 to the main Catalyst application. If you are a new user, we suggest you
210 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
212 See L<Catalyst::Manual> for more documentation.
214 Catalyst plugins can be loaded by naming them as arguments to the "use
215 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
216 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
219 use Catalyst qw/My::Module/;
221 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
222 fully qualify the name by using a unary plus:
226 +Fully::Qualified::Plugin::Name
229 Special flags like C<-Debug> and C<-Engine> can also be specified as
230 arguments when Catalyst is loaded:
232 use Catalyst qw/-Debug My::Module/;
234 The position of plugins and flags in the chain is important, because
235 they are loaded in the order in which they appear.
237 The following flags are supported:
241 Enables debug output. You can also force this setting from the system
242 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
243 settings override the application, with <MYAPP>_DEBUG having the highest
248 Forces Catalyst to use a specific engine. Omit the
249 C<Catalyst::Engine::> prefix of the engine name, i.e.:
251 use Catalyst qw/-Engine=CGI/;
255 Forces Catalyst to use a specific home directory, e.g.:
257 use Catalyst qw[-Home=/usr/mst];
259 This can also be done in the shell environment by setting either the
260 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
261 is replaced with the uppercased name of your application, any "::" in
262 the name will be replaced with underscores, e.g. MyApp::Web should use
263 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
271 Enables statistics collection and reporting. You can also force this setting
272 from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
273 environment settings override the application, with <MYAPP>_STATS having the
278 use Catalyst qw/-Stats=1/
282 =head2 INFORMATION ABOUT THE CURRENT REQUEST
286 Returns a L<Catalyst::Action> object for the current action, which
287 stringifies to the action name. See L<Catalyst::Action>.
291 Returns the namespace of the current action, i.e., the URI prefix
292 corresponding to the controller of the current action. For example:
294 # in Controller::Foo::Bar
295 $c->namespace; # returns 'foo/bar';
301 Returns the current L<Catalyst::Request> object, giving access to
302 information about the current client request (including parameters,
303 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
305 =head2 REQUEST FLOW HANDLING
307 =head2 $c->forward( $action [, \@arguments ] )
309 =head2 $c->forward( $class, $method, [, \@arguments ] )
311 Forwards processing to another action, by its private name. If you give a
312 class name but no method, C<process()> is called. You may also optionally
313 pass arguments in an arrayref. The action will receive the arguments in
314 C<@_> and C<< $c->req->args >>. Upon returning from the function,
315 C<< $c->req->args >> will be restored to the previous values.
317 Any data C<return>ed from the action forwarded to, will be returned by the
320 my $foodata = $c->forward('/foo');
321 $c->forward('index');
322 $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
323 $c->forward('MyApp::View::TT');
325 Note that forward implies an C<<eval { }>> around the call (actually
326 C<execute> does), thus de-fatalizing all 'dies' within the called
327 action. If you want C<die> to propagate you need to do something like:
330 die $c->error if $c->error;
332 Or make sure to always return true values from your actions and write
335 $c->forward('foo') || return;
339 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
341 =head2 $c->detach( $action [, \@arguments ] )
343 =head2 $c->detach( $class, $method, [, \@arguments ] )
347 The same as C<forward>, but doesn't return to the previous action when
348 processing is finished.
350 When called with no arguments it escapes the processing chain entirely.
354 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
360 Returns the current L<Catalyst::Response> object, see there for details.
364 Returns a hashref to the stash, which may be used to store data and pass
365 it between components during a request. You can also set hash keys by
366 passing arguments. The stash is automatically sent to the view. The
367 stash is cleared at the end of a request; it cannot be used for
368 persistent storage (for this you must use a session; see
369 L<Catalyst::Plugin::Session> for a complete system integrated with
372 $c->stash->{foo} = $bar;
373 $c->stash( { moose => 'majestic', qux => 0 } );
374 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
376 # stash is automatically passed to the view for use in a template
377 $c->forward( 'MyApp::View::TT' );
384 my $stash = @_ > 1 ? {@_} : $_[0];
385 croak('stash takes a hash or hashref') unless ref $stash;
386 foreach my $key ( keys %$stash ) {
387 $c->{stash}->{$key} = $stash->{$key};
395 =head2 $c->error($error, ...)
397 =head2 $c->error($arrayref)
399 Returns an arrayref containing error messages. If Catalyst encounters an
400 error while processing a request, it stores the error in $c->error. This
401 method should only be used to store fatal error messages.
403 my @error = @{ $c->error };
407 $c->error('Something bad happened');
414 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
415 croak @$error unless ref $c;
416 push @{ $c->{error} }, @$error;
418 elsif ( defined $_[0] ) { $c->{error} = undef }
419 return $c->{error} || [];
425 Contains the return value of the last executed action.
427 =head2 $c->clear_errors
429 Clear errors. You probably don't want to clear the errors unless you are
430 implementing a custom error screen.
432 This is equivalent to running
446 my ( $c, @names ) = @_;
448 foreach my $name (@names) {
449 foreach my $component ( keys %{ $c->components } ) {
450 return $c->components->{$component} if $component =~ /$name/i;
457 # try explicit component names
459 my ( $c, @names ) = @_;
461 foreach my $try (@names) {
462 return $c->components->{$try} if ( exists $c->components->{$try} );
468 # like component, but try just these prefixes before regex searching,
469 # and do not try to return "sort keys %{ $c->components }"
471 my ( $c, $name, @prefixes ) = @_;
473 my $appclass = ref $c || $c;
475 my @names = map { "${appclass}::${_}::${name}" } @prefixes;
477 my $comp = $c->_comp_explicit(@names);
478 return $comp if defined($comp);
479 $comp = $c->_comp_search($name);
483 # Find possible names for a prefix
486 my ( $c, @prefixes ) = @_;
488 my $appclass = ref $c || $c;
490 my @pre = map { "${appclass}::${_}::" } @prefixes;
494 COMPONENT: foreach my $comp ($c->component) {
495 foreach my $p (@pre) {
496 if ($comp =~ s/^$p//) {
506 # Return a component if only one matches.
508 my ( $c, @prefixes ) = @_;
510 my $appclass = ref $c || $c;
512 my ( $comp, $rest ) =
513 map { $c->_comp_search("^${appclass}::${_}::") } @prefixes;
514 return $comp unless $rest;
517 # Filter a component before returning by calling ACCEPT_CONTEXT if available
518 sub _filter_component {
519 my ( $c, $comp, @args ) = @_;
520 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
521 return $comp->ACCEPT_CONTEXT( $c, @args );
523 else { return $comp }
526 =head2 COMPONENT ACCESSORS
528 =head2 $c->controller($name)
530 Gets a L<Catalyst::Controller> instance by name.
532 $c->controller('Foo')->do_stuff;
534 If the name is omitted, will return the controller for the dispatched
540 my ( $c, $name, @args ) = @_;
541 return $c->_filter_component( $c->_comp_prefixes( $name, qw/Controller C/ ),
544 return $c->component( $c->action->class );
547 =head2 $c->model($name)
549 Gets a L<Catalyst::Model> instance by name.
551 $c->model('Foo')->do_stuff;
553 Any extra arguments are directly passed to ACCEPT_CONTEXT.
555 If the name is omitted, it will look for
556 - a model object in $c->stash{current_model_instance}, then
557 - a model name in $c->stash->{current_model}, then
558 - a config setting 'default_model', or
559 - check if there is only one model, and return it if that's the case.
564 my ( $c, $name, @args ) = @_;
565 return $c->_filter_component( $c->_comp_prefixes( $name, qw/Model M/ ),
569 return $c->stash->{current_model_instance}
570 if $c->stash->{current_model_instance};
571 return $c->model( $c->stash->{current_model} )
572 if $c->stash->{current_model};
574 return $c->model( $c->config->{default_model} )
575 if $c->config->{default_model};
576 return $c->_filter_component( $c->_comp_singular(qw/Model M/) );
580 =head2 $c->controllers
582 Returns the available names which can be passed to $c->controller
588 return $c->_comp_names(qw/Controller C/);
592 =head2 $c->view($name)
594 Gets a L<Catalyst::View> instance by name.
596 $c->view('Foo')->do_stuff;
598 Any extra arguments are directly passed to ACCEPT_CONTEXT.
600 If the name is omitted, it will look for
601 - a view object in $c->stash{current_view_instance}, then
602 - a view name in $c->stash->{current_view}, then
603 - a config setting 'default_view', or
604 - check if there is only one view, and return it if that's the case.
609 my ( $c, $name, @args ) = @_;
610 return $c->_filter_component( $c->_comp_prefixes( $name, qw/View V/ ),
614 return $c->stash->{current_view_instance}
615 if $c->stash->{current_view_instance};
616 return $c->view( $c->stash->{current_view} )
617 if $c->stash->{current_view};
619 return $c->view( $c->config->{default_view} )
620 if $c->config->{default_view};
621 return $c->_filter_component( $c->_comp_singular(qw/View V/) );
626 Returns the available names which can be passed to $c->model
632 return $c->_comp_names(qw/Model M/);
638 Returns the available names which can be passed to $c->view
644 return $c->_comp_names(qw/View V/);
647 =head2 $c->comp($name)
649 =head2 $c->component($name)
651 Gets a component object by name. This method is not recommended,
652 unless you want to get a specific component by full
653 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
654 should be used instead.
665 my $appclass = ref $c || $c;
668 $name, "${appclass}::${name}",
669 map { "${appclass}::${_}::${name}" }
670 qw/Model M Controller C View V/
673 my $comp = $c->_comp_explicit(@names);
674 return $c->_filter_component( $comp, @_ ) if defined($comp);
676 $comp = $c->_comp_search($name);
677 return $c->_filter_component( $comp, @_ ) if defined($comp);
680 return sort keys %{ $c->components };
685 =head2 CLASS DATA AND HELPER CLASSES
689 Returns or takes a hashref containing the application's configuration.
691 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
693 You can also use a C<YAML>, C<XML> or C<Config::General> config file
694 like myapp.yml in your applications home directory. See
695 L<Catalyst::Plugin::ConfigLoader>.
698 db: dsn:SQLite:foo.db
703 around config => sub {
707 $c->log->warn("Setting config after setup has been run is not a good idea.")
708 if ( @_ and $c->setup_finished );
715 Returns the logging object instance. Unless it is already set, Catalyst
716 sets this up with a L<Catalyst::Log> object. To use your own log class,
717 set the logger with the C<< __PACKAGE__->log >> method prior to calling
718 C<< __PACKAGE__->setup >>.
720 __PACKAGE__->log( MyLogger->new );
725 $c->log->info( 'Now logging with my own logger!' );
727 Your log class should implement the methods described in
733 Overload to enable debug messages (same as -Debug option).
735 Note that this is a static method, not an accessor and should be overloaded
736 by declaring "sub debug { 1 }" in your MyApp.pm, not by calling $c->debug(1).
742 =head2 $c->dispatcher
744 Returns the dispatcher instance. Stringifies to class name. See
745 L<Catalyst::Dispatcher>.
749 Returns the engine instance. Stringifies to the class name. See
753 =head2 UTILITY METHODS
755 =head2 $c->path_to(@path)
757 Merges C<@path> with C<< $c->config->{home} >> and returns a
758 L<Path::Class::Dir> object.
762 $c->path_to( 'db', 'sqlite.db' );
767 my ( $c, @path ) = @_;
768 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
769 if ( -d $path ) { return $path }
770 else { return Path::Class::File->new( $c->config->{home}, @path ) }
773 =head2 $c->plugin( $name, $class, @args )
775 Helper method for plugins. It creates a classdata accessor/mutator and
776 loads and instantiates the given class.
778 MyApp->plugin( 'prototype', 'HTML::Prototype' );
780 $c->prototype->define_javascript_functions;
785 my ( $class, $name, $plugin, @args ) = @_;
786 $class->_register_plugin( $plugin, 1 );
788 eval { $plugin->import };
789 #MooseX::ClassAttribute::process_class_attribute($class, $name => (is => 'rw'));
790 $class->mk_classdata($name);
792 eval { $obj = $plugin->new(@args) };
795 Catalyst::Exception->throw( message =>
796 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
800 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
806 Initializes the dispatcher and engine, loads any plugins, and loads the
807 model, view, and controller components. You may also specify an array
808 of plugins to load here, if you choose to not load them in the C<use
812 MyApp->setup( qw/-Debug/ );
817 my ( $class, @arguments ) = @_;
819 $class->log->warn("Running setup twice is not a good idea.")
820 if ( $class->setup_finished );
822 unless ( $class->isa('Catalyst') ) {
824 Catalyst::Exception->throw(
825 message => qq/'$class' does not inherit from Catalyst/ );
828 if ( $class->arguments ) {
829 @arguments = ( @arguments, @{ $class->arguments } );
835 foreach (@arguments) {
839 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
841 elsif (/^-(\w+)=?(.*)$/) {
842 $flags->{ lc $1 } = $2;
845 push @{ $flags->{plugins} }, $_;
849 $class->setup_home( delete $flags->{home} );
851 $class->setup_log( delete $flags->{log} );
852 $class->setup_plugins( delete $flags->{plugins} );
853 $class->setup_dispatcher( delete $flags->{dispatcher} );
854 $class->setup_engine( delete $flags->{engine} );
855 $class->setup_stats( delete $flags->{stats} );
857 for my $flag ( sort keys %{$flags} ) {
859 if ( my $code = $class->can( 'setup_' . $flag ) ) {
860 &$code( $class, delete $flags->{$flag} );
863 $class->log->warn(qq/Unknown flag "$flag"/);
867 eval { require Catalyst::Devel; };
868 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
869 $class->log->warn(<<"EOF");
870 You are running an old script!
872 Please update by running (this will overwrite existing files):
873 catalyst.pl -force -scripts $class
875 or (this will not overwrite existing files):
876 catalyst.pl -scripts $class
881 if ( $class->debug ) {
882 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
885 my $t = Text::SimpleTable->new(74);
886 $t->row($_) for @plugins;
887 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
890 my $dispatcher = $class->dispatcher;
891 my $engine = $class->engine;
892 my $home = $class->config->{home};
894 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
895 $class->log->debug(qq/Loaded engine "$engine"/);
899 ? $class->log->debug(qq/Found home "$home"/)
900 : $class->log->debug(qq/Home "$home" doesn't exist/)
901 : $class->log->debug(q/Couldn't find home/);
906 no warnings qw/redefine/;
907 local *setup = sub { };
911 # Initialize our data structure
912 $class->components( {} );
914 $class->setup_components;
916 if ( $class->debug ) {
917 my $t = Text::SimpleTable->new( [ 63, 'Class' ], [ 8, 'Type' ] );
918 for my $comp ( sort keys %{ $class->components } ) {
919 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
920 $t->row( $comp, $type );
922 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
923 if ( keys %{ $class->components } );
926 # Add our self to components, since we are also a component
927 $class->components->{$class} = $class;
929 $class->setup_actions;
931 if ( $class->debug ) {
932 my $name = $class->config->{name} || 'Application';
933 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
935 $class->log->_flush() if $class->log->can('_flush');
937 $class->setup_finished(1);
940 =head2 $c->uri_for( $path, @args?, \%query_values? )
942 Merges path with C<< $c->request->base >> for absolute URIs and with
943 C<< $c->namespace >> for relative URIs, then returns a normalized L<URI>
944 object. If any args are passed, they are added at the end of the path.
945 If the last argument to C<uri_for> is a hash reference, it is assumed to
946 contain GET parameter key/value pairs, which will be appended to the URI
949 Note that uri_for is destructive to the passed hashref. Subsequent calls
950 with the same hashref may have unintended results.
952 Instead of C<$path>, you can also optionally pass a C<$action> object
953 which will be resolved to a path using
954 C<< $c->dispatcher->uri_for_action >>; if the first element of
955 C<@args> is an arrayref it is treated as a list of captures to be passed
956 to C<uri_for_action>.
961 my ( $c, $path, @args ) = @_;
963 if ( Scalar::Util::blessed($path) ) { # action object
964 my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
967 $path = $c->dispatcher->uri_for_action($path, $captures);
968 return undef unless defined($path);
969 $path = '/' if $path eq '';
972 undef($path) if (defined $path && $path eq '');
975 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
977 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
978 s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
980 unshift(@args, $path);
982 unless (defined $path && $path =~ s!^/!!) { # in-place strip
983 my $namespace = $c->namespace;
984 if (defined $path) { # cheesy hack to handle path '../foo'
985 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
987 unshift(@args, $namespace || '');
990 # join args with '/', or a blank string
991 my $args = join('/', grep { defined($_) } @args);
992 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
994 my $base = $c->req->base;
995 my $class = ref($base);
996 $base =~ s{(?<!/)$}{/};
1000 if (my @keys = keys %$params) {
1001 # somewhat lifted from URI::_query's query_form
1002 $query = '?'.join('&', map {
1003 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1006 my $val = $params->{$_};
1007 $val = '' unless defined $val;
1010 utf8::encode( $_ ) if utf8::is_utf8($_);
1011 # using the URI::Escape pattern here so utf8 chars survive
1012 s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1014 "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1018 my $res = bless(\"${base}${args}${query}", $class);
1022 =head2 $c->welcome_message
1024 Returns the Catalyst welcome HTML page.
1028 sub welcome_message {
1030 my $name = $c->config->{name};
1031 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1032 my $prefix = Catalyst::Utils::appprefix( ref $c );
1033 $c->response->content_type('text/html; charset=utf-8');
1035 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1036 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1037 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1039 <meta http-equiv="Content-Language" content="en" />
1040 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1041 <title>$name on Catalyst $VERSION</title>
1042 <style type="text/css">
1045 background-color: #eee;
1052 margin-bottom: 10px;
1054 background-color: #ccc;
1055 border: 1px solid #aaa;
1060 font-family: verdana, tahoma, sans-serif;
1063 font-family: verdana, tahoma, sans-serif;
1066 text-decoration: none;
1068 border-bottom: 1px dotted #bbb;
1070 :link:hover, :visited:hover {
1083 background-color: #fff;
1084 border: 1px solid #aaa;
1088 font-weight: normal;
1110 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1115 <img src="$logo" alt="Catalyst Logo" />
1117 <p>Welcome to the world of Catalyst.
1118 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1119 framework will make web development something you had
1120 never expected it to be: Fun, rewarding, and quick.</p>
1121 <h2>What to do now?</h2>
1122 <p>That really depends on what <b>you</b> want to do.
1123 We do, however, provide you with a few starting points.</p>
1124 <p>If you want to jump right into web development with Catalyst
1125 you might want want to start with a tutorial.</p>
1126 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1128 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1130 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1131 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1133 <h2>What to do next?</h2>
1134 <p>Next it's time to write an actual application. Use the
1135 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
1136 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a>, and
1137 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>;
1138 they can save you a lot of work.</p>
1139 <pre><code>script/${prefix}_create.pl -help</code></pre>
1140 <p>Also, be sure to check out the vast and growing
1141 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>;
1142 you are likely to find what you need there.
1146 <p>Catalyst has a very active community. Here are the main places to
1147 get in touch with us.</p>
1150 <a href="http://dev.catalyst.perl.org">Wiki</a>
1153 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
1156 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1159 <h2>In conclusion</h2>
1160 <p>The Catalyst team hopes you will enjoy using Catalyst as much
1161 as we enjoyed making it. Please contact us if you have ideas
1162 for improvement or other feedback.</p>
1170 =head1 INTERNAL METHODS
1172 These methods are not meant to be used by end users.
1174 =head2 $c->components
1176 Returns a hash of components.
1178 =head2 $c->context_class
1180 Returns or sets the context class.
1184 Returns a hashref containing coderefs and execution counts (needed for
1185 deep recursion detection).
1189 Returns the number of actions on the current internal execution stack.
1193 Dispatches a request to actions.
1197 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1199 =head2 $c->dispatcher_class
1201 Returns or sets the dispatcher class.
1203 =head2 $c->dump_these
1205 Returns a list of 2-element array references (name, structure) pairs
1206 that will be dumped on the error page in debug mode.
1212 [ Request => $c->req ],
1213 [ Response => $c->res ],
1214 [ Stash => $c->stash ],
1215 [ Config => $c->config ];
1218 =head2 $c->engine_class
1220 Returns or sets the engine class.
1222 =head2 $c->execute( $class, $coderef )
1224 Execute a coderef in given class and catch exceptions. Errors are available
1230 my ( $c, $class, $code ) = @_;
1231 $class = $c->component($class) || $class;
1234 if ( $c->depth >= $RECURSION ) {
1235 my $action = "$code";
1236 $action = "/$action" unless $action =~ /->/;
1237 my $error = qq/Deep recursion detected calling "$action"/;
1238 $c->log->error($error);
1244 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1246 push( @{ $c->stack }, $code );
1248 eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
1250 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1252 my $last = pop( @{ $c->stack } );
1254 if ( my $error = $@ ) {
1255 if ( !ref($error) and $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
1257 unless ( ref $error ) {
1258 no warnings 'uninitialized';
1260 my $class = $last->class;
1261 my $name = $last->name;
1262 $error = qq/Caught exception in $class->$name "$error"/;
1271 sub _stats_start_execute {
1272 my ( $c, $code ) = @_;
1274 return if ( ( $code->name =~ /^_.*/ )
1275 && ( !$c->config->{show_internal_actions} ) );
1277 $c->counter->{"$code"}++;
1279 my $action = "$code";
1280 $action = "/$action" unless $action =~ /->/;
1282 # determine if the call was the result of a forward
1283 # this is done by walking up the call stack and looking for a calling
1284 # sub of Catalyst::forward before the eval
1286 for my $index ( 2 .. 11 ) {
1288 if ( ( caller($index) )[0] eq 'Catalyst'
1289 && ( caller($index) )[3] eq '(eval)' );
1291 if ( ( caller($index) )[3] =~ /forward$/ ) {
1292 $callsub = ( caller($index) )[3];
1293 $action = "-> $action";
1298 my $uid = "$code" . $c->counter->{"$code"};
1300 # is this a root-level call or a forwarded call?
1301 if ( $callsub =~ /forward$/ ) {
1303 # forward, locate the caller
1304 if ( my $parent = $c->stack->[-1] ) {
1307 parent => "$parent" . $c->counter->{"$parent"},
1313 # forward with no caller may come from a plugin
1332 sub _stats_finish_execute {
1333 my ( $c, $info ) = @_;
1334 $c->stats->profile( end => $info );
1337 =head2 $c->_localize_fields( sub { }, \%keys );
1341 sub _localize_fields {
1342 my ( $c, $localized, $code ) = ( @_ );
1344 my $request = delete $localized->{request} || {};
1345 my $response = delete $localized->{response} || {};
1347 local @{ $c }{ keys %$localized } = values %$localized;
1348 local @{ $c->request }{ keys %$request } = values %$request;
1349 local @{ $c->response }{ keys %$response } = values %$response;
1356 Finalizes the request.
1363 for my $error ( @{ $c->error } ) {
1364 $c->log->error($error);
1367 # Allow engine to handle finalize flow (for POE)
1368 if ( $c->engine->can('finalize') ) {
1369 $c->engine->finalize($c);
1373 $c->finalize_uploads;
1376 if ( $#{ $c->error } >= 0 ) {
1380 $c->finalize_headers;
1383 if ( $c->request->method eq 'HEAD' ) {
1384 $c->response->body('');
1390 if ($c->use_stats) {
1391 my $elapsed = sprintf '%f', $c->stats->elapsed;
1392 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1394 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1397 return $c->response->status;
1400 =head2 $c->finalize_body
1406 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1408 =head2 $c->finalize_cookies
1414 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1416 =head2 $c->finalize_error
1422 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1424 =head2 $c->finalize_headers
1430 sub finalize_headers {
1433 # Check if we already finalized headers
1434 return if $c->response->{_finalized_headers};
1437 if ( my $location = $c->response->redirect ) {
1438 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1439 $c->response->header( Location => $location );
1441 if ( !$c->response->body ) {
1442 # Add a default body if none is already present
1444 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1450 if ( $c->response->body && !$c->response->content_length ) {
1452 # get the length from a filehandle
1453 if ( blessed( $c->response->body ) && $c->response->body->can('read') )
1455 my $stat = stat $c->response->body;
1456 if ( $stat && $stat->size > 0 ) {
1457 $c->response->content_length( $stat->size );
1460 $c->log->warn('Serving filehandle without a content-length');
1464 # everything should be bytes at this point, but just in case
1465 $c->response->content_length( bytes::length( $c->response->body ) );
1470 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1471 $c->response->headers->remove_header("Content-Length");
1472 $c->response->body('');
1475 $c->finalize_cookies;
1477 $c->engine->finalize_headers( $c, @_ );
1480 $c->response->{_finalized_headers} = 1;
1483 =head2 $c->finalize_output
1485 An alias for finalize_body.
1487 =head2 $c->finalize_read
1489 Finalizes the input after reading is complete.
1493 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1495 =head2 $c->finalize_uploads
1497 Finalizes uploads. Cleans up any temporary files.
1501 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1503 =head2 $c->get_action( $action, $namespace )
1505 Gets an action in a given namespace.
1509 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1511 =head2 $c->get_actions( $action, $namespace )
1513 Gets all actions of a given name in a namespace and all parent
1518 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1520 =head2 $c->handle_request( $class, @arguments )
1522 Called to handle each HTTP request.
1526 sub handle_request {
1527 my ( $class, @arguments ) = @_;
1529 # Always expect worst case!
1532 if ($class->debug) {
1533 my $secs = time - $START || 1;
1534 my $av = sprintf '%.3f', $COUNT / $secs;
1535 my $time = localtime time;
1536 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1539 my $c = $class->prepare(@arguments);
1541 $status = $c->finalize;
1544 if ( my $error = $@ ) {
1546 $class->log->error(qq/Caught exception in engine "$error"/);
1550 $class->log->_flush() if $class->log->can('_flush');
1554 =head2 $c->prepare( @arguments )
1556 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1562 my ( $class, @arguments ) = @_;
1564 $class->context_class( ref $class || $class ) unless $class->context_class;
1565 my $c = $class->context_class->new(
1569 request => $class->request_class->new(
1572 body_parameters => {},
1574 headers => HTTP::Headers->new,
1576 query_parameters => {},
1582 response => $class->response_class->new(
1586 headers => HTTP::Headers->new(),
1595 $c->stats($class->stats_class->new)->enable($c->use_stats);
1597 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1600 # For on-demand data
1601 $c->request->_context($c);
1602 $c->response->_context($c);
1604 # Allow engine to direct the prepare flow (for POE)
1605 if ( $c->engine->can('prepare') ) {
1606 $c->engine->prepare( $c, @arguments );
1609 $c->prepare_request(@arguments);
1610 $c->prepare_connection;
1611 $c->prepare_query_parameters;
1612 $c->prepare_headers;
1613 $c->prepare_cookies;
1616 # Prepare the body for reading, either by prepare_body
1617 # or the user, if they are using $c->read
1620 # Parse the body unless the user wants it on-demand
1621 unless ( $c->config->{parse_on_demand} ) {
1626 my $method = $c->req->method || '';
1627 my $path = $c->req->path || '/';
1628 my $address = $c->req->address || '';
1630 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1638 =head2 $c->prepare_action
1640 Prepares action. See L<Catalyst::Dispatcher>.
1644 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1646 =head2 $c->prepare_body
1648 Prepares message body.
1655 # Do we run for the first time?
1656 return if defined $c->request->{_body};
1658 # Initialize on-demand data
1659 $c->engine->prepare_body( $c, @_ );
1660 $c->prepare_parameters;
1661 $c->prepare_uploads;
1663 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1664 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1665 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1666 my $param = $c->req->body_parameters->{$key};
1667 my $value = defined($param) ? $param : '';
1669 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1671 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1675 =head2 $c->prepare_body_chunk( $chunk )
1677 Prepares a chunk of data before sending it to L<HTTP::Body>.
1679 See L<Catalyst::Engine>.
1683 sub prepare_body_chunk {
1685 $c->engine->prepare_body_chunk( $c, @_ );
1688 =head2 $c->prepare_body_parameters
1690 Prepares body parameters.
1694 sub prepare_body_parameters {
1696 $c->engine->prepare_body_parameters( $c, @_ );
1699 =head2 $c->prepare_connection
1701 Prepares connection.
1705 sub prepare_connection {
1707 $c->engine->prepare_connection( $c, @_ );
1710 =head2 $c->prepare_cookies
1716 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1718 =head2 $c->prepare_headers
1724 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1726 =head2 $c->prepare_parameters
1728 Prepares parameters.
1732 sub prepare_parameters {
1734 $c->prepare_body_parameters;
1735 $c->engine->prepare_parameters( $c, @_ );
1738 =head2 $c->prepare_path
1740 Prepares path and base.
1744 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1746 =head2 $c->prepare_query_parameters
1748 Prepares query parameters.
1752 sub prepare_query_parameters {
1755 $c->engine->prepare_query_parameters( $c, @_ );
1757 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1758 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1759 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1760 my $param = $c->req->query_parameters->{$key};
1761 my $value = defined($param) ? $param : '';
1763 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1765 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1769 =head2 $c->prepare_read
1771 Prepares the input for reading.
1775 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1777 =head2 $c->prepare_request
1779 Prepares the engine request.
1783 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1785 =head2 $c->prepare_uploads
1791 sub prepare_uploads {
1794 $c->engine->prepare_uploads( $c, @_ );
1796 if ( $c->debug && keys %{ $c->request->uploads } ) {
1797 my $t = Text::SimpleTable->new(
1798 [ 12, 'Parameter' ],
1803 for my $key ( sort keys %{ $c->request->uploads } ) {
1804 my $upload = $c->request->uploads->{$key};
1805 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1806 $t->row( $key, $u->filename, $u->type, $u->size );
1809 $c->log->debug( "File Uploads are:\n" . $t->draw );
1813 =head2 $c->prepare_write
1815 Prepares the output for writing.
1819 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1821 =head2 $c->request_class
1823 Returns or sets the request class.
1825 =head2 $c->response_class
1827 Returns or sets the response class.
1829 =head2 $c->read( [$maxlength] )
1831 Reads a chunk of data from the request body. This method is designed to
1832 be used in a while loop, reading C<$maxlength> bytes on every call.
1833 C<$maxlength> defaults to the size of the request if not specified.
1835 You have to set C<< MyApp->config->{parse_on_demand} >> to use this
1838 Warning: If you use read(), Catalyst will not process the body,
1839 so you will not be able to access POST parameters or file uploads via
1840 $c->request. You must handle all body parsing yourself.
1844 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1852 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1854 =head2 $c->set_action( $action, $code, $namespace, $attrs )
1856 Sets an action in a given namespace.
1860 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1862 =head2 $c->setup_actions($component)
1864 Sets up actions for a component.
1868 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1870 =head2 $c->setup_components
1872 Sets up components. Specify a C<setup_components> config option to pass
1873 additional options directly to L<Module::Pluggable>. To add additional
1874 search paths, specify a key named C<search_extra> as an array
1875 reference. Items in the array beginning with C<::> will have the
1876 application class name prepended to them.
1880 sub setup_components {
1883 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
1884 my $config = $class->config->{ setup_components };
1885 my $extra = delete $config->{ search_extra } || [];
1887 push @paths, @$extra;
1889 my $locator = Module::Pluggable::Object->new(
1890 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
1894 my @comps = sort { length $a <=> length $b } $locator->plugins;
1895 my %comps = map { $_ => 1 } @comps;
1897 for my $component ( @comps ) {
1899 # We pass ignore_loaded here so that overlay files for (e.g.)
1900 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
1901 # we know M::P::O found a file on disk so this is safe
1903 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
1905 my $module = $class->setup_component( $component );
1907 $component => $module,
1909 $_ => $class->setup_component( $_ )
1911 not exists $comps{$_}
1912 } Devel::InnerPackage::list_packages( $component )
1915 for my $key ( keys %modules ) {
1916 $class->components->{ $key } = $modules{ $key };
1921 =head2 $c->setup_component
1925 sub setup_component {
1926 my( $class, $component ) = @_;
1928 unless ( $component->can( 'COMPONENT' ) ) {
1932 my $suffix = Catalyst::Utils::class2classsuffix( $component );
1933 my $config = $class->config->{ $suffix } || {};
1935 my $instance = eval { $component->COMPONENT( $class, $config ); };
1937 if ( my $error = $@ ) {
1939 Catalyst::Exception->throw(
1940 message => qq/Couldn't instantiate component "$component", "$error"/
1944 Catalyst::Exception->throw(
1946 qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
1947 ) unless eval { $instance->can( 'can' ) };
1952 =head2 $c->setup_dispatcher
1958 sub setup_dispatcher {
1959 my ( $class, $dispatcher ) = @_;
1962 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1965 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
1966 $dispatcher = 'Catalyst::Dispatcher::' . $env;
1969 unless ($dispatcher) {
1970 $dispatcher = $class->dispatcher_class;
1973 unless (Class::Inspector->loaded($dispatcher)) {
1974 require Class::Inspector->filename($dispatcher);
1977 # dispatcher instance
1978 $class->dispatcher( $dispatcher->new );
1981 =head2 $c->setup_engine
1988 my ( $class, $engine ) = @_;
1991 $engine = 'Catalyst::Engine::' . $engine;
1994 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
1995 $engine = 'Catalyst::Engine::' . $env;
1998 if ( $ENV{MOD_PERL} ) {
2000 # create the apache method
2003 *{"$class\::apache"} = sub { shift->engine->apache };
2006 my ( $software, $version ) =
2007 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2010 $version =~ s/(\.[^.]+)\./$1/g;
2012 if ( $software eq 'mod_perl' ) {
2016 if ( $version >= 1.99922 ) {
2017 $engine = 'Catalyst::Engine::Apache2::MP20';
2020 elsif ( $version >= 1.9901 ) {
2021 $engine = 'Catalyst::Engine::Apache2::MP19';
2024 elsif ( $version >= 1.24 ) {
2025 $engine = 'Catalyst::Engine::Apache::MP13';
2029 Catalyst::Exception->throw( message =>
2030 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2035 # install the correct mod_perl handler
2036 if ( $version >= 1.9901 ) {
2037 *handler = sub : method {
2038 shift->handle_request(@_);
2042 *handler = sub ($$) { shift->handle_request(@_) };
2047 elsif ( $software eq 'Zeus-Perl' ) {
2048 $engine = 'Catalyst::Engine::Zeus';
2052 Catalyst::Exception->throw(
2053 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2058 $engine = $class->engine_class;
2061 unless (Class::Inspector->loaded($engine)) {
2062 require Class::Inspector->filename($engine);
2065 # check for old engines that are no longer compatible
2067 if ( $engine->isa('Catalyst::Engine::Apache')
2068 && !Catalyst::Engine::Apache->VERSION )
2073 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2074 && Catalyst::Engine::Server->VERSION le '0.02' )
2079 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2080 && $engine->VERSION eq '0.01' )
2085 elsif ($engine->isa('Catalyst::Engine::Zeus')
2086 && $engine->VERSION eq '0.01' )
2092 Catalyst::Exception->throw( message =>
2093 qq/Engine "$engine" is not supported by this version of Catalyst/
2098 $class->engine( $engine->new );
2101 =head2 $c->setup_home
2103 Sets up the home directory.
2108 my ( $class, $home ) = @_;
2110 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2115 $home = Catalyst::Utils::home($class);
2119 $class->config->{home} ||= $home;
2120 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2124 =head2 $c->setup_log
2131 my ( $class, $debug ) = @_;
2133 unless ( $class->log ) {
2134 $class->log( Catalyst::Log->new );
2137 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2138 if ( defined($env_debug) ? $env_debug : $debug ) {
2140 *{"$class\::debug"} = sub { 1 };
2141 $class->log->debug('Debug messages enabled');
2145 =head2 $c->setup_plugins
2151 =head2 $c->setup_stats
2153 Sets up timing statistics class.
2158 my ( $class, $stats ) = @_;
2160 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2162 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2163 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2165 *{"$class\::use_stats"} = sub { 1 };
2166 $class->log->debug('Statistics enabled');
2171 =head2 $c->registered_plugins
2173 Returns a sorted list of the plugins which have either been stated in the
2174 import list or which have been added via C<< MyApp->plugin(@args); >>.
2176 If passed a given plugin name, it will report a boolean value indicating
2177 whether or not that plugin is loaded. A fully qualified name is required if
2178 the plugin name does not begin with C<Catalyst::Plugin::>.
2180 if ($c->registered_plugins('Some::Plugin')) {
2188 sub registered_plugins {
2190 return sort keys %{ $proto->_plugins } unless @_;
2192 return 1 if exists $proto->_plugins->{$plugin};
2193 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2196 sub _register_plugin {
2197 my ( $proto, $plugin, $instant ) = @_;
2198 my $class = ref $proto || $proto;
2200 # no ignore_loaded here, the plugin may already have been
2201 # defined in memory and we don't want to error on "no file" if so
2203 Catalyst::Utils::ensure_class_loaded( $plugin );
2205 $proto->_plugins->{$plugin} = 1;
2208 unshift @{"$class\::ISA"}, $plugin;
2209 # $class->meta->superclasses($plugin, $class->meta->superclasses);
2215 my ( $class, $plugins ) = @_;
2217 $class->_plugins( {} ) unless $class->_plugins;
2219 for my $plugin ( reverse @$plugins ) {
2221 unless ( $plugin =~ s/\A\+// ) {
2222 $plugin = "Catalyst::Plugin::$plugin";
2225 $class->_register_plugin($plugin);
2232 Returns an arrayref of the internal execution stack (actions that are
2233 currently executing).
2235 =head2 $c->stats_class
2237 Returns or sets the stats (timing statistics) class.
2239 =head2 $c->use_stats
2241 Returns 1 when stats collection is enabled. Stats collection is enabled
2242 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2243 environment variable is set.
2245 Note that this is a static method, not an accessor and should be overloaded
2246 by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1).
2253 =head2 $c->write( $data )
2255 Writes $data to the output stream. When using this method directly, you
2256 will need to manually set the C<Content-Length> header to the length of
2257 your output data, if known.
2264 # Finalize headers if someone manually writes output
2265 $c->finalize_headers;
2267 return $c->engine->write( $c, @_ );
2272 Returns the Catalyst version number. Mostly useful for "powered by"
2273 messages in template systems.
2277 sub version { return $Catalyst::VERSION }
2279 =head1 INTERNAL ACTIONS
2281 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2282 C<_ACTION>, and C<_END>. These are by default not shown in the private
2283 action table, but you can make them visible with a config parameter.
2285 MyApp->config->{show_internal_actions} = 1;
2287 =head1 CASE SENSITIVITY
2289 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2290 mapped to C</foo/bar>. You can activate case sensitivity with a config
2293 MyApp->config->{case_sensitive} = 1;
2295 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2297 =head1 ON-DEMAND PARSER
2299 The request body is usually parsed at the beginning of a request,
2300 but if you want to handle input yourself, you can enable on-demand
2301 parsing with a config parameter.
2303 MyApp->config->{parse_on_demand} = 1;
2305 =head1 PROXY SUPPORT
2307 Many production servers operate using the common double-server approach,
2308 with a lightweight frontend web server passing requests to a larger
2309 backend server. An application running on the backend server must deal
2310 with two problems: the remote user always appears to be C<127.0.0.1> and
2311 the server's hostname will appear to be C<localhost> regardless of the
2312 virtual host that the user connected through.
2314 Catalyst will automatically detect this situation when you are running
2315 the frontend and backend servers on the same machine. The following
2316 changes are made to the request.
2318 $c->req->address is set to the user's real IP address, as read from
2319 the HTTP X-Forwarded-For header.
2321 The host value for $c->req->base and $c->req->uri is set to the real
2322 host, as read from the HTTP X-Forwarded-Host header.
2324 Obviously, your web server must support these headers for this to work.
2326 In a more complex server farm environment where you may have your
2327 frontend proxy server(s) on different machines, you will need to set a
2328 configuration option to tell Catalyst to read the proxied data from the
2331 MyApp->config->{using_frontend_proxy} = 1;
2333 If you do not wish to use the proxy support at all, you may set:
2335 MyApp->config->{ignore_frontend_proxy} = 1;
2337 =head1 THREAD SAFETY
2339 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2340 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2341 believe the Catalyst core to be thread-safe.
2343 If you plan to operate in a threaded environment, remember that all other
2344 modules you are using must also be thread-safe. Some modules, most notably
2345 L<DBD::SQLite>, are not thread-safe.
2351 Join #catalyst on irc.perl.org.
2355 http://lists.rawmode.org/mailman/listinfo/catalyst
2356 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
2360 http://catalyst.perl.org
2364 http://dev.catalyst.perl.org
2368 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2370 =head2 L<Catalyst::Manual> - The Catalyst Manual
2372 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
2374 =head2 L<Catalyst::Engine> - Core engine
2376 =head2 L<Catalyst::Log> - Log class.
2378 =head2 L<Catalyst::Request> - Request object
2380 =head2 L<Catalyst::Response> - Response object
2382 =head2 L<Catalyst::Test> - The test suite.
2456 Sebastian Riedel, C<sri@oook.de>
2460 This library is free software, you can redistribute it and/or modify it under
2461 the same terms as Perl itself.