Debug mode is also triggered by running myapp_server.pl -d
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
CommitLineData
fc7ec1d9 1package Catalyst;
2
a7caa492 3use Moose;
60eabdaf 4extends 'Catalyst::Component';
2f5cb070 5use Moose::Util qw/find_meta/;
fbcc39ad 6use bytes;
edb20ed3 7use Scope::Upper ();
a2f2cde9 8use Catalyst::Exception;
fc7ec1d9 9use Catalyst::Log;
fbcc39ad 10use Catalyst::Request;
11use Catalyst::Request::Upload;
12use Catalyst::Response;
812a28c9 13use Catalyst::Utils;
31375184 14use Catalyst::Controller;
364d7324 15use Devel::InnerPackage ();
8f62c91a 16use File::stat;
c50f595c 17use Module::Pluggable::Object ();
c50f595c 18use Text::SimpleTable ();
19use Path::Class::Dir ();
20use Path::Class::File ();
c50f595c 21use URI ();
933ba403 22use URI::http;
23use URI::https;
5513038d 24use Tree::Simple qw/use_weak_refs/;
25use Tree::Simple::Visitor::FindByUID;
269408a4 26use Class::C3::Adopt::NEXT;
261c571e 27use attributes;
5789a3d8 28use utf8;
108201b5 29use Carp qw/croak carp shortmess/;
fc7ec1d9 30
f63c03e4 31BEGIN { require 5.008001; }
32
8a440eba 33has stack => (is => 'ro', default => sub { [] });
6680c772 34has stash => (is => 'rw', default => sub { {} });
35has state => (is => 'rw', default => 0);
b6d4ee6e 36has stats => (is => 'rw');
37has action => (is => 'rw');
6680c772 38has counter => (is => 'rw', default => sub { {} });
39has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
40has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
e63bdf38 41has namespace => (is => 'rw');
42
8767c5a3 43sub depth { scalar @{ shift->stack || [] }; }
0fc2d522 44sub comp { shift->component(@_) }
6680c772 45
46sub req {
6680c772 47 my $self = shift; return $self->request(@_);
48}
49sub res {
6680c772 50 my $self = shift; return $self->response(@_);
51}
fbcc39ad 52
53# For backwards compatibility
0fc2d522 54sub finalize_output { shift->finalize_body(@_) };
fbcc39ad 55
56# For statistics
57our $COUNT = 1;
58our $START = time;
59our $RECURSION = 1000;
60our $DETACH = "catalyst_detach\n";
55424863 61our $GO = "catalyst_go\n";
fbcc39ad 62
b6d4ee6e 63#I imagine that very few of these really need to be class variables. if any.
64#maybe we should just make them attributes with a default?
fbcc39ad 65__PACKAGE__->mk_classdata($_)
3cec521a 66 for qw/components arguments dispatcher engine log dispatcher_class
62a6df80 67 engine_class context_class request_class response_class stats_class
dc5f035e 68 setup_finished/;
cb0354c6 69
3cec521a 70__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
71__PACKAGE__->engine_class('Catalyst::Engine::CGI');
72__PACKAGE__->request_class('Catalyst::Request');
73__PACKAGE__->response_class('Catalyst::Response');
dc5f035e 74__PACKAGE__->stats_class('Catalyst::Stats');
fbcc39ad 75
6415bb4d 76# Remember to update this in Catalyst::Runtime as well!
77
a3307111 78our $VERSION = '5.80002';
4ed63588 79
80{
81 my $dev_version = $VERSION =~ /_\d{2}$/;
82 *_IS_DEVELOPMENT_VERSION = sub () { $dev_version };
83}
84
c3f6d73a 85$VERSION = eval $VERSION;
189e2a51 86
fbcc39ad 87sub import {
88 my ( $class, @arguments ) = @_;
89
90 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
91 # callers @ISA.
92 return unless $class eq 'Catalyst';
93
84ff88cf 94 my $caller = caller();
95 return if $caller eq 'main';
269408a4 96
97 # Kill Adopt::NEXT warnings if we're a non-RC version
4ed63588 98 unless (_IS_DEVELOPMENT_VERSION()) {
8833fe2c 99 Class::C3::Adopt::NEXT->unimport(qr/^Catalyst::/);
269408a4 100 }
101
84ff88cf 102 my $meta = Moose::Meta::Class->initialize($caller);
103 #Moose->import({ into => $caller }); #do we want to do this?
fbcc39ad 104
105 unless ( $caller->isa('Catalyst') ) {
84ff88cf 106 my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
107 $meta->superclasses(@superclasses);
108 }
109 unless( $meta->has_method('meta') ){
110 $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
fbcc39ad 111 }
112
113 $caller->arguments( [@arguments] );
114 $caller->setup_home;
115}
fc7ec1d9 116
117=head1 NAME
118
119Catalyst - The Elegant MVC Web Application Framework
120
121=head1 SYNOPSIS
122
e7ad3b81 123See the L<Catalyst::Manual> distribution for comprehensive
124documentation and tutorials.
125
86418559 126 # Install Catalyst::Devel for helpers and other development tools
b4b01a8a 127 # use the helper to create a new application
91864987 128 catalyst.pl MyApp
fc7ec1d9 129
130 # add models, views, controllers
2f381252 131 script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
cc95842f 132 script/myapp_create.pl view MyTemplate TT
0ef52a96 133 script/myapp_create.pl controller Search
fc7ec1d9 134
e7f1cf73 135 # built in testserver -- use -r to restart automatically on changes
cc95842f 136 # --help to see all available options
ae4e40a7 137 script/myapp_server.pl
fc7ec1d9 138
0ef52a96 139 # command line testing interface
ae4e40a7 140 script/myapp_test.pl /yada
fc7ec1d9 141
b4b01a8a 142 ### in lib/MyApp.pm
0ef52a96 143 use Catalyst qw/-Debug/; # include plugins here as well
62a6df80 144
85d9fce6 145 ### In lib/MyApp/Controller/Root.pm (autocreated)
0ef52a96 146 sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
ae1e6b59 147 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
148 $c->stash->{template} = 'foo.tt'; # set the template
0ef52a96 149 # lookup something from db -- stash vars are passed to TT
62a6df80 150 $c->stash->{data} =
b4b01a8a 151 $c->model('Database::Foo')->search( { country => $args[0] } );
0ef52a96 152 if ( $c->req->params->{bar} ) { # access GET or POST parameters
153 $c->forward( 'bar' ); # process another action
62a6df80 154 # do something else after forward returns
0ef52a96 155 }
156 }
62a6df80 157
ae1e6b59 158 # The foo.tt TT template can use the stash data from the database
0ef52a96 159 [% WHILE (item = data.next) %]
160 [% item.foo %]
161 [% END %]
62a6df80 162
0ef52a96 163 # called for /bar/of/soap, /bar/of/soap/10, etc.
164 sub bar : Path('/bar/of/soap') { ... }
fc7ec1d9 165
ae1e6b59 166 # called for all actions, from the top-most controller downwards
62a6df80 167 sub auto : Private {
0ef52a96 168 my ( $self, $c ) = @_;
b4b01a8a 169 if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
0ef52a96 170 $c->res->redirect( '/login' ); # require login
171 return 0; # abort request and go immediately to end()
172 }
ae1e6b59 173 return 1; # success; carry on to next action
0ef52a96 174 }
62a6df80 175
ae1e6b59 176 # called after all actions are finished
62a6df80 177 sub end : Private {
5a8ed4fe 178 my ( $self, $c ) = @_;
0ef52a96 179 if ( scalar @{ $c->error } ) { ... } # handle errors
180 return if $c->res->body; # already have a response
181 $c->forward( 'MyApp::View::TT' ); # render template
5a8ed4fe 182 }
183
0ef52a96 184 ### in MyApp/Controller/Foo.pm
185 # called for /foo/bar
186 sub bar : Local { ... }
62a6df80 187
5400c668 188 # called for /blargle
189 sub blargle : Global { ... }
62a6df80 190
5400c668 191 # an index action matches /foo, but not /foo/1, etc.
192 sub index : Private { ... }
62a6df80 193
0ef52a96 194 ### in MyApp/Controller/Foo/Bar.pm
195 # called for /foo/bar/baz
196 sub baz : Local { ... }
62a6df80 197
b4b01a8a 198 # first Root auto is called, then Foo auto, then this
0ef52a96 199 sub auto : Private { ... }
62a6df80 200
0ef52a96 201 # powerful regular expression paths are also possible
202 sub details : Regex('^product/(\w+)/details$') {
5a8ed4fe 203 my ( $self, $c ) = @_;
0ef52a96 204 # extract the (\w+) from the URI
2982e768 205 my $product = $c->req->captures->[0];
5a8ed4fe 206 }
fc7ec1d9 207
0ef52a96 208See L<Catalyst::Manual::Intro> for additional information.
3803e98f 209
fc7ec1d9 210=head1 DESCRIPTION
211
86418559 212Catalyst is a modern framework for making web applications without the
213pain usually associated with this process. This document is a reference
214to the main Catalyst application. If you are a new user, we suggest you
215start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
fc7ec1d9 216
217See L<Catalyst::Manual> for more documentation.
218
ae1e6b59 219Catalyst plugins can be loaded by naming them as arguments to the "use
220Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
221plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
222C<My::Module>.
fc7ec1d9 223
0ef52a96 224 use Catalyst qw/My::Module/;
fc7ec1d9 225
836e1134 226If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
227fully qualify the name by using a unary plus:
228
229 use Catalyst qw/
230 My::Module
231 +Fully::Qualified::Plugin::Name
232 /;
233
ae1e6b59 234Special flags like C<-Debug> and C<-Engine> can also be specified as
235arguments when Catalyst is loaded:
fc7ec1d9 236
237 use Catalyst qw/-Debug My::Module/;
238
ae1e6b59 239The position of plugins and flags in the chain is important, because
86418559 240they are loaded in the order in which they appear.
fc7ec1d9 241
23f9d934 242The following flags are supported:
243
b5ecfcf0 244=head2 -Debug
23f9d934 245
f8ad6ea5 246Enables debug output. You can also force this setting from the system
86418559 247environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
248settings override the application, with <MYAPP>_DEBUG having the highest
249priority.
fc7ec1d9 250
b5ecfcf0 251=head2 -Engine
fc7ec1d9 252
ae1e6b59 253Forces Catalyst to use a specific engine. Omit the
254C<Catalyst::Engine::> prefix of the engine name, i.e.:
fc7ec1d9 255
0ef52a96 256 use Catalyst qw/-Engine=CGI/;
fc7ec1d9 257
b5ecfcf0 258=head2 -Home
fbcc39ad 259
ae1e6b59 260Forces Catalyst to use a specific home directory, e.g.:
261
86418559 262 use Catalyst qw[-Home=/usr/mst];
fbcc39ad 263
cc95842f 264This can also be done in the shell environment by setting either the
265C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
266is replaced with the uppercased name of your application, any "::" in
267the name will be replaced with underscores, e.g. MyApp::Web should use
268MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
269
b5ecfcf0 270=head2 -Log
fbcc39ad 271
0fa676a7 272 use Catalyst '-Log=warn,fatal,error';
62a6df80 273
0fa676a7 274Specifies a comma-delimited list of log levels.
fbcc39ad 275
dc5f035e 276=head2 -Stats
277
278Enables statistics collection and reporting. You can also force this setting
279from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
280environment settings override the application, with <MYAPP>_STATS having the
281highest priority.
282
62a6df80 283e.g.
dc5f035e 284
285 use Catalyst qw/-Stats=1/
286
23f9d934 287=head1 METHODS
288
f7b672ef 289=head2 INFORMATION ABOUT THE CURRENT REQUEST
0ef52a96 290
b5ecfcf0 291=head2 $c->action
66e28e3f 292
ae1e6b59 293Returns a L<Catalyst::Action> object for the current action, which
294stringifies to the action name. See L<Catalyst::Action>.
0ef52a96 295
b5ecfcf0 296=head2 $c->namespace
0ef52a96 297
86418559 298Returns the namespace of the current action, i.e., the URI prefix
ae1e6b59 299corresponding to the controller of the current action. For example:
300
301 # in Controller::Foo::Bar
302 $c->namespace; # returns 'foo/bar';
0ef52a96 303
b5ecfcf0 304=head2 $c->request
0ef52a96 305
b5ecfcf0 306=head2 $c->req
0ef52a96 307
86418559 308Returns the current L<Catalyst::Request> object, giving access to
309information about the current client request (including parameters,
310cookies, HTTP headers, etc.). See L<Catalyst::Request>.
0ef52a96 311
b4b01a8a 312=head2 REQUEST FLOW HANDLING
0ef52a96 313
b5ecfcf0 314=head2 $c->forward( $action [, \@arguments ] )
0ef52a96 315
b5ecfcf0 316=head2 $c->forward( $class, $method, [, \@arguments ] )
0ef52a96 317
86418559 318Forwards processing to another action, by its private name. If you give a
b4b01a8a 319class name but no method, C<process()> is called. You may also optionally
320pass arguments in an arrayref. The action will receive the arguments in
cc95842f 321C<@_> and C<< $c->req->args >>. Upon returning from the function,
322C<< $c->req->args >> will be restored to the previous values.
0ef52a96 323
3b984c64 324Any data C<return>ed from the action forwarded to, will be returned by the
d759db1e 325call to forward.
3b984c64 326
327 my $foodata = $c->forward('/foo');
0ef52a96 328 $c->forward('index');
e112461a 329 $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
0ef52a96 330 $c->forward('MyApp::View::TT');
331
86418559 332Note that forward implies an C<<eval { }>> around the call (actually
333C<execute> does), thus de-fatalizing all 'dies' within the called
334action. If you want C<die> to propagate you need to do something like:
f3e6a8c0 335
336 $c->forward('foo');
337 die $c->error if $c->error;
338
86418559 339Or make sure to always return true values from your actions and write
340your code like this:
f3e6a8c0 341
342 $c->forward('foo') || return;
343
0ef52a96 344=cut
345
6680c772 346sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
0ef52a96 347
b5ecfcf0 348=head2 $c->detach( $action [, \@arguments ] )
0ef52a96 349
b5ecfcf0 350=head2 $c->detach( $class, $method, [, \@arguments ] )
0ef52a96 351
264bac8c 352=head2 $c->detach()
353
62a6df80 354The same as C<forward>, but doesn't return to the previous action when
355processing is finished.
0ef52a96 356
264bac8c 357When called with no arguments it escapes the processing chain entirely.
358
0ef52a96 359=cut
360
361sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
362
5d91ffe2 363=head2 $c->visit( $action [, \@captures, \@arguments ] )
ae0e35ee 364
5d91ffe2 365=head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
ae0e35ee 366
367Almost the same as C<forward>, but does a full dispatch, instead of just
368calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
369C<auto> and the method you go to are called, just like a new request.
370
4b48773e 371In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
372This means, for example, that $c->action methods such as C<name>, C<class> and
373C<reverse> return information for the visited action when they are invoked
374within the visited action. This is different from the behavior of C<forward>
375which continues to use the $c->action object from the caller action even when
376invoked from the callee.
377
ae0e35ee 378C<$c-E<gt>stash> is kept unchanged.
379
380In effect, C<visit> allows you to "wrap" another action, just as it
381would have been called by dispatching from a URL, while the analogous
382C<go> allows you to transfer control to another action as if it had
383been reached directly from a URL.
384
385=cut
386
387sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
388
5d91ffe2 389=head2 $c->go( $action [, \@captures, \@arguments ] )
2f381252 390
5d91ffe2 391=head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
2f381252 392
ae0e35ee 393Almost the same as C<detach>, but does a full dispatch like C<visit>,
394instead of just calling the new C<$action> /
395C<$class-E<gt>$method>. This means that C<begin>, C<auto> and the
396method you visit are called, just like a new request.
2f381252 397
398C<$c-E<gt>stash> is kept unchanged.
399
400=cut
401
402sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
403
b4b01a8a 404=head2 $c->response
405
406=head2 $c->res
407
cc95842f 408Returns the current L<Catalyst::Response> object, see there for details.
b4b01a8a 409
410=head2 $c->stash
411
412Returns a hashref to the stash, which may be used to store data and pass
413it between components during a request. You can also set hash keys by
414passing arguments. The stash is automatically sent to the view. The
415stash is cleared at the end of a request; it cannot be used for
86418559 416persistent storage (for this you must use a session; see
417L<Catalyst::Plugin::Session> for a complete system integrated with
418Catalyst).
b4b01a8a 419
420 $c->stash->{foo} = $bar;
421 $c->stash( { moose => 'majestic', qux => 0 } );
422 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
62a6df80 423
b4b01a8a 424 # stash is automatically passed to the view for use in a template
cc95842f 425 $c->forward( 'MyApp::View::TT' );
b4b01a8a 426
427=cut
428
4090e3bb 429around stash => sub {
430 my $orig = shift;
b4b01a8a 431 my $c = shift;
4090e3bb 432 my $stash = $orig->($c);
b4b01a8a 433 if (@_) {
4090e3bb 434 my $new_stash = @_ > 1 ? {@_} : $_[0];
435 croak('stash takes a hash or hashref') unless ref $new_stash;
436 foreach my $key ( keys %$new_stash ) {
437 $stash->{$key} = $new_stash->{$key};
b4b01a8a 438 }
439 }
0fc2d522 440
4090e3bb 441 return $stash;
442};
0fc2d522 443
b4b01a8a 444
b5ecfcf0 445=head2 $c->error
0ef52a96 446
b5ecfcf0 447=head2 $c->error($error, ...)
0ef52a96 448
b5ecfcf0 449=head2 $c->error($arrayref)
0ef52a96 450
83a8fcac 451Returns an arrayref containing error messages. If Catalyst encounters an
452error while processing a request, it stores the error in $c->error. This
e7ad3b81 453method should only be used to store fatal error messages.
0ef52a96 454
455 my @error = @{ $c->error };
456
457Add a new error.
458
459 $c->error('Something bad happened');
460
0ef52a96 461=cut
462
463sub error {
464 my $c = shift;
465 if ( $_[0] ) {
466 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
9ce44430 467 croak @$error unless ref $c;
0ef52a96 468 push @{ $c->{error} }, @$error;
469 }
470 elsif ( defined $_[0] ) { $c->{error} = undef }
471 return $c->{error} || [];
472}
473
b4b01a8a 474
475=head2 $c->state
476
477Contains the return value of the last executed action.
478
ca81eb67 479=head2 $c->clear_errors
480
481Clear errors. You probably don't want to clear the errors unless you are
482implementing a custom error screen.
483
484This is equivalent to running
485
486 $c->error(0);
487
488=cut
489
490sub clear_errors {
491 my $c = shift;
492 $c->error(0);
493}
494
2f381252 495# search components given a name and some prefixes
496sub _comp_search_prefixes {
497 my ( $c, $name, @prefixes ) = @_;
498 my $appclass = ref $c || $c;
499 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
cce626ed 500 $filter = qr/$filter/; # Compile regex now rather than once per loop
0ef52a96 501
2f381252 502 # map the original component name to the sub part that we will search against
503 my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
504 grep { /$filter/ } keys %{ $c->components };
0756fe3b 505
2f381252 506 # undef for a name will return all
507 return keys %eligible if !defined $name;
0756fe3b 508
2f381252 509 my $query = ref $name ? $name : qr/^$name$/i;
510 my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
0756fe3b 511
2f381252 512 return map { $c->components->{ $_ } } @result if @result;
0756fe3b 513
2f381252 514 # if we were given a regexp to search against, we're done.
515 return if ref $name;
0756fe3b 516
2f381252 517 # regexp fallback
518 $query = qr/$name/i;
519 @result = map { $c->components->{ $_ } } grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
0756fe3b 520
2f381252 521 # no results? try against full names
522 if( !@result ) {
523 @result = map { $c->components->{ $_ } } grep { m{$query} } keys %eligible;
524 }
0756fe3b 525
2f381252 526 # don't warn if we didn't find any results, it just might not exist
527 if( @result ) {
cce626ed 528 # Disgusting hack to work out correct method name
529 my $warn_for = lc $prefixes[0];
e260802a 530 my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
108201b5 531 (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
532 "component resolution is unreliable and unsafe.";
533 my $short = $result[0];
534 $short =~ s/.*?Model:://;
535 my $shortmess = Carp::shortmess('');
536 if ($shortmess =~ m#Catalyst/Plugin#) {
537 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
538 "plugin's config";
539 } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
540 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
541 "component's config";
542 } else {
cce626ed 543 $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}({'${name}'}), " .
108201b5 544 "but if you really wanted to search, pass in a regexp as the argument " .
cce626ed 545 "like so: \$c->${warn_for}(qr/${name}/)";
108201b5 546 }
547 $c->log->warn( "${msg}$shortmess" );
2f381252 548 }
0756fe3b 549
2f381252 550 return @result;
0756fe3b 551}
552
62a6df80 553# Find possible names for a prefix
3b88a455 554sub _comp_names {
555 my ( $c, @prefixes ) = @_;
3b88a455 556 my $appclass = ref $c || $c;
557
2f381252 558 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
3b88a455 559
2f381252 560 my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes );
3b88a455 561 return @names;
562}
563
197bd788 564# Filter a component before returning by calling ACCEPT_CONTEXT if available
565sub _filter_component {
566 my ( $c, $comp, @args ) = @_;
2f381252 567
8abaac85 568 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
197bd788 569 return $comp->ACCEPT_CONTEXT( $c, @args );
570 }
62a6df80 571
2f381252 572 return $comp;
197bd788 573}
574
f7b672ef 575=head2 COMPONENT ACCESSORS
0ef52a96 576
b5ecfcf0 577=head2 $c->controller($name)
af3ff00e 578
0ef52a96 579Gets a L<Catalyst::Controller> instance by name.
af3ff00e 580
581 $c->controller('Foo')->do_stuff;
582
86418559 583If the name is omitted, will return the controller for the dispatched
584action.
649fd1fa 585
2f381252 586If you want to search for controllers, pass in a regexp as the argument.
587
588 # find all controllers that start with Foo
589 my @foo_controllers = $c->controller(qr{^Foo});
590
591
af3ff00e 592=cut
593
594sub controller {
197bd788 595 my ( $c, $name, @args ) = @_;
2f381252 596
597 if( $name ) {
598 my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
599 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
600 return $c->_filter_component( $result[ 0 ], @args );
601 }
602
197bd788 603 return $c->component( $c->action->class );
af3ff00e 604}
605
b5ecfcf0 606=head2 $c->model($name)
fc7ec1d9 607
0ef52a96 608Gets a L<Catalyst::Model> instance by name.
609
610 $c->model('Foo')->do_stuff;
fc7ec1d9 611
72f87c4b 612Any extra arguments are directly passed to ACCEPT_CONTEXT.
613
62a6df80 614If the name is omitted, it will look for
2f381252 615 - a model object in $c->stash->{current_model_instance}, then
a3b71f0f 616 - a model name in $c->stash->{current_model}, then
617 - a config setting 'default_model', or
618 - check if there is only one model, and return it if that's the case.
649fd1fa 619
2f381252 620If you want to search for models, pass in a regexp as the argument.
621
622 # find all models that start with Foo
623 my @foo_models = $c->model(qr{^Foo});
624
fc7ec1d9 625=cut
626
0ef52a96 627sub model {
197bd788 628 my ( $c, $name, @args ) = @_;
2f381252 629
630 if( $name ) {
631 my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
632 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
633 return $c->_filter_component( $result[ 0 ], @args );
634 }
635
a3b71f0f 636 if (ref $c) {
62a6df80 637 return $c->stash->{current_model_instance}
a3b71f0f 638 if $c->stash->{current_model_instance};
639 return $c->model( $c->stash->{current_model} )
640 if $c->stash->{current_model};
a3b71f0f 641 }
72f87c4b 642 return $c->model( $c->config->{default_model} )
643 if $c->config->{default_model};
3b88a455 644
2f381252 645 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
3b88a455 646
2f381252 647 if( $rest ) {
108201b5 648 $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
2f381252 649 $c->log->warn( '* $c->config->{default_model} # the name of the default model to use' );
650 $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
651 $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
11c270bd 652 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
2f381252 653 }
3b88a455 654
2f381252 655 return $c->_filter_component( $comp );
3b88a455 656}
657
b4b01a8a 658
b5ecfcf0 659=head2 $c->view($name)
0ef52a96 660
661Gets a L<Catalyst::View> instance by name.
fc7ec1d9 662
0ef52a96 663 $c->view('Foo')->do_stuff;
fc7ec1d9 664
72f87c4b 665Any extra arguments are directly passed to ACCEPT_CONTEXT.
666
62a6df80 667If the name is omitted, it will look for
2f381252 668 - a view object in $c->stash->{current_view_instance}, then
a3b71f0f 669 - a view name in $c->stash->{current_view}, then
670 - a config setting 'default_view', or
671 - check if there is only one view, and return it if that's the case.
649fd1fa 672
2f381252 673If you want to search for views, pass in a regexp as the argument.
674
675 # find all views that start with Foo
676 my @foo_views = $c->view(qr{^Foo});
677
fc7ec1d9 678=cut
679
0ef52a96 680sub view {
197bd788 681 my ( $c, $name, @args ) = @_;
2f381252 682
683 if( $name ) {
684 my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
685 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
686 return $c->_filter_component( $result[ 0 ], @args );
687 }
688
a3b71f0f 689 if (ref $c) {
62a6df80 690 return $c->stash->{current_view_instance}
a3b71f0f 691 if $c->stash->{current_view_instance};
692 return $c->view( $c->stash->{current_view} )
693 if $c->stash->{current_view};
a3b71f0f 694 }
72f87c4b 695 return $c->view( $c->config->{default_view} )
696 if $c->config->{default_view};
2f381252 697
698 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
699
700 if( $rest ) {
701 $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
702 $c->log->warn( '* $c->config->{default_view} # the name of the default view to use' );
703 $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
704 $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
11c270bd 705 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
2f381252 706 }
707
708 return $c->_filter_component( $comp );
709}
710
711=head2 $c->controllers
712
713Returns the available names which can be passed to $c->controller
714
715=cut
716
717sub controllers {
718 my ( $c ) = @_;
719 return $c->_comp_names(qw/Controller C/);
0ef52a96 720}
fbcc39ad 721
b4b01a8a 722=head2 $c->models
723
724Returns the available names which can be passed to $c->model
725
726=cut
727
728sub models {
729 my ( $c ) = @_;
730 return $c->_comp_names(qw/Model M/);
731}
732
733
3b88a455 734=head2 $c->views
735
736Returns the available names which can be passed to $c->view
737
738=cut
739
740sub views {
741 my ( $c ) = @_;
742 return $c->_comp_names(qw/View V/);
743}
744
b4b01a8a 745=head2 $c->comp($name)
746
747=head2 $c->component($name)
748
cc95842f 749Gets a component object by name. This method is not recommended,
b4b01a8a 750unless you want to get a specific component by full
cc95842f 751class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
b4b01a8a 752should be used instead.
753
2f381252 754If C<$name> is a regexp, a list of components matched against the full
755component name will be returned.
756
b4b01a8a 757=cut
758
759sub component {
2f381252 760 my ( $c, $name, @args ) = @_;
b4b01a8a 761
2f381252 762 if( $name ) {
763 my $comps = $c->components;
b4b01a8a 764
2f381252 765 if( !ref $name ) {
766 # is it the exact name?
767 return $c->_filter_component( $comps->{ $name }, @args )
768 if exists $comps->{ $name };
b4b01a8a 769
2f381252 770 # perhaps we just omitted "MyApp"?
771 my $composed = ( ref $c || $c ) . "::${name}";
772 return $c->_filter_component( $comps->{ $composed }, @args )
773 if exists $comps->{ $composed };
b4b01a8a 774
2f381252 775 # search all of the models, views and controllers
776 my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
777 return $c->_filter_component( $comp, @args ) if $comp;
778 }
779
780 # This is here so $c->comp( '::M::' ) works
781 my $query = ref $name ? $name : qr{$name}i;
b4b01a8a 782
2f381252 783 my @result = grep { m{$query} } keys %{ $c->components };
784 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
b4b01a8a 785
2f381252 786 if( $result[ 0 ] ) {
108201b5 787 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
2f381252 788 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
789 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
790 return $c->_filter_component( $result[ 0 ], @args );
791 }
792
793 # I would expect to return an empty list here, but that breaks back-compat
b4b01a8a 794 }
795
2f381252 796 # fallback
b4b01a8a 797 return sort keys %{ $c->components };
798}
799
b4b01a8a 800=head2 CLASS DATA AND HELPER CLASSES
fbcc39ad 801
b5ecfcf0 802=head2 $c->config
fbcc39ad 803
0ef52a96 804Returns or takes a hashref containing the application's configuration.
805
61b1d329 806 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
81557adf 807
cc95842f 808You can also use a C<YAML>, C<XML> or C<Config::General> config file
b3542016 809like myapp.conf in your applications home directory. See
cc95842f 810L<Catalyst::Plugin::ConfigLoader>.
a6ad13b6 811
b3542016 812=head3 Cascading configuration.
a6ad13b6 813
b3542016 814The config method is present on all Catalyst components, and configuration
815will be merged when an application is started. Configuration loaded with
816L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
62a6df80 817followed by configuration in your top level C<MyApp> class. These two
b3542016 818configurations are merged, and then configuration data whos hash key matches a
819component name is merged with configuration for that component.
820
821The configuration for a component is then passed to the C<new> method when a
822component is constructed.
823
824For example:
825
826 MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
827 MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
62a6df80 828
829will mean that C<MyApp::Model::Foo> receives the following data when
b3542016 830constructed:
831
832 MyApp::Model::Foo->new({
833 bar => 'baz',
834 quux => 'frob',
835 overrides => 'me',
836 });
b4b01a8a 837
3643e890 838=cut
839
4090e3bb 840around config => sub {
841 my $orig = shift;
3643e890 842 my $c = shift;
843
fcf89172 844 croak('Setting config after setup has been run is not allowed.')
845 if ( @_ and $c->setup_finished );
3643e890 846
4090e3bb 847 $c->$orig(@_);
848};
3643e890 849
b5ecfcf0 850=head2 $c->log
0ef52a96 851
86418559 852Returns the logging object instance. Unless it is already set, Catalyst
853sets this up with a L<Catalyst::Log> object. To use your own log class,
854set the logger with the C<< __PACKAGE__->log >> method prior to calling
9e7673af 855C<< __PACKAGE__->setup >>.
856
857 __PACKAGE__->log( MyLogger->new );
858 __PACKAGE__->setup;
859
860And later:
0ef52a96 861
ae1e6b59 862 $c->log->info( 'Now logging with my own logger!' );
0ef52a96 863
86418559 864Your log class should implement the methods described in
865L<Catalyst::Log>.
af3ff00e 866
b4b01a8a 867
868=head2 $c->debug
869
c74d3f0c 870Returns 1 if debug mode is enabled, 0 otherwise.
b4b01a8a 871
7e5c67f2 872You can enable debug mode in several ways:
873
874=over
875
62a6df80 876=item By calling myapp_server.pl with the -d flag
877
7e5c67f2 878=item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
879
880=item The -Debug option in your MyApp.pm
881
8eae92ad 882=item By declaring C<sub debug { 1 }> in your MyApp.pm.
7e5c67f2 883
884=back
c74d3f0c 885
8eae92ad 886Calling C<< $c->debug(1) >> has no effect.
e80e8542 887
af3ff00e 888=cut
889
b4b01a8a 890sub debug { 0 }
891
892=head2 $c->dispatcher
893
2887a7f1 894Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
b4b01a8a 895
896=head2 $c->engine
897
2887a7f1 898Returns the engine instance. See L<Catalyst::Engine>.
b4b01a8a 899
900
f7b672ef 901=head2 UTILITY METHODS
66e28e3f 902
b5ecfcf0 903=head2 $c->path_to(@path)
01033d73 904
cc95842f 905Merges C<@path> with C<< $c->config->{home} >> and returns a
afbb9aa3 906L<Path::Class::Dir> object.
01033d73 907
908For example:
909
910 $c->path_to( 'db', 'sqlite.db' );
911
912=cut
913
914sub path_to {
915 my ( $c, @path ) = @_;
a738ab68 916 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
01033d73 917 if ( -d $path ) { return $path }
a738ab68 918 else { return Path::Class::File->new( $c->config->{home}, @path ) }
01033d73 919}
920
b5ecfcf0 921=head2 $c->plugin( $name, $class, @args )
0ef52a96 922
10011c19 923Helper method for plugins. It creates a class data accessor/mutator and
ae1e6b59 924loads and instantiates the given class.
0ef52a96 925
926 MyApp->plugin( 'prototype', 'HTML::Prototype' );
927
928 $c->prototype->define_javascript_functions;
4e68badc 929
6b2a933b 930B<Note:> This method of adding plugins is deprecated. The ability
4e68badc 931to add plugins like this B<will be removed> in a Catalyst 5.81.
6b2a933b 932Please do not use this functionality in new code.
0ef52a96 933
934=cut
935
936sub plugin {
937 my ( $class, $name, $plugin, @args ) = @_;
6b2a933b 938
4e68badc 939 # See block comment in t/unit_core_plugin.t
b3542016 940 $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
4e68badc 941
97b58e17 942 $class->_register_plugin( $plugin, 1 );
0ef52a96 943
944 eval { $plugin->import };
945 $class->mk_classdata($name);
946 my $obj;
947 eval { $obj = $plugin->new(@args) };
948
949 if ($@) {
950 Catalyst::Exception->throw( message =>
951 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
952 }
953
954 $class->$name($obj);
955 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
956 if $class->debug;
957}
958
b5ecfcf0 959=head2 MyApp->setup
fbcc39ad 960
e7f1cf73 961Initializes the dispatcher and engine, loads any plugins, and loads the
ae1e6b59 962model, view, and controller components. You may also specify an array
963of plugins to load here, if you choose to not load them in the C<use
964Catalyst> line.
fbcc39ad 965
0ef52a96 966 MyApp->setup;
967 MyApp->setup( qw/-Debug/ );
fbcc39ad 968
969=cut
970
971sub setup {
0319a12c 972 my ( $class, @arguments ) = @_;
c2f3cc1b 973 croak('Running setup more than once')
974 if ( $class->setup_finished );
5168a5fc 975
fbcc39ad 976 unless ( $class->isa('Catalyst') ) {
953b0e15 977
fbcc39ad 978 Catalyst::Exception->throw(
979 message => qq/'$class' does not inherit from Catalyst/ );
1c99e125 980 }
0319a12c 981
fbcc39ad 982 if ( $class->arguments ) {
983 @arguments = ( @arguments, @{ $class->arguments } );
984 }
985
986 # Process options
987 my $flags = {};
988
989 foreach (@arguments) {
990
991 if (/^-Debug$/) {
992 $flags->{log} =
993 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
994 }
995 elsif (/^-(\w+)=?(.*)$/) {
996 $flags->{ lc $1 } = $2;
997 }
998 else {
999 push @{ $flags->{plugins} }, $_;
1000 }
1001 }
1002
99f187d6 1003 $class->setup_home( delete $flags->{home} );
1004
fbcc39ad 1005 $class->setup_log( delete $flags->{log} );
1006 $class->setup_plugins( delete $flags->{plugins} );
1007 $class->setup_dispatcher( delete $flags->{dispatcher} );
1008 $class->setup_engine( delete $flags->{engine} );
dc5f035e 1009 $class->setup_stats( delete $flags->{stats} );
fbcc39ad 1010
1011 for my $flag ( sort keys %{$flags} ) {
1012
1013 if ( my $code = $class->can( 'setup_' . $flag ) ) {
1014 &$code( $class, delete $flags->{$flag} );
1015 }
1016 else {
1017 $class->log->warn(qq/Unknown flag "$flag"/);
1018 }
1019 }
1020
0eb4af72 1021 eval { require Catalyst::Devel; };
1022 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1023 $class->log->warn(<<"EOF");
4ff0d824 1024You are running an old script!
1025
34a83d89 1026 Please update by running (this will overwrite existing files):
1027 catalyst.pl -force -scripts $class
1028
1029 or (this will not overwrite existing files):
1030 catalyst.pl -scripts $class
1cf0345b 1031
4ff0d824 1032EOF
0eb4af72 1033 }
62a6df80 1034
fbcc39ad 1035 if ( $class->debug ) {
6601f2ad 1036 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
fbcc39ad 1037
1038 if (@plugins) {
39fc2ce1 1039 my $column_width = Catalyst::Utils::term_width() - 6;
1040 my $t = Text::SimpleTable->new($column_width);
8c113188 1041 $t->row($_) for @plugins;
1cf0345b 1042 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
fbcc39ad 1043 }
1044
1045 my $dispatcher = $class->dispatcher;
1046 my $engine = $class->engine;
1047 my $home = $class->config->{home};
1048
01ce7075 1049 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1050 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
fbcc39ad 1051
1052 $home
1053 ? ( -d $home )
1054 ? $class->log->debug(qq/Found home "$home"/)
1055 : $class->log->debug(qq/Home "$home" doesn't exist/)
1056 : $class->log->debug(q/Couldn't find home/);
1057 }
1058
54f4bfef 1059 # Call plugins setup, this is stupid and evil.
16b7c476 1060 # Also screws C3 badly on 5.10, hack to avoid.
fbcc39ad 1061 {
1062 no warnings qw/redefine/;
1063 local *setup = sub { };
16b7c476 1064 $class->setup unless $Catalyst::__AM_RESTARTING;
fbcc39ad 1065 }
1066
1067 # Initialize our data structure
1068 $class->components( {} );
1069
1070 $class->setup_components;
1071
1072 if ( $class->debug ) {
39fc2ce1 1073 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1074 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
684d10ed 1075 for my $comp ( sort keys %{ $class->components } ) {
1076 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1077 $t->row( $comp, $type );
1078 }
1cf0345b 1079 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
8c113188 1080 if ( keys %{ $class->components } );
fbcc39ad 1081 }
1082
1083 # Add our self to components, since we are also a component
96d8d513 1084 if( $class->isa('Catalyst::Controller') ){
1085 $class->components->{$class} = $class;
1086 }
fbcc39ad 1087
1088 $class->setup_actions;
1089
1090 if ( $class->debug ) {
1091 my $name = $class->config->{name} || 'Application';
1092 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1093 }
1094 $class->log->_flush() if $class->log->can('_flush');
3643e890 1095
62a6df80 1096 # Make sure that the application class becomes immutable at this point,
1097 # which ensures that it gets an inlined constructor. This means that it
3d041c32 1098 # works even if the user has added a plugin which contains a new method.
1099 # Note however that we have to do the work on scope end, so that method
62a6df80 1100 # modifiers work correctly in MyApp (as you have to call setup _before_
3d041c32 1101 # applying modifiers).
edb20ed3 1102 Scope::Upper::reap(sub {
e106a59f 1103 my $meta = Class::MOP::get_metaclass_by_name($class);
05d79b22 1104 $meta->make_immutable(replace_constructor => 1) unless $meta->is_immutable;
d134bcca 1105 }, Scope::Upper::SCOPE(1));
3d041c32 1106
a5d07d29 1107 $class->setup_finalize;
1108}
1109
23c63a17 1110
1111=head2 $app->setup_finalize
1112
1113A hook to attach modifiers to.
4bc471c9 1114Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup.
23c63a17 1115Also better than C< setup_finished(); >, as that is a getter method.
1116
1117 sub setup_finalize {
1118
1119 my $app = shift;
1120
1121 ## do stuff, i.e., determine a primary key column for sessions stored in a DB
1122
1123 $app->next::method(@_);
1124
1125
1126 }
1127
1128=cut
1129
a5d07d29 1130sub setup_finalize {
1131 my ($class) = @_;
3643e890 1132 $class->setup_finished(1);
fbcc39ad 1133}
1134
8a27f860 1135=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1136
73664287 1137=head2 $c->uri_for( $path, @args?, \%query_values? )
fbcc39ad 1138
8a27f860 1139=over
fbcc39ad 1140
8a27f860 1141=item $action
8dc69021 1142
8a27f860 1143A Catalyst::Action object representing the Catalyst action you want to
1144create a URI for. To get one for an action in the current controller,
1145use C<< $c->action('someactionname') >>. To get one from different
1146controller, fetch the controller using C<< $c->controller() >>, then
1147call C<action_for> on it.
ea0e58d9 1148
9df7c5d9 1149You can maintain the arguments captured by an action (e.g.: Regex, Chained)
62a6df80 1150using C<< $c->req->captures >>.
9df7c5d9 1151
1152 # For the current action
1153 $c->uri_for($c->action, $c->req->captures);
62a6df80 1154
9df7c5d9 1155 # For the Foo action in the Bar controller
1156 $c->uri_for($c->controller->('Bar')->action_for('Foo'), $c->req->captures);
1157
d5e3d528 1158=back
1159
4cf1dd00 1160=cut
1161
fbcc39ad 1162sub uri_for {
00e6a2b7 1163 my ( $c, $path, @args ) = @_;
00e6a2b7 1164
7e95ba12 1165 if ( blessed($path) ) { # action object
ea0e58d9 1166 my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
1167 ? shift(@args)
1168 : [] );
aa7e913e 1169 my $action = $path;
1170 $path = $c->dispatcher->uri_for_action($action, $captures);
1171 if (not defined $path) {
1172 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1173 if $c->debug;
1174 return undef;
1175 }
81e75875 1176 $path = '/' if $path eq '';
ea0e58d9 1177 }
1178
51674a63 1179 undef($path) if (defined $path && $path eq '');
00e6a2b7 1180
97b58e17 1181 my $params =
1182 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
8327e2e2 1183
cbb93105 1184 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
51674a63 1185 s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
1186
1187 unshift(@args, $path);
1188
1189 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1190 my $namespace = $c->namespace;
1191 if (defined $path) { # cheesy hack to handle path '../foo'
1192 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 1193 }
51674a63 1194 unshift(@args, $namespace || '');
1195 }
62a6df80 1196
189e2a51 1197 # join args with '/', or a blank string
51674a63 1198 my $args = join('/', grep { defined($_) } @args);
1199 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
7a2295bc 1200 $args =~ s!^/+!!;
51674a63 1201 my $base = $c->req->base;
1202 my $class = ref($base);
1203 $base =~ s{(?<!/)$}{/};
1204
1205 my $query = '';
1206
1207 if (my @keys = keys %$params) {
1208 # somewhat lifted from URI::_query's query_form
1209 $query = '?'.join('&', map {
2f381252 1210 my $val = $params->{$_};
51674a63 1211 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1212 s/ /+/g;
1213 my $key = $_;
51674a63 1214 $val = '' unless defined $val;
1215 (map {
1216 $_ = "$_";
0ce485e9 1217 utf8::encode( $_ ) if utf8::is_utf8($_);
51674a63 1218 # using the URI::Escape pattern here so utf8 chars survive
1219 s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1220 s/ /+/g;
1221 "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1222 } @keys);
1223 }
1224
1225 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1226 $res;
fbcc39ad 1227}
1228
833b385e 1229=head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
1230
1231=head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
1232
1233=over
1234
1235=item $path
1236
1237A private path to the Catalyst action you want to create a URI for.
1238
1239This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1240>> and passing the resulting C<$action> and the remaining arguments to C<<
1241$c->uri_for >>.
1242
1243You can also pass in a Catalyst::Action object, in which case it is passed to
1244C<< $c->uri_for >>.
1245
1246=back
1247
1248=cut
1249
1250sub uri_for_action {
1251 my ( $c, $path, @args ) = @_;
62a6df80 1252 my $action = blessed($path)
1253 ? $path
833b385e 1254 : $c->dispatcher->get_action_by_path($path);
4ac0b9cb 1255 unless (defined $action) {
1256 croak "Can't find action for path '$path'";
1257 }
833b385e 1258 return $c->uri_for( $action, @args );
1259}
1260
b5ecfcf0 1261=head2 $c->welcome_message
ab2374d3 1262
1263Returns the Catalyst welcome HTML page.
1264
1265=cut
1266
1267sub welcome_message {
bf1f2c60 1268 my $c = shift;
1269 my $name = $c->config->{name};
1270 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1271 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1272 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1273 return <<"EOF";
80cdbbff 1274<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1275 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1276<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1277 <head>
85d9fce6 1278 <meta http-equiv="Content-Language" content="en" />
1279 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1280 <title>$name on Catalyst $VERSION</title>
1281 <style type="text/css">
1282 body {
ab2374d3 1283 color: #000;
1284 background-color: #eee;
1285 }
1286 div#content {
1287 width: 640px;
80cdbbff 1288 margin-left: auto;
1289 margin-right: auto;
ab2374d3 1290 margin-top: 10px;
1291 margin-bottom: 10px;
1292 text-align: left;
1293 background-color: #ccc;
1294 border: 1px solid #aaa;
ab2374d3 1295 }
d84c4dab 1296 p, h1, h2 {
ab2374d3 1297 margin-left: 20px;
1298 margin-right: 20px;
16215972 1299 font-family: verdana, tahoma, sans-serif;
ab2374d3 1300 }
d84c4dab 1301 a {
1302 font-family: verdana, tahoma, sans-serif;
1303 }
d114e033 1304 :link, :visited {
1305 text-decoration: none;
1306 color: #b00;
1307 border-bottom: 1px dotted #bbb;
1308 }
1309 :link:hover, :visited:hover {
d114e033 1310 color: #555;
1311 }
ab2374d3 1312 div#topbar {
1313 margin: 0px;
1314 }
3e82a295 1315 pre {
3e82a295 1316 margin: 10px;
1317 padding: 8px;
1318 }
ab2374d3 1319 div#answers {
1320 padding: 8px;
1321 margin: 10px;
d114e033 1322 background-color: #fff;
ab2374d3 1323 border: 1px solid #aaa;
ab2374d3 1324 }
1325 h1 {
33108eaf 1326 font-size: 0.9em;
1327 font-weight: normal;
ab2374d3 1328 text-align: center;
1329 }
1330 h2 {
1331 font-size: 1.0em;
1332 }
1333 p {
1334 font-size: 0.9em;
1335 }
ae7c5252 1336 p img {
1337 float: right;
1338 margin-left: 10px;
1339 }
9619f23c 1340 span#appname {
1341 font-weight: bold;
33108eaf 1342 font-size: 1.6em;
ab2374d3 1343 }
1344 </style>
1345 </head>
1346 <body>
1347 <div id="content">
1348 <div id="topbar">
9619f23c 1349 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1350 $VERSION</h1>
ab2374d3 1351 </div>
1352 <div id="answers">
ae7c5252 1353 <p>
80cdbbff 1354 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1355 </p>
596aaffe 1356 <p>Welcome to the world of Catalyst.
f92fd545 1357 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1358 framework will make web development something you had
60dd6e1d 1359 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1360 <h2>What to do now?</h2>
4b8cb778 1361 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1362 We do, however, provide you with a few starting points.</p>
1363 <p>If you want to jump right into web development with Catalyst
2f381252 1364 you might want to start with a tutorial.</p>
b607f8a0 1365<pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
596aaffe 1366</pre>
1367<p>Afterwards you can go on to check out a more complete look at our features.</p>
1368<pre>
b607f8a0 1369<code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1370<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1371</code></pre>
ab2374d3 1372 <h2>What to do next?</h2>
f5681c92 1373 <p>Next it's time to write an actual application. Use the
80cdbbff 1374 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
60dd6e1d 1375 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1376 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
bf1f2c60 1377 they can save you a lot of work.</p>
1378 <pre><code>script/${prefix}_create.pl -help</code></pre>
1379 <p>Also, be sure to check out the vast and growing
802bf2cb 1380 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
bf1f2c60 1381 you are likely to find what you need there.
f5681c92 1382 </p>
1383
82245cc4 1384 <h2>Need help?</h2>
f5681c92 1385 <p>Catalyst has a very active community. Here are the main places to
1386 get in touch with us.</p>
16215972 1387 <ul>
1388 <li>
2b9a7d76 1389 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1390 </li>
1391 <li>
6d4c3368 1392 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1393 </li>
1394 <li>
4eaf7c88 1395 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1396 </li>
1397 </ul>
ab2374d3 1398 <h2>In conclusion</h2>
62a6df80 1399 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1400 as we enjoyed making it. Please contact us if you have ideas
1401 for improvement or other feedback.</p>
ab2374d3 1402 </div>
1403 </div>
1404 </body>
1405</html>
1406EOF
1407}
1408
fbcc39ad 1409=head1 INTERNAL METHODS
1410
ae1e6b59 1411These methods are not meant to be used by end users.
1412
b5ecfcf0 1413=head2 $c->components
fbcc39ad 1414
e7f1cf73 1415Returns a hash of components.
fbcc39ad 1416
b5ecfcf0 1417=head2 $c->context_class
1f9cb7c1 1418
e7f1cf73 1419Returns or sets the context class.
1f9cb7c1 1420
b5ecfcf0 1421=head2 $c->counter
fbcc39ad 1422
ae1e6b59 1423Returns a hashref containing coderefs and execution counts (needed for
1424deep recursion detection).
fbcc39ad 1425
b5ecfcf0 1426=head2 $c->depth
fbcc39ad 1427
e7f1cf73 1428Returns the number of actions on the current internal execution stack.
fbcc39ad 1429
b5ecfcf0 1430=head2 $c->dispatch
fbcc39ad 1431
e7f1cf73 1432Dispatches a request to actions.
fbcc39ad 1433
1434=cut
1435
1436sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1437
b5ecfcf0 1438=head2 $c->dispatcher_class
1f9cb7c1 1439
e7f1cf73 1440Returns or sets the dispatcher class.
1f9cb7c1 1441
b5ecfcf0 1442=head2 $c->dump_these
7f92deef 1443
ae1e6b59 1444Returns a list of 2-element array references (name, structure) pairs
1445that will be dumped on the error page in debug mode.
7f92deef 1446
1447=cut
1448
1449sub dump_these {
1450 my $c = shift;
62a6df80 1451 [ Request => $c->req ],
1452 [ Response => $c->res ],
052a2d89 1453 [ Stash => $c->stash ],
1454 [ Config => $c->config ];
7f92deef 1455}
1456
b5ecfcf0 1457=head2 $c->engine_class
1f9cb7c1 1458
e7f1cf73 1459Returns or sets the engine class.
1f9cb7c1 1460
b5ecfcf0 1461=head2 $c->execute( $class, $coderef )
fbcc39ad 1462
0ef52a96 1463Execute a coderef in given class and catch exceptions. Errors are available
1464via $c->error.
fbcc39ad 1465
1466=cut
1467
1468sub execute {
1469 my ( $c, $class, $code ) = @_;
858828dd 1470 $class = $c->component($class) || $class;
fbcc39ad 1471 $c->state(0);
a0eca838 1472
197bd788 1473 if ( $c->depth >= $RECURSION ) {
f3414019 1474 my $action = $code->reverse();
91d08727 1475 $action = "/$action" unless $action =~ /->/;
f3414019 1476 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 1477 $c->log->error($error);
1478 $c->error($error);
1479 $c->state(0);
1480 return $c->state;
1481 }
1482
dc5f035e 1483 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 1484
8767c5a3 1485 push( @{ $c->stack }, $code );
62a6df80 1486
6f3df815 1487 no warnings 'recursion';
f3414019 1488 eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
22247e54 1489
dc5f035e 1490 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
62a6df80 1491
a6724a82 1492 my $last = pop( @{ $c->stack } );
fbcc39ad 1493
1494 if ( my $error = $@ ) {
2f381252 1495 if ( !ref($error) and $error eq $DETACH ) {
1496 die $DETACH if($c->depth > 1);
1497 }
55424863 1498 elsif ( !ref($error) and $error eq $GO ) {
1499 die $GO if($c->depth > 0);
1500 }
fbcc39ad 1501 else {
1502 unless ( ref $error ) {
91d08727 1503 no warnings 'uninitialized';
fbcc39ad 1504 chomp $error;
f59def82 1505 my $class = $last->class;
1506 my $name = $last->name;
1507 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 1508 }
fbcc39ad 1509 $c->error($error);
1510 $c->state(0);
1511 }
1512 }
1513 return $c->state;
1514}
1515
7a7d7af5 1516sub _stats_start_execute {
1517 my ( $c, $code ) = @_;
1518
a6724a82 1519 return if ( ( $code->name =~ /^_.*/ )
1520 && ( !$c->config->{show_internal_actions} ) );
7a7d7af5 1521
f3414019 1522 my $action_name = $code->reverse();
1523 $c->counter->{$action_name}++;
7a7d7af5 1524
f3414019 1525 my $action = $action_name;
a6724a82 1526 $action = "/$action" unless $action =~ /->/;
1527
7a7d7af5 1528 # determine if the call was the result of a forward
1529 # this is done by walking up the call stack and looking for a calling
1530 # sub of Catalyst::forward before the eval
1531 my $callsub = q{};
1532 for my $index ( 2 .. 11 ) {
1533 last
1534 if ( ( caller($index) )[0] eq 'Catalyst'
1535 && ( caller($index) )[3] eq '(eval)' );
1536
1537 if ( ( caller($index) )[3] =~ /forward$/ ) {
1538 $callsub = ( caller($index) )[3];
1539 $action = "-> $action";
1540 last;
1541 }
1542 }
1543
f3414019 1544 my $uid = $action_name . $c->counter->{$action_name};
74efc144 1545
a6724a82 1546 # is this a root-level call or a forwarded call?
1547 if ( $callsub =~ /forward$/ ) {
1548
1549 # forward, locate the caller
1550 if ( my $parent = $c->stack->[-1] ) {
69d8f33c 1551 $c->stats->profile(
62a6df80 1552 begin => $action,
69d8f33c 1553 parent => "$parent" . $c->counter->{"$parent"},
1554 uid => $uid,
1555 );
7a7d7af5 1556 }
1557 else {
1558
a6724a82 1559 # forward with no caller may come from a plugin
69d8f33c 1560 $c->stats->profile(
1561 begin => $action,
1562 uid => $uid,
1563 );
7a7d7af5 1564 }
1565 }
a6724a82 1566 else {
62a6df80 1567
a6724a82 1568 # root-level call
69d8f33c 1569 $c->stats->profile(
1570 begin => $action,
1571 uid => $uid,
1572 );
a6724a82 1573 }
dc5f035e 1574 return $action;
7a7d7af5 1575
7a7d7af5 1576}
1577
1578sub _stats_finish_execute {
1579 my ( $c, $info ) = @_;
69d8f33c 1580 $c->stats->profile( end => $info );
7a7d7af5 1581}
1582
3d0d6d21 1583=head2 $c->_localize_fields( sub { }, \%keys );
1584
1585=cut
1586
e63bdf38 1587#Why does this exist? This is no longer safe and WILL NOT WORK.
1588# it doesnt seem to be used anywhere. can we remove it?
3d0d6d21 1589sub _localize_fields {
1590 my ( $c, $localized, $code ) = ( @_ );
1591
1592 my $request = delete $localized->{request} || {};
1593 my $response = delete $localized->{response} || {};
62a6df80 1594
3d0d6d21 1595 local @{ $c }{ keys %$localized } = values %$localized;
1596 local @{ $c->request }{ keys %$request } = values %$request;
1597 local @{ $c->response }{ keys %$response } = values %$response;
1598
1599 $code->();
1600}
1601
b5ecfcf0 1602=head2 $c->finalize
fbcc39ad 1603
e7f1cf73 1604Finalizes the request.
fbcc39ad 1605
1606=cut
1607
1608sub finalize {
1609 my $c = shift;
1610
369c09bc 1611 for my $error ( @{ $c->error } ) {
1612 $c->log->error($error);
1613 }
1614
5050d7a7 1615 # Allow engine to handle finalize flow (for POE)
e63bdf38 1616 my $engine = $c->engine;
1617 if ( my $code = $engine->can('finalize') ) {
1618 $engine->$code($c);
fbcc39ad 1619 }
5050d7a7 1620 else {
fbcc39ad 1621
5050d7a7 1622 $c->finalize_uploads;
fbcc39ad 1623
5050d7a7 1624 # Error
1625 if ( $#{ $c->error } >= 0 ) {
1626 $c->finalize_error;
1627 }
1628
1629 $c->finalize_headers;
fbcc39ad 1630
5050d7a7 1631 # HEAD request
1632 if ( $c->request->method eq 'HEAD' ) {
1633 $c->response->body('');
1634 }
1635
1636 $c->finalize_body;
1637 }
62a6df80 1638
1639 if ($c->use_stats) {
596677b6 1640 my $elapsed = sprintf '%f', $c->stats->elapsed;
12bf12c0 1641 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
908e3d9e 1642 $c->log->info(
62a6df80 1643 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
908e3d9e 1644 }
fbcc39ad 1645
1646 return $c->response->status;
1647}
1648
b5ecfcf0 1649=head2 $c->finalize_body
fbcc39ad 1650
e7f1cf73 1651Finalizes body.
fbcc39ad 1652
1653=cut
1654
1655sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1656
b5ecfcf0 1657=head2 $c->finalize_cookies
fbcc39ad 1658
e7f1cf73 1659Finalizes cookies.
fbcc39ad 1660
1661=cut
1662
147821ea 1663sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 1664
b5ecfcf0 1665=head2 $c->finalize_error
fbcc39ad 1666
e7f1cf73 1667Finalizes error.
fbcc39ad 1668
1669=cut
1670
1671sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1672
b5ecfcf0 1673=head2 $c->finalize_headers
fbcc39ad 1674
e7f1cf73 1675Finalizes headers.
fbcc39ad 1676
1677=cut
1678
1679sub finalize_headers {
1680 my $c = shift;
1681
e63bdf38 1682 my $response = $c->response; #accessor calls can add up?
1683
fbcc39ad 1684 # Check if we already finalized headers
6680c772 1685 return if $response->finalized_headers;
fbcc39ad 1686
1687 # Handle redirects
e63bdf38 1688 if ( my $location = $response->redirect ) {
fbcc39ad 1689 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 1690 $response->header( Location => $location );
a7caa492 1691
02570318 1692 if ( !$response->has_body ) {
39655cdc 1693 # Add a default body if none is already present
e63bdf38 1694 $response->body(
e422816e 1695 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
39655cdc 1696 );
1697 }
fbcc39ad 1698 }
1699
1700 # Content-Length
e63bdf38 1701 if ( $response->body && !$response->content_length ) {
775878ac 1702
8f62c91a 1703 # get the length from a filehandle
e63bdf38 1704 if ( blessed( $response->body ) && $response->body->can('read') )
197bd788 1705 {
e63bdf38 1706 my $stat = stat $response->body;
3b6a1db1 1707 if ( $stat && $stat->size > 0 ) {
e63bdf38 1708 $response->content_length( $stat->size );
8f62c91a 1709 }
1710 else {
775878ac 1711 $c->log->warn('Serving filehandle without a content-length');
8f62c91a 1712 }
1713 }
1714 else {
b5d7a61f 1715 # everything should be bytes at this point, but just in case
e63bdf38 1716 $response->content_length( bytes::length( $response->body ) );
8f62c91a 1717 }
fbcc39ad 1718 }
1719
1720 # Errors
e63bdf38 1721 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1722 $response->headers->remove_header("Content-Length");
1723 $response->body('');
fbcc39ad 1724 }
1725
1726 $c->finalize_cookies;
1727
1728 $c->engine->finalize_headers( $c, @_ );
1729
1730 # Done
6680c772 1731 $response->finalized_headers(1);
fbcc39ad 1732}
1733
b5ecfcf0 1734=head2 $c->finalize_output
fbcc39ad 1735
1736An alias for finalize_body.
1737
b5ecfcf0 1738=head2 $c->finalize_read
fbcc39ad 1739
e7f1cf73 1740Finalizes the input after reading is complete.
fbcc39ad 1741
1742=cut
1743
1744sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1745
b5ecfcf0 1746=head2 $c->finalize_uploads
fbcc39ad 1747
ae1e6b59 1748Finalizes uploads. Cleans up any temporary files.
fbcc39ad 1749
1750=cut
1751
1752sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1753
b5ecfcf0 1754=head2 $c->get_action( $action, $namespace )
fbcc39ad 1755
e7f1cf73 1756Gets an action in a given namespace.
fbcc39ad 1757
1758=cut
1759
684d10ed 1760sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 1761
b5ecfcf0 1762=head2 $c->get_actions( $action, $namespace )
a9dc674c 1763
ae1e6b59 1764Gets all actions of a given name in a namespace and all parent
1765namespaces.
a9dc674c 1766
1767=cut
1768
1769sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1770
f7b672ef 1771=head2 $c->handle_request( $class, @arguments )
fbcc39ad 1772
e7f1cf73 1773Called to handle each HTTP request.
fbcc39ad 1774
1775=cut
1776
1777sub handle_request {
1778 my ( $class, @arguments ) = @_;
1779
1780 # Always expect worst case!
1781 my $status = -1;
1782 eval {
dea1884f 1783 if ($class->debug) {
908e3d9e 1784 my $secs = time - $START || 1;
1785 my $av = sprintf '%.3f', $COUNT / $secs;
1786 my $time = localtime time;
1787 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 1788 }
908e3d9e 1789
1790 my $c = $class->prepare(@arguments);
1791 $c->dispatch;
62a6df80 1792 $status = $c->finalize;
fbcc39ad 1793 };
1794
1795 if ( my $error = $@ ) {
1796 chomp $error;
1797 $class->log->error(qq/Caught exception in engine "$error"/);
1798 }
1799
1800 $COUNT++;
62a6df80 1801
6680c772 1802 if(my $coderef = $class->log->can('_flush')){
1803 $class->log->$coderef();
1804 }
fbcc39ad 1805 return $status;
1806}
1807
b5ecfcf0 1808=head2 $c->prepare( @arguments )
fbcc39ad 1809
ae1e6b59 1810Creates a Catalyst context from an engine-specific request (Apache, CGI,
1811etc.).
fbcc39ad 1812
1813=cut
1814
1815sub prepare {
1816 my ( $class, @arguments ) = @_;
1817
6680c772 1818 # XXX
1819 # After the app/ctxt split, this should become an attribute based on something passed
1820 # into the application.
3cec521a 1821 $class->context_class( ref $class || $class ) unless $class->context_class;
62a6df80 1822
6680c772 1823 my $c = $class->context_class->new({});
1824
1825 # For on-demand data
1826 $c->request->_context($c);
1827 $c->response->_context($c);
fbcc39ad 1828
b6d4ee6e 1829 #surely this is not the most efficient way to do things...
dc5f035e 1830 $c->stats($class->stats_class->new)->enable($c->use_stats);
908e3d9e 1831 if ( $c->debug ) {
62a6df80 1832 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 1833 }
1834
e63bdf38 1835 #XXX reuse coderef from can
5050d7a7 1836 # Allow engine to direct the prepare flow (for POE)
1837 if ( $c->engine->can('prepare') ) {
1838 $c->engine->prepare( $c, @arguments );
1839 }
1840 else {
1841 $c->prepare_request(@arguments);
1842 $c->prepare_connection;
1843 $c->prepare_query_parameters;
1844 $c->prepare_headers;
1845 $c->prepare_cookies;
1846 $c->prepare_path;
1847
878b821c 1848 # Prepare the body for reading, either by prepare_body
1849 # or the user, if they are using $c->read
1850 $c->prepare_read;
62a6df80 1851
878b821c 1852 # Parse the body unless the user wants it on-demand
1853 unless ( $c->config->{parse_on_demand} ) {
1854 $c->prepare_body;
1855 }
5050d7a7 1856 }
fbcc39ad 1857
fbcc39ad 1858 my $method = $c->req->method || '';
2f381252 1859 my $path = $c->req->path;
1860 $path = '/' unless length $path;
fbcc39ad 1861 my $address = $c->req->address || '';
1862
e3a13771 1863 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
fbcc39ad 1864 if $c->debug;
1865
e3a13771 1866 $c->prepare_action;
1867
fbcc39ad 1868 return $c;
1869}
1870
b5ecfcf0 1871=head2 $c->prepare_action
fbcc39ad 1872
b4b01a8a 1873Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 1874
1875=cut
1876
1877sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1878
b5ecfcf0 1879=head2 $c->prepare_body
fbcc39ad 1880
e7f1cf73 1881Prepares message body.
fbcc39ad 1882
1883=cut
1884
1885sub prepare_body {
1886 my $c = shift;
1887
0f56bbcf 1888 return if $c->request->_has_body;
fbcc39ad 1889
1890 # Initialize on-demand data
1891 $c->engine->prepare_body( $c, @_ );
1892 $c->prepare_parameters;
1893 $c->prepare_uploads;
1894
0584323b 1895 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1896 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1897 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1898 my $param = $c->req->body_parameters->{$key};
1899 my $value = defined($param) ? $param : '';
1900 $t->row( $key,
1901 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1902 }
1903 $c->log->debug( "Body Parameters are:\n" . $t->draw );
fbcc39ad 1904 }
1905}
1906
b5ecfcf0 1907=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 1908
e7f1cf73 1909Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 1910
b4b01a8a 1911See L<Catalyst::Engine>.
1912
4bd82c41 1913=cut
1914
4f5ebacd 1915sub prepare_body_chunk {
1916 my $c = shift;
4bd82c41 1917 $c->engine->prepare_body_chunk( $c, @_ );
1918}
1919
b5ecfcf0 1920=head2 $c->prepare_body_parameters
fbcc39ad 1921
e7f1cf73 1922Prepares body parameters.
fbcc39ad 1923
1924=cut
1925
1926sub prepare_body_parameters {
1927 my $c = shift;
1928 $c->engine->prepare_body_parameters( $c, @_ );
1929}
1930
b5ecfcf0 1931=head2 $c->prepare_connection
fbcc39ad 1932
e7f1cf73 1933Prepares connection.
fbcc39ad 1934
1935=cut
1936
1937sub prepare_connection {
1938 my $c = shift;
1939 $c->engine->prepare_connection( $c, @_ );
1940}
1941
b5ecfcf0 1942=head2 $c->prepare_cookies
fbcc39ad 1943
e7f1cf73 1944Prepares cookies.
fbcc39ad 1945
1946=cut
1947
1948sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1949
b5ecfcf0 1950=head2 $c->prepare_headers
fbcc39ad 1951
e7f1cf73 1952Prepares headers.
fbcc39ad 1953
1954=cut
1955
1956sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1957
b5ecfcf0 1958=head2 $c->prepare_parameters
fbcc39ad 1959
e7f1cf73 1960Prepares parameters.
fbcc39ad 1961
1962=cut
1963
1964sub prepare_parameters {
1965 my $c = shift;
1966 $c->prepare_body_parameters;
1967 $c->engine->prepare_parameters( $c, @_ );
1968}
1969
b5ecfcf0 1970=head2 $c->prepare_path
fbcc39ad 1971
e7f1cf73 1972Prepares path and base.
fbcc39ad 1973
1974=cut
1975
1976sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1977
b5ecfcf0 1978=head2 $c->prepare_query_parameters
fbcc39ad 1979
e7f1cf73 1980Prepares query parameters.
fbcc39ad 1981
1982=cut
1983
1984sub prepare_query_parameters {
1985 my $c = shift;
1986
1987 $c->engine->prepare_query_parameters( $c, @_ );
1988
0584323b 1989 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1990 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1991 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1992 my $param = $c->req->query_parameters->{$key};
fbcc39ad 1993 my $value = defined($param) ? $param : '';
8c113188 1994 $t->row( $key,
fbcc39ad 1995 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1996 }
0584323b 1997 $c->log->debug( "Query Parameters are:\n" . $t->draw );
fbcc39ad 1998 }
1999}
2000
b5ecfcf0 2001=head2 $c->prepare_read
fbcc39ad 2002
e7f1cf73 2003Prepares the input for reading.
fbcc39ad 2004
2005=cut
2006
2007sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2008
b5ecfcf0 2009=head2 $c->prepare_request
fbcc39ad 2010
e7f1cf73 2011Prepares the engine request.
fbcc39ad 2012
2013=cut
2014
2015sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2016
b5ecfcf0 2017=head2 $c->prepare_uploads
fbcc39ad 2018
e7f1cf73 2019Prepares uploads.
fbcc39ad 2020
2021=cut
2022
2023sub prepare_uploads {
2024 my $c = shift;
2025
2026 $c->engine->prepare_uploads( $c, @_ );
2027
2028 if ( $c->debug && keys %{ $c->request->uploads } ) {
8c113188 2029 my $t = Text::SimpleTable->new(
34d28dfd 2030 [ 12, 'Parameter' ],
2031 [ 26, 'Filename' ],
8c113188 2032 [ 18, 'Type' ],
2033 [ 9, 'Size' ]
2034 );
fbcc39ad 2035 for my $key ( sort keys %{ $c->request->uploads } ) {
2036 my $upload = $c->request->uploads->{$key};
2037 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 2038 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 2039 }
2040 }
2041 $c->log->debug( "File Uploads are:\n" . $t->draw );
2042 }
2043}
2044
b5ecfcf0 2045=head2 $c->prepare_write
fbcc39ad 2046
e7f1cf73 2047Prepares the output for writing.
fbcc39ad 2048
2049=cut
2050
2051sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2052
b5ecfcf0 2053=head2 $c->request_class
1f9cb7c1 2054
e7f1cf73 2055Returns or sets the request class.
1f9cb7c1 2056
b5ecfcf0 2057=head2 $c->response_class
1f9cb7c1 2058
e7f1cf73 2059Returns or sets the response class.
1f9cb7c1 2060
b5ecfcf0 2061=head2 $c->read( [$maxlength] )
fbcc39ad 2062
ae1e6b59 2063Reads a chunk of data from the request body. This method is designed to
2064be used in a while loop, reading C<$maxlength> bytes on every call.
2065C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 2066
cc95842f 2067You have to set C<< MyApp->config->{parse_on_demand} >> to use this
ae1e6b59 2068directly.
fbcc39ad 2069
878b821c 2070Warning: If you use read(), Catalyst will not process the body,
2071so you will not be able to access POST parameters or file uploads via
2072$c->request. You must handle all body parsing yourself.
2073
fbcc39ad 2074=cut
2075
2076sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2077
b5ecfcf0 2078=head2 $c->run
fbcc39ad 2079
2080Starts the engine.
2081
2082=cut
2083
2084sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2085
b5ecfcf0 2086=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 2087
e7f1cf73 2088Sets an action in a given namespace.
fbcc39ad 2089
2090=cut
2091
2092sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2093
b5ecfcf0 2094=head2 $c->setup_actions($component)
fbcc39ad 2095
e7f1cf73 2096Sets up actions for a component.
fbcc39ad 2097
2098=cut
2099
2100sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2101
b5ecfcf0 2102=head2 $c->setup_components
fbcc39ad 2103
86418559 2104Sets up components. Specify a C<setup_components> config option to pass
2105additional options directly to L<Module::Pluggable>. To add additional
2106search paths, specify a key named C<search_extra> as an array
2107reference. Items in the array beginning with C<::> will have the
18de900e 2108application class name prepended to them.
fbcc39ad 2109
62a6df80 2110All components found will also have any
2f381252 2111L<Devel::InnerPackage|inner packages> loaded and set up as components.
2112Note, that modules which are B<not> an I<inner package> of the main
2113file namespace loaded will not be instantiated as components.
2114
fbcc39ad 2115=cut
2116
2117sub setup_components {
2118 my $class = shift;
2119
18de900e 2120 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
2121 my $config = $class->config->{ setup_components };
2122 my $extra = delete $config->{ search_extra } || [];
62a6df80 2123
18de900e 2124 push @paths, @$extra;
62a6df80 2125
364d7324 2126 my $locator = Module::Pluggable::Object->new(
18de900e 2127 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2128 %$config
364d7324 2129 );
b94b200c 2130
2131 my @comps = sort { length $a <=> length $b } $locator->plugins;
2132 my %comps = map { $_ => 1 } @comps;
73e1183e 2133
2134 my $deprecated_component_names = grep { /::[CMV]::/ } @comps;
2135 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2136 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
19a24dbb 2137 ) if $deprecated_component_names;
73e1183e 2138
b94b200c 2139 for my $component ( @comps ) {
dd91afb5 2140
2141 # We pass ignore_loaded here so that overlay files for (e.g.)
2142 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2143 # we know M::P::O found a file on disk so this is safe
2144
f5a4863c 2145 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2146 #Class::MOP::load_class($component);
364d7324 2147
2148 my $module = $class->setup_component( $component );
2149 my %modules = (
2150 $component => $module,
2151 map {
2152 $_ => $class->setup_component( $_ )
62a6df80 2153 } grep {
b94b200c 2154 not exists $comps{$_}
364d7324 2155 } Devel::InnerPackage::list_packages( $component )
2156 );
62a6df80 2157
364d7324 2158 for my $key ( keys %modules ) {
2159 $class->components->{ $key } = $modules{ $key };
fbcc39ad 2160 }
364d7324 2161 }
2162}
fbcc39ad 2163
364d7324 2164=head2 $c->setup_component
fbcc39ad 2165
364d7324 2166=cut
fbcc39ad 2167
2f5cb070 2168sub _controller_init_base_classes {
2169 my ($class, $component) = @_;
2170 foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) {
2171 Moose->init_meta( for_class => $class )
2172 unless find_meta($class);
2173 }
2174}
2175
364d7324 2176sub setup_component {
2177 my( $class, $component ) = @_;
fbcc39ad 2178
364d7324 2179 unless ( $component->can( 'COMPONENT' ) ) {
2180 return $component;
2181 }
fbcc39ad 2182
2f5cb070 2183 # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
2184 # nearest to Catalyst::Controller first, no matter what order stuff happens
2185 # to be loaded. There are TODO tests in Moose for this, see
2186 # f2391d17574eff81d911b97be15ea51080500003
2187 if ($component->isa('Catalyst::Controller')) {
2188 $class->_controller_init_base_classes($component);
2189 }
62a6df80 2190
364d7324 2191 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2192 my $config = $class->config->{ $suffix } || {};
fbcc39ad 2193
364d7324 2194 my $instance = eval { $component->COMPONENT( $class, $config ); };
fbcc39ad 2195
2196 if ( my $error = $@ ) {
fbcc39ad 2197 chomp $error;
fbcc39ad 2198 Catalyst::Exception->throw(
364d7324 2199 message => qq/Couldn't instantiate component "$component", "$error"/
2200 );
fbcc39ad 2201 }
2202
7490de2a 2203 unless (blessed $instance) {
2204 my $metaclass = Moose::Util::find_meta($component);
2205 my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2206 my $component_method_from = $method_meta->associated_metaclass->name;
637fa644 2207 my $value = defined($instance) ? $instance : 'undef';
7490de2a 2208 Catalyst::Exception->throw(
2209 message =>
637fa644 2210 qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
7490de2a 2211 );
2212 }
364d7324 2213 return $instance;
fbcc39ad 2214}
2215
b5ecfcf0 2216=head2 $c->setup_dispatcher
fbcc39ad 2217
ae1e6b59 2218Sets up dispatcher.
2219
fbcc39ad 2220=cut
2221
2222sub setup_dispatcher {
2223 my ( $class, $dispatcher ) = @_;
2224
2225 if ($dispatcher) {
2226 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2227 }
2228
cb69249e 2229 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2230 $dispatcher = 'Catalyst::Dispatcher::' . $env;
fbcc39ad 2231 }
2232
2233 unless ($dispatcher) {
cb0354c6 2234 $dispatcher = $class->dispatcher_class;
fbcc39ad 2235 }
2236
e63bdf38 2237 Class::MOP::load_class($dispatcher);
fbcc39ad 2238
2239 # dispatcher instance
2240 $class->dispatcher( $dispatcher->new );
2241}
2242
b5ecfcf0 2243=head2 $c->setup_engine
fbcc39ad 2244
ae1e6b59 2245Sets up engine.
2246
fbcc39ad 2247=cut
2248
2249sub setup_engine {
2250 my ( $class, $engine ) = @_;
2251
2252 if ($engine) {
2253 $engine = 'Catalyst::Engine::' . $engine;
2254 }
2255
cb69249e 2256 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2257 $engine = 'Catalyst::Engine::' . $env;
fbcc39ad 2258 }
2259
9b0a3e0f 2260 if ( $ENV{MOD_PERL} ) {
e106a59f 2261 my $meta = Class::MOP::get_metaclass_by_name($class);
62a6df80 2262
fbcc39ad 2263 # create the apache method
74c89dea 2264 $meta->add_method('apache' => sub { shift->engine->apache });
fbcc39ad 2265
2266 my ( $software, $version ) =
2267 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2268
2269 $version =~ s/_//g;
2270 $version =~ s/(\.[^.]+)\./$1/g;
2271
2272 if ( $software eq 'mod_perl' ) {
2273
9b0a3e0f 2274 if ( !$engine ) {
22247e54 2275
9b0a3e0f 2276 if ( $version >= 1.99922 ) {
2277 $engine = 'Catalyst::Engine::Apache2::MP20';
2278 }
22247e54 2279
9b0a3e0f 2280 elsif ( $version >= 1.9901 ) {
2281 $engine = 'Catalyst::Engine::Apache2::MP19';
2282 }
22247e54 2283
9b0a3e0f 2284 elsif ( $version >= 1.24 ) {
2285 $engine = 'Catalyst::Engine::Apache::MP13';
2286 }
22247e54 2287
9b0a3e0f 2288 else {
2289 Catalyst::Exception->throw( message =>
2290 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2291 }
fbcc39ad 2292
fbcc39ad 2293 }
2294
2295 # install the correct mod_perl handler
2296 if ( $version >= 1.9901 ) {
2297 *handler = sub : method {
2298 shift->handle_request(@_);
2299 };
2300 }
2301 else {
2302 *handler = sub ($$) { shift->handle_request(@_) };
2303 }
2304
2305 }
2306
2307 elsif ( $software eq 'Zeus-Perl' ) {
2308 $engine = 'Catalyst::Engine::Zeus';
2309 }
2310
2311 else {
2312 Catalyst::Exception->throw(
2313 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2314 }
2315 }
2316
2317 unless ($engine) {
cb0354c6 2318 $engine = $class->engine_class;
fbcc39ad 2319 }
2320
e63bdf38 2321 Class::MOP::load_class($engine);
0e7f5826 2322
d54484bf 2323 # check for old engines that are no longer compatible
2324 my $old_engine;
0e7f5826 2325 if ( $engine->isa('Catalyst::Engine::Apache')
2326 && !Catalyst::Engine::Apache->VERSION )
d54484bf 2327 {
2328 $old_engine = 1;
2329 }
0e7f5826 2330
d54484bf 2331 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
0e7f5826 2332 && Catalyst::Engine::Server->VERSION le '0.02' )
d54484bf 2333 {
2334 $old_engine = 1;
2335 }
0e7f5826 2336
2337 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2338 && $engine->VERSION eq '0.01' )
d54484bf 2339 {
2340 $old_engine = 1;
2341 }
0e7f5826 2342
2343 elsif ($engine->isa('Catalyst::Engine::Zeus')
2344 && $engine->VERSION eq '0.01' )
d54484bf 2345 {
2346 $old_engine = 1;
2347 }
fbcc39ad 2348
d54484bf 2349 if ($old_engine) {
2350 Catalyst::Exception->throw( message =>
0e7f5826 2351 qq/Engine "$engine" is not supported by this version of Catalyst/
d54484bf 2352 );
2353 }
0e7f5826 2354
fbcc39ad 2355 # engine instance
2356 $class->engine( $engine->new );
2357}
2358
b5ecfcf0 2359=head2 $c->setup_home
fbcc39ad 2360
ae1e6b59 2361Sets up the home directory.
2362
fbcc39ad 2363=cut
2364
2365sub setup_home {
2366 my ( $class, $home ) = @_;
2367
cb69249e 2368 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2369 $home = $env;
fbcc39ad 2370 }
2371
b6d4ee6e 2372 $home ||= Catalyst::Utils::home($class);
fbcc39ad 2373
2374 if ($home) {
e63bdf38 2375 #I remember recently being scolded for assigning config values like this
fbcc39ad 2376 $class->config->{home} ||= $home;
a738ab68 2377 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
fbcc39ad 2378 }
2379}
2380
b5ecfcf0 2381=head2 $c->setup_log
fbcc39ad 2382
0fa676a7 2383Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2384passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2385log to.
62a6df80 2386
0fa676a7 2387This method also installs a C<debug> method that returns a true value into the
2388catalyst subclass if the "debug" level is passed in the comma-delimited list,
2389or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2390
2391Note that if the log has already been setup, by either a previous call to
2392C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
5baa3bbc 2393that this method won't actually set up the log object.
ae1e6b59 2394
fbcc39ad 2395=cut
2396
2397sub setup_log {
0fa676a7 2398 my ( $class, $levels ) = @_;
fbcc39ad 2399
5baa3bbc 2400 $levels ||= '';
2401 $levels =~ s/^\s+//;
2402 $levels =~ s/\s+$//;
abf65c2a 2403 my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
2404
2405 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2406 if ( defined $env_debug ) {
2407 $levels{debug} = 1 if $env_debug; # Ugly!
2408 delete($levels{debug}) unless $env_debug;
2409 }
2410
fbcc39ad 2411 unless ( $class->log ) {
0fa676a7 2412 $class->log( Catalyst::Log->new(keys %levels) );
fbcc39ad 2413 }
af3ff00e 2414
abf65c2a 2415 if ( $levels{debug} ) {
e106a59f 2416 Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
fbcc39ad 2417 $class->log->debug('Debug messages enabled');
2418 }
2419}
2420
b5ecfcf0 2421=head2 $c->setup_plugins
fbcc39ad 2422
ae1e6b59 2423Sets up plugins.
2424
fbcc39ad 2425=cut
2426
dc5f035e 2427=head2 $c->setup_stats
2428
2429Sets up timing statistics class.
2430
2431=cut
2432
2433sub setup_stats {
2434 my ( $class, $stats ) = @_;
2435
2436 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2437
2438 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2439 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
e106a59f 2440 Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
b01f0c69 2441 $class->log->debug('Statistics enabled');
dc5f035e 2442 }
2443}
2444
2445
62a6df80 2446=head2 $c->registered_plugins
836e1134 2447
2448Returns a sorted list of the plugins which have either been stated in the
2449import list or which have been added via C<< MyApp->plugin(@args); >>.
2450
2451If passed a given plugin name, it will report a boolean value indicating
2452whether or not that plugin is loaded. A fully qualified name is required if
2453the plugin name does not begin with C<Catalyst::Plugin::>.
2454
2455 if ($c->registered_plugins('Some::Plugin')) {
2456 ...
2457 }
2458
2459=cut
fbcc39ad 2460
836e1134 2461{
97b58e17 2462
2463 sub registered_plugins {
836e1134 2464 my $proto = shift;
197bd788 2465 return sort keys %{ $proto->_plugins } unless @_;
836e1134 2466 my $plugin = shift;
d0d4d785 2467 return 1 if exists $proto->_plugins->{$plugin};
2468 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
836e1134 2469 }
fbcc39ad 2470
836e1134 2471 sub _register_plugin {
2472 my ( $proto, $plugin, $instant ) = @_;
2473 my $class = ref $proto || $proto;
fbcc39ad 2474
dd91afb5 2475 # no ignore_loaded here, the plugin may already have been
2476 # defined in memory and we don't want to error on "no file" if so
2477
b6d4ee6e 2478 Class::MOP::load_class( $plugin );
fbcc39ad 2479
197bd788 2480 $proto->_plugins->{$plugin} = 1;
836e1134 2481 unless ($instant) {
fbcc39ad 2482 no strict 'refs';
e106a59f 2483 if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
74c89dea 2484 my @superclasses = ($plugin, $meta->superclasses );
2485 $meta->superclasses(@superclasses);
5fb67d52 2486 } else {
2487 unshift @{"$class\::ISA"}, $plugin;
2488 }
fbcc39ad 2489 }
836e1134 2490 return $class;
2491 }
2492
2493 sub setup_plugins {
2494 my ( $class, $plugins ) = @_;
2495
d0d4d785 2496 $class->_plugins( {} ) unless $class->_plugins;
836e1134 2497 $plugins ||= [];
2498 for my $plugin ( reverse @$plugins ) {
2499
2500 unless ( $plugin =~ s/\A\+// ) {
2501 $plugin = "Catalyst::Plugin::$plugin";
2502 }
2503
2504 $class->_register_plugin($plugin);
2505 }
fbcc39ad 2506 }
2507}
2508
b5ecfcf0 2509=head2 $c->stack
8767c5a3 2510
86418559 2511Returns an arrayref of the internal execution stack (actions that are
2512currently executing).
8767c5a3 2513
dc5f035e 2514=head2 $c->stats_class
2515
2516Returns or sets the stats (timing statistics) class.
2517
2518=head2 $c->use_stats
2519
2520Returns 1 when stats collection is enabled. Stats collection is enabled
2521when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2522environment variable is set.
2523
8eae92ad 2524Note that this is a static method, not an accessor and should be overridden
2525by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
dc5f035e 2526
2527=cut
2528
2529sub use_stats { 0 }
2530
2531
b5ecfcf0 2532=head2 $c->write( $data )
fbcc39ad 2533
ae1e6b59 2534Writes $data to the output stream. When using this method directly, you
2535will need to manually set the C<Content-Length> header to the length of
2536your output data, if known.
fbcc39ad 2537
2538=cut
2539
4f5ebacd 2540sub write {
2541 my $c = shift;
2542
2543 # Finalize headers if someone manually writes output
2544 $c->finalize_headers;
2545
2546 return $c->engine->write( $c, @_ );
2547}
fbcc39ad 2548
b5ecfcf0 2549=head2 version
bf88a181 2550
ae1e6b59 2551Returns the Catalyst version number. Mostly useful for "powered by"
2552messages in template systems.
bf88a181 2553
2554=cut
2555
2556sub version { return $Catalyst::VERSION }
2557
b0bb11ec 2558=head1 INTERNAL ACTIONS
2559
ae1e6b59 2560Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2561C<_ACTION>, and C<_END>. These are by default not shown in the private
3e705254 2562action table, but you can make them visible with a config parameter.
b0bb11ec 2563
2564 MyApp->config->{show_internal_actions} = 1;
2565
d2ee9760 2566=head1 CASE SENSITIVITY
2567
3e705254 2568By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
ae1e6b59 2569mapped to C</foo/bar>. You can activate case sensitivity with a config
3e705254 2570parameter.
d2ee9760 2571
2572 MyApp->config->{case_sensitive} = 1;
2573
3e705254 2574This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
fbcc39ad 2575
2576=head1 ON-DEMAND PARSER
2577
2578The request body is usually parsed at the beginning of a request,
878b821c 2579but if you want to handle input yourself, you can enable on-demand
2580parsing with a config parameter.
fbcc39ad 2581
2582 MyApp->config->{parse_on_demand} = 1;
62a6df80 2583
fbcc39ad 2584=head1 PROXY SUPPORT
2585
ae1e6b59 2586Many production servers operate using the common double-server approach,
2587with a lightweight frontend web server passing requests to a larger
2588backend server. An application running on the backend server must deal
2589with two problems: the remote user always appears to be C<127.0.0.1> and
2590the server's hostname will appear to be C<localhost> regardless of the
2591virtual host that the user connected through.
fbcc39ad 2592
ae1e6b59 2593Catalyst will automatically detect this situation when you are running
2594the frontend and backend servers on the same machine. The following
2595changes are made to the request.
fbcc39ad 2596
62a6df80 2597 $c->req->address is set to the user's real IP address, as read from
ae1e6b59 2598 the HTTP X-Forwarded-For header.
62a6df80 2599
ae1e6b59 2600 The host value for $c->req->base and $c->req->uri is set to the real
2601 host, as read from the HTTP X-Forwarded-Host header.
fbcc39ad 2602
3e705254 2603Obviously, your web server must support these headers for this to work.
fbcc39ad 2604
ae1e6b59 2605In a more complex server farm environment where you may have your
2606frontend proxy server(s) on different machines, you will need to set a
2607configuration option to tell Catalyst to read the proxied data from the
2608headers.
fbcc39ad 2609
2610 MyApp->config->{using_frontend_proxy} = 1;
62a6df80 2611
fbcc39ad 2612If you do not wish to use the proxy support at all, you may set:
d1a31ac6 2613
fbcc39ad 2614 MyApp->config->{ignore_frontend_proxy} = 1;
2615
2616=head1 THREAD SAFETY
2617
86418559 2618Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2619C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2620believe the Catalyst core to be thread-safe.
fbcc39ad 2621
2622If you plan to operate in a threaded environment, remember that all other
3e705254 2623modules you are using must also be thread-safe. Some modules, most notably
2624L<DBD::SQLite>, are not thread-safe.
d1a31ac6 2625
3cb1db8c 2626=head1 SUPPORT
2627
2628IRC:
2629
4eaf7c88 2630 Join #catalyst on irc.perl.org.
3cb1db8c 2631
3e705254 2632Mailing Lists:
3cb1db8c 2633
6d4c3368 2634 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2635 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
1985c30b 2636
432d507d 2637Web:
2638
2639 http://catalyst.perl.org
2640
0ef52a96 2641Wiki:
2642
2643 http://dev.catalyst.perl.org
2644
fc7ec1d9 2645=head1 SEE ALSO
2646
829a28ca 2647=head2 L<Task::Catalyst> - All you need to start with Catalyst
2648
b5ecfcf0 2649=head2 L<Catalyst::Manual> - The Catalyst Manual
e7f1cf73 2650
b5ecfcf0 2651=head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
61b1e958 2652
b5ecfcf0 2653=head2 L<Catalyst::Engine> - Core engine
61b1e958 2654
b5ecfcf0 2655=head2 L<Catalyst::Log> - Log class.
61b1e958 2656
b5ecfcf0 2657=head2 L<Catalyst::Request> - Request object
61b1e958 2658
b5ecfcf0 2659=head2 L<Catalyst::Response> - Response object
61b1e958 2660
b5ecfcf0 2661=head2 L<Catalyst::Test> - The test suite.
fc7ec1d9 2662
2f381252 2663=head1 PROJECT FOUNDER
2664
2665sri: Sebastian Riedel <sri@cpan.org>
fc7ec1d9 2666
2f381252 2667=head1 CONTRIBUTORS
15f0b5b7 2668
2f381252 2669abw: Andy Wardley
fbcc39ad 2670
2f381252 2671acme: Leon Brocard <leon@astray.com>
33108eaf 2672
f4a57de4 2673Andrew Bramble
2674
15f0b5b7 2675Andrew Ford
2676
2677Andrew Ruthven
2678
2f381252 2679andyg: Andy Grundman <andy@hybridized.org>
fbcc39ad 2680
2f381252 2681audreyt: Audrey Tang
15f0b5b7 2682
2f381252 2683bricas: Brian Cassidy <bricas@cpan.org>
0cf56dbc 2684
e31b525c 2685Caelum: Rafael Kitover <rkitover@io.com>
2686
2f381252 2687chansen: Christian Hansen
6aaa1c60 2688
2f381252 2689chicks: Christopher Hicks
15f0b5b7 2690
0fa676a7 2691David E. Wheeler
2692
2f381252 2693dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
15f0b5b7 2694
2f381252 2695Drew Taylor
15f0b5b7 2696
2f381252 2697esskar: Sascha Kiefer
0ef52a96 2698
2f381252 2699fireartist: Carl Franks <cfranks@cpan.org>
15f0b5b7 2700
2f381252 2701gabb: Danijel Milicevic
61bef238 2702
15f0b5b7 2703Gary Ashton Jones
2704
2705Geoff Richards
2706
e4cc83b2 2707ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2708
2f381252 2709jcamacho: Juan Camacho
fbcc39ad 2710
108201b5 2711jhannah: Jay Hannah <jay@jays.net>
2712
15f0b5b7 2713Jody Belka
2714
2715Johan Lindstrom
2716
2f381252 2717jon: Jon Schutz <jjschutz@cpan.org>
15f0b5b7 2718
2f381252 2719marcus: Marcus Ramberg <mramberg@cpan.org>
15f0b5b7 2720
2f381252 2721miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
15f0b5b7 2722
2f381252 2723mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
15f0b5b7 2724
2f381252 2725mugwump: Sam Vilain
71c3bcc3 2726
2f381252 2727naughton: David Naughton
a727119f 2728
2f381252 2729ningu: David Kamholz <dkamholz@cpan.org>
1cf1c56a 2730
2f381252 2731nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
9c71d51d 2732
2f381252 2733numa: Dan Sully <daniel@cpan.org>
fc7ec1d9 2734
2f381252 2735obra: Jesse Vincent
2736
2737omega: Andreas Marienborg
51f0308d 2738
39fc2ce1 2739Oleg Kostyuk <cub.uanic@gmail.com>
2740
2f381252 2741phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
bdcb95ef 2742
6dae3eef 2743rafl: Florian Ragwitz <rafl@debian.org>
2744
2f381252 2745sky: Arthur Bergman
2746
2747the_jester: Jesse Sheidlower
2748
bb33cb06 2749t0m: Tomas Doran <bobtfish@bobtfish.net>
2750
2f381252 2751Ulf Edvinsson
51f0308d 2752
2f381252 2753willert: Sebastian Willert <willert@cpan.org>
51f0308d 2754
fc7ec1d9 2755=head1 LICENSE
2756
9ce5ab63 2757This library is free software, you can redistribute it and/or modify it under
41ca9ba7 2758the same terms as Perl itself.
fc7ec1d9 2759
2760=cut
2761
4090e3bb 2762no Moose;
2763
46d0346d 2764__PACKAGE__->meta->make_immutable;
2765
fc7ec1d9 27661;