new release to fix busted distributopn
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
CommitLineData
fc7ec1d9 1package Catalyst;
2
a7caa492 3use Moose;
c98492ae 4use Moose::Meta::Class ();
60eabdaf 5extends 'Catalyst::Component';
2f5cb070 6use Moose::Util qw/find_meta/;
38e43e65 7use namespace::clean -except => 'meta';
a2f2cde9 8use Catalyst::Exception;
154ef0c8 9use Catalyst::Exception::Detach;
10use Catalyst::Exception::Go;
fc7ec1d9 11use Catalyst::Log;
fbcc39ad 12use Catalyst::Request;
13use Catalyst::Request::Upload;
14use Catalyst::Response;
812a28c9 15use Catalyst::Utils;
31375184 16use Catalyst::Controller;
62b6b631 17use Data::OptList;
364d7324 18use Devel::InnerPackage ();
c50f595c 19use Module::Pluggable::Object ();
c50f595c 20use Text::SimpleTable ();
21use Path::Class::Dir ();
22use Path::Class::File ();
c50f595c 23use URI ();
933ba403 24use URI::http;
25use URI::https;
7af54927 26use HTML::Entities;
5513038d 27use Tree::Simple qw/use_weak_refs/;
28use Tree::Simple::Visitor::FindByUID;
269408a4 29use Class::C3::Adopt::NEXT;
3afa2d52 30use List::Util qw/uniq/;
261c571e 31use attributes;
532f0516 32use String::RewritePrefix;
b1ededd4 33use Catalyst::EngineLoader;
5789a3d8 34use utf8;
108201b5 35use Carp qw/croak carp shortmess/;
3640641e 36use Try::Tiny;
4995a5ce 37use Safe::Isa;
dd5b1dc4 38use Moose::Util 'find_meta';
ad79be34 39use Plack::Middleware::Conditional;
40use Plack::Middleware::ReverseProxy;
fb99321f 41use Plack::Middleware::IIS6ScriptNameFix;
201e0a1f 42use Plack::Middleware::IIS7KeepAliveFix;
d3670826 43use Plack::Middleware::LighttpdScriptNameFix;
aa20e9f5 44use Plack::Middleware::ContentLength;
45use Plack::Middleware::Head;
660f9bb0 46use Plack::Middleware::HTTPExceptions;
ecf903d0 47use Plack::Middleware::FixMissingBodyInRedirect;
3157d22a 48use Plack::Middleware::MethodOverride;
79070bc6 49use Plack::Middleware::RemoveRedundantBody;
6561feae 50use Catalyst::Middleware::Stash;
20a09634 51use Plack::Util;
e7399d8b 52use Class::Load 'load_class';
0ca510f0 53use Encode 2.21 'decode_utf8', 'encode_utf8';
d86c0bd4 54use Scalar::Util;
fc7ec1d9 55
0f6be50c 56BEGIN { require 5.008003; }
f63c03e4 57
8a440eba 58has stack => (is => 'ro', default => sub { [] });
6680c772 59has state => (is => 'rw', default => 0);
b6d4ee6e 60has stats => (is => 'rw');
61has action => (is => 'rw');
6680c772 62has counter => (is => 'rw', default => sub { {} });
398f13db 63has request => (
64 is => 'rw',
65 default => sub {
66 my $self = shift;
ec4d7259 67 my $class = ref $self;
68 my $composed_request_class = $class->composed_request_class;
69 return $composed_request_class->new( $self->_build_request_constructor_args);
398f13db 70 },
62864794 71 predicate => 'has_request',
398f13db 72 lazy => 1,
73);
a2c6c7b9 74sub _build_request_constructor_args {
0df490ef 75 my $self = shift;
76 my %p = ( _log => $self->log );
77 $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
b87d834e 78 $p{data_handlers} = {$self->registered_data_handlers};
88ba7793 79 $p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request}
80 if $self->config->{use_hash_multivalue_in_request};
0df490ef 81 \%p;
82}
83
ec4d7259 84sub composed_request_class {
85 my $class = shift;
2d4da72c 86 return $class->_composed_request_class if $class->_composed_request_class;
87
044e7667 88 my @traits = (@{$class->request_class_traits||[]}, @{$class->config->{request_class_traits}||[]});
7dac038c 89
90 # For each trait listed, figure out what the namespace is. First we try the $trait
91 # as it is in the config. Then try $MyApp::TraitFor::Request:$trait. Last we try
92 # Catalyst::TraitFor::Request::$trait. If none load, throw error.
93
94 my $trait_ns = 'TraitFor::Request';
95 my @normalized_traits = map {
96 Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
97 } @traits;
98
2d4da72c 99 if ($class->debug && scalar(@normalized_traits)) {
100 my $column_width = Catalyst::Utils::term_width() - 6;
101 my $t = Text::SimpleTable->new($column_width);
102 $t->row($_) for @normalized_traits;
103 $class->log->debug( "Composed Request Class Traits:\n" . $t->draw . "\n" );
104 }
105
106 return $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @normalized_traits));
ec4d7259 107}
108
7c1c4dc6 109has response => (
110 is => 'rw',
111 default => sub {
112 my $self = shift;
ec4d7259 113 my $class = ref $self;
114 my $composed_response_class = $class->composed_response_class;
115 return $composed_response_class->new( $self->_build_response_constructor_args);
7c1c4dc6 116 },
62864794 117 predicate=>'has_response',
7c1c4dc6 118 lazy => 1,
119);
a2c6c7b9 120sub _build_response_constructor_args {
e8361cf8 121 return +{
122 _log => $_[0]->log,
123 encoding => $_[0]->encoding,
124 };
0df490ef 125}
126
ec4d7259 127sub composed_response_class {
128 my $class = shift;
2d4da72c 129 return $class->_composed_response_class if $class->_composed_response_class;
88e5a8b0 130
044e7667 131 my @traits = (@{$class->response_class_traits||[]}, @{$class->config->{response_class_traits}||[]});
7dac038c 132
133 my $trait_ns = 'TraitFor::Response';
134 my @normalized_traits = map {
135 Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
136 } @traits;
137
2d4da72c 138 if ($class->debug && scalar(@normalized_traits)) {
139 my $column_width = Catalyst::Utils::term_width() - 6;
140 my $t = Text::SimpleTable->new($column_width);
141 $t->row($_) for @normalized_traits;
142 $class->log->debug( "Composed Response Class Traits:\n" . $t->draw . "\n" );
143 }
144
145 return $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @normalized_traits));
ec4d7259 146}
147
e63bdf38 148has namespace => (is => 'rw');
149
8767c5a3 150sub depth { scalar @{ shift->stack || [] }; }
0fc2d522 151sub comp { shift->component(@_) }
6680c772 152
153sub req {
6680c772 154 my $self = shift; return $self->request(@_);
155}
156sub res {
6680c772 157 my $self = shift; return $self->response(@_);
158}
fbcc39ad 159
160# For backwards compatibility
0fc2d522 161sub finalize_output { shift->finalize_body(@_) };
fbcc39ad 162
163# For statistics
164our $COUNT = 1;
165our $START = time;
166our $RECURSION = 1000;
154ef0c8 167our $DETACH = Catalyst::Exception::Detach->new;
168our $GO = Catalyst::Exception::Go->new;
fbcc39ad 169
88e5a8b0 170#I imagine that very few of these really
7dac038c 171#need to be class variables. if any.
b6d4ee6e 172#maybe we should just make them attributes with a default?
fbcc39ad 173__PACKAGE__->mk_classdata($_)
3cec521a 174 for qw/components arguments dispatcher engine log dispatcher_class
1e5dad00 175 engine_loader context_class request_class response_class stats_class
b87d834e 176 setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware
ec4d7259 177 _data_handlers _encoding _encode_check finalized_default_middleware
178 request_class_traits response_class_traits stats_class_traits
179 _composed_request_class _composed_response_class _composed_stats_class/;
cb0354c6 180
3cec521a 181__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
3cec521a 182__PACKAGE__->request_class('Catalyst::Request');
183__PACKAGE__->response_class('Catalyst::Response');
dc5f035e 184__PACKAGE__->stats_class('Catalyst::Stats');
ec4d7259 185
186sub composed_stats_class {
187 my $class = shift;
2d4da72c 188 return $class->_composed_stats_class if $class->_composed_stats_class;
189
044e7667 190 my @traits = (@{$class->stats_class_traits||[]}, @{$class->config->{stats_class_traits}||[]});
7dac038c 191
192 my $trait_ns = 'TraitFor::Stats';
193 my @normalized_traits = map {
194 Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_)
195 } @traits;
196
2d4da72c 197 if ($class->debug && scalar(@normalized_traits)) {
198 my $column_width = Catalyst::Utils::term_width() - 6;
199 my $t = Text::SimpleTable->new($column_width);
200 $t->row($_) for @normalized_traits;
201 $class->log->debug( "Composed Stats Class Traits:\n" . $t->draw . "\n" );
202 }
203
204 return $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @normalized_traits));
ec4d7259 205}
206
9c38cb50 207__PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
fbcc39ad 208
6415bb4d 209# Remember to update this in Catalyst::Runtime as well!
7e12141f 210our $VERSION = '5.90126';
5c779e98 211$VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
189e2a51 212
fbcc39ad 213sub import {
214 my ( $class, @arguments ) = @_;
215
216 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
217 # callers @ISA.
218 return unless $class eq 'Catalyst';
219
84ff88cf 220 my $caller = caller();
221 return if $caller eq 'main';
269408a4 222
84ff88cf 223 my $meta = Moose::Meta::Class->initialize($caller);
fbcc39ad 224 unless ( $caller->isa('Catalyst') ) {
84ff88cf 225 my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
226 $meta->superclasses(@superclasses);
227 }
1cad29ab 228 # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
229 $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
230
84ff88cf 231 unless( $meta->has_method('meta') ){
9c74923d 232 if ($Moose::VERSION >= 1.15) {
233 $meta->_add_meta_method('meta');
234 }
235 else {
236 $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
237 }
fbcc39ad 238 }
239
240 $caller->arguments( [@arguments] );
241 $caller->setup_home;
242}
fc7ec1d9 243
e6bfaa20 244sub _application { $_[0] }
245
bf590d36 246=encoding UTF-8
247
fc7ec1d9 248=head1 NAME
249
250Catalyst - The Elegant MVC Web Application Framework
251
252=head1 SYNOPSIS
253
e7ad3b81 254See the L<Catalyst::Manual> distribution for comprehensive
255documentation and tutorials.
256
86418559 257 # Install Catalyst::Devel for helpers and other development tools
b4b01a8a 258 # use the helper to create a new application
91864987 259 catalyst.pl MyApp
fc7ec1d9 260
261 # add models, views, controllers
2f381252 262 script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
cc95842f 263 script/myapp_create.pl view MyTemplate TT
0ef52a96 264 script/myapp_create.pl controller Search
fc7ec1d9 265
e7f1cf73 266 # built in testserver -- use -r to restart automatically on changes
cc95842f 267 # --help to see all available options
ae4e40a7 268 script/myapp_server.pl
fc7ec1d9 269
0ef52a96 270 # command line testing interface
ae4e40a7 271 script/myapp_test.pl /yada
fc7ec1d9 272
b4b01a8a 273 ### in lib/MyApp.pm
0ef52a96 274 use Catalyst qw/-Debug/; # include plugins here as well
62a6df80 275
85d9fce6 276 ### In lib/MyApp/Controller/Root.pm (autocreated)
20f0d47b 277 sub foo : Chained('/') Args() { # called for /foo, /foo/1, /foo/1/2, etc.
ae1e6b59 278 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
279 $c->stash->{template} = 'foo.tt'; # set the template
0ef52a96 280 # lookup something from db -- stash vars are passed to TT
62a6df80 281 $c->stash->{data} =
b4b01a8a 282 $c->model('Database::Foo')->search( { country => $args[0] } );
0ef52a96 283 if ( $c->req->params->{bar} ) { # access GET or POST parameters
284 $c->forward( 'bar' ); # process another action
62a6df80 285 # do something else after forward returns
0ef52a96 286 }
287 }
62a6df80 288
ae1e6b59 289 # The foo.tt TT template can use the stash data from the database
0ef52a96 290 [% WHILE (item = data.next) %]
291 [% item.foo %]
292 [% END %]
62a6df80 293
0ef52a96 294 # called for /bar/of/soap, /bar/of/soap/10, etc.
20f0d47b 295 sub bar : Chained('/') PathPart('/bar/of/soap') Args() { ... }
62a6df80 296
ae1e6b59 297 # called after all actions are finished
20f0d47b 298 sub end : Action {
5a8ed4fe 299 my ( $self, $c ) = @_;
0ef52a96 300 if ( scalar @{ $c->error } ) { ... } # handle errors
301 return if $c->res->body; # already have a response
302 $c->forward( 'MyApp::View::TT' ); # render template
5a8ed4fe 303 }
304
0ef52a96 305See L<Catalyst::Manual::Intro> for additional information.
3803e98f 306
fc7ec1d9 307=head1 DESCRIPTION
308
86418559 309Catalyst is a modern framework for making web applications without the
310pain usually associated with this process. This document is a reference
311to the main Catalyst application. If you are a new user, we suggest you
312start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
fc7ec1d9 313
314See L<Catalyst::Manual> for more documentation.
315
ae1e6b59 316Catalyst plugins can be loaded by naming them as arguments to the "use
317Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
318plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
319C<My::Module>.
fc7ec1d9 320
0ef52a96 321 use Catalyst qw/My::Module/;
fc7ec1d9 322
836e1134 323If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
324fully qualify the name by using a unary plus:
325
326 use Catalyst qw/
327 My::Module
328 +Fully::Qualified::Plugin::Name
329 /;
330
5853fd49 331Special flags like C<-Debug> can also be specified as
ae1e6b59 332arguments when Catalyst is loaded:
fc7ec1d9 333
334 use Catalyst qw/-Debug My::Module/;
335
ae1e6b59 336The position of plugins and flags in the chain is important, because
86418559 337they are loaded in the order in which they appear.
fc7ec1d9 338
23f9d934 339The following flags are supported:
340
b5ecfcf0 341=head2 -Debug
23f9d934 342
f8ad6ea5 343Enables debug output. You can also force this setting from the system
86418559 344environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
345settings override the application, with <MYAPP>_DEBUG having the highest
346priority.
fc7ec1d9 347
c8083f4e 348This sets the log level to 'debug' and enables full debug output on the
349error screen. If you only want the latter, see L<< $c->debug >>.
350
b5ecfcf0 351=head2 -Home
fbcc39ad 352
ae1e6b59 353Forces Catalyst to use a specific home directory, e.g.:
354
86418559 355 use Catalyst qw[-Home=/usr/mst];
fbcc39ad 356
cc95842f 357This can also be done in the shell environment by setting either the
358C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
359is replaced with the uppercased name of your application, any "::" in
360the name will be replaced with underscores, e.g. MyApp::Web should use
361MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
362
d7a82605 363If none of these are set, Catalyst will attempt to automatically detect the
8ad6fd58 364home directory. If you are working in a development environment, Catalyst
a943d722 365will try and find the directory containing either Makefile.PL, Build.PL,
366dist.ini, or cpanfile. If the application has been installed into the system
367(i.e. you have done C<make install>), then Catalyst will use the path to your
8ad6fd58 368application module, without the .pm extension (e.g., /foo/MyApp if your
d7a82605 369application was installed at /foo/MyApp.pm)
370
b5ecfcf0 371=head2 -Log
fbcc39ad 372
0fa676a7 373 use Catalyst '-Log=warn,fatal,error';
62a6df80 374
0fa676a7 375Specifies a comma-delimited list of log levels.
fbcc39ad 376
dc5f035e 377=head2 -Stats
378
01c5eab0 379Enables statistics collection and reporting.
dc5f035e 380
01c5eab0 381 use Catalyst qw/-Stats=1/;
dc5f035e 382
01c5eab0 383You can also force this setting from the system environment with CATALYST_STATS
384or <MYAPP>_STATS. The environment settings override the application, with
385<MYAPP>_STATS having the highest priority.
dc5f035e 386
01c5eab0 387Stats are also enabled if L<< debugging |/"-Debug" >> is enabled.
dc5f035e 388
23f9d934 389=head1 METHODS
390
f7b672ef 391=head2 INFORMATION ABOUT THE CURRENT REQUEST
0ef52a96 392
b5ecfcf0 393=head2 $c->action
66e28e3f 394
ae1e6b59 395Returns a L<Catalyst::Action> object for the current action, which
396stringifies to the action name. See L<Catalyst::Action>.
0ef52a96 397
b5ecfcf0 398=head2 $c->namespace
0ef52a96 399
86418559 400Returns the namespace of the current action, i.e., the URI prefix
ae1e6b59 401corresponding to the controller of the current action. For example:
402
403 # in Controller::Foo::Bar
404 $c->namespace; # returns 'foo/bar';
0ef52a96 405
b5ecfcf0 406=head2 $c->request
0ef52a96 407
b5ecfcf0 408=head2 $c->req
0ef52a96 409
86418559 410Returns the current L<Catalyst::Request> object, giving access to
411information about the current client request (including parameters,
412cookies, HTTP headers, etc.). See L<Catalyst::Request>.
0ef52a96 413
62864794 414There is a predicate method C<has_request> that returns true if the
415request object has been created. This is something you might need to
416check if you are writing plugins that run before a request is finalized.
417
b4b01a8a 418=head2 REQUEST FLOW HANDLING
0ef52a96 419
b5ecfcf0 420=head2 $c->forward( $action [, \@arguments ] )
0ef52a96 421
b5ecfcf0 422=head2 $c->forward( $class, $method, [, \@arguments ] )
0ef52a96 423
52c77837 424This is one way of calling another action (method) in the same or
425a different controller. You can also use C<< $self->my_method($c, @args) >>
426in the same controller or C<< $c->controller('MyController')->my_method($c, @args) >>
427in a different controller.
428The main difference is that 'forward' uses some of the Catalyst request
429cycle overhead, including debugging, which may be useful to you. On the
430other hand, there are some complications to using 'forward', restrictions
431on values returned from 'forward', and it may not handle errors as you prefer.
432Whether you use 'forward' or not is up to you; it is not considered superior to
433the other ways to call a method.
434
435'forward' calls another action, by its private name. If you give a
b4b01a8a 436class name but no method, C<process()> is called. You may also optionally
437pass arguments in an arrayref. The action will receive the arguments in
cc95842f 438C<@_> and C<< $c->req->args >>. Upon returning from the function,
439C<< $c->req->args >> will be restored to the previous values.
0ef52a96 440
3b984c64 441Any data C<return>ed from the action forwarded to, will be returned by the
d759db1e 442call to forward.
3b984c64 443
444 my $foodata = $c->forward('/foo');
0ef52a96 445 $c->forward('index');
1d3a0700 446 $c->forward(qw/Model::DBIC::Foo do_stuff/);
447 $c->forward('View::TT');
0ef52a96 448
18a9655c 449Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
450an C<< eval { } >> around the call (actually
8ad6fd58 451L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all
452exceptions thrown by the called action non-fatal and pushing them onto
453$c->error instead. If you want C<die> to propagate you need to do something
454like:
f3e6a8c0 455
456 $c->forward('foo');
7d6820cc 457 die join "\n", @{ $c->error } if @{ $c->error };
f3e6a8c0 458
86418559 459Or make sure to always return true values from your actions and write
460your code like this:
f3e6a8c0 461
462 $c->forward('foo') || return;
1d3a0700 463
2e60292e 464Another note is that C<< $c->forward >> always returns a scalar because it
465actually returns $c->state which operates in a scalar context.
466Thus, something like:
467
468 return @array;
1d3a0700 469
470in an action that is forwarded to is going to return a scalar,
2e60292e 471i.e. how many items are in that array, which is probably not what you want.
1d3a0700 472If you need to return an array then return a reference to it,
2e60292e 473or stash it like so:
474
475 $c->stash->{array} = \@array;
476
477and access it from the stash.
f3e6a8c0 478
eb67e0f6 479Keep in mind that the C<end> method used is that of the caller action. So a C<< $c->detach >> inside a forwarded action would run the C<end> method from the original action requested.
9c74923d 480
0ef52a96 481=cut
482
6680c772 483sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
0ef52a96 484
b5ecfcf0 485=head2 $c->detach( $action [, \@arguments ] )
0ef52a96 486
b5ecfcf0 487=head2 $c->detach( $class, $method, [, \@arguments ] )
0ef52a96 488
264bac8c 489=head2 $c->detach()
490
18a9655c 491The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
492doesn't return to the previous action when processing is finished.
0ef52a96 493
264bac8c 494When called with no arguments it escapes the processing chain entirely.
495
0ef52a96 496=cut
497
498sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
499
8431b9cc 500=head2 $c->visit( $action [, \@arguments ] )
501
5d91ffe2 502=head2 $c->visit( $action [, \@captures, \@arguments ] )
ae0e35ee 503
8431b9cc 504=head2 $c->visit( $class, $method, [, \@arguments ] )
505
5d91ffe2 506=head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
ae0e35ee 507
18a9655c 508Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
509but does a full dispatch, instead of just calling the new C<$action> /
510C<< $class->$method >>. This means that C<begin>, C<auto> and the method
511you go to are called, just like a new request.
ae0e35ee 512
4b48773e 513In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
18a9655c 514This means, for example, that C<< $c->action >> methods such as
515L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
516L<reverse|Catalyst::Action/reverse> return information for the visited action
517when they are invoked within the visited action. This is different from the
518behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
519continues to use the $c->action object from the caller action even when
8ad6fd58 520invoked from the called action.
4b48773e 521
18a9655c 522C<< $c->stash >> is kept unchanged.
ae0e35ee 523
18a9655c 524In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
525allows you to "wrap" another action, just as it would have been called by
526dispatching from a URL, while the analogous
527L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
528transfer control to another action as if it had been reached directly from a URL.
ae0e35ee 529
530=cut
531
532sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
533
8431b9cc 534=head2 $c->go( $action [, \@arguments ] )
535
5d91ffe2 536=head2 $c->go( $action [, \@captures, \@arguments ] )
2f381252 537
8431b9cc 538=head2 $c->go( $class, $method, [, \@arguments ] )
539
5d91ffe2 540=head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
2f381252 541
1d3a0700 542The relationship between C<go> and
12c48597 543L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
1d3a0700 544the relationship between
12c48597 545L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
546L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
547C<< $c->go >> will perform a full dispatch on the specified action or method,
548with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
549C<go> escapes the processing of the current request chain on completion, and
f380e881 550does not return to its caller.
2f381252 551
9c74923d 552@arguments are arguments to the final destination of $action. @captures are
553arguments to the intermediate steps, if any, on the way to the final sub of
554$action.
555
2f381252 556=cut
557
558sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
559
b4b01a8a 560=head2 $c->response
561
562=head2 $c->res
563
cc95842f 564Returns the current L<Catalyst::Response> object, see there for details.
b4b01a8a 565
62864794 566There is a predicate method C<has_response> that returns true if the
567request object has been created. This is something you might need to
568check if you are writing plugins that run before a request is finalized.
569
b4b01a8a 570=head2 $c->stash
571
572Returns a hashref to the stash, which may be used to store data and pass
573it between components during a request. You can also set hash keys by
574passing arguments. The stash is automatically sent to the view. The
575stash is cleared at the end of a request; it cannot be used for
86418559 576persistent storage (for this you must use a session; see
577L<Catalyst::Plugin::Session> for a complete system integrated with
578Catalyst).
b4b01a8a 579
580 $c->stash->{foo} = $bar;
581 $c->stash( { moose => 'majestic', qux => 0 } );
582 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
62a6df80 583
b4b01a8a 584 # stash is automatically passed to the view for use in a template
cc95842f 585 $c->forward( 'MyApp::View::TT' );
b4b01a8a 586
4b0b7489 587The stash hash is currently stored in the PSGI C<$env> and is managed by
588L<Catalyst::Middleware::Stash>. Since it's part of the C<$env> items in
589the stash can be accessed in sub applications mounted under your main
590L<Catalyst> application. For example if you delegate the response of an
591action to another L<Catalyst> application, that sub application will have
592access to all the stash keys of the main one, and if can of course add
593more keys of its own. However those new keys will not 'bubble' back up
594to the main application.
595
596For more information the best thing to do is to review the test case:
597t/middleware-stash.t in the distribution /t directory.
598
6561feae 599=cut
600
601sub stash {
602 my $c = shift;
98d049ef 603 $c->log->error("You are requesting the stash but you don't have a context") unless blessed $c;
561098d1 604 return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_);
6561feae 605}
b4b01a8a 606
b5ecfcf0 607=head2 $c->error
0ef52a96 608
b5ecfcf0 609=head2 $c->error($error, ...)
0ef52a96 610
b5ecfcf0 611=head2 $c->error($arrayref)
0ef52a96 612
83a8fcac 613Returns an arrayref containing error messages. If Catalyst encounters an
614error while processing a request, it stores the error in $c->error. This
e7ad3b81 615method should only be used to store fatal error messages.
0ef52a96 616
617 my @error = @{ $c->error };
618
619Add a new error.
620
621 $c->error('Something bad happened');
622
b94f8e72 623Calling this will always return an arrayref (if there are no errors it
624will be an empty arrayref.
625
0ef52a96 626=cut
627
628sub error {
629 my $c = shift;
630 if ( $_[0] ) {
631 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
9ce44430 632 croak @$error unless ref $c;
0ef52a96 633 push @{ $c->{error} }, @$error;
634 }
635 elsif ( defined $_[0] ) { $c->{error} = undef }
636 return $c->{error} || [];
637}
638
b4b01a8a 639=head2 $c->state
640
1d3a0700 641Contains the return value of the last executed action.
2e60292e 642Note that << $c->state >> operates in a scalar context which means that all
643values it returns are scalar.
b4b01a8a 644
e459bd03 645Please note that if an action throws an exception, the value of state
646should no longer be considered the return if the last action. It is generally
647going to be 0, which indicates an error state. Examine $c->error for error
648details.
649
ca81eb67 650=head2 $c->clear_errors
651
652Clear errors. You probably don't want to clear the errors unless you are
653implementing a custom error screen.
654
655This is equivalent to running
656
657 $c->error(0);
658
659=cut
660
661sub clear_errors {
662 my $c = shift;
663 $c->error(0);
664}
665
30e84ba1 666=head2 $c->has_errors
667
668Returns true if you have errors
669
670=cut
671
672sub has_errors { scalar(@{shift->error}) ? 1:0 }
673
b94f8e72 674=head2 $c->last_error
675
676Returns the most recent error in the stack (the one most recently added...)
e5ac67e5 677or nothing if there are no errors. This does not modify the contents of the
678error stack.
b94f8e72 679
680=cut
681
e5ac67e5 682sub last_error {
683 my (@errs) = @{shift->error};
684 return scalar(@errs) ? $errs[-1]: undef;
685}
b94f8e72 686
687=head2 shift_errors
688
e5ac67e5 689shifts the most recently added error off the error stack and returns it. Returns
566678d0 690nothing if there are no more errors.
b94f8e72 691
692=cut
693
694sub shift_errors {
695 my ($self) = @_;
e5ac67e5 696 my @errors = @{$self->error};
697 my $err = shift(@errors);
698 $self->{error} = \@errors;
699 return $err;
700}
701
702=head2 pop_errors
703
704pops the most recently added error off the error stack and returns it. Returns
705nothing if there are no more errors.
706
707=cut
708
709sub pop_errors {
710 my ($self) = @_;
711 my @errors = @{$self->error};
712 my $err = pop(@errors);
b94f8e72 713 $self->{error} = \@errors;
714 return $err;
715}
716
2f381252 717sub _comp_search_prefixes {
c23b894b 718 my $c = shift;
719 return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
720}
721
722# search components given a name and some prefixes
723sub _comp_names_search_prefixes {
2f381252 724 my ( $c, $name, @prefixes ) = @_;
725 my $appclass = ref $c || $c;
726 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
cce626ed 727 $filter = qr/$filter/; # Compile regex now rather than once per loop
0ef52a96 728
2f381252 729 # map the original component name to the sub part that we will search against
730 my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
731 grep { /$filter/ } keys %{ $c->components };
0756fe3b 732
2f381252 733 # undef for a name will return all
734 return keys %eligible if !defined $name;
0756fe3b 735
4995a5ce 736 my $query = $name->$_isa('Regexp') ? $name : qr/^$name$/i;
2f381252 737 my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
0756fe3b 738
c23b894b 739 return @result if @result;
0756fe3b 740
2f381252 741 # if we were given a regexp to search against, we're done.
4995a5ce 742 return if $name->$_isa('Regexp');
0756fe3b 743
ab86b480 744 # skip regexp fallback if configured
745 return
746 if $appclass->config->{disable_component_resolution_regex_fallback};
747
2f381252 748 # regexp fallback
749 $query = qr/$name/i;
c23b894b 750 @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
0756fe3b 751
2f381252 752 # no results? try against full names
753 if( !@result ) {
c23b894b 754 @result = grep { m{$query} } keys %eligible;
2f381252 755 }
0756fe3b 756
2f381252 757 # don't warn if we didn't find any results, it just might not exist
758 if( @result ) {
cce626ed 759 # Disgusting hack to work out correct method name
760 my $warn_for = lc $prefixes[0];
e260802a 761 my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
108201b5 762 (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
763 "component resolution is unreliable and unsafe.";
764 my $short = $result[0];
ab86b480 765 # remove the component namespace prefix
766 $short =~ s/.*?(Model|Controller|View):://;
108201b5 767 my $shortmess = Carp::shortmess('');
768 if ($shortmess =~ m#Catalyst/Plugin#) {
769 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
770 "plugin's config";
771 } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
772 $msg .= " You probably need to set '$short' instead of '${name}' in this " .
773 "component's config";
774 } else {
ab86b480 775 $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " .
108201b5 776 "but if you really wanted to search, pass in a regexp as the argument " .
cce626ed 777 "like so: \$c->${warn_for}(qr/${name}/)";
108201b5 778 }
779 $c->log->warn( "${msg}$shortmess" );
2f381252 780 }
0756fe3b 781
2f381252 782 return @result;
0756fe3b 783}
784
62a6df80 785# Find possible names for a prefix
3b88a455 786sub _comp_names {
787 my ( $c, @prefixes ) = @_;
3b88a455 788 my $appclass = ref $c || $c;
789
2f381252 790 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
3b88a455 791
c23b894b 792 my @names = map { s{$filter}{}; $_; }
793 $c->_comp_names_search_prefixes( undef, @prefixes );
794
3b88a455 795 return @names;
796}
797
197bd788 798# Filter a component before returning by calling ACCEPT_CONTEXT if available
e39312ba 799
197bd788 800sub _filter_component {
801 my ( $c, $comp, @args ) = @_;
2f381252 802
3e560748 803 if(ref $comp eq 'CODE') {
98d049ef 804 $comp = $comp->();
3e560748 805 }
806
8abaac85 807 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
718a1619 808 return $comp->ACCEPT_CONTEXT( $c, @args );
197bd788 809 }
62a6df80 810
3e560748 811 $c->log->warn("You called component '${\$comp->catalyst_component_name}' with arguments [@args], but this component does not ACCEPT_CONTEXT, so args are ignored.") if scalar(@args) && $c->debug;
812
2f381252 813 return $comp;
197bd788 814}
815
f7b672ef 816=head2 COMPONENT ACCESSORS
0ef52a96 817
b5ecfcf0 818=head2 $c->controller($name)
af3ff00e 819
0ef52a96 820Gets a L<Catalyst::Controller> instance by name.
af3ff00e 821
822 $c->controller('Foo')->do_stuff;
823
86418559 824If the name is omitted, will return the controller for the dispatched
825action.
649fd1fa 826
2f381252 827If you want to search for controllers, pass in a regexp as the argument.
828
829 # find all controllers that start with Foo
830 my @foo_controllers = $c->controller(qr{^Foo});
831
832
af3ff00e 833=cut
834
835sub controller {
197bd788 836 my ( $c, $name, @args ) = @_;
2f381252 837
13311c16 838 my $appclass = ref($c) || $c;
2f381252 839 if( $name ) {
4995a5ce 840 unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
13311c16 841 my $comps = $c->components;
842 my $check = $appclass."::Controller::".$name;
843 return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
3b5f9ebb 844 foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) {
845 next unless $path =~ /.*::Controller/;
846 $check = $path."::".$name;
847 return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
848 }
13311c16 849 }
2f381252 850 my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
851 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
852 return $c->_filter_component( $result[ 0 ], @args );
853 }
854
197bd788 855 return $c->component( $c->action->class );
af3ff00e 856}
857
b5ecfcf0 858=head2 $c->model($name)
fc7ec1d9 859
0ef52a96 860Gets a L<Catalyst::Model> instance by name.
861
862 $c->model('Foo')->do_stuff;
fc7ec1d9 863
3e560748 864Any extra arguments are directly passed to ACCEPT_CONTEXT, if the model
865defines ACCEPT_CONTEXT. If it does not, the args are discarded.
72f87c4b 866
62a6df80 867If the name is omitted, it will look for
2f381252 868 - a model object in $c->stash->{current_model_instance}, then
a3b71f0f 869 - a model name in $c->stash->{current_model}, then
870 - a config setting 'default_model', or
871 - check if there is only one model, and return it if that's the case.
649fd1fa 872
2f381252 873If you want to search for models, pass in a regexp as the argument.
874
875 # find all models that start with Foo
876 my @foo_models = $c->model(qr{^Foo});
877
fc7ec1d9 878=cut
879
0ef52a96 880sub model {
197bd788 881 my ( $c, $name, @args ) = @_;
df960201 882 my $appclass = ref($c) || $c;
2f381252 883 if( $name ) {
4995a5ce 884 unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
13311c16 885 my $comps = $c->components;
886 my $check = $appclass."::Model::".$name;
887 return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
3b5f9ebb 888 foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) {
889 next unless $path =~ /.*::Model/;
890 $check = $path."::".$name;
891 return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
892 }
13311c16 893 }
2f381252 894 my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
895 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
896 return $c->_filter_component( $result[ 0 ], @args );
897 }
898
a3b71f0f 899 if (ref $c) {
62a6df80 900 return $c->stash->{current_model_instance}
a3b71f0f 901 if $c->stash->{current_model_instance};
902 return $c->model( $c->stash->{current_model} )
903 if $c->stash->{current_model};
a3b71f0f 904 }
df960201 905 return $c->model( $appclass->config->{default_model} )
906 if $appclass->config->{default_model};
3b88a455 907
2f381252 908 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
3b88a455 909
2f381252 910 if( $rest ) {
108201b5 911 $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
4600a5a1 912 $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' );
2f381252 913 $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
914 $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
11c270bd 915 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
2f381252 916 }
3b88a455 917
2f381252 918 return $c->_filter_component( $comp );
3b88a455 919}
920
b4b01a8a 921
b5ecfcf0 922=head2 $c->view($name)
0ef52a96 923
924Gets a L<Catalyst::View> instance by name.
fc7ec1d9 925
0ef52a96 926 $c->view('Foo')->do_stuff;
fc7ec1d9 927
72f87c4b 928Any extra arguments are directly passed to ACCEPT_CONTEXT.
929
62a6df80 930If the name is omitted, it will look for
2f381252 931 - a view object in $c->stash->{current_view_instance}, then
a3b71f0f 932 - a view name in $c->stash->{current_view}, then
933 - a config setting 'default_view', or
934 - check if there is only one view, and return it if that's the case.
649fd1fa 935
2f381252 936If you want to search for views, pass in a regexp as the argument.
937
938 # find all views that start with Foo
939 my @foo_views = $c->view(qr{^Foo});
940
fc7ec1d9 941=cut
942
0ef52a96 943sub view {
197bd788 944 my ( $c, $name, @args ) = @_;
2f381252 945
df960201 946 my $appclass = ref($c) || $c;
2f381252 947 if( $name ) {
4995a5ce 948 unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
13311c16 949 my $comps = $c->components;
950 my $check = $appclass."::View::".$name;
9c74923d 951 if( exists $comps->{$check} ) {
952 return $c->_filter_component( $comps->{$check}, @args );
953 }
954 else {
955 $c->log->warn( "Attempted to use view '$check', but does not exist" );
956 }
3b5f9ebb 957 foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) {
958 next unless $path =~ /.*::View/;
959 $check = $path."::".$name;
960 return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
961 }
13311c16 962 }
2f381252 963 my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
964 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
965 return $c->_filter_component( $result[ 0 ], @args );
966 }
967
a3b71f0f 968 if (ref $c) {
62a6df80 969 return $c->stash->{current_view_instance}
a3b71f0f 970 if $c->stash->{current_view_instance};
971 return $c->view( $c->stash->{current_view} )
972 if $c->stash->{current_view};
a3b71f0f 973 }
df960201 974 return $c->view( $appclass->config->{default_view} )
975 if $appclass->config->{default_view};
2f381252 976
977 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
978
979 if( $rest ) {
980 $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
4600a5a1 981 $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
2f381252 982 $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
983 $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
11c270bd 984 $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
2f381252 985 }
986
987 return $c->_filter_component( $comp );
988}
989
990=head2 $c->controllers
991
992Returns the available names which can be passed to $c->controller
993
994=cut
995
996sub controllers {
997 my ( $c ) = @_;
998 return $c->_comp_names(qw/Controller C/);
0ef52a96 999}
fbcc39ad 1000
b4b01a8a 1001=head2 $c->models
1002
1003Returns the available names which can be passed to $c->model
1004
1005=cut
1006
1007sub models {
1008 my ( $c ) = @_;
1009 return $c->_comp_names(qw/Model M/);
1010}
1011
1012
3b88a455 1013=head2 $c->views
1014
1015Returns the available names which can be passed to $c->view
1016
1017=cut
1018
1019sub views {
1020 my ( $c ) = @_;
1021 return $c->_comp_names(qw/View V/);
1022}
1023
b4b01a8a 1024=head2 $c->comp($name)
1025
1026=head2 $c->component($name)
1027
cc95842f 1028Gets a component object by name. This method is not recommended,
b4b01a8a 1029unless you want to get a specific component by full
cc95842f 1030class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
b4b01a8a 1031should be used instead.
1032
2f381252 1033If C<$name> is a regexp, a list of components matched against the full
1034component name will be returned.
1035
ab86b480 1036If Catalyst can't find a component by name, it will fallback to regex
1037matching by default. To disable this behaviour set
1038disable_component_resolution_regex_fallback to a true value.
1d3a0700 1039
220f4575 1040 __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 );
ab86b480 1041
b4b01a8a 1042=cut
1043
1044sub component {
2f381252 1045 my ( $c, $name, @args ) = @_;
b4b01a8a 1046
2f381252 1047 if( $name ) {
1048 my $comps = $c->components;
b4b01a8a 1049
2f381252 1050 if( !ref $name ) {
1051 # is it the exact name?
1052 return $c->_filter_component( $comps->{ $name }, @args )
1053 if exists $comps->{ $name };
b4b01a8a 1054
2f381252 1055 # perhaps we just omitted "MyApp"?
1056 my $composed = ( ref $c || $c ) . "::${name}";
1057 return $c->_filter_component( $comps->{ $composed }, @args )
1058 if exists $comps->{ $composed };
b4b01a8a 1059
2f381252 1060 # search all of the models, views and controllers
1061 my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
1062 return $c->_filter_component( $comp, @args ) if $comp;
1063 }
1064
f899107d 1065 return
1066 if $c->config->{disable_component_resolution_regex_fallback};
1067
2f381252 1068 # This is here so $c->comp( '::M::' ) works
1069 my $query = ref $name ? $name : qr{$name}i;
b4b01a8a 1070
2f381252 1071 my @result = grep { m{$query} } keys %{ $c->components };
1072 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
b4b01a8a 1073
2f381252 1074 if( $result[ 0 ] ) {
108201b5 1075 $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
2f381252 1076 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
1077 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
1078 return $c->_filter_component( $result[ 0 ], @args );
1079 }
1080
1081 # I would expect to return an empty list here, but that breaks back-compat
b4b01a8a 1082 }
1083
2f381252 1084 # fallback
b4b01a8a 1085 return sort keys %{ $c->components };
1086}
1087
b4b01a8a 1088=head2 CLASS DATA AND HELPER CLASSES
fbcc39ad 1089
b5ecfcf0 1090=head2 $c->config
fbcc39ad 1091
0ef52a96 1092Returns or takes a hashref containing the application's configuration.
1093
61b1d329 1094 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
81557adf 1095
18a9655c 1096You can also use a C<YAML>, C<XML> or L<Config::General> config file
1097like C<myapp.conf> in your applications home directory. See
cc95842f 1098L<Catalyst::Plugin::ConfigLoader>.
a6ad13b6 1099
6df30f7e 1100=head3 Cascading configuration
a6ad13b6 1101
b3542016 1102The config method is present on all Catalyst components, and configuration
1103will be merged when an application is started. Configuration loaded with
1104L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
62a6df80 1105followed by configuration in your top level C<MyApp> class. These two
a51d14ff 1106configurations are merged, and then configuration data whose hash key matches a
b3542016 1107component name is merged with configuration for that component.
1108
1109The configuration for a component is then passed to the C<new> method when a
1110component is constructed.
1111
1112For example:
1113
1114 MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
790ff9aa 1115 MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
62a6df80 1116
1117will mean that C<MyApp::Model::Foo> receives the following data when
b3542016 1118constructed:
1119
1120 MyApp::Model::Foo->new({
1121 bar => 'baz',
1122 quux => 'frob',
1123 overrides => 'me',
1124 });
b4b01a8a 1125
f8a54681 1126It's common practice to use a Moose attribute
1127on the receiving component to access the config value.
1128
1129 package MyApp::Model::Foo;
1130
1131 use Moose;
1132
1133 # this attr will receive 'baz' at construction time
9c74923d 1134 has 'bar' => (
f8a54681 1135 is => 'rw',
1136 isa => 'Str',
1137 );
1138
1139You can then get the value 'baz' by calling $c->model('Foo')->bar
9c74923d 1140(or $self->bar inside code in the model).
1141
1142B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
1143as a way of reading config within your code, as this B<will not> give you the
1144correctly merged config back. You B<MUST> take the config values supplied to
1145the constructor and use those instead.
f8a54681 1146
3643e890 1147=cut
1148
4090e3bb 1149around config => sub {
1150 my $orig = shift;
3643e890 1151 my $c = shift;
1152
fcf89172 1153 croak('Setting config after setup has been run is not allowed.')
1154 if ( @_ and $c->setup_finished );
3643e890 1155
4090e3bb 1156 $c->$orig(@_);
1157};
3643e890 1158
b5ecfcf0 1159=head2 $c->log
0ef52a96 1160
86418559 1161Returns the logging object instance. Unless it is already set, Catalyst
1162sets this up with a L<Catalyst::Log> object. To use your own log class,
1163set the logger with the C<< __PACKAGE__->log >> method prior to calling
9e7673af 1164C<< __PACKAGE__->setup >>.
1165
1166 __PACKAGE__->log( MyLogger->new );
1167 __PACKAGE__->setup;
1168
1169And later:
0ef52a96 1170
ae1e6b59 1171 $c->log->info( 'Now logging with my own logger!' );
0ef52a96 1172
86418559 1173Your log class should implement the methods described in
1174L<Catalyst::Log>.
af3ff00e 1175
6adc45cf 1176=head2 has_encoding
1177
1178Returned True if there's a valid encoding
1179
1180=head2 clear_encoding
1181
1182Clears the encoding for the current context
1183
9c38cb50 1184=head2 encoding
1185
70005e98 1186Sets or gets the application encoding. Setting encoding takes either an
1187Encoding object or a string that we try to resolve via L<Encode::find_encoding>.
1188
1189You would expect to get the encoding object back if you attempt to set it. If
1190there is a failure you will get undef returned and an error message in the log.
9c38cb50 1191
1192=cut
1193
6adc45cf 1194sub has_encoding { shift->encoding ? 1:0 }
1195
1196sub clear_encoding {
1197 my $c = shift;
1198 if(blessed $c) {
1199 $c->encoding(undef);
1200 } else {
70005e98 1201 $c->log->error("You can't clear encoding on the application");
6adc45cf 1202 }
1203}
1204
9c38cb50 1205sub encoding {
1206 my $c = shift;
1207 my $encoding;
1208
1209 if ( scalar @_ ) {
70005e98 1210
1211 # Don't let one change this once we are too far into the response
1212 if(blessed $c && $c->res->finalized_headers) {
1213 Carp::croak("You may not change the encoding once the headers are finalized");
1214 return;
1215 }
1216
9c38cb50 1217 # Let it be set to undef
1218 if (my $wanted = shift) {
1219 $encoding = Encode::find_encoding($wanted)
1220 or Carp::croak( qq/Unknown encoding '$wanted'/ );
1221 binmode(STDERR, ':encoding(' . $encoding->name . ')');
1222 }
1223 else {
1224 binmode(STDERR);
1225 }
1226
1227 $encoding = ref $c
1228 ? $c->{encoding} = $encoding
1229 : $c->_encoding($encoding);
1230 } else {
1231 $encoding = ref $c && exists $c->{encoding}
1232 ? $c->{encoding}
1233 : $c->_encoding;
1234 }
1235
1236 return $encoding;
1237}
b4b01a8a 1238
1239=head2 $c->debug
1240
c74d3f0c 1241Returns 1 if debug mode is enabled, 0 otherwise.
b4b01a8a 1242
7e5c67f2 1243You can enable debug mode in several ways:
1244
1245=over
1246
62a6df80 1247=item By calling myapp_server.pl with the -d flag
1248
7e5c67f2 1249=item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
1250
1251=item The -Debug option in your MyApp.pm
1252
8eae92ad 1253=item By declaring C<sub debug { 1 }> in your MyApp.pm.
7e5c67f2 1254
1255=back
c74d3f0c 1256
c8083f4e 1257The first three also set the log level to 'debug'.
1258
8eae92ad 1259Calling C<< $c->debug(1) >> has no effect.
e80e8542 1260
af3ff00e 1261=cut
1262
b4b01a8a 1263sub debug { 0 }
1264
1265=head2 $c->dispatcher
1266
2887a7f1 1267Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
b4b01a8a 1268
1269=head2 $c->engine
1270
2887a7f1 1271Returns the engine instance. See L<Catalyst::Engine>.
b4b01a8a 1272
1273
f7b672ef 1274=head2 UTILITY METHODS
66e28e3f 1275
b5ecfcf0 1276=head2 $c->path_to(@path)
01033d73 1277
cc95842f 1278Merges C<@path> with C<< $c->config->{home} >> and returns a
4e392da6 1279L<Path::Class::Dir> object. Note you can usually use this object as
1280a filename, but sometimes you will have to explicitly stringify it
18a9655c 1281yourself by calling the C<< ->stringify >> method.
01033d73 1282
1283For example:
1284
1285 $c->path_to( 'db', 'sqlite.db' );
1286
1287=cut
1288
1289sub path_to {
1290 my ( $c, @path ) = @_;
a738ab68 1291 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
01033d73 1292 if ( -d $path ) { return $path }
a738ab68 1293 else { return Path::Class::File->new( $c->config->{home}, @path ) }
01033d73 1294}
1295
0ef52a96 1296sub plugin {
1297 my ( $class, $name, $plugin, @args ) = @_;
6b2a933b 1298
4e68badc 1299 # See block comment in t/unit_core_plugin.t
3bdf9e57 1300 $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in a future release/);
4e68badc 1301
97b58e17 1302 $class->_register_plugin( $plugin, 1 );
0ef52a96 1303
1304 eval { $plugin->import };
1305 $class->mk_classdata($name);
1306 my $obj;
1307 eval { $obj = $plugin->new(@args) };
1308
1309 if ($@) {
1310 Catalyst::Exception->throw( message =>
1311 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
1312 }
1313
1314 $class->$name($obj);
1315 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
1316 if $class->debug;
1317}
1318
b5ecfcf0 1319=head2 MyApp->setup
fbcc39ad 1320
e7f1cf73 1321Initializes the dispatcher and engine, loads any plugins, and loads the
ae1e6b59 1322model, view, and controller components. You may also specify an array
1323of plugins to load here, if you choose to not load them in the C<use
1324Catalyst> line.
fbcc39ad 1325
0ef52a96 1326 MyApp->setup;
1327 MyApp->setup( qw/-Debug/ );
fbcc39ad 1328
cf7ace24 1329B<Note:> You B<should not> wrap this method with method modifiers
1330or bad things will happen - wrap the C<setup_finalize> method instead.
1331
ac1cf8d4 1332B<Note:> You can create a custom setup stage that will execute when the
1333application is starting. Use this to customize setup.
1334
1335 MyApp->setup(-Custom=value);
1336
1337 sub setup_custom {
1338 my ($class, $value) = @_;
1339 }
1340
1341Can be handy if you want to hook into the setup phase.
1342
fbcc39ad 1343=cut
1344
1345sub setup {
0319a12c 1346 my ( $class, @arguments ) = @_;
c2f3cc1b 1347 croak('Running setup more than once')
1348 if ( $class->setup_finished );
5168a5fc 1349
fbcc39ad 1350 unless ( $class->isa('Catalyst') ) {
953b0e15 1351
fbcc39ad 1352 Catalyst::Exception->throw(
1353 message => qq/'$class' does not inherit from Catalyst/ );
1c99e125 1354 }
0319a12c 1355
fbcc39ad 1356 if ( $class->arguments ) {
1357 @arguments = ( @arguments, @{ $class->arguments } );
1358 }
1359
1360 # Process options
1361 my $flags = {};
1362
1363 foreach (@arguments) {
1364
1365 if (/^-Debug$/) {
1366 $flags->{log} =
1367 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
1368 }
1369 elsif (/^-(\w+)=?(.*)$/) {
1370 $flags->{ lc $1 } = $2;
1371 }
1372 else {
1373 push @{ $flags->{plugins} }, $_;
1374 }
1375 }
1376
99f187d6 1377 $class->setup_home( delete $flags->{home} );
1378
5bb2a5b3 1379 $class->setup_log( delete $flags->{log} );
fbcc39ad 1380 $class->setup_plugins( delete $flags->{plugins} );
17176f15 1381
b87d834e 1382 $class->setup_data_handlers();
fbcc39ad 1383 $class->setup_dispatcher( delete $flags->{dispatcher} );
acbecf08 1384 if (my $engine = delete $flags->{engine}) {
0aafa77a 1385 $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading");
acbecf08 1386 }
1387 $class->setup_engine();
dc5f035e 1388 $class->setup_stats( delete $flags->{stats} );
fbcc39ad 1389
1390 for my $flag ( sort keys %{$flags} ) {
1391
1392 if ( my $code = $class->can( 'setup_' . $flag ) ) {
1393 &$code( $class, delete $flags->{$flag} );
1394 }
1395 else {
1396 $class->log->warn(qq/Unknown flag "$flag"/);
1397 }
1398 }
1399
0eb4af72 1400 eval { require Catalyst::Devel; };
1401 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1402 $class->log->warn(<<"EOF");
4ff0d824 1403You are running an old script!
1404
34a83d89 1405 Please update by running (this will overwrite existing files):
1406 catalyst.pl -force -scripts $class
1407
1408 or (this will not overwrite existing files):
1409 catalyst.pl -scripts $class
1cf0345b 1410
4ff0d824 1411EOF
0eb4af72 1412 }
62a6df80 1413
b677b4c2 1414 # Call plugins setup, this is stupid and evil.
1415 # Also screws C3 badly on 5.10, hack to avoid.
1416 {
1417 no warnings qw/redefine/;
1418 local *setup = sub { };
1419 $class->setup unless $Catalyst::__AM_RESTARTING;
1420 }
1421
9c38cb50 1422 # If you are expecting configuration info as part of your setup, it needs
1423 # to get called here and below, since we need the above line to support
1424 # ConfigLoader based configs.
1425
1426 $class->setup_encoding();
ac34e337 1427 $class->setup_middleware();
1428
02352a28 1429 # Initialize our data structure
1430 $class->components( {} );
1431
1432 $class->setup_components;
1433
fbcc39ad 1434 if ( $class->debug ) {
6601f2ad 1435 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
fbcc39ad 1436
1437 if (@plugins) {
39fc2ce1 1438 my $column_width = Catalyst::Utils::term_width() - 6;
1439 my $t = Text::SimpleTable->new($column_width);
8c113188 1440 $t->row($_) for @plugins;
1cf0345b 1441 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
fbcc39ad 1442 }
1443
ba0b0de3 1444 my @middleware = map {
88e5a8b0 1445 ref $_ eq 'CODE' ?
1446 "Inline Coderef" :
1447 (ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '')
ba0b0de3 1448 || '') } $class->registered_middlewares;
10e39267 1449
1450 if (@middleware) {
1451 my $column_width = Catalyst::Utils::term_width() - 6;
1452 my $t = Text::SimpleTable->new($column_width);
1453 $t->row($_) for @middleware;
1454 $class->log->debug( "Loaded PSGI Middleware:\n" . $t->draw . "\n" );
1455 }
1456
ef5ad930 1457 my %dh = $class->registered_data_handlers;
1458 if (my @data_handlers = keys %dh) {
b87d834e 1459 my $column_width = Catalyst::Utils::term_width() - 6;
1460 my $t = Text::SimpleTable->new($column_width);
1461 $t->row($_) for @data_handlers;
1462 $class->log->debug( "Loaded Request Data Handlers:\n" . $t->draw . "\n" );
1463 }
1464
fbcc39ad 1465 my $dispatcher = $class->dispatcher;
1466 my $engine = $class->engine;
1467 my $home = $class->config->{home};
1468
01ce7075 1469 $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1470 $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
fbcc39ad 1471
1472 $home
1473 ? ( -d $home )
1474 ? $class->log->debug(qq/Found home "$home"/)
1475 : $class->log->debug(qq/Home "$home" doesn't exist/)
1476 : $class->log->debug(q/Couldn't find home/);
fbcc39ad 1477
39fc2ce1 1478 my $column_width = Catalyst::Utils::term_width() - 8 - 9;
8860df07 1479
39fc2ce1 1480 my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
684d10ed 1481 for my $comp ( sort keys %{ $class->components } ) {
1482 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1483 $t->row( $comp, $type );
1484 }
1cf0345b 1485 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
8c113188 1486 if ( keys %{ $class->components } );
fbcc39ad 1487 }
1488
1489 # Add our self to components, since we are also a component
96d8d513 1490 if( $class->isa('Catalyst::Controller') ){
1491 $class->components->{$class} = $class;
1492 }
fbcc39ad 1493
1494 $class->setup_actions;
1495
1496 if ( $class->debug ) {
1497 my $name = $class->config->{name} || 'Application';
1498 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1499 }
3643e890 1500
647a3de1 1501 if ($class->config->{case_sensitive}) {
1502 $class->log->warn($class . "->config->{case_sensitive} is set.");
1503 $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1504 }
1505
3a079e11 1506 # call these so we pre setup the composed classes
1507 $class->composed_request_class;
1508 $class->composed_response_class;
1509 $class->composed_stats_class;
1510
a5d07d29 1511 $class->setup_finalize;
1b526dcc 1512
1513 # Flush the log for good measure (in case something turned off 'autoflush' early)
647a3de1 1514 $class->log->_flush() if $class->log->can('_flush');
1b526dcc 1515
5077b8a3 1516 return $class || 1; # Just in case someone named their Application 0...
a5d07d29 1517}
1518
23c63a17 1519=head2 $app->setup_finalize
1520
128a7cee 1521A hook to attach modifiers to. This method does not do anything except set the
1522C<setup_finished> accessor.
23c63a17 1523
ae7da8f5 1524Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
23c63a17 1525
128a7cee 1526Example:
23c63a17 1527
128a7cee 1528 after setup_finalize => sub {
1529 my $app = shift;
23c63a17 1530
128a7cee 1531 ## do stuff here..
1532 };
23c63a17 1533
1534=cut
1535
a5d07d29 1536sub setup_finalize {
1537 my ($class) = @_;
3643e890 1538 $class->setup_finished(1);
fbcc39ad 1539}
1540
b4fed1aa 1541=head2 $c->uri_for( $path?, @args?, \%query_values?, \$fragment? )
fbcc39ad 1542
b4fed1aa 1543=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values?, \$fragment? )
9df7c5d9 1544
b4fed1aa 1545=head2 $c->uri_for( $action, [@captures, @args], \%query_values?, \$fragment? )
b063a165 1546
ee8963de 1547Constructs an absolute L<URI> object based on the application root, the
1548provided path, and the additional arguments and query parameters provided.
186d5270 1549When used as a string, provides a textual URI. If you need more flexibility
92981fc3 1550than this (i.e. the option to provide relative URIs etc.) see
186d5270 1551L<Catalyst::Plugin::SmartURI>.
ee8963de 1552
d71da6fe 1553If no arguments are provided, the URI for the current action is returned.
1554To return the current action and also provide @args, use
1d3a0700 1555C<< $c->uri_for( $c->action, @args ) >>.
d71da6fe 1556
ee8963de 1557If the first argument is a string, it is taken as a public URI path relative
1558to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
e7e4c469 1559relative to the application root (if it does). It is then merged with
ee8963de 1560C<< $c->request->base >>; any C<@args> are appended as additional path
1561components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1562
02336198 1563B<NOTE> If you are using this 'stringy' first argument, we skip encoding and
1564allow you to declare something like:
1565
1566 $c->uri_for('/foo/bar#baz')
1567
1568Where 'baz' is a URI fragment. We consider this first argument string to be
1569'expert' mode where you are expected to create a valid URL and we for the most
1570part just pass it through without a lot of internal effort to escape and encode.
1571
ee8963de 1572If the first argument is a L<Catalyst::Action> it represents an action which
1573will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1574optional C<\@captures> argument (an arrayref) allows passing the captured
1575variables that are needed to fill in the paths of Chained and Regex actions;
1576once the path is resolved, C<uri_for> continues as though a path was
1577provided, appending any arguments or parameters and creating an absolute
1578URI.
1579
e7e4c469 1580The captures for the current request can be found in
ee8963de 1581C<< $c->request->captures >>, and actions can be resolved using
1582C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1583path, use C<< $c->uri_for_action >> instead.
1584
1585 # Equivalent to $c->req->uri
e7e4c469 1586 $c->uri_for($c->action, $c->req->captures,
ee8963de 1587 @{ $c->req->args }, $c->req->params);
62a6df80 1588
9df7c5d9 1589 # For the Foo action in the Bar controller
ee8963de 1590 $c->uri_for($c->controller('Bar')->action_for('Foo'));
9df7c5d9 1591
ee8963de 1592 # Path to a static resource
1593 $c->uri_for('/static/images/logo.png');
d5e3d528 1594
342d2169 1595In general the scheme of the generated URI object will follow the incoming request
1596however if your targeted action or action chain has the Scheme attribute it will
1597use that instead.
1598
d2b583c3 1599Also, if the targeted Action or Action chain declares Args/CaptureArgs that have
1600type constraints, we will require that your proposed URL verify on those declared
1601constraints.
1602
4cf1dd00 1603=cut
1604
fbcc39ad 1605sub uri_for {
00e6a2b7 1606 my ( $c, $path, @args ) = @_;
00e6a2b7 1607
0ee04045 1608 if ( $path->$_isa('Catalyst::Controller') ) {
7069eab5 1609 $path = $path->path_prefix;
1610 $path =~ s{/+\z}{};
1611 $path .= '/';
1612 }
1613
0cdca4d8 1614 my $fragment = ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? ${pop @args} : undef );
6b9f9ef7 1615
02336198 1616 unless(blessed $path) {
7064f69b 1617 if (defined($path) and $path =~ s/#(.+)$//) {
0cdca4d8 1618 if(defined($1) and defined $fragment) {
02336198 1619 carp "Abiguious fragment declaration: You cannot define a fragment in '$path' and as an argument '$fragment'";
1620 }
1621 if(defined($1)) {
1622 $fragment = $1;
1623 }
1624 }
1625 }
1626
2689f8a4 1627 my $params =
1628 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1629
02336198 1630 undef($path) if (defined $path && $path eq '');
1631
2689f8a4 1632 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
5c779e98 1633
342d2169 1634 my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef;
0ee04045 1635 if ( $path->$_isa('Catalyst::Action') ) { # action object
c042d18d 1636 s|/|%2F|g for @args;
2689f8a4 1637 my $captures = [ map { s|/|%2F|g; $_; }
c042d18d 1638 ( scalar @args && ref $args[0] eq 'ARRAY'
1639 ? @{ shift(@args) }
aaf72276 1640 : ()) ];
7b346bc3 1641
aa7e913e 1642 my $action = $path;
86a399db 1643 my $expanded_action = $c->dispatcher->expand_action( $action );
d2b583c3 1644 my $num_captures = $expanded_action->number_of_captures;
86a399db 1645
0cff119a 1646 # ->uri_for( $action, \@captures_and_args, \%query_values? )
c042d18d 1647 if( !@args && $action->number_of_args ) {
1648 unshift @args, splice @$captures, $num_captures;
0cff119a 1649 }
1650
86a399db 1651 if($num_captures) {
ec4d7259 1652 unless($expanded_action->match_captures_constraints($c, $captures)) {
0d42b769 1653 $c->log->debug("captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'")
1654 if $c->debug;
1655 return undef;
c1192f1e 1656 }
1657 }
1658
1659 $path = $c->dispatcher->uri_for_action($action, $captures);
aa7e913e 1660 if (not defined $path) {
1661 $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1662 if $c->debug;
1663 return undef;
1664 }
81e75875 1665 $path = '/' if $path eq '';
c1192f1e 1666
1667 # At this point @encoded_args is the remaining Args (all captures removed).
86a399db 1668 if($expanded_action->has_args_constraints) {
c042d18d 1669 unless($expanded_action->match_args($c,\@args)) {
0d42b769 1670 $c->log->debug("args [@args] do not match the type constraints in action '$expanded_action'")
1671 if $c->debug;
1672 return undef;
c1192f1e 1673 }
1674 }
ea0e58d9 1675 }
1676
c042d18d 1677 unshift(@args, $path);
51674a63 1678
1679 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1680 my $namespace = $c->namespace;
1681 if (defined $path) { # cheesy hack to handle path '../foo'
c042d18d 1682 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 1683 }
c042d18d 1684 unshift(@args, $namespace || '');
51674a63 1685 }
62a6df80 1686
189e2a51 1687 # join args with '/', or a blank string
c042d18d 1688 my $args = join('/', grep { defined($_) } @args);
51674a63 1689 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
e6968720 1690 $args =~ s!^/+!!;
f9451270 1691
1692 my ($base, $class) = ('/', 'URI::_generic');
1693 if(blessed($c)) {
1694 $base = $c->req->base;
342d2169 1695 if($target_action) {
1696 $target_action = $c->dispatcher->expand_action($target_action);
1697 if(my $s = $target_action->scheme) {
1698 $s = lc($s);
1699 $class = "URI::$s";
1700 $base->scheme($s);
1701 } else {
1702 $class = ref($base);
1703 }
1704 } else {
1705 $class = ref($base);
1706 }
1707
f9451270 1708 $base =~ s{(?<!/)$}{/};
1709 }
51674a63 1710
1711 my $query = '';
51674a63 1712 if (my @keys = keys %$params) {
1713 # somewhat lifted from URI::_query's query_form
1714 $query = '?'.join('&', map {
2f381252 1715 my $val = $params->{$_};
901b4331 1716 my $key = encode_utf8($_);
1717 # using the URI::Escape pattern here so utf8 chars survive
1718 $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1719 $key =~ s/ /+/g;
1720
51674a63 1721 $val = '' unless defined $val;
1722 (map {
901b4331 1723 my $param = encode_utf8($_);
51674a63 1724 # using the URI::Escape pattern here so utf8 chars survive
1f851263 1725 $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1726 $param =~ s/ /+/g;
5c779e98 1727
901b4331 1728 "${key}=$param";
1729 } ( ref $val eq 'ARRAY' ? @$val : $val ));
51674a63 1730 } @keys);
1731 }
1732
d2b583c3 1733 $base = encode_utf8 $base;
1734 $base =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1735 $args = encode_utf8 $args;
1736 $args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
3a6d7f15 1737
6b9f9ef7 1738 if(defined $fragment) {
02336198 1739 if(blessed $path) {
0cdca4d8 1740 $fragment = encode_utf8($fragment);
02336198 1741 $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1742 $fragment =~ s/ /+/g;
1743 }
6b9f9ef7 1744 $query .= "#$fragment";
1745 }
3a6d7f15 1746
51674a63 1747 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1748 $res;
fbcc39ad 1749}
1750
25d61080 1751=head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? )
833b385e 1752
25d61080 1753=head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? )
833b385e 1754
1755=over
1756
1757=item $path
1758
1759A private path to the Catalyst action you want to create a URI for.
1760
1761This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1762>> and passing the resulting C<$action> and the remaining arguments to C<<
1763$c->uri_for >>.
1764
1765You can also pass in a Catalyst::Action object, in which case it is passed to
1766C<< $c->uri_for >>.
1767
c9ec25f8 1768Note that although the path looks like a URI that dispatches to the wanted action, it is not a URI, but an internal path to that action.
1769
1770For example, if the action looks like:
1771
1772 package MyApp::Controller::Users;
1773
1774 sub lst : Path('the-list') {}
1775
1776You can use:
1777
1778 $c->uri_for_action('/users/lst')
1779
1780and it will create the URI /users/the-list.
1781
25d61080 1782=item \@captures_and_args?
1783
e197ea54 1784Optional array reference of Captures (i.e. C<CaptureArgs> or C<< $c->req->captures >>)
25d61080 1785and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained>
1786to interpolate all the parameters in the URI.
1787
1788=item @args?
1789
942572d7 1790Optional list of extra arguments - can be supplied in the
1791C<< \@captures_and_args? >> array ref, or here - whichever is easier for your
1792code.
25d61080 1793
942572d7 1794Your action can have zero, a fixed or a variable number of args (e.g.
1795C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number)..
25d61080 1796
1797=item \%query_values?
1798
1799Optional array reference of query parameters to append. E.g.
1800
1801 { foo => 'bar' }
1802
1803will generate
1804
1805 /rest/of/your/uri?foo=bar
1806
833b385e 1807=back
1808
1809=cut
1810
1811sub uri_for_action {
1812 my ( $c, $path, @args ) = @_;
62a6df80 1813 my $action = blessed($path)
1814 ? $path
833b385e 1815 : $c->dispatcher->get_action_by_path($path);
4ac0b9cb 1816 unless (defined $action) {
1817 croak "Can't find action for path '$path'";
1818 }
833b385e 1819 return $c->uri_for( $action, @args );
1820}
1821
b5ecfcf0 1822=head2 $c->welcome_message
ab2374d3 1823
1824Returns the Catalyst welcome HTML page.
1825
1826=cut
1827
1828sub welcome_message {
bf1f2c60 1829 my $c = shift;
1830 my $name = $c->config->{name};
1831 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1832 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1833 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1834 return <<"EOF";
80cdbbff 1835<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1836 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1837<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1838 <head>
85d9fce6 1839 <meta http-equiv="Content-Language" content="en" />
1840 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1841 <title>$name on Catalyst $VERSION</title>
1842 <style type="text/css">
1843 body {
ab2374d3 1844 color: #000;
1845 background-color: #eee;
1846 }
1847 div#content {
1848 width: 640px;
80cdbbff 1849 margin-left: auto;
1850 margin-right: auto;
ab2374d3 1851 margin-top: 10px;
1852 margin-bottom: 10px;
1853 text-align: left;
1854 background-color: #ccc;
1855 border: 1px solid #aaa;
ab2374d3 1856 }
d84c4dab 1857 p, h1, h2 {
ab2374d3 1858 margin-left: 20px;
1859 margin-right: 20px;
16215972 1860 font-family: verdana, tahoma, sans-serif;
ab2374d3 1861 }
d84c4dab 1862 a {
1863 font-family: verdana, tahoma, sans-serif;
1864 }
d114e033 1865 :link, :visited {
1866 text-decoration: none;
1867 color: #b00;
1868 border-bottom: 1px dotted #bbb;
1869 }
1870 :link:hover, :visited:hover {
d114e033 1871 color: #555;
1872 }
ab2374d3 1873 div#topbar {
1874 margin: 0px;
1875 }
3e82a295 1876 pre {
3e82a295 1877 margin: 10px;
1878 padding: 8px;
1879 }
ab2374d3 1880 div#answers {
1881 padding: 8px;
1882 margin: 10px;
d114e033 1883 background-color: #fff;
ab2374d3 1884 border: 1px solid #aaa;
ab2374d3 1885 }
1886 h1 {
33108eaf 1887 font-size: 0.9em;
1888 font-weight: normal;
ab2374d3 1889 text-align: center;
1890 }
1891 h2 {
1892 font-size: 1.0em;
1893 }
1894 p {
1895 font-size: 0.9em;
1896 }
ae7c5252 1897 p img {
1898 float: right;
1899 margin-left: 10px;
1900 }
9619f23c 1901 span#appname {
1902 font-weight: bold;
33108eaf 1903 font-size: 1.6em;
ab2374d3 1904 }
1905 </style>
1906 </head>
1907 <body>
1908 <div id="content">
1909 <div id="topbar">
9619f23c 1910 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1911 $VERSION</h1>
ab2374d3 1912 </div>
1913 <div id="answers">
ae7c5252 1914 <p>
80cdbbff 1915 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1916 </p>
596aaffe 1917 <p>Welcome to the world of Catalyst.
f92fd545 1918 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1919 framework will make web development something you had
60dd6e1d 1920 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1921 <h2>What to do now?</h2>
4b8cb778 1922 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1923 We do, however, provide you with a few starting points.</p>
1924 <p>If you want to jump right into web development with Catalyst
2f381252 1925 you might want to start with a tutorial.</p>
80267996 1926<pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code>
596aaffe 1927</pre>
1928<p>Afterwards you can go on to check out a more complete look at our features.</p>
1929<pre>
80267996 1930<code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a>
b607f8a0 1931<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1932</code></pre>
ab2374d3 1933 <h2>What to do next?</h2>
f5681c92 1934 <p>Next it's time to write an actual application. Use the
80267996 1935 helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>,
1936 <a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and
1937 <a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>;
bf1f2c60 1938 they can save you a lot of work.</p>
c5f31918 1939 <pre><code>script/${prefix}_create.pl --help</code></pre>
bf1f2c60 1940 <p>Also, be sure to check out the vast and growing
802bf2cb 1941 collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
bf1f2c60 1942 you are likely to find what you need there.
f5681c92 1943 </p>
1944
82245cc4 1945 <h2>Need help?</h2>
f5681c92 1946 <p>Catalyst has a very active community. Here are the main places to
1947 get in touch with us.</p>
16215972 1948 <ul>
1949 <li>
2b9a7d76 1950 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1951 </li>
1952 <li>
6d4c3368 1953 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1954 </li>
1955 <li>
4eaf7c88 1956 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1957 </li>
1958 </ul>
ab2374d3 1959 <h2>In conclusion</h2>
62a6df80 1960 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1961 as we enjoyed making it. Please contact us if you have ideas
1962 for improvement or other feedback.</p>
ab2374d3 1963 </div>
1964 </div>
1965 </body>
1966</html>
1967EOF
1968}
1969
aee7cdcc 1970=head2 run_options
1971
1972Contains a hash of options passed from the application script, including
c2c8d3cb 1973the original ARGV the script received, the processed values from that
aee7cdcc 1974ARGV and any extra arguments to the script which were not processed.
1975
1976This can be used to add custom options to your application's scripts
1977and setup your application differently depending on the values of these
1978options.
1979
fbcc39ad 1980=head1 INTERNAL METHODS
1981
ae1e6b59 1982These methods are not meant to be used by end users.
1983
b5ecfcf0 1984=head2 $c->components
fbcc39ad 1985
e7f1cf73 1986Returns a hash of components.
fbcc39ad 1987
b5ecfcf0 1988=head2 $c->context_class
1f9cb7c1 1989
e7f1cf73 1990Returns or sets the context class.
1f9cb7c1 1991
b5ecfcf0 1992=head2 $c->counter
fbcc39ad 1993
ae1e6b59 1994Returns a hashref containing coderefs and execution counts (needed for
1995deep recursion detection).
fbcc39ad 1996
b5ecfcf0 1997=head2 $c->depth
fbcc39ad 1998
e7f1cf73 1999Returns the number of actions on the current internal execution stack.
fbcc39ad 2000
b5ecfcf0 2001=head2 $c->dispatch
fbcc39ad 2002
e7f1cf73 2003Dispatches a request to actions.
fbcc39ad 2004
2005=cut
2006
2007sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
2008
b5ecfcf0 2009=head2 $c->dispatcher_class
1f9cb7c1 2010
e7f1cf73 2011Returns or sets the dispatcher class.
1f9cb7c1 2012
b5ecfcf0 2013=head2 $c->dump_these
7f92deef 2014
ae1e6b59 2015Returns a list of 2-element array references (name, structure) pairs
2016that will be dumped on the error page in debug mode.
7f92deef 2017
2018=cut
2019
2020sub dump_these {
2021 my $c = shift;
62a6df80 2022 [ Request => $c->req ],
2023 [ Response => $c->res ],
052a2d89 2024 [ Stash => $c->stash ],
2025 [ Config => $c->config ];
7f92deef 2026}
2027
b5ecfcf0 2028=head2 $c->engine_class
1f9cb7c1 2029
e7f1cf73 2030Returns or sets the engine class.
1f9cb7c1 2031
b5ecfcf0 2032=head2 $c->execute( $class, $coderef )
fbcc39ad 2033
0ef52a96 2034Execute a coderef in given class and catch exceptions. Errors are available
2035via $c->error.
fbcc39ad 2036
2037=cut
2038
2039sub execute {
2040 my ( $c, $class, $code ) = @_;
858828dd 2041 $class = $c->component($class) || $class;
e459bd03 2042 #$c->state(0);
a0eca838 2043
197bd788 2044 if ( $c->depth >= $RECURSION ) {
f3414019 2045 my $action = $code->reverse();
91d08727 2046 $action = "/$action" unless $action =~ /->/;
f3414019 2047 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 2048 $c->log->error($error);
2049 $c->error($error);
2050 $c->state(0);
2051 return $c->state;
2052 }
2053
dc5f035e 2054 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 2055
8767c5a3 2056 push( @{ $c->stack }, $code );
62a6df80 2057
6f3df815 2058 no warnings 'recursion';
524b0e1c 2059 # N.B. This used to be combined, but I have seen $c get clobbered if so, and
2060 # I have no idea how, ergo $ret (which appears to fix the issue)
2061 eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
22247e54 2062
dc5f035e 2063 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
62a6df80 2064
a6724a82 2065 my $last = pop( @{ $c->stack } );
fbcc39ad 2066
2067 if ( my $error = $@ ) {
e25e23a7 2068 #rethow if this can be handled by middleware
80172e7d 2069 if ( $c->_handle_http_exception($error) ) {
30e84ba1 2070 foreach my $err (@{$c->error}) {
2071 $c->log->error($err);
2072 }
2073 $c->clear_errors;
2074 $c->log->_flush if $c->log->can('_flush');
2075
e25e23a7 2076 $error->can('rethrow') ? $error->rethrow : croak $error;
2077 }
79f5d571 2078 if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
f87b7c21 2079 $error->rethrow if $c->depth > 1;
2f381252 2080 }
79f5d571 2081 elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
f87b7c21 2082 $error->rethrow if $c->depth > 0;
55424863 2083 }
fbcc39ad 2084 else {
2085 unless ( ref $error ) {
91d08727 2086 no warnings 'uninitialized';
fbcc39ad 2087 chomp $error;
f59def82 2088 my $class = $last->class;
2089 my $name = $last->name;
2090 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 2091 }
fbcc39ad 2092 $c->error($error);
fbcc39ad 2093 }
e459bd03 2094 #$c->state(0);
fbcc39ad 2095 }
2096 return $c->state;
2097}
2098
7a7d7af5 2099sub _stats_start_execute {
2100 my ( $c, $code ) = @_;
df960201 2101 my $appclass = ref($c) || $c;
a6724a82 2102 return if ( ( $code->name =~ /^_.*/ )
df960201 2103 && ( !$appclass->config->{show_internal_actions} ) );
7a7d7af5 2104
f3414019 2105 my $action_name = $code->reverse();
2106 $c->counter->{$action_name}++;
7a7d7af5 2107
f3414019 2108 my $action = $action_name;
a6724a82 2109 $action = "/$action" unless $action =~ /->/;
2110
7a7d7af5 2111 # determine if the call was the result of a forward
2112 # this is done by walking up the call stack and looking for a calling
2113 # sub of Catalyst::forward before the eval
2114 my $callsub = q{};
2115 for my $index ( 2 .. 11 ) {
2116 last
2117 if ( ( caller($index) )[0] eq 'Catalyst'
2118 && ( caller($index) )[3] eq '(eval)' );
2119
2120 if ( ( caller($index) )[3] =~ /forward$/ ) {
2121 $callsub = ( caller($index) )[3];
2122 $action = "-> $action";
2123 last;
2124 }
2125 }
2126
f3414019 2127 my $uid = $action_name . $c->counter->{$action_name};
74efc144 2128
a6724a82 2129 # is this a root-level call or a forwarded call?
2130 if ( $callsub =~ /forward$/ ) {
91740f34 2131 my $parent = $c->stack->[-1];
a6724a82 2132
2133 # forward, locate the caller
9c74923d 2134 if ( defined $parent && exists $c->counter->{"$parent"} ) {
69d8f33c 2135 $c->stats->profile(
62a6df80 2136 begin => $action,
69d8f33c 2137 parent => "$parent" . $c->counter->{"$parent"},
2138 uid => $uid,
2139 );
7a7d7af5 2140 }
2141 else {
2142
a6724a82 2143 # forward with no caller may come from a plugin
69d8f33c 2144 $c->stats->profile(
2145 begin => $action,
2146 uid => $uid,
2147 );
7a7d7af5 2148 }
2149 }
a6724a82 2150 else {
62a6df80 2151
a6724a82 2152 # root-level call
69d8f33c 2153 $c->stats->profile(
2154 begin => $action,
2155 uid => $uid,
2156 );
a6724a82 2157 }
dc5f035e 2158 return $action;
7a7d7af5 2159
7a7d7af5 2160}
2161
2162sub _stats_finish_execute {
2163 my ( $c, $info ) = @_;
69d8f33c 2164 $c->stats->profile( end => $info );
7a7d7af5 2165}
2166
b5ecfcf0 2167=head2 $c->finalize
fbcc39ad 2168
e7f1cf73 2169Finalizes the request.
fbcc39ad 2170
2171=cut
2172
2173sub finalize {
2174 my $c = shift;
2175
369c09bc 2176 for my $error ( @{ $c->error } ) {
2177 $c->log->error($error);
2178 }
2179
eb1f4b49 2180 # Support skipping finalize for psgix.io style 'jailbreak'. Used to support
2181 # stuff like cometd and websockets
c4df830e 2182
c2fef52f 2183 if($c->request->_has_io_fh) {
74bebe95 2184 $c->log_response;
2185 return;
2186 }
eb1f4b49 2187
5050d7a7 2188 # Allow engine to handle finalize flow (for POE)
e63bdf38 2189 my $engine = $c->engine;
2190 if ( my $code = $engine->can('finalize') ) {
2191 $engine->$code($c);
fbcc39ad 2192 }
5050d7a7 2193 else {
fbcc39ad 2194
5050d7a7 2195 $c->finalize_uploads;
fbcc39ad 2196
5050d7a7 2197 # Error
2198 if ( $#{ $c->error } >= 0 ) {
2199 $c->finalize_error;
2200 }
2201
9c38cb50 2202 $c->finalize_encoding;
89ba65d5 2203 $c->finalize_headers unless $c->response->finalized_headers;
5050d7a7 2204 $c->finalize_body;
2205 }
62a6df80 2206
2bf54936 2207 $c->log_response;
10f204e1 2208
3d4fc940 2209 $c->log_stats if $c->use_stats;
fbcc39ad 2210
2211 return $c->response->status;
2212}
2213
3d4fc940 2214=head2 $c->log_stats
2215
2216Logs statistics.
2217
2218=cut
2219
2220sub log_stats {
2221 my $c = shift;
2222
2223 my $elapsed = $c->stats->elapsed;
2224 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
2225 $c->log->info(
2226 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
2227}
2228
2229
b5ecfcf0 2230=head2 $c->finalize_body
fbcc39ad 2231
e7f1cf73 2232Finalizes body.
fbcc39ad 2233
2234=cut
2235
2236sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
2237
b5ecfcf0 2238=head2 $c->finalize_cookies
fbcc39ad 2239
e7f1cf73 2240Finalizes cookies.
fbcc39ad 2241
2242=cut
2243
147821ea 2244sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 2245
b5ecfcf0 2246=head2 $c->finalize_error
fbcc39ad 2247
df93c9b5 2248Finalizes error. If there is only one error in L</error> and it is an object that
2249does C<as_psgi> or C<code> we rethrow the error and presume it caught by middleware
2250up the ladder. Otherwise we return the debugging error page (in debug mode) or we
2251return the default error page (production mode).
fbcc39ad 2252
2253=cut
2254
660f9bb0 2255sub finalize_error {
2256 my $c = shift;
2257 if($#{$c->error} > 0) {
2258 $c->engine->finalize_error( $c, @_ );
2259 } else {
2260 my ($error) = @{$c->error};
80172e7d 2261 if ( $c->_handle_http_exception($error) ) {
660f9bb0 2262 # In the case where the error 'knows what it wants', becauses its PSGI
2263 # aware, just rethow and let middleware catch it
2264 $error->can('rethrow') ? $error->rethrow : croak $error;
660f9bb0 2265 } else {
2266 $c->engine->finalize_error( $c, @_ )
2267 }
2268 }
2269}
fbcc39ad 2270
b5ecfcf0 2271=head2 $c->finalize_headers
fbcc39ad 2272
e7f1cf73 2273Finalizes headers.
fbcc39ad 2274
2275=cut
2276
2277sub finalize_headers {
2278 my $c = shift;
2279
e63bdf38 2280 my $response = $c->response; #accessor calls can add up?
2281
fbcc39ad 2282 # Check if we already finalized headers
6680c772 2283 return if $response->finalized_headers;
fbcc39ad 2284
2285 # Handle redirects
e63bdf38 2286 if ( my $location = $response->redirect ) {
fbcc39ad 2287 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 2288 $response->header( Location => $location );
fbcc39ad 2289 }
2290
9629478d 2291 # Remove incorrectly added body and content related meta data when returning
2292 # an information response, or a response the is required to not include a body
2293
fbcc39ad 2294 $c->finalize_cookies;
2295
6adc45cf 2296 # This currently is a NOOP but I don't want to remove it since I guess people
2297 # might have Response subclasses that use it for something... (JNAP)
89ba65d5 2298 $c->response->finalize_headers();
fbcc39ad 2299
2300 # Done
6680c772 2301 $response->finalized_headers(1);
fbcc39ad 2302}
2303
9c38cb50 2304=head2 $c->finalize_encoding
2305
4a64c27b 2306Make sure your body is encoded properly IF you set an encoding. By
566678d0 2307default the encoding is UTF-8 but you can disable it by explicitly setting the
dd096a3a 2308encoding configuration value to undef.
2309
6adc45cf 2310We can only encode when the body is a scalar. Methods for encoding via the
2311streaming interfaces (such as C<write> and C<write_fh> on L<Catalyst::Response>
2312are available).
2313
9c38cb50 2314See L</ENCODING>.
2315
2316=cut
2317
2318sub finalize_encoding {
2319 my $c = shift;
6adc45cf 2320 my $res = $c->res || return;
2321
2322 # Warn if the set charset is different from the one you put into encoding. We need
2323 # to do this early since encodable_response is false for this condition and we need
2324 # to match the debug output for backcompat (there's a test for this...) -JNAP
2325 if(
88e5a8b0 2326 $res->content_type_charset and $c->encoding and
6adc45cf 2327 (uc($c->encoding->mime_name) ne uc($res->content_type_charset))
2328 ) {
2329 my $ct = lc($res->content_type_charset);
2330 $c->log->debug("Catalyst encoding config is set to encode in '" .
2331 $c->encoding->mime_name .
2332 "', content type is '$ct', not encoding ");
2333 }
9c38cb50 2334
6adc45cf 2335 if(
2336 ($res->encodable_response) and
2337 (defined($res->body)) and
2338 (ref(\$res->body) eq 'SCALAR')
2339 ) {
32e66829 2340 # if you are finding yourself here and your body is already encoded correctly
2341 # and you want to turn this off, use $c->clear_encoding to prevent encoding
2342 # at this step, or set encoding to undef in the config to do so for the whole
2343 # application. See the ENCODING documentaiton for better notes.
6adc45cf 2344 $c->res->body( $c->encoding->encode( $c->res->body, $c->_encode_check ) );
9c38cb50 2345
6adc45cf 2346 # Set the charset if necessary. This might be a bit bonkers since encodable response
88e5a8b0 2347 # is false when the set charset is not the same as the encoding mimetype (maybe
6adc45cf 2348 # confusing action at a distance here..
9c056c82 2349 # Don't try to set the charset if one already exists or if headers are already finalized
6adc45cf 2350 $c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name)
9c056c82 2351 unless($c->res->content_type_charset ||
2352 ($c->res->_context && $c->res->finalized_headers && !$c->res->_has_response_cb));
9c38cb50 2353 }
9c38cb50 2354}
2355
b5ecfcf0 2356=head2 $c->finalize_output
fbcc39ad 2357
2358An alias for finalize_body.
2359
b5ecfcf0 2360=head2 $c->finalize_read
fbcc39ad 2361
e7f1cf73 2362Finalizes the input after reading is complete.
fbcc39ad 2363
2364=cut
2365
2366sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
2367
b5ecfcf0 2368=head2 $c->finalize_uploads
fbcc39ad 2369
ae1e6b59 2370Finalizes uploads. Cleans up any temporary files.
fbcc39ad 2371
2372=cut
2373
2374sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
2375
b5ecfcf0 2376=head2 $c->get_action( $action, $namespace )
fbcc39ad 2377
e7f1cf73 2378Gets an action in a given namespace.
fbcc39ad 2379
2380=cut
2381
684d10ed 2382sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 2383
b5ecfcf0 2384=head2 $c->get_actions( $action, $namespace )
a9dc674c 2385
ae1e6b59 2386Gets all actions of a given name in a namespace and all parent
2387namespaces.
a9dc674c 2388
2389=cut
2390
2391sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
2392
e5ce5f04 2393=head2 $app->handle_request( @arguments )
fbcc39ad 2394
e7f1cf73 2395Called to handle each HTTP request.
fbcc39ad 2396
2397=cut
2398
2399sub handle_request {
2400 my ( $class, @arguments ) = @_;
2401
2402 # Always expect worst case!
2403 my $status = -1;
3640641e 2404 try {
dea1884f 2405 if ($class->debug) {
908e3d9e 2406 my $secs = time - $START || 1;
2407 my $av = sprintf '%.3f', $COUNT / $secs;
2408 my $time = localtime time;
2409 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 2410 }
908e3d9e 2411
2412 my $c = $class->prepare(@arguments);
2413 $c->dispatch;
62a6df80 2414 $status = $c->finalize;
660f9bb0 2415 } catch {
660f9bb0 2416 #rethow if this can be handled by middleware
80172e7d 2417 if ( $class->_handle_http_exception($_) ) {
6e94698d 2418 $_->can('rethrow') ? $_->rethrow : croak $_;
660f9bb0 2419 }
6e94698d 2420 chomp(my $error = $_);
2421 $class->log->error(qq/Caught exception in engine "$error"/);
3640641e 2422 };
fbcc39ad 2423
2424 $COUNT++;
62a6df80 2425
6680c772 2426 if(my $coderef = $class->log->can('_flush')){
2427 $class->log->$coderef();
2428 }
fbcc39ad 2429 return $status;
2430}
2431
d536010b 2432=head2 $class->prepare( @arguments )
fbcc39ad 2433
ae1e6b59 2434Creates a Catalyst context from an engine-specific request (Apache, CGI,
2435etc.).
fbcc39ad 2436
2437=cut
2438
398f13db 2439has _uploadtmp => (
2440 is => 'ro',
2441 predicate => '_has_uploadtmp',
2442);
2443
fbcc39ad 2444sub prepare {
2445 my ( $class, @arguments ) = @_;
2446
6680c772 2447 # XXX
2448 # After the app/ctxt split, this should become an attribute based on something passed
2449 # into the application.
3cec521a 2450 $class->context_class( ref $class || $class ) unless $class->context_class;
62a6df80 2451
398f13db 2452 my $uploadtmp = $class->config->{uploadtmp};
2453 my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
fbcc39ad 2454
258733f1 2455 $c->response->_context($c);
395037a2 2456 $c->stats($class->stats_class->new)->enable($c->use_stats);
ec4d7259 2457
4f0b7cf1 2458 if ( $c->debug || $c->config->{enable_catalyst_header} ) {
62a6df80 2459 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 2460 }
2461
3640641e 2462 try {
2463 # Allow engine to direct the prepare flow (for POE)
2464 if ( my $prepare = $c->engine->can('prepare') ) {
2465 $c->engine->$prepare( $c, @arguments );
2466 }
2467 else {
2468 $c->prepare_request(@arguments);
2469 $c->prepare_connection;
2470 $c->prepare_query_parameters;
41aaa5d6 2471 $c->prepare_headers; # Just hooks, no longer needed - they just
2472 $c->prepare_cookies; # cause the lazy attribute on req to build
3640641e 2473 $c->prepare_path;
2474
2475 # Prepare the body for reading, either by prepare_body
2476 # or the user, if they are using $c->read
2477 $c->prepare_read;
2478
2479 # Parse the body unless the user wants it on-demand
2480 unless ( ref($c)->config->{parse_on_demand} ) {
2481 $c->prepare_body;
2482 }
878b821c 2483 }
676bed72 2484 $c->prepare_action;
5050d7a7 2485 }
3640641e 2486 # VERY ugly and probably shouldn't rely on ->finalize actually working
2487 catch {
2488 # failed prepare is always due to an invalid request, right?
5e25c01f 2489 # Note we call finalize and then die here, which escapes
2490 # finalize being called in the enclosing block..
2491 # It in fact couldn't be called, as we don't return $c..
2492 # This is a mess - but I'm unsure you can fix this without
2493 # breaking compat for people doing crazy things (we should set
2494 # the 400 and just return the ctx here IMO, letting finalize get called
2495 # above...
058e4074 2496 if ( $c->_handle_http_exception($_) ) {
2497 foreach my $err (@{$c->error}) {
2498 $c->log->error($err);
2499 }
2500 $c->clear_errors;
2501 $c->log->_flush if $c->log->can('_flush');
2502 $_->can('rethrow') ? $_->rethrow : croak $_;
2503 } else {
2504 $c->response->status(400);
2505 $c->response->content_type('text/plain');
2506 $c->response->body('Bad Request');
2507 $c->finalize;
2508 die $_;
2509 }
3640641e 2510 };
fbcc39ad 2511
10f204e1 2512 $c->log_request;
be57189a 2513 $c->{stash} = $c->stash;
d86c0bd4 2514 Scalar::Util::weaken($c->{stash});
fbcc39ad 2515
2516 return $c;
2517}
2518
b5ecfcf0 2519=head2 $c->prepare_action
fbcc39ad 2520
b4b01a8a 2521Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 2522
2523=cut
2524
9c38cb50 2525sub prepare_action {
2526 my $c = shift;
2527 my $ret = $c->dispatcher->prepare_action( $c, @_);
2528
2529 if($c->encoding) {
2530 foreach (@{$c->req->arguments}, @{$c->req->captures}) {
2531 $_ = $c->_handle_param_unicode_decoding($_);
2532 }
2533 }
2534
2535 return $ret;
2536}
2537
fbcc39ad 2538
b5ecfcf0 2539=head2 $c->prepare_body
fbcc39ad 2540
e7f1cf73 2541Prepares message body.
fbcc39ad 2542
2543=cut
2544
2545sub prepare_body {
2546 my $c = shift;
2547
0f56bbcf 2548 return if $c->request->_has_body;
fbcc39ad 2549
2550 # Initialize on-demand data
2551 $c->engine->prepare_body( $c, @_ );
2552 $c->prepare_parameters;
2553 $c->prepare_uploads;
fbcc39ad 2554}
2555
b5ecfcf0 2556=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 2557
e7f1cf73 2558Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 2559
b4b01a8a 2560See L<Catalyst::Engine>.
2561
4bd82c41 2562=cut
2563
4f5ebacd 2564sub prepare_body_chunk {
2565 my $c = shift;
4bd82c41 2566 $c->engine->prepare_body_chunk( $c, @_ );
2567}
2568
b5ecfcf0 2569=head2 $c->prepare_body_parameters
fbcc39ad 2570
e7f1cf73 2571Prepares body parameters.
fbcc39ad 2572
2573=cut
2574
2575sub prepare_body_parameters {
2576 my $c = shift;
b9d96e27 2577 $c->request->prepare_body_parameters( $c, @_ );
fbcc39ad 2578}
2579
b5ecfcf0 2580=head2 $c->prepare_connection
fbcc39ad 2581
e7f1cf73 2582Prepares connection.
fbcc39ad 2583
2584=cut
2585
2586sub prepare_connection {
2587 my $c = shift;
817ed8ab 2588 $c->request->prepare_connection($c);
fbcc39ad 2589}
2590
b5ecfcf0 2591=head2 $c->prepare_cookies
fbcc39ad 2592
41aaa5d6 2593Prepares cookies by ensuring that the attribute on the request
2594object has been built.
fbcc39ad 2595
2596=cut
2597
41aaa5d6 2598sub prepare_cookies { my $c = shift; $c->request->cookies }
fbcc39ad 2599
b5ecfcf0 2600=head2 $c->prepare_headers
fbcc39ad 2601
41aaa5d6 2602Prepares request headers by ensuring that the attribute on the request
2603object has been built.
fbcc39ad 2604
2605=cut
2606
41aaa5d6 2607sub prepare_headers { my $c = shift; $c->request->headers }
fbcc39ad 2608
b5ecfcf0 2609=head2 $c->prepare_parameters
fbcc39ad 2610
e7f1cf73 2611Prepares parameters.
fbcc39ad 2612
2613=cut
2614
2615sub prepare_parameters {
2616 my $c = shift;
2617 $c->prepare_body_parameters;
2618 $c->engine->prepare_parameters( $c, @_ );
2619}
2620
b5ecfcf0 2621=head2 $c->prepare_path
fbcc39ad 2622
e7f1cf73 2623Prepares path and base.
fbcc39ad 2624
2625=cut
2626
2627sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2628
b5ecfcf0 2629=head2 $c->prepare_query_parameters
fbcc39ad 2630
e7f1cf73 2631Prepares query parameters.
fbcc39ad 2632
2633=cut
2634
2635sub prepare_query_parameters {
2636 my $c = shift;
2637
2638 $c->engine->prepare_query_parameters( $c, @_ );
10f204e1 2639}
fbcc39ad 2640
10f204e1 2641=head2 $c->log_request
2642
2643Writes information about the request to the debug logs. This includes:
2644
2645=over 4
2646
854e5dcd 2647=item * Request method, path, and remote IP address
10f204e1 2648
2649=item * Query keywords (see L<Catalyst::Request/query_keywords>)
2650
e7cbe1bf 2651=item * Request parameters
10f204e1 2652
2653=item * File uploads
2654
2655=back
fbcc39ad 2656
2657=cut
2658
10f204e1 2659sub log_request {
2660 my $c = shift;
fbcc39ad 2661
10f204e1 2662 return unless $c->debug;
fbcc39ad 2663
2bf54936 2664 my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2665 my $request = $dump->[1];
e7cbe1bf 2666
2667 my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
10f204e1 2668 $method ||= '';
2669 $path = '/' unless length $path;
2670 $address ||= '';
0ca510f0 2671
2672 $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
2673 $path = decode_utf8($path);
2674
10f204e1 2675 $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2676
3a4abdb3 2677 $c->log_request_headers($request->headers);
e7cbe1bf 2678
2679 if ( my $keywords = $request->query_keywords ) {
10f204e1 2680 $c->log->debug("Query keywords are: $keywords");
fbcc39ad 2681 }
10f204e1 2682
9c74923d 2683 $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
10f204e1 2684
e7cbe1bf 2685 $c->log_request_uploads($request);
fbcc39ad 2686}
2687
10f204e1 2688=head2 $c->log_response
fbcc39ad 2689
75b65816 2690Writes information about the response to the debug logs by calling
2691C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
fbcc39ad 2692
2693=cut
2694
75b65816 2695sub log_response {
2696 my $c = shift;
fbcc39ad 2697
75b65816 2698 return unless $c->debug;
fbcc39ad 2699
75b65816 2700 my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2701 my $response = $dump->[1];
2702
2703 $c->log_response_status_line($response);
2704 $c->log_response_headers($response->headers);
2705}
2706
2707=head2 $c->log_response_status_line($response)
2708
2709Writes one line of information about the response to the debug logs. This includes:
10f204e1 2710
2711=over 4
2712
2713=item * Response status code
2714
3a4abdb3 2715=item * Content-Type header (if present)
2716
2717=item * Content-Length header (if present)
10f204e1 2718
2719=back
fbcc39ad 2720
2721=cut
2722
75b65816 2723sub log_response_status_line {
2724 my ($c, $response) = @_;
fbcc39ad 2725
697bab77 2726 $c->log->debug(
2727 sprintf(
2728 'Response Code: %s; Content-Type: %s; Content-Length: %s',
2729 $response->status || 'unknown',
2730 $response->headers->header('Content-Type') || 'unknown',
2731 $response->headers->header('Content-Length') || 'unknown'
2732 )
2733 );
10f204e1 2734}
fbcc39ad 2735
75b65816 2736=head2 $c->log_response_headers($headers);
2737
8ad6fd58 2738Hook method which can be wrapped by plugins to log the response headers.
75b65816 2739No-op in the default implementation.
fbcc39ad 2740
2741=cut
2742
75b65816 2743sub log_response_headers {}
fbcc39ad 2744
10f204e1 2745=head2 $c->log_request_parameters( query => {}, body => {} )
2746
2747Logs request parameters to debug logs
2748
10f204e1 2749=cut
2750
2751sub log_request_parameters {
2752 my $c = shift;
2753 my %all_params = @_;
2754
2bf54936 2755 return unless $c->debug;
e7cbe1bf 2756
10f204e1 2757 my $column_width = Catalyst::Utils::term_width() - 44;
2758 foreach my $type (qw(query body)) {
2bf54936 2759 my $params = $all_params{$type};