Fixed non-moose classes initialization order issues. Not quite as fugly as I first...
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
CommitLineData
fc7ec1d9 1package Catalyst;
2
a7caa492 3use Moose;
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
ac5c933b 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
fae37484 78our $VERSION = '5.80001';
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
ac5c933b 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
ac5c933b 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
ac5c933b 154 # do something else after forward returns
0ef52a96 155 }
156 }
ac5c933b 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 %]
ac5c933b 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
ac5c933b 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 }
ac5c933b 175
ae1e6b59 176 # called after all actions are finished
ac5c933b 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 { ... }
ac5c933b 187
5400c668 188 # called for /blargle
189 sub blargle : Global { ... }
ac5c933b 190
5400c668 191 # an index action matches /foo, but not /foo/1, etc.
192 sub index : Private { ... }
ac5c933b 193
0ef52a96 194 ### in MyApp/Controller/Foo/Bar.pm
195 # called for /foo/bar/baz
196 sub baz : Local { ... }
ac5c933b 197
b4b01a8a 198 # first Root auto is called, then Foo auto, then this
0ef52a96 199 sub auto : Private { ... }
ac5c933b 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';
273
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
ac5c933b 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
ac5c933b 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
ac5c933b 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];
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
ac5c933b 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 }
2f381252 571
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
ac5c933b 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) {
ac5c933b 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
ac5c933b 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) {
ac5c933b 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,
817followed by configuration in your top level C<MyApp> class. These two
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' });
828
829will mean that C<MyApp::Model::Foo> receives the following data when
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
876=item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
877
878=item The -Debug option in your MyApp.pm
879
880=item By declaring "sub debug { 1 }" in your MyApp.pm.
881
882=back
c74d3f0c 883
884Calling $c->debug(1) has no effect.
e80e8542 885
af3ff00e 886=cut
887
b4b01a8a 888sub debug { 0 }
889
890=head2 $c->dispatcher
891
2887a7f1 892Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
b4b01a8a 893
894=head2 $c->engine
895
2887a7f1 896Returns the engine instance. See L<Catalyst::Engine>.
b4b01a8a 897
898
f7b672ef 899=head2 UTILITY METHODS
66e28e3f 900
b5ecfcf0 901=head2 $c->path_to(@path)
01033d73 902
cc95842f 903Merges C<@path> with C<< $c->config->{home} >> and returns a
afbb9aa3 904L<Path::Class::Dir> object.
01033d73 905
906For example:
907
908 $c->path_to( 'db', 'sqlite.db' );
909
910=cut
911
912sub path_to {
913 my ( $c, @path ) = @_;
a738ab68 914 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
01033d73 915 if ( -d $path ) { return $path }
a738ab68 916 else { return Path::Class::File->new( $c->config->{home}, @path ) }
01033d73 917}
918
b5ecfcf0 919=head2 $c->plugin( $name, $class, @args )
0ef52a96 920
10011c19 921Helper method for plugins. It creates a class data accessor/mutator and
ae1e6b59 922loads and instantiates the given class.
0ef52a96 923
924 MyApp->plugin( 'prototype', 'HTML::Prototype' );
925
926 $c->prototype->define_javascript_functions;
4e68badc 927
6b2a933b 928B<Note:> This method of adding plugins is deprecated. The ability
4e68badc 929to add plugins like this B<will be removed> in a Catalyst 5.81.
6b2a933b 930Please do not use this functionality in new code.
0ef52a96 931
932=cut
933
934sub plugin {
935 my ( $class, $name, $plugin, @args ) = @_;
6b2a933b 936
4e68badc 937 # See block comment in t/unit_core_plugin.t
b3542016 938 $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
4e68badc 939
97b58e17 940 $class->_register_plugin( $plugin, 1 );
0ef52a96 941
942 eval { $plugin->import };
943 $class->mk_classdata($name);
944 my $obj;
945 eval { $obj = $plugin->new(@args) };
946
947 if ($@) {
948 Catalyst::Exception->throw( message =>
949 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
950 }
951
952 $class->$name($obj);
953 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
954 if $class->debug;
955}
956
b5ecfcf0 957=head2 MyApp->setup
fbcc39ad 958
e7f1cf73 959Initializes the dispatcher and engine, loads any plugins, and loads the
ae1e6b59 960model, view, and controller components. You may also specify an array
961of plugins to load here, if you choose to not load them in the C<use
962Catalyst> line.
fbcc39ad 963
0ef52a96 964 MyApp->setup;
965 MyApp->setup( qw/-Debug/ );
fbcc39ad 966
967=cut
968
969sub setup {
0319a12c 970 my ( $class, @arguments ) = @_;
c2f3cc1b 971 croak('Running setup more than once')
972 if ( $class->setup_finished );
5168a5fc 973
fbcc39ad 974 unless ( $class->isa('Catalyst') ) {
953b0e15 975
fbcc39ad 976 Catalyst::Exception->throw(
977 message => qq/'$class' does not inherit from Catalyst/ );
1c99e125 978 }
0319a12c 979
fbcc39ad 980 if ( $class->arguments ) {
981 @arguments = ( @arguments, @{ $class->arguments } );
982 }
983
984 # Process options
985 my $flags = {};
986
987 foreach (@arguments) {
988
989 if (/^-Debug$/) {
990 $flags->{log} =
991 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
992 }
993 elsif (/^-(\w+)=?(.*)$/) {
994 $flags->{ lc $1 } = $2;
995 }
996 else {
997 push @{ $flags->{plugins} }, $_;
998 }
999 }
1000
99f187d6 1001 $class->setup_home( delete $flags->{home} );
1002
fbcc39ad 1003 $class->setup_log( delete $flags->{log} );
1004 $class->setup_plugins( delete $flags->{plugins} );
1005 $class->setup_dispatcher( delete $flags->{dispatcher} );
1006 $class->setup_engine( delete $flags->{engine} );
dc5f035e 1007 $class->setup_stats( delete $flags->{stats} );
fbcc39ad 1008
1009 for my $flag ( sort keys %{$flags} ) {
1010
1011 if ( my $code = $class->can( 'setup_' . $flag ) ) {
1012 &$code( $class, delete $flags->{$flag} );
1013 }
1014 else {
1015 $class->log->warn(qq/Unknown flag "$flag"/);
1016 }
1017 }
1018
0eb4af72 1019 eval { require Catalyst::Devel; };
1020 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1021 $class->log->warn(<<"EOF");
4ff0d824 1022You are running an old script!
1023
34a83d89 1024 Please update by running (this will overwrite existing files):
1025 catalyst.pl -force -scripts $class
1026
1027 or (this will not overwrite existing files):
1028 catalyst.pl -scripts $class
1cf0345b 1029
4ff0d824 1030EOF
0eb4af72 1031 }
ac5c933b 1032
fbcc39ad 1033 if ( $class->debug ) {
6601f2ad 1034 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
fbcc39ad 1035
1036 if (@plugins) {
39fc2ce1 1037 my $column_width = Catalyst::Utils::term_width() - 6;
1038 my $t = Text::SimpleTable->new($column_width);
8c113188 1039 $t->row($_) for @plugins;
1cf0345b 1040 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
fbcc39ad 1041 }
1042
1043 my $dispatcher = $class->dispatcher;
1044 my $engine = $class->engine;
1045 my $home = $class->config->{home};
1046
01ce7075 1047 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1048 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
fbcc39ad 1049
1050 $home
1051 ? ( -d $home )
1052 ? $class->log->debug(qq/Found home "$home"/)
1053 : $class->log->debug(qq/Home "$home" doesn't exist/)
1054 : $class->log->debug(q/Couldn't find home/);
1055 }
1056
54f4bfef 1057 # Call plugins setup, this is stupid and evil.
fbcc39ad 1058 {
1059 no warnings qw/redefine/;
1060 local *setup = sub { };
1061 $class->setup;
1062 }
1063
1064 # Initialize our data structure
1065 $class->components( {} );
1066
1067 $class->setup_components;
1068
1069 if ( $class->debug ) {
39fc2ce1 1070 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1071 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
684d10ed 1072 for my $comp ( sort keys %{ $class->components } ) {
1073 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1074 $t->row( $comp, $type );
1075 }
1cf0345b 1076 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
8c113188 1077 if ( keys %{ $class->components } );
fbcc39ad 1078 }
1079
1080 # Add our self to components, since we are also a component
96d8d513 1081 if( $class->isa('Catalyst::Controller') ){
1082 $class->components->{$class} = $class;
1083 }
fbcc39ad 1084
1085 $class->setup_actions;
1086
1087 if ( $class->debug ) {
1088 my $name = $class->config->{name} || 'Application';
1089 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1090 }
1091 $class->log->_flush() if $class->log->can('_flush');
3643e890 1092
3d041c32 1093 # Make sure that the application class becomes immutable at this point,
1094 # which ensures that it gets an inlined constructor. This means that it
1095 # works even if the user has added a plugin which contains a new method.
1096 # Note however that we have to do the work on scope end, so that method
1097 # modifiers work correctly in MyApp (as you have to call setup _before_
1098 # applying modifiers).
edb20ed3 1099 Scope::Upper::reap(sub {
e106a59f 1100 my $meta = Class::MOP::get_metaclass_by_name($class);
3d041c32 1101 $meta->make_immutable unless $meta->is_immutable;
d134bcca 1102 }, Scope::Upper::SCOPE(1));
3d041c32 1103
a5d07d29 1104 $class->setup_finalize;
1105}
1106
23c63a17 1107
1108=head2 $app->setup_finalize
1109
1110A hook to attach modifiers to.
4bc471c9 1111Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup.
23c63a17 1112Also better than C< setup_finished(); >, as that is a getter method.
1113
1114 sub setup_finalize {
1115
1116 my $app = shift;
1117
1118 ## do stuff, i.e., determine a primary key column for sessions stored in a DB
1119
1120 $app->next::method(@_);
1121
1122
1123 }
1124
1125=cut
1126
a5d07d29 1127sub setup_finalize {
1128 my ($class) = @_;
3643e890 1129 $class->setup_finished(1);
fbcc39ad 1130}
1131
8a27f860 1132=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1133
73664287 1134=head2 $c->uri_for( $path, @args?, \%query_values? )
fbcc39ad 1135
8a27f860 1136=over
fbcc39ad 1137
8a27f860 1138=item $action
8dc69021 1139
8a27f860 1140A Catalyst::Action object representing the Catalyst action you want to
1141create a URI for. To get one for an action in the current controller,
1142use C<< $c->action('someactionname') >>. To get one from different
1143controller, fetch the controller using C<< $c->controller() >>, then
1144call C<action_for> on it.
ea0e58d9 1145
9df7c5d9 1146You can maintain the arguments captured by an action (e.g.: Regex, Chained)
1147using C<< $c->req->captures >>.
1148
1149 # For the current action
1150 $c->uri_for($c->action, $c->req->captures);
1151
1152 # For the Foo action in the Bar controller
1153 $c->uri_for($c->controller->('Bar')->action_for('Foo'), $c->req->captures);
1154
d5e3d528 1155=back
1156
4cf1dd00 1157=cut
1158
fbcc39ad 1159sub uri_for {
00e6a2b7 1160 my ( $c, $path, @args ) = @_;
00e6a2b7 1161
7e95ba12 1162 if ( blessed($path) ) { # action object
ea0e58d9 1163 my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
1164 ? shift(@args)
1165 : [] );
aa7e913e 1166 my $action = $path;
1167 $path = $c->dispatcher->uri_for_action($action, $captures);
1168 if (not defined $path) {
1169 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1170 if $c->debug;
1171 return undef;
1172 }
81e75875 1173 $path = '/' if $path eq '';
ea0e58d9 1174 }
1175
51674a63 1176 undef($path) if (defined $path && $path eq '');
00e6a2b7 1177
97b58e17 1178 my $params =
1179 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
8327e2e2 1180
cbb93105 1181 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
51674a63 1182 s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
1183
1184 unshift(@args, $path);
1185
1186 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1187 my $namespace = $c->namespace;
1188 if (defined $path) { # cheesy hack to handle path '../foo'
1189 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 1190 }
51674a63 1191 unshift(@args, $namespace || '');
1192 }
ac5c933b 1193
189e2a51 1194 # join args with '/', or a blank string
51674a63 1195 my $args = join('/', grep { defined($_) } @args);
1196 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
7a2295bc 1197 $args =~ s!^/+!!;
51674a63 1198 my $base = $c->req->base;
1199 my $class = ref($base);
1200 $base =~ s{(?<!/)$}{/};
1201
1202 my $query = '';
1203
1204 if (my @keys = keys %$params) {
1205 # somewhat lifted from URI::_query's query_form
1206 $query = '?'.join('&', map {
2f381252 1207 my $val = $params->{$_};
51674a63 1208 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1209 s/ /+/g;
1210 my $key = $_;
51674a63 1211 $val = '' unless defined $val;
1212 (map {
1213 $_ = "$_";
0ce485e9 1214 utf8::encode( $_ ) if utf8::is_utf8($_);
51674a63 1215 # using the URI::Escape pattern here so utf8 chars survive
1216 s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1217 s/ /+/g;
1218 "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1219 } @keys);
1220 }
1221
1222 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1223 $res;
fbcc39ad 1224}
1225
833b385e 1226=head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
1227
1228=head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
1229
1230=over
1231
1232=item $path
1233
1234A private path to the Catalyst action you want to create a URI for.
1235
1236This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1237>> and passing the resulting C<$action> and the remaining arguments to C<<
1238$c->uri_for >>.
1239
1240You can also pass in a Catalyst::Action object, in which case it is passed to
1241C<< $c->uri_for >>.
1242
1243=back
1244
1245=cut
1246
1247sub uri_for_action {
1248 my ( $c, $path, @args ) = @_;
1249 my $action = blessed($path)
1250 ? $path
1251 : $c->dispatcher->get_action_by_path($path);
4ac0b9cb 1252 unless (defined $action) {
1253 croak "Can't find action for path '$path'";
1254 }
833b385e 1255 return $c->uri_for( $action, @args );
1256}
1257
b5ecfcf0 1258=head2 $c->welcome_message
ab2374d3 1259
1260Returns the Catalyst welcome HTML page.
1261
1262=cut
1263
1264sub welcome_message {
bf1f2c60 1265 my $c = shift;
1266 my $name = $c->config->{name};
1267 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1268 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1269 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1270 return <<"EOF";
80cdbbff 1271<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1272 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1273<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1274 <head>
85d9fce6 1275 <meta http-equiv="Content-Language" content="en" />
1276 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1277 <title>$name on Catalyst $VERSION</title>
1278 <style type="text/css">
1279 body {
ab2374d3 1280 color: #000;
1281 background-color: #eee;
1282 }
1283 div#content {
1284 width: 640px;
80cdbbff 1285 margin-left: auto;
1286 margin-right: auto;
ab2374d3 1287 margin-top: 10px;
1288 margin-bottom: 10px;
1289 text-align: left;
1290 background-color: #ccc;
1291 border: 1px solid #aaa;
ab2374d3 1292 }
d84c4dab 1293 p, h1, h2 {
ab2374d3 1294 margin-left: 20px;
1295 margin-right: 20px;
16215972 1296 font-family: verdana, tahoma, sans-serif;
ab2374d3 1297 }
d84c4dab 1298 a {
1299 font-family: verdana, tahoma, sans-serif;
1300 }
d114e033 1301 :link, :visited {
1302 text-decoration: none;
1303 color: #b00;
1304 border-bottom: 1px dotted #bbb;
1305 }
1306 :link:hover, :visited:hover {
d114e033 1307 color: #555;
1308 }
ab2374d3 1309 div#topbar {
1310 margin: 0px;
1311 }
3e82a295 1312 pre {
3e82a295 1313 margin: 10px;
1314 padding: 8px;
1315 }
ab2374d3 1316 div#answers {
1317 padding: 8px;
1318 margin: 10px;
d114e033 1319 background-color: #fff;
ab2374d3 1320 border: 1px solid #aaa;
ab2374d3 1321 }
1322 h1 {
33108eaf 1323 font-size: 0.9em;
1324 font-weight: normal;
ab2374d3 1325 text-align: center;
1326 }
1327 h2 {
1328 font-size: 1.0em;
1329 }
1330 p {
1331 font-size: 0.9em;
1332 }
ae7c5252 1333 p img {
1334 float: right;
1335 margin-left: 10px;
1336 }
9619f23c 1337 span#appname {
1338 font-weight: bold;
33108eaf 1339 font-size: 1.6em;
ab2374d3 1340 }
1341 </style>
1342 </head>
1343 <body>
1344 <div id="content">
1345 <div id="topbar">
9619f23c 1346 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1347 $VERSION</h1>
ab2374d3 1348 </div>
1349 <div id="answers">
ae7c5252 1350 <p>
80cdbbff 1351 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1352 </p>
596aaffe 1353 <p>Welcome to the world of Catalyst.
f92fd545 1354 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1355 framework will make web development something you had
60dd6e1d 1356 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1357 <h2>What to do now?</h2>
4b8cb778 1358 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1359 We do, however, provide you with a few starting points.</p>
1360 <p>If you want to jump right into web development with Catalyst
2f381252 1361 you might want to start with a tutorial.</p>
b607f8a0 1362<pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
596aaffe 1363</pre>
1364<p>Afterwards you can go on to check out a more complete look at our features.</p>
1365<pre>
b607f8a0 1366<code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1367<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1368</code></pre>
ab2374d3 1369 <h2>What to do next?</h2>
f5681c92 1370 <p>Next it's time to write an actual application. Use the
80cdbbff 1371 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
60dd6e1d 1372 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1373 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
bf1f2c60 1374 they can save you a lot of work.</p>
1375 <pre><code>script/${prefix}_create.pl -help</code></pre>
1376 <p>Also, be sure to check out the vast and growing
802bf2cb 1377 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
bf1f2c60 1378 you are likely to find what you need there.
f5681c92 1379 </p>
1380
82245cc4 1381 <h2>Need help?</h2>
f5681c92 1382 <p>Catalyst has a very active community. Here are the main places to
1383 get in touch with us.</p>
16215972 1384 <ul>
1385 <li>
2b9a7d76 1386 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1387 </li>
1388 <li>
6d4c3368 1389 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1390 </li>
1391 <li>
4eaf7c88 1392 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1393 </li>
1394 </ul>
ab2374d3 1395 <h2>In conclusion</h2>
ac5c933b 1396 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1397 as we enjoyed making it. Please contact us if you have ideas
1398 for improvement or other feedback.</p>
ab2374d3 1399 </div>
1400 </div>
1401 </body>
1402</html>
1403EOF
1404}
1405
fbcc39ad 1406=head1 INTERNAL METHODS
1407
ae1e6b59 1408These methods are not meant to be used by end users.
1409
b5ecfcf0 1410=head2 $c->components
fbcc39ad 1411
e7f1cf73 1412Returns a hash of components.
fbcc39ad 1413
b5ecfcf0 1414=head2 $c->context_class
1f9cb7c1 1415
e7f1cf73 1416Returns or sets the context class.
1f9cb7c1 1417
b5ecfcf0 1418=head2 $c->counter
fbcc39ad 1419
ae1e6b59 1420Returns a hashref containing coderefs and execution counts (needed for
1421deep recursion detection).
fbcc39ad 1422
b5ecfcf0 1423=head2 $c->depth
fbcc39ad 1424
e7f1cf73 1425Returns the number of actions on the current internal execution stack.
fbcc39ad 1426
b5ecfcf0 1427=head2 $c->dispatch
fbcc39ad 1428
e7f1cf73 1429Dispatches a request to actions.
fbcc39ad 1430
1431=cut
1432
1433sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1434
b5ecfcf0 1435=head2 $c->dispatcher_class
1f9cb7c1 1436
e7f1cf73 1437Returns or sets the dispatcher class.
1f9cb7c1 1438
b5ecfcf0 1439=head2 $c->dump_these
7f92deef 1440
ae1e6b59 1441Returns a list of 2-element array references (name, structure) pairs
1442that will be dumped on the error page in debug mode.
7f92deef 1443
1444=cut
1445
1446sub dump_these {
1447 my $c = shift;
ac5c933b 1448 [ Request => $c->req ],
1449 [ Response => $c->res ],
052a2d89 1450 [ Stash => $c->stash ],
1451 [ Config => $c->config ];
7f92deef 1452}
1453
b5ecfcf0 1454=head2 $c->engine_class
1f9cb7c1 1455
e7f1cf73 1456Returns or sets the engine class.
1f9cb7c1 1457
b5ecfcf0 1458=head2 $c->execute( $class, $coderef )
fbcc39ad 1459
0ef52a96 1460Execute a coderef in given class and catch exceptions. Errors are available
1461via $c->error.
fbcc39ad 1462
1463=cut
1464
1465sub execute {
1466 my ( $c, $class, $code ) = @_;
858828dd 1467 $class = $c->component($class) || $class;
fbcc39ad 1468 $c->state(0);
a0eca838 1469
197bd788 1470 if ( $c->depth >= $RECURSION ) {
f3414019 1471 my $action = $code->reverse();
91d08727 1472 $action = "/$action" unless $action =~ /->/;
f3414019 1473 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 1474 $c->log->error($error);
1475 $c->error($error);
1476 $c->state(0);
1477 return $c->state;
1478 }
1479
dc5f035e 1480 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 1481
8767c5a3 1482 push( @{ $c->stack }, $code );
ac5c933b 1483
6f3df815 1484 no warnings 'recursion';
f3414019 1485 eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
22247e54 1486
dc5f035e 1487 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
ac5c933b 1488
a6724a82 1489 my $last = pop( @{ $c->stack } );
fbcc39ad 1490
1491 if ( my $error = $@ ) {
2f381252 1492 if ( !ref($error) and $error eq $DETACH ) {
1493 die $DETACH if($c->depth > 1);
1494 }
55424863 1495 elsif ( !ref($error) and $error eq $GO ) {
1496 die $GO if($c->depth > 0);
1497 }
fbcc39ad 1498 else {
1499 unless ( ref $error ) {
91d08727 1500 no warnings 'uninitialized';
fbcc39ad 1501 chomp $error;
f59def82 1502 my $class = $last->class;
1503 my $name = $last->name;
1504 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 1505 }
fbcc39ad 1506 $c->error($error);
1507 $c->state(0);
1508 }
1509 }
1510 return $c->state;
1511}
1512
7a7d7af5 1513sub _stats_start_execute {
1514 my ( $c, $code ) = @_;
1515
a6724a82 1516 return if ( ( $code->name =~ /^_.*/ )
1517 && ( !$c->config->{show_internal_actions} ) );
7a7d7af5 1518
f3414019 1519 my $action_name = $code->reverse();
1520 $c->counter->{$action_name}++;
7a7d7af5 1521
f3414019 1522 my $action = $action_name;
a6724a82 1523 $action = "/$action" unless $action =~ /->/;
1524
7a7d7af5 1525 # determine if the call was the result of a forward
1526 # this is done by walking up the call stack and looking for a calling
1527 # sub of Catalyst::forward before the eval
1528 my $callsub = q{};
1529 for my $index ( 2 .. 11 ) {
1530 last
1531 if ( ( caller($index) )[0] eq 'Catalyst'
1532 && ( caller($index) )[3] eq '(eval)' );
1533
1534 if ( ( caller($index) )[3] =~ /forward$/ ) {
1535 $callsub = ( caller($index) )[3];
1536 $action = "-> $action";
1537 last;
1538 }
1539 }
1540
f3414019 1541 my $uid = $action_name . $c->counter->{$action_name};
74efc144 1542
a6724a82 1543 # is this a root-level call or a forwarded call?
1544 if ( $callsub =~ /forward$/ ) {
1545
1546 # forward, locate the caller
1547 if ( my $parent = $c->stack->[-1] ) {
69d8f33c 1548 $c->stats->profile(
ac5c933b 1549 begin => $action,
69d8f33c 1550 parent => "$parent" . $c->counter->{"$parent"},
1551 uid => $uid,
1552 );
7a7d7af5 1553 }
1554 else {
1555
a6724a82 1556 # forward with no caller may come from a plugin
69d8f33c 1557 $c->stats->profile(
1558 begin => $action,
1559 uid => $uid,
1560 );
7a7d7af5 1561 }
1562 }
a6724a82 1563 else {
ac5c933b 1564
a6724a82 1565 # root-level call
69d8f33c 1566 $c->stats->profile(
1567 begin => $action,
1568 uid => $uid,
1569 );
a6724a82 1570 }
dc5f035e 1571 return $action;
7a7d7af5 1572
7a7d7af5 1573}
1574
1575sub _stats_finish_execute {
1576 my ( $c, $info ) = @_;
69d8f33c 1577 $c->stats->profile( end => $info );
7a7d7af5 1578}
1579
3d0d6d21 1580=head2 $c->_localize_fields( sub { }, \%keys );
1581
1582=cut
1583
e63bdf38 1584#Why does this exist? This is no longer safe and WILL NOT WORK.
1585# it doesnt seem to be used anywhere. can we remove it?
3d0d6d21 1586sub _localize_fields {
1587 my ( $c, $localized, $code ) = ( @_ );
1588
1589 my $request = delete $localized->{request} || {};
1590 my $response = delete $localized->{response} || {};
ac5c933b 1591
3d0d6d21 1592 local @{ $c }{ keys %$localized } = values %$localized;
1593 local @{ $c->request }{ keys %$request } = values %$request;
1594 local @{ $c->response }{ keys %$response } = values %$response;
1595
1596 $code->();
1597}
1598
b5ecfcf0 1599=head2 $c->finalize
fbcc39ad 1600
e7f1cf73 1601Finalizes the request.
fbcc39ad 1602
1603=cut
1604
1605sub finalize {
1606 my $c = shift;
1607
369c09bc 1608 for my $error ( @{ $c->error } ) {
1609 $c->log->error($error);
1610 }
1611
5050d7a7 1612 # Allow engine to handle finalize flow (for POE)
e63bdf38 1613 my $engine = $c->engine;
1614 if ( my $code = $engine->can('finalize') ) {
1615 $engine->$code($c);
fbcc39ad 1616 }
5050d7a7 1617 else {
fbcc39ad 1618
5050d7a7 1619 $c->finalize_uploads;
fbcc39ad 1620
5050d7a7 1621 # Error
1622 if ( $#{ $c->error } >= 0 ) {
1623 $c->finalize_error;
1624 }
1625
1626 $c->finalize_headers;
fbcc39ad 1627
5050d7a7 1628 # HEAD request
1629 if ( $c->request->method eq 'HEAD' ) {
1630 $c->response->body('');
1631 }
1632
1633 $c->finalize_body;
1634 }
ac5c933b 1635
1636 if ($c->use_stats) {
596677b6 1637 my $elapsed = sprintf '%f', $c->stats->elapsed;
12bf12c0 1638 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
908e3d9e 1639 $c->log->info(
ac5c933b 1640 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
908e3d9e 1641 }
fbcc39ad 1642
1643 return $c->response->status;
1644}
1645
b5ecfcf0 1646=head2 $c->finalize_body
fbcc39ad 1647
e7f1cf73 1648Finalizes body.
fbcc39ad 1649
1650=cut
1651
1652sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1653
b5ecfcf0 1654=head2 $c->finalize_cookies
fbcc39ad 1655
e7f1cf73 1656Finalizes cookies.
fbcc39ad 1657
1658=cut
1659
147821ea 1660sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 1661
b5ecfcf0 1662=head2 $c->finalize_error
fbcc39ad 1663
e7f1cf73 1664Finalizes error.
fbcc39ad 1665
1666=cut
1667
1668sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1669
b5ecfcf0 1670=head2 $c->finalize_headers
fbcc39ad 1671
e7f1cf73 1672Finalizes headers.
fbcc39ad 1673
1674=cut
1675
1676sub finalize_headers {
1677 my $c = shift;
1678
e63bdf38 1679 my $response = $c->response; #accessor calls can add up?
1680
fbcc39ad 1681 # Check if we already finalized headers
6680c772 1682 return if $response->finalized_headers;
fbcc39ad 1683
1684 # Handle redirects
e63bdf38 1685 if ( my $location = $response->redirect ) {
fbcc39ad 1686 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 1687 $response->header( Location => $location );
a7caa492 1688
02570318 1689 if ( !$response->has_body ) {
39655cdc 1690 # Add a default body if none is already present
e63bdf38 1691 $response->body(
e422816e 1692 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
39655cdc 1693 );
1694 }
fbcc39ad 1695 }
1696
1697 # Content-Length
e63bdf38 1698 if ( $response->body && !$response->content_length ) {
775878ac 1699
8f62c91a 1700 # get the length from a filehandle
e63bdf38 1701 if ( blessed( $response->body ) && $response->body->can('read') )
197bd788 1702 {
e63bdf38 1703 my $stat = stat $response->body;
3b6a1db1 1704 if ( $stat && $stat->size > 0 ) {
e63bdf38 1705 $response->content_length( $stat->size );
8f62c91a 1706 }
1707 else {
775878ac 1708 $c->log->warn('Serving filehandle without a content-length');
8f62c91a 1709 }
1710 }
1711 else {
b5d7a61f 1712 # everything should be bytes at this point, but just in case
e63bdf38 1713 $response->content_length( bytes::length( $response->body ) );
8f62c91a 1714 }
fbcc39ad 1715 }
1716
1717 # Errors
e63bdf38 1718 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1719 $response->headers->remove_header("Content-Length");
1720 $response->body('');
fbcc39ad 1721 }
1722
1723 $c->finalize_cookies;
1724
1725 $c->engine->finalize_headers( $c, @_ );
1726
1727 # Done
6680c772 1728 $response->finalized_headers(1);
fbcc39ad 1729}
1730
b5ecfcf0 1731=head2 $c->finalize_output
fbcc39ad 1732
1733An alias for finalize_body.
1734
b5ecfcf0 1735=head2 $c->finalize_read
fbcc39ad 1736
e7f1cf73 1737Finalizes the input after reading is complete.
fbcc39ad 1738
1739=cut
1740
1741sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1742
b5ecfcf0 1743=head2 $c->finalize_uploads
fbcc39ad 1744
ae1e6b59 1745Finalizes uploads. Cleans up any temporary files.
fbcc39ad 1746
1747=cut
1748
1749sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1750
b5ecfcf0 1751=head2 $c->get_action( $action, $namespace )
fbcc39ad 1752
e7f1cf73 1753Gets an action in a given namespace.
fbcc39ad 1754
1755=cut
1756
684d10ed 1757sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 1758
b5ecfcf0 1759=head2 $c->get_actions( $action, $namespace )
a9dc674c 1760
ae1e6b59 1761Gets all actions of a given name in a namespace and all parent
1762namespaces.
a9dc674c 1763
1764=cut
1765
1766sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1767
f7b672ef 1768=head2 $c->handle_request( $class, @arguments )
fbcc39ad 1769
e7f1cf73 1770Called to handle each HTTP request.
fbcc39ad 1771
1772=cut
1773
1774sub handle_request {
1775 my ( $class, @arguments ) = @_;
1776
1777 # Always expect worst case!
1778 my $status = -1;
1779 eval {
dea1884f 1780 if ($class->debug) {
908e3d9e 1781 my $secs = time - $START || 1;
1782 my $av = sprintf '%.3f', $COUNT / $secs;
1783 my $time = localtime time;
1784 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 1785 }
908e3d9e 1786
1787 my $c = $class->prepare(@arguments);
1788 $c->dispatch;
ac5c933b 1789 $status = $c->finalize;
fbcc39ad 1790 };
1791
1792 if ( my $error = $@ ) {
1793 chomp $error;
1794 $class->log->error(qq/Caught exception in engine "$error"/);
1795 }
1796
1797 $COUNT++;
6680c772 1798
1799 if(my $coderef = $class->log->can('_flush')){
1800 $class->log->$coderef();
1801 }
fbcc39ad 1802 return $status;
1803}
1804
b5ecfcf0 1805=head2 $c->prepare( @arguments )
fbcc39ad 1806
ae1e6b59 1807Creates a Catalyst context from an engine-specific request (Apache, CGI,
1808etc.).
fbcc39ad 1809
1810=cut
1811
1812sub prepare {
1813 my ( $class, @arguments ) = @_;
1814
6680c772 1815 # XXX
1816 # After the app/ctxt split, this should become an attribute based on something passed
1817 # into the application.
3cec521a 1818 $class->context_class( ref $class || $class ) unless $class->context_class;
6680c772 1819
1820 my $c = $class->context_class->new({});
1821
1822 # For on-demand data
1823 $c->request->_context($c);
1824 $c->response->_context($c);
fbcc39ad 1825
b6d4ee6e 1826 #surely this is not the most efficient way to do things...
dc5f035e 1827 $c->stats($class->stats_class->new)->enable($c->use_stats);
908e3d9e 1828 if ( $c->debug ) {
ac5c933b 1829 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 1830 }
1831
e63bdf38 1832 #XXX reuse coderef from can
5050d7a7 1833 # Allow engine to direct the prepare flow (for POE)
1834 if ( $c->engine->can('prepare') ) {
1835 $c->engine->prepare( $c, @arguments );
1836 }
1837 else {
1838 $c->prepare_request(@arguments);
1839 $c->prepare_connection;
1840 $c->prepare_query_parameters;
1841 $c->prepare_headers;
1842 $c->prepare_cookies;
1843 $c->prepare_path;
1844
878b821c 1845 # Prepare the body for reading, either by prepare_body
1846 # or the user, if they are using $c->read
1847 $c->prepare_read;
ac5c933b 1848
878b821c 1849 # Parse the body unless the user wants it on-demand
1850 unless ( $c->config->{parse_on_demand} ) {
1851 $c->prepare_body;
1852 }
5050d7a7 1853 }
fbcc39ad 1854
fbcc39ad 1855 my $method = $c->req->method || '';
2f381252 1856 my $path = $c->req->path;
1857 $path = '/' unless length $path;
fbcc39ad 1858 my $address = $c->req->address || '';
1859
e3a13771 1860 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
fbcc39ad 1861 if $c->debug;
1862
e3a13771 1863 $c->prepare_action;
1864
fbcc39ad 1865 return $c;
1866}
1867
b5ecfcf0 1868=head2 $c->prepare_action
fbcc39ad 1869
b4b01a8a 1870Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 1871
1872=cut
1873
1874sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1875
b5ecfcf0 1876=head2 $c->prepare_body
fbcc39ad 1877
e7f1cf73 1878Prepares message body.
fbcc39ad 1879
1880=cut
1881
1882sub prepare_body {
1883 my $c = shift;
1884
0f56bbcf 1885 return if $c->request->_has_body;
fbcc39ad 1886
1887 # Initialize on-demand data
1888 $c->engine->prepare_body( $c, @_ );
1889 $c->prepare_parameters;
1890 $c->prepare_uploads;
1891
0584323b 1892 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1893 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1894 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1895 my $param = $c->req->body_parameters->{$key};
1896 my $value = defined($param) ? $param : '';
1897 $t->row( $key,
1898 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1899 }
1900 $c->log->debug( "Body Parameters are:\n" . $t->draw );
fbcc39ad 1901 }
1902}
1903
b5ecfcf0 1904=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 1905
e7f1cf73 1906Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 1907
b4b01a8a 1908See L<Catalyst::Engine>.
1909
4bd82c41 1910=cut
1911
4f5ebacd 1912sub prepare_body_chunk {
1913 my $c = shift;
4bd82c41 1914 $c->engine->prepare_body_chunk( $c, @_ );
1915}
1916
b5ecfcf0 1917=head2 $c->prepare_body_parameters
fbcc39ad 1918
e7f1cf73 1919Prepares body parameters.
fbcc39ad 1920
1921=cut
1922
1923sub prepare_body_parameters {
1924 my $c = shift;
1925 $c->engine->prepare_body_parameters( $c, @_ );
1926}
1927
b5ecfcf0 1928=head2 $c->prepare_connection
fbcc39ad 1929
e7f1cf73 1930Prepares connection.
fbcc39ad 1931
1932=cut
1933
1934sub prepare_connection {
1935 my $c = shift;
1936 $c->engine->prepare_connection( $c, @_ );
1937}
1938
b5ecfcf0 1939=head2 $c->prepare_cookies
fbcc39ad 1940
e7f1cf73 1941Prepares cookies.
fbcc39ad 1942
1943=cut
1944
1945sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1946
b5ecfcf0 1947=head2 $c->prepare_headers
fbcc39ad 1948
e7f1cf73 1949Prepares headers.
fbcc39ad 1950
1951=cut
1952
1953sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1954
b5ecfcf0 1955=head2 $c->prepare_parameters
fbcc39ad 1956
e7f1cf73 1957Prepares parameters.
fbcc39ad 1958
1959=cut
1960
1961sub prepare_parameters {
1962 my $c = shift;
1963 $c->prepare_body_parameters;
1964 $c->engine->prepare_parameters( $c, @_ );
1965}
1966
b5ecfcf0 1967=head2 $c->prepare_path
fbcc39ad 1968
e7f1cf73 1969Prepares path and base.
fbcc39ad 1970
1971=cut
1972
1973sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1974
b5ecfcf0 1975=head2 $c->prepare_query_parameters
fbcc39ad 1976
e7f1cf73 1977Prepares query parameters.
fbcc39ad 1978
1979=cut
1980
1981sub prepare_query_parameters {
1982 my $c = shift;
1983
1984 $c->engine->prepare_query_parameters( $c, @_ );
1985
0584323b 1986 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1987 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1988 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1989 my $param = $c->req->query_parameters->{$key};
fbcc39ad 1990 my $value = defined($param) ? $param : '';
8c113188 1991 $t->row( $key,
fbcc39ad 1992 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1993 }
0584323b 1994 $c->log->debug( "Query Parameters are:\n" . $t->draw );
fbcc39ad 1995 }
1996}
1997
b5ecfcf0 1998=head2 $c->prepare_read
fbcc39ad 1999
e7f1cf73 2000Prepares the input for reading.
fbcc39ad 2001
2002=cut
2003
2004sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2005
b5ecfcf0 2006=head2 $c->prepare_request
fbcc39ad 2007
e7f1cf73 2008Prepares the engine request.
fbcc39ad 2009
2010=cut
2011
2012sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2013
b5ecfcf0 2014=head2 $c->prepare_uploads
fbcc39ad 2015
e7f1cf73 2016Prepares uploads.
fbcc39ad 2017
2018=cut
2019
2020sub prepare_uploads {
2021 my $c = shift;
2022
2023 $c->engine->prepare_uploads( $c, @_ );
2024
2025 if ( $c->debug && keys %{ $c->request->uploads } ) {
8c113188 2026 my $t = Text::SimpleTable->new(
34d28dfd 2027 [ 12, 'Parameter' ],
2028 [ 26, 'Filename' ],
8c113188 2029 [ 18, 'Type' ],
2030 [ 9, 'Size' ]
2031 );
fbcc39ad 2032 for my $key ( sort keys %{ $c->request->uploads } ) {
2033 my $upload = $c->request->uploads->{$key};
2034 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 2035 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 2036 }
2037 }
2038 $c->log->debug( "File Uploads are:\n" . $t->draw );
2039 }
2040}
2041
b5ecfcf0 2042=head2 $c->prepare_write
fbcc39ad 2043
e7f1cf73 2044Prepares the output for writing.
fbcc39ad 2045
2046=cut
2047
2048sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2049
b5ecfcf0 2050=head2 $c->request_class
1f9cb7c1 2051
e7f1cf73 2052Returns or sets the request class.
1f9cb7c1 2053
b5ecfcf0 2054=head2 $c->response_class
1f9cb7c1 2055
e7f1cf73 2056Returns or sets the response class.
1f9cb7c1 2057
b5ecfcf0 2058=head2 $c->read( [$maxlength] )
fbcc39ad 2059
ae1e6b59 2060Reads a chunk of data from the request body. This method is designed to
2061be used in a while loop, reading C<$maxlength> bytes on every call.
2062C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 2063
cc95842f 2064You have to set C<< MyApp->config->{parse_on_demand} >> to use this
ae1e6b59 2065directly.
fbcc39ad 2066
878b821c 2067Warning: If you use read(), Catalyst will not process the body,
2068so you will not be able to access POST parameters or file uploads via
2069$c->request. You must handle all body parsing yourself.
2070
fbcc39ad 2071=cut
2072
2073sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2074
b5ecfcf0 2075=head2 $c->run
fbcc39ad 2076
2077Starts the engine.
2078
2079=cut
2080
2081sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2082
b5ecfcf0 2083=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 2084
e7f1cf73 2085Sets an action in a given namespace.
fbcc39ad 2086
2087=cut
2088
2089sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2090
b5ecfcf0 2091=head2 $c->setup_actions($component)
fbcc39ad 2092
e7f1cf73 2093Sets up actions for a component.
fbcc39ad 2094
2095=cut
2096
2097sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2098
b5ecfcf0 2099=head2 $c->setup_components
fbcc39ad 2100
86418559 2101Sets up components. Specify a C<setup_components> config option to pass
2102additional options directly to L<Module::Pluggable>. To add additional
2103search paths, specify a key named C<search_extra> as an array
2104reference. Items in the array beginning with C<::> will have the
18de900e 2105application class name prepended to them.
fbcc39ad 2106
2f381252 2107All components found will also have any
2108L<Devel::InnerPackage|inner packages> loaded and set up as components.
2109Note, that modules which are B<not> an I<inner package> of the main
2110file namespace loaded will not be instantiated as components.
2111
fbcc39ad 2112=cut
2113
2114sub setup_components {
2115 my $class = shift;
2116
18de900e 2117 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
2118 my $config = $class->config->{ setup_components };
2119 my $extra = delete $config->{ search_extra } || [];
ac5c933b 2120
18de900e 2121 push @paths, @$extra;
ac5c933b 2122
364d7324 2123 my $locator = Module::Pluggable::Object->new(
18de900e 2124 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2125 %$config
364d7324 2126 );
b94b200c 2127
2128 my @comps = sort { length $a <=> length $b } $locator->plugins;
2129 my %comps = map { $_ => 1 } @comps;
73e1183e 2130
2131 my $deprecated_component_names = grep { /::[CMV]::/ } @comps;
2132 $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2133 qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
19a24dbb 2134 ) if $deprecated_component_names;
73e1183e 2135
b94b200c 2136 for my $component ( @comps ) {
dd91afb5 2137
2138 # We pass ignore_loaded here so that overlay files for (e.g.)
2139 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2140 # we know M::P::O found a file on disk so this is safe
2141
f5a4863c 2142 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2143 #Class::MOP::load_class($component);
364d7324 2144
2145 my $module = $class->setup_component( $component );
2146 my %modules = (
2147 $component => $module,
2148 map {
2149 $_ => $class->setup_component( $_ )
ac5c933b 2150 } grep {
b94b200c 2151 not exists $comps{$_}
364d7324 2152 } Devel::InnerPackage::list_packages( $component )
2153 );
ac5c933b 2154
364d7324 2155 for my $key ( keys %modules ) {
2156 $class->components->{ $key } = $modules{ $key };
fbcc39ad 2157 }
364d7324 2158 }
2159}
fbcc39ad 2160
364d7324 2161=head2 $c->setup_component
fbcc39ad 2162
364d7324 2163=cut
fbcc39ad 2164
2f5cb070 2165sub _controller_init_base_classes {
2166 my ($class, $component) = @_;
2167 foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) {
2168 Moose->init_meta( for_class => $class )
2169 unless find_meta($class);
2170 }
2171}
2172
364d7324 2173sub setup_component {
2174 my( $class, $component ) = @_;
fbcc39ad 2175
364d7324 2176 unless ( $component->can( 'COMPONENT' ) ) {
2177 return $component;
2178 }
fbcc39ad 2179
2f5cb070 2180 # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
2181 # nearest to Catalyst::Controller first, no matter what order stuff happens
2182 # to be loaded. There are TODO tests in Moose for this, see
2183 # f2391d17574eff81d911b97be15ea51080500003
2184 if ($component->isa('Catalyst::Controller')) {
2185 $class->_controller_init_base_classes($component);
2186 }
2187
364d7324 2188 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2189 my $config = $class->config->{ $suffix } || {};
fbcc39ad 2190
364d7324 2191 my $instance = eval { $component->COMPONENT( $class, $config ); };
fbcc39ad 2192
2193 if ( my $error = $@ ) {
fbcc39ad 2194 chomp $error;
fbcc39ad 2195 Catalyst::Exception->throw(
364d7324 2196 message => qq/Couldn't instantiate component "$component", "$error"/
2197 );
fbcc39ad 2198 }
2199
7490de2a 2200 unless (blessed $instance) {
2201 my $metaclass = Moose::Util::find_meta($component);
2202 my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2203 my $component_method_from = $method_meta->associated_metaclass->name;
637fa644 2204 my $value = defined($instance) ? $instance : 'undef';
7490de2a 2205 Catalyst::Exception->throw(
2206 message =>
637fa644 2207 qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
7490de2a 2208 );
2209 }
364d7324 2210 return $instance;
fbcc39ad 2211}
2212
b5ecfcf0 2213=head2 $c->setup_dispatcher
fbcc39ad 2214
ae1e6b59 2215Sets up dispatcher.
2216
fbcc39ad 2217=cut
2218
2219sub setup_dispatcher {
2220 my ( $class, $dispatcher ) = @_;
2221
2222 if ($dispatcher) {
2223 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2224 }
2225
cb69249e 2226 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2227 $dispatcher = 'Catalyst::Dispatcher::' . $env;
fbcc39ad 2228 }
2229
2230 unless ($dispatcher) {
cb0354c6 2231 $dispatcher = $class->dispatcher_class;
fbcc39ad 2232 }
2233
e63bdf38 2234 Class::MOP::load_class($dispatcher);
fbcc39ad 2235
2236 # dispatcher instance
2237 $class->dispatcher( $dispatcher->new );
2238}
2239
b5ecfcf0 2240=head2 $c->setup_engine
fbcc39ad 2241
ae1e6b59 2242Sets up engine.
2243
fbcc39ad 2244=cut
2245
2246sub setup_engine {
2247 my ( $class, $engine ) = @_;
2248
2249 if ($engine) {
2250 $engine = 'Catalyst::Engine::' . $engine;
2251 }
2252
cb69249e 2253 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2254 $engine = 'Catalyst::Engine::' . $env;
fbcc39ad 2255 }
2256
9b0a3e0f 2257 if ( $ENV{MOD_PERL} ) {
e106a59f 2258 my $meta = Class::MOP::get_metaclass_by_name($class);
74c89dea 2259
fbcc39ad 2260 # create the apache method
74c89dea 2261 $meta->add_method('apache' => sub { shift->engine->apache });
fbcc39ad 2262
2263 my ( $software, $version ) =
2264 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2265
2266 $version =~ s/_//g;
2267 $version =~ s/(\.[^.]+)\./$1/g;
2268
2269 if ( $software eq 'mod_perl' ) {
2270
9b0a3e0f 2271 if ( !$engine ) {
22247e54 2272
9b0a3e0f 2273 if ( $version >= 1.99922 ) {
2274 $engine = 'Catalyst::Engine::Apache2::MP20';
2275 }
22247e54 2276
9b0a3e0f 2277 elsif ( $version >= 1.9901 ) {
2278 $engine = 'Catalyst::Engine::Apache2::MP19';
2279 }
22247e54 2280
9b0a3e0f 2281 elsif ( $version >= 1.24 ) {
2282 $engine = 'Catalyst::Engine::Apache::MP13';
2283 }
22247e54 2284
9b0a3e0f 2285 else {
2286 Catalyst::Exception->throw( message =>
2287 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2288 }
fbcc39ad 2289
fbcc39ad 2290 }
2291
2292 # install the correct mod_perl handler
2293 if ( $version >= 1.9901 ) {
2294 *handler = sub : method {
2295 shift->handle_request(@_);
2296 };
2297 }
2298 else {
2299 *handler = sub ($$) { shift->handle_request(@_) };
2300 }
2301
2302 }
2303
2304 elsif ( $software eq 'Zeus-Perl' ) {
2305 $engine = 'Catalyst::Engine::Zeus';
2306 }
2307
2308 else {
2309 Catalyst::Exception->throw(
2310 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2311 }
2312 }
2313
2314 unless ($engine) {
cb0354c6 2315 $engine = $class->engine_class;
fbcc39ad 2316 }
2317
e63bdf38 2318 Class::MOP::load_class($engine);
0e7f5826 2319
d54484bf 2320 # check for old engines that are no longer compatible
2321 my $old_engine;
0e7f5826 2322 if ( $engine->isa('Catalyst::Engine::Apache')
2323 && !Catalyst::Engine::Apache->VERSION )
d54484bf 2324 {
2325 $old_engine = 1;
2326 }
0e7f5826 2327
d54484bf 2328 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
0e7f5826 2329 && Catalyst::Engine::Server->VERSION le '0.02' )
d54484bf 2330 {
2331 $old_engine = 1;
2332 }
0e7f5826 2333
2334 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2335 && $engine->VERSION eq '0.01' )
d54484bf 2336 {
2337 $old_engine = 1;
2338 }
0e7f5826 2339
2340 elsif ($engine->isa('Catalyst::Engine::Zeus')
2341 && $engine->VERSION eq '0.01' )
d54484bf 2342 {
2343 $old_engine = 1;
2344 }
fbcc39ad 2345
d54484bf 2346 if ($old_engine) {
2347 Catalyst::Exception->throw( message =>
0e7f5826 2348 qq/Engine "$engine" is not supported by this version of Catalyst/
d54484bf 2349 );
2350 }
0e7f5826 2351
fbcc39ad 2352 # engine instance
2353 $class->engine( $engine->new );
2354}
2355
b5ecfcf0 2356=head2 $c->setup_home
fbcc39ad 2357
ae1e6b59 2358Sets up the home directory.
2359
fbcc39ad 2360=cut
2361
2362sub setup_home {
2363 my ( $class, $home ) = @_;
2364
cb69249e 2365 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2366 $home = $env;
fbcc39ad 2367 }
2368
b6d4ee6e 2369 $home ||= Catalyst::Utils::home($class);
fbcc39ad 2370
2371 if ($home) {
e63bdf38 2372 #I remember recently being scolded for assigning config values like this
fbcc39ad 2373 $class->config->{home} ||= $home;
a738ab68 2374 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
fbcc39ad 2375 }
2376}
2377
b5ecfcf0 2378=head2 $c->setup_log
fbcc39ad 2379
0fa676a7 2380Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2381passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2382log to.
2383
2384This method also installs a C<debug> method that returns a true value into the
2385catalyst subclass if the "debug" level is passed in the comma-delimited list,
2386or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2387
2388Note that if the log has already been setup, by either a previous call to
2389C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
5baa3bbc 2390that this method won't actually set up the log object.
ae1e6b59 2391
fbcc39ad 2392=cut
2393
2394sub setup_log {
0fa676a7 2395 my ( $class, $levels ) = @_;
fbcc39ad 2396
5baa3bbc 2397 $levels ||= '';
2398 $levels =~ s/^\s+//;
2399 $levels =~ s/\s+$//;
2400 my %levels = map { $_ => 1 } split /\s*,\s*/, $levels || '';
2401
fbcc39ad 2402 unless ( $class->log ) {
0fa676a7 2403 $class->log( Catalyst::Log->new(keys %levels) );
fbcc39ad 2404 }
af3ff00e 2405
cb69249e 2406 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
0fa676a7 2407 if ( defined($env_debug) or $levels{debug} ) {
e106a59f 2408 Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
fbcc39ad 2409 $class->log->debug('Debug messages enabled');
2410 }
2411}
2412
b5ecfcf0 2413=head2 $c->setup_plugins
fbcc39ad 2414
ae1e6b59 2415Sets up plugins.
2416
fbcc39ad 2417=cut
2418
dc5f035e 2419=head2 $c->setup_stats
2420
2421Sets up timing statistics class.
2422
2423=cut
2424
2425sub setup_stats {
2426 my ( $class, $stats ) = @_;
2427
2428 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2429
2430 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2431 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
e106a59f 2432 Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
b01f0c69 2433 $class->log->debug('Statistics enabled');
dc5f035e 2434 }
2435}
2436
2437
ac5c933b 2438=head2 $c->registered_plugins
836e1134 2439
2440Returns a sorted list of the plugins which have either been stated in the
2441import list or which have been added via C<< MyApp->plugin(@args); >>.
2442
2443If passed a given plugin name, it will report a boolean value indicating
2444whether or not that plugin is loaded. A fully qualified name is required if
2445the plugin name does not begin with C<Catalyst::Plugin::>.
2446
2447 if ($c->registered_plugins('Some::Plugin')) {
2448 ...
2449 }
2450
2451=cut
fbcc39ad 2452
836e1134 2453{
97b58e17 2454
2455 sub registered_plugins {
836e1134 2456 my $proto = shift;
197bd788 2457 return sort keys %{ $proto->_plugins } unless @_;
836e1134 2458 my $plugin = shift;
d0d4d785 2459 return 1 if exists $proto->_plugins->{$plugin};
2460 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
836e1134 2461 }
fbcc39ad 2462
836e1134 2463 sub _register_plugin {
2464 my ( $proto, $plugin, $instant ) = @_;
2465 my $class = ref $proto || $proto;
fbcc39ad 2466
dd91afb5 2467 # no ignore_loaded here, the plugin may already have been
2468 # defined in memory and we don't want to error on "no file" if so
2469
b6d4ee6e 2470 Class::MOP::load_class( $plugin );
fbcc39ad 2471
197bd788 2472 $proto->_plugins->{$plugin} = 1;
836e1134 2473 unless ($instant) {
fbcc39ad 2474 no strict 'refs';
e106a59f 2475 if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
74c89dea 2476 my @superclasses = ($plugin, $meta->superclasses );
2477 $meta->superclasses(@superclasses);
5fb67d52 2478 } else {
2479 unshift @{"$class\::ISA"}, $plugin;
2480 }
fbcc39ad 2481 }
836e1134 2482 return $class;
2483 }
2484
2485 sub setup_plugins {
2486 my ( $class, $plugins ) = @_;
2487
d0d4d785 2488 $class->_plugins( {} ) unless $class->_plugins;
836e1134 2489 $plugins ||= [];
2490 for my $plugin ( reverse @$plugins ) {
2491
2492 unless ( $plugin =~ s/\A\+// ) {
2493 $plugin = "Catalyst::Plugin::$plugin";
2494 }
2495
2496 $class->_register_plugin($plugin);
2497 }
fbcc39ad 2498 }
2499}
2500
b5ecfcf0 2501=head2 $c->stack
8767c5a3 2502
86418559 2503Returns an arrayref of the internal execution stack (actions that are
2504currently executing).
8767c5a3 2505
dc5f035e 2506=head2 $c->stats_class
2507
2508Returns or sets the stats (timing statistics) class.
2509
2510=head2 $c->use_stats
2511
2512Returns 1 when stats collection is enabled. Stats collection is enabled
2513when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2514environment variable is set.
2515
2516Note that this is a static method, not an accessor and should be overloaded
2517by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1).
2518
2519=cut
2520
2521sub use_stats { 0 }
2522
2523
b5ecfcf0 2524=head2 $c->write( $data )
fbcc39ad 2525
ae1e6b59 2526Writes $data to the output stream. When using this method directly, you
2527will need to manually set the C<Content-Length> header to the length of
2528your output data, if known.
fbcc39ad 2529
2530=cut
2531
4f5ebacd 2532sub write {
2533 my $c = shift;
2534
2535 # Finalize headers if someone manually writes output
2536 $c->finalize_headers;
2537
2538 return $c->engine->write( $c, @_ );
2539}
fbcc39ad 2540
b5ecfcf0 2541=head2 version
bf88a181 2542
ae1e6b59 2543Returns the Catalyst version number. Mostly useful for "powered by"
2544messages in template systems.
bf88a181 2545
2546=cut
2547
2548sub version { return $Catalyst::VERSION }
2549
b0bb11ec 2550=head1 INTERNAL ACTIONS
2551
ae1e6b59 2552Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2553C<_ACTION>, and C<_END>. These are by default not shown in the private
3e705254 2554action table, but you can make them visible with a config parameter.
b0bb11ec 2555
2556 MyApp->config->{show_internal_actions} = 1;
2557
d2ee9760 2558=head1 CASE SENSITIVITY
2559
3e705254 2560By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
ae1e6b59 2561mapped to C</foo/bar>. You can activate case sensitivity with a config
3e705254 2562parameter.
d2ee9760 2563
2564 MyApp->config->{case_sensitive} = 1;
2565
3e705254 2566This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
fbcc39ad 2567
2568=head1 ON-DEMAND PARSER
2569
2570The request body is usually parsed at the beginning of a request,
878b821c 2571but if you want to handle input yourself, you can enable on-demand
2572parsing with a config parameter.
fbcc39ad 2573
2574 MyApp->config->{parse_on_demand} = 1;
ac5c933b 2575
fbcc39ad 2576=head1 PROXY SUPPORT
2577
ae1e6b59 2578Many production servers operate using the common double-server approach,
2579with a lightweight frontend web server passing requests to a larger
2580backend server. An application running on the backend server must deal
2581with two problems: the remote user always appears to be C<127.0.0.1> and
2582the server's hostname will appear to be C<localhost> regardless of the
2583virtual host that the user connected through.
fbcc39ad 2584
ae1e6b59 2585Catalyst will automatically detect this situation when you are running
2586the frontend and backend servers on the same machine. The following
2587changes are made to the request.
fbcc39ad 2588
ac5c933b 2589 $c->req->address is set to the user's real IP address, as read from
ae1e6b59 2590 the HTTP X-Forwarded-For header.
ac5c933b 2591
ae1e6b59 2592 The host value for $c->req->base and $c->req->uri is set to the real
2593 host, as read from the HTTP X-Forwarded-Host header.
fbcc39ad 2594
3e705254 2595Obviously, your web server must support these headers for this to work.
fbcc39ad 2596
ae1e6b59 2597In a more complex server farm environment where you may have your
2598frontend proxy server(s) on different machines, you will need to set a
2599configuration option to tell Catalyst to read the proxied data from the
2600headers.
fbcc39ad 2601
2602 MyApp->config->{using_frontend_proxy} = 1;
ac5c933b 2603
fbcc39ad 2604If you do not wish to use the proxy support at all, you may set:
d1a31ac6 2605
fbcc39ad 2606 MyApp->config->{ignore_frontend_proxy} = 1;
2607
2608=head1 THREAD SAFETY
2609
86418559 2610Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2611C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2612believe the Catalyst core to be thread-safe.
fbcc39ad 2613
2614If you plan to operate in a threaded environment, remember that all other
3e705254 2615modules you are using must also be thread-safe. Some modules, most notably
2616L<DBD::SQLite>, are not thread-safe.
d1a31ac6 2617
3cb1db8c 2618=head1 SUPPORT
2619
2620IRC:
2621
4eaf7c88 2622 Join #catalyst on irc.perl.org.
3cb1db8c 2623
3e705254 2624Mailing Lists:
3cb1db8c 2625
6d4c3368 2626 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2627 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
1985c30b 2628
432d507d 2629Web:
2630
2631 http://catalyst.perl.org
2632
0ef52a96 2633Wiki:
2634
2635 http://dev.catalyst.perl.org
2636
fc7ec1d9 2637=head1 SEE ALSO
2638
829a28ca 2639=head2 L<Task::Catalyst> - All you need to start with Catalyst
2640
b5ecfcf0 2641=head2 L<Catalyst::Manual> - The Catalyst Manual
e7f1cf73 2642
b5ecfcf0 2643=head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
61b1e958 2644
b5ecfcf0 2645=head2 L<Catalyst::Engine> - Core engine
61b1e958 2646
b5ecfcf0 2647=head2 L<Catalyst::Log> - Log class.
61b1e958 2648
b5ecfcf0 2649=head2 L<Catalyst::Request> - Request object
61b1e958 2650
b5ecfcf0 2651=head2 L<Catalyst::Response> - Response object
61b1e958 2652
b5ecfcf0 2653=head2 L<Catalyst::Test> - The test suite.
fc7ec1d9 2654
2f381252 2655=head1 PROJECT FOUNDER
2656
2657sri: Sebastian Riedel <sri@cpan.org>
fc7ec1d9 2658
2f381252 2659=head1 CONTRIBUTORS
15f0b5b7 2660
2f381252 2661abw: Andy Wardley
fbcc39ad 2662
2f381252 2663acme: Leon Brocard <leon@astray.com>
33108eaf 2664
f4a57de4 2665Andrew Bramble
2666
15f0b5b7 2667Andrew Ford
2668
2669Andrew Ruthven
2670
2f381252 2671andyg: Andy Grundman <andy@hybridized.org>
fbcc39ad 2672
2f381252 2673audreyt: Audrey Tang
15f0b5b7 2674
2f381252 2675bricas: Brian Cassidy <bricas@cpan.org>
0cf56dbc 2676
e31b525c 2677Caelum: Rafael Kitover <rkitover@io.com>
2678
2f381252 2679chansen: Christian Hansen
6aaa1c60 2680
2f381252 2681chicks: Christopher Hicks
15f0b5b7 2682
0fa676a7 2683David E. Wheeler
2684
2f381252 2685dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
15f0b5b7 2686
2f381252 2687Drew Taylor
15f0b5b7 2688
2f381252 2689esskar: Sascha Kiefer
0ef52a96 2690
2f381252 2691fireartist: Carl Franks <cfranks@cpan.org>
15f0b5b7 2692
2f381252 2693gabb: Danijel Milicevic
61bef238 2694
15f0b5b7 2695Gary Ashton Jones
2696
2697Geoff Richards
2698
e4cc83b2 2699ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2700
2f381252 2701jcamacho: Juan Camacho
fbcc39ad 2702
108201b5 2703jhannah: Jay Hannah <jay@jays.net>
2704
15f0b5b7 2705Jody Belka
2706
2707Johan Lindstrom
2708
2f381252 2709jon: Jon Schutz <jjschutz@cpan.org>
15f0b5b7 2710
2f381252 2711marcus: Marcus Ramberg <mramberg@cpan.org>
15f0b5b7 2712
2f381252 2713miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
15f0b5b7 2714
2f381252 2715mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
15f0b5b7 2716
2f381252 2717mugwump: Sam Vilain
71c3bcc3 2718
2f381252 2719naughton: David Naughton
a727119f 2720
2f381252 2721ningu: David Kamholz <dkamholz@cpan.org>
1cf1c56a 2722
2f381252 2723nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
9c71d51d 2724
2f381252 2725numa: Dan Sully <daniel@cpan.org>
fc7ec1d9 2726
2f381252 2727obra: Jesse Vincent
2728
2729omega: Andreas Marienborg
51f0308d 2730
39fc2ce1 2731Oleg Kostyuk <cub.uanic@gmail.com>
2732
2f381252 2733phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
bdcb95ef 2734
6dae3eef 2735rafl: Florian Ragwitz <rafl@debian.org>
2736
2f381252 2737sky: Arthur Bergman
2738
2739the_jester: Jesse Sheidlower
2740
bb33cb06 2741t0m: Tomas Doran <bobtfish@bobtfish.net>
2742
2f381252 2743Ulf Edvinsson
51f0308d 2744
2f381252 2745willert: Sebastian Willert <willert@cpan.org>
51f0308d 2746
fc7ec1d9 2747=head1 LICENSE
2748
9ce5ab63 2749This library is free software, you can redistribute it and/or modify it under
41ca9ba7 2750the same terms as Perl itself.
fc7ec1d9 2751
2752=cut
2753
4090e3bb 2754no Moose;
2755
46d0346d 2756__PACKAGE__->meta->make_immutable;
2757
fc7ec1d9 27581;