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