lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use Moose;
   4 use Moose::Meta::Class ();
   5 extends 'Catalyst::Component';
   6 use Moose::Util qw/find_meta/;
   7 use namespace::clean -except => 'meta';
   8 use Catalyst::Exception;
   9 use Catalyst::Exception::Detach;
  10 use Catalyst::Exception::Go;
  11 use Catalyst::Log;
  12 use Catalyst::Request;
  13 use Catalyst::Request::Upload;
  14 use Catalyst::Response;
  15 use Catalyst::Utils;
  16 use Catalyst::Controller;
  17 use Data::OptList;
  18 use Devel::InnerPackage ();
  19 use Module::Pluggable::Object ();
  20 use Text::SimpleTable ();
  21 use Path::Class::Dir ();
  22 use Path::Class::File ();
  23 use URI ();
  24 use URI::http;
  25 use URI::https;
  26 use HTML::Entities;
  27 use Tree::Simple qw/use_weak_refs/;
  28 use Tree::Simple::Visitor::FindByUID;
  29 use Class::C3::Adopt::NEXT;
  30 use List::MoreUtils qw/uniq/;
  31 use attributes;
  32 use String::RewritePrefix;
  33 use Catalyst::EngineLoader;
  34 use utf8;
  35 use Carp qw/croak carp shortmess/;
  36 use Try::Tiny;
  37 use Safe::Isa;
  38 use Moose::Util 'find_meta';
  39 use Plack::Middleware::Conditional;
  40 use Plack::Middleware::ReverseProxy;
  41 use Plack::Middleware::IIS6ScriptNameFix;
  42 use Plack::Middleware::IIS7KeepAliveFix;
  43 use Plack::Middleware::LighttpdScriptNameFix;
  44 use Plack::Middleware::ContentLength;
  45 use Plack::Middleware::Head;
  46 use Plack::Middleware::HTTPExceptions;
  47 use Plack::Middleware::FixMissingBodyInRedirect;
  48 use Plack::Middleware::MethodOverride;
  49 use Plack::Middleware::RemoveRedundantBody;
  50 use Catalyst::Middleware::Stash;
  51 use Plack::Util;
  52 use Class::Load 'load_class';
  53 use Encode 2.21 ();
  54
  55 BEGIN { require 5.008003; }
  56
  57 has stack => (is => 'ro', default => sub { [] });
  58 has state => (is => 'rw', default => 0);
  59 has stats => (is => 'rw');
  60 has action => (is => 'rw');
  61 has counter => (is => 'rw', default => sub { {} });
  62 has request => (
  63     is => 'rw',
  64     default => sub {
  65         my $self = shift;
  66         $self->request_class->new($self->_build_request_constructor_args);
  67     },
  68     lazy => 1,
  69 );
  70 sub _build_request_constructor_args {
  71     my $self = shift;
  72     my %p = ( _log => $self->log );
  73     $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp;
  74     $p{data_handlers} = {$self->registered_data_handlers};
  75     $p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request}
  76       if $self->config->{use_hash_multivalue_in_request};
  77     \%p;
  78 }
  79
  80 has response => (
  81     is => 'rw',
  82     default => sub {
  83         my $self = shift;
  84         $self->response_class->new($self->_build_response_constructor_args);
  85     },
  86     lazy => 1,
  87 );
  88 sub _build_response_constructor_args {
  89     my $self = shift;
  90     { _log => $self->log };
  91 }
  92
  93 has namespace => (is => 'rw');
  94
  95 sub depth { scalar @{ shift->stack || [] }; }
  96 sub comp { shift->component(@_) }
  97
  98 sub req {
  99     my $self = shift; return $self->request(@_);
 100 }
 101 sub res {
 102     my $self = shift; return $self->response(@_);
 103 }
 104
 105 # For backwards compatibility
 106 sub finalize_output { shift->finalize_body(@_) };
 107
 108 # For statistics
 109 our $COUNT     = 1;
 110 our $START     = time;
 111 our $RECURSION = 1000;
 112 our $DETACH    = Catalyst::Exception::Detach->new;
 113 our $GO        = Catalyst::Exception::Go->new;
 114
 115 #I imagine that very few of these really need to be class variables. if any.
 116 #maybe we should just make them attributes with a default?
 117 __PACKAGE__->mk_classdata($_)
 118   for qw/components arguments dispatcher engine log dispatcher_class
 119   engine_loader context_class request_class response_class stats_class
 120   setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware
 121   _data_handlers _encoding _encode_check/;
 122
 123 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
 124 __PACKAGE__->request_class('Catalyst::Request');
 125 __PACKAGE__->response_class('Catalyst::Response');
 126 __PACKAGE__->stats_class('Catalyst::Stats');
 127 __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
 128
 129 # Remember to update this in Catalyst::Runtime as well!
 130 our $VERSION = '5.90078';
 131
 132 sub import {
 133     my ( $class, @arguments ) = @_;
 134
 135     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
 136     # callers @ISA.
 137     return unless $class eq 'Catalyst';
 138
 139     my $caller = caller();
 140     return if $caller eq 'main';
 141
 142     my $meta = Moose::Meta::Class->initialize($caller);
 143     unless ( $caller->isa('Catalyst') ) {
 144         my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
 145         $meta->superclasses(@superclasses);
 146     }
 147     # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
 148     $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
 149
 150     unless( $meta->has_method('meta') ){
 151         if ($Moose::VERSION >= 1.15) {
 152             $meta->_add_meta_method('meta');
 153         }
 154         else {
 155             $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
 156         }
 157     }
 158
 159     $caller->arguments( [@arguments] );
 160     $caller->setup_home;
 161 }
 162
 163 sub _application { $_[0] }
 164
 165 =encoding UTF-8
 166
 167 =head1 NAME
 168
 169 Catalyst - The Elegant MVC Web Application Framework
 170
 171 =head1 SYNOPSIS
 172
 173 See the L<Catalyst::Manual> distribution for comprehensive
 174 documentation and tutorials.
 175
 176     # Install Catalyst::Devel for helpers and other development tools
 177     # use the helper to create a new application
 178     catalyst.pl MyApp
 179
 180     # add models, views, controllers
 181     script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
 182     script/myapp_create.pl view MyTemplate TT
 183     script/myapp_create.pl controller Search
 184
 185     # built in testserver -- use -r to restart automatically on changes
 186     # --help to see all available options
 187     script/myapp_server.pl
 188
 189     # command line testing interface
 190     script/myapp_test.pl /yada
 191
 192     ### in lib/MyApp.pm
 193     use Catalyst qw/-Debug/; # include plugins here as well
 194
 195     ### In lib/MyApp/Controller/Root.pm (autocreated)
 196     sub foo : Chained('/') Args() { # called for /foo, /foo/1, /foo/1/2, etc.
 197         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
 198         $c->stash->{template} = 'foo.tt'; # set the template
 199         # lookup something from db -- stash vars are passed to TT
 200         $c->stash->{data} =
 201           $c->model('Database::Foo')->search( { country => $args[0] } );
 202         if ( $c->req->params->{bar} ) { # access GET or POST parameters
 203             $c->forward( 'bar' ); # process another action
 204             # do something else after forward returns
 205         }
 206     }
 207
 208     # The foo.tt TT template can use the stash data from the database
 209     [% WHILE (item = data.next) %]
 210         [% item.foo %]
 211     [% END %]
 212
 213     # called for /bar/of/soap, /bar/of/soap/10, etc.
 214     sub bar : Chained('/') PathPart('/bar/of/soap') Args() { ... }
 215
 216     # called after all actions are finished
 217     sub end : Action {
 218         my ( $self, $c ) = @_;
 219         if ( scalar @{ $c->error } ) { ... } # handle errors
 220         return if $c->res->body; # already have a response
 221         $c->forward( 'MyApp::View::TT' ); # render template
 222     }
 223
 224 See L<Catalyst::Manual::Intro> for additional information.
 225
 226 =head1 DESCRIPTION
 227
 228 Catalyst is a modern framework for making web applications without the
 229 pain usually associated with this process. This document is a reference
 230 to the main Catalyst application. If you are a new user, we suggest you
 231 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
 232
 233 See L<Catalyst::Manual> for more documentation.
 234
 235 Catalyst plugins can be loaded by naming them as arguments to the "use
 236 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
 237 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
 238 C<My::Module>.
 239
 240     use Catalyst qw/My::Module/;
 241
 242 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
 243 fully qualify the name by using a unary plus:
 244
 245     use Catalyst qw/
 246         My::Module
 247         +Fully::Qualified::Plugin::Name
 248     /;
 249
 250 Special flags like C<-Debug> can also be specified as
 251 arguments when Catalyst is loaded:
 252
 253     use Catalyst qw/-Debug My::Module/;
 254
 255 The position of plugins and flags in the chain is important, because
 256 they are loaded in the order in which they appear.
 257
 258 The following flags are supported:
 259
 260 =head2 -Debug
 261
 262 Enables debug output. You can also force this setting from the system
 263 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
 264 settings override the application, with <MYAPP>_DEBUG having the highest
 265 priority.
 266
 267 This sets the log level to 'debug' and enables full debug output on the
 268 error screen. If you only want the latter, see L<< $c->debug >>.
 269
 270 =head2 -Home
 271
 272 Forces Catalyst to use a specific home directory, e.g.:
 273
 274     use Catalyst qw[-Home=/usr/mst];
 275
 276 This can also be done in the shell environment by setting either the
 277 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
 278 is replaced with the uppercased name of your application, any "::" in
 279 the name will be replaced with underscores, e.g. MyApp::Web should use
 280 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 281
 282 If none of these are set, Catalyst will attempt to automatically detect the
 283 home directory. If you are working in a development environment, Catalyst
 284 will try and find the directory containing either Makefile.PL, Build.PL,
 285 dist.ini, or cpanfile. If the application has been installed into the system
 286 (i.e. you have done C<make install>), then Catalyst will use the path to your
 287 application module, without the .pm extension (e.g., /foo/MyApp if your
 288 application was installed at /foo/MyApp.pm)
 289
 290 =head2 -Log
 291
 292     use Catalyst '-Log=warn,fatal,error';
 293
 294 Specifies a comma-delimited list of log levels.
 295
 296 =head2 -Stats
 297
 298 Enables statistics collection and reporting.
 299
 300    use Catalyst qw/-Stats=1/;
 301
 302 You can also force this setting from the system environment with CATALYST_STATS
 303 or <MYAPP>_STATS. The environment settings override the application, with
 304 <MYAPP>_STATS having the highest priority.
 305
 306 Stats are also enabled if L<< debugging |/"-Debug" >> is enabled.
 307
 308 =head1 METHODS
 309
 310 =head2 INFORMATION ABOUT THE CURRENT REQUEST
 311
 312 =head2 $c->action
 313
 314 Returns a L<Catalyst::Action> object for the current action, which
 315 stringifies to the action name. See L<Catalyst::Action>.
 316
 317 =head2 $c->namespace
 318
 319 Returns the namespace of the current action, i.e., the URI prefix
 320 corresponding to the controller of the current action. For example:
 321
 322     # in Controller::Foo::Bar
 323     $c->namespace; # returns 'foo/bar';
 324
 325 =head2 $c->request
 326
 327 =head2 $c->req
 328
 329 Returns the current L<Catalyst::Request> object, giving access to
 330 information about the current client request (including parameters,
 331 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
 332
 333 =head2 REQUEST FLOW HANDLING
 334
 335 =head2 $c->forward( $action [, \@arguments ] )
 336
 337 =head2 $c->forward( $class, $method, [, \@arguments ] )
 338
 339 This is one way of calling another action (method) in the same or
 340 a different controller. You can also use C<< $self->my_method($c, @args) >>
 341 in the same controller or C<< $c->controller('MyController')->my_method($c, @args) >>
 342 in a different controller.
 343 The main difference is that 'forward' uses some of the Catalyst request
 344 cycle overhead, including debugging, which may be useful to you. On the
 345 other hand, there are some complications to using 'forward', restrictions
 346 on values returned from 'forward', and it may not handle errors as you prefer.
 347 Whether you use 'forward' or not is up to you; it is not considered superior to
 348 the other ways to call a method.
 349
 350 'forward' calls  another action, by its private name. If you give a
 351 class name but no method, C<process()> is called. You may also optionally
 352 pass arguments in an arrayref. The action will receive the arguments in
 353 C<@_> and C<< $c->req->args >>. Upon returning from the function,
 354 C<< $c->req->args >> will be restored to the previous values.
 355
 356 Any data C<return>ed from the action forwarded to, will be returned by the
 357 call to forward.
 358
 359     my $foodata = $c->forward('/foo');
 360     $c->forward('index');
 361     $c->forward(qw/Model::DBIC::Foo do_stuff/);
 362     $c->forward('View::TT');
 363
 364 Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
 365 an C<< eval { } >> around the call (actually
 366 L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all
 367 exceptions thrown by the called action non-fatal and pushing them onto
 368 $c->error instead. If you want C<die> to propagate you need to do something
 369 like:
 370
 371     $c->forward('foo');
 372     die join "\n", @{ $c->error } if @{ $c->error };
 373
 374 Or make sure to always return true values from your actions and write
 375 your code like this:
 376
 377     $c->forward('foo') || return;
 378
 379 Another note is that C<< $c->forward >> always returns a scalar because it
 380 actually returns $c->state which operates in a scalar context.
 381 Thus, something like:
 382
 383     return @array;
 384
 385 in an action that is forwarded to is going to return a scalar,
 386 i.e. how many items are in that array, which is probably not what you want.
 387 If you need to return an array then return a reference to it,
 388 or stash it like so:
 389
 390     $c->stash->{array} = \@array;
 391
 392 and access it from the stash.
 393
 394 Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
 395
 396 =cut
 397
 398 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
 399
 400 =head2 $c->detach( $action [, \@arguments ] )
 401
 402 =head2 $c->detach( $class, $method, [, \@arguments ] )
 403
 404 =head2 $c->detach()
 405
 406 The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
 407 doesn't return to the previous action when processing is finished.
 408
 409 When called with no arguments it escapes the processing chain entirely.
 410
 411 =cut
 412
 413 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 414
 415 =head2 $c->visit( $action [, \@arguments ] )
 416
 417 =head2 $c->visit( $action [, \@captures, \@arguments ] )
 418
 419 =head2 $c->visit( $class, $method, [, \@arguments ] )
 420
 421 =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
 422
 423 Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
 424 but does a full dispatch, instead of just calling the new C<$action> /
 425 C<< $class->$method >>. This means that C<begin>, C<auto> and the method
 426 you go to are called, just like a new request.
 427
 428 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
 429 This means, for example, that C<< $c->action >> methods such as
 430 L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
 431 L<reverse|Catalyst::Action/reverse> return information for the visited action
 432 when they are invoked within the visited action.  This is different from the
 433 behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
 434 continues to use the $c->action object from the caller action even when
 435 invoked from the called action.
 436
 437 C<< $c->stash >> is kept unchanged.
 438
 439 In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
 440 allows you to "wrap" another action, just as it would have been called by
 441 dispatching from a URL, while the analogous
 442 L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
 443 transfer control to another action as if it had been reached directly from a URL.
 444
 445 =cut
 446
 447 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
 448
 449 =head2 $c->go( $action [, \@arguments ] )
 450
 451 =head2 $c->go( $action [, \@captures, \@arguments ] )
 452
 453 =head2 $c->go( $class, $method, [, \@arguments ] )
 454
 455 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
 456
 457 The relationship between C<go> and
 458 L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
 459 the relationship between
 460 L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
 461 L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
 462 C<< $c->go >> will perform a full dispatch on the specified action or method,
 463 with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
 464 C<go> escapes the processing of the current request chain on completion, and
 465 does not return to its caller.
 466
 467 @arguments are arguments to the final destination of $action. @captures are
 468 arguments to the intermediate steps, if any, on the way to the final sub of
 469 $action.
 470
 471 =cut
 472
 473 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
 474
 475 =head2 $c->response
 476
 477 =head2 $c->res
 478
 479 Returns the current L<Catalyst::Response> object, see there for details.
 480
 481 =head2 $c->stash
 482
 483 Returns a hashref to the stash, which may be used to store data and pass
 484 it between components during a request. You can also set hash keys by
 485 passing arguments. The stash is automatically sent to the view. The
 486 stash is cleared at the end of a request; it cannot be used for
 487 persistent storage (for this you must use a session; see
 488 L<Catalyst::Plugin::Session> for a complete system integrated with
 489 Catalyst).
 490
 491     $c->stash->{foo} = $bar;
 492     $c->stash( { moose => 'majestic', qux => 0 } );
 493     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
 494
 495     # stash is automatically passed to the view for use in a template
 496     $c->forward( 'MyApp::View::TT' );
 497
 498 =cut
 499
 500 sub stash {
 501   my $c = shift;
 502   return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_);
 503 }
 504
 505 =head2 $c->error
 506
 507 =head2 $c->error($error, ...)
 508
 509 =head2 $c->error($arrayref)
 510
 511 Returns an arrayref containing error messages.  If Catalyst encounters an
 512 error while processing a request, it stores the error in $c->error.  This
 513 method should only be used to store fatal error messages.
 514
 515     my @error = @{ $c->error };
 516
 517 Add a new error.
 518
 519     $c->error('Something bad happened');
 520
 521 Calling this will always return an arrayref (if there are no errors it
 522 will be an empty arrayref.
 523
 524 =cut
 525
 526 sub error {
 527     my $c = shift;
 528     if ( $_[0] ) {
 529         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
 530         croak @$error unless ref $c;
 531         push @{ $c->{error} }, @$error;
 532     }
 533     elsif ( defined $_[0] ) { $c->{error} = undef }
 534     return $c->{error} || [];
 535 }
 536
 537
 538 =head2 $c->state
 539
 540 Contains the return value of the last executed action.
 541 Note that << $c->state >> operates in a scalar context which means that all
 542 values it returns are scalar.
 543
 544 =head2 $c->clear_errors
 545
 546 Clear errors.  You probably don't want to clear the errors unless you are
 547 implementing a custom error screen.
 548
 549 This is equivalent to running
 550
 551     $c->error(0);
 552
 553 =cut
 554
 555 sub clear_errors {
 556     my $c = shift;
 557     $c->error(0);
 558 }
 559
 560 =head2 $c->has_errors
 561
 562 Returns true if you have errors
 563
 564 =cut
 565
 566 sub has_errors { scalar(@{shift->error}) ? 1:0 }
 567
 568 =head2 $c->last_error
 569
 570 Returns the most recent error in the stack (the one most recently added...)
 571 or nothing if there are no errors.
 572
 573 =cut
 574
 575 sub last_error { my ($err, @errs) = @{shift->error}; return $err }
 576
 577 =head2 shift_errors
 578
 579 shifts the most recently added error off the error stack and returns if.  Returns
 580 nothing if there are nomore errors.
 581
 582 =cut
 583
 584 sub shift_errors {
 585     my ($self) = @_;
 586     my ($err, @errors) = @{$self->error};
 587     $self->{error} = \@errors;
 588     return $err;
 589 }
 590
 591 sub _comp_search_prefixes {
 592     my $c = shift;
 593     return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
 594 }
 595
 596 # search components given a name and some prefixes
 597 sub _comp_names_search_prefixes {
 598     my ( $c, $name, @prefixes ) = @_;
 599     my $appclass = ref $c || $c;
 600     my $filter   = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 601     $filter = qr/$filter/; # Compile regex now rather than once per loop
 602
 603     # map the original component name to the sub part that we will search against
 604     my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
 605         grep { /$filter/ } keys %{ $c->components };
 606
 607     # undef for a name will return all
 608     return keys %eligible if !defined $name;
 609
 610     my $query  = $name->$_isa('Regexp') ? $name : qr/^$name$/i;
 611     my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
 612
 613     return @result if @result;
 614
 615     # if we were given a regexp to search against, we're done.
 616     return if $name->$_isa('Regexp');
 617
 618     # skip regexp fallback if configured
 619     return
 620         if $appclass->config->{disable_component_resolution_regex_fallback};
 621
 622     # regexp fallback
 623     $query  = qr/$name/i;
 624     @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
 625
 626     # no results? try against full names
 627     if( !@result ) {
 628         @result = grep { m{$query} } keys %eligible;
 629     }
 630
 631     # don't warn if we didn't find any results, it just might not exist
 632     if( @result ) {
 633         # Disgusting hack to work out correct method name
 634         my $warn_for = lc $prefixes[0];
 635         my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
 636            (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
 637            "component resolution is unreliable and unsafe.";
 638         my $short = $result[0];
 639         # remove the component namespace prefix
 640         $short =~ s/.*?(Model|Controller|View):://;
 641         my $shortmess = Carp::shortmess('');
 642         if ($shortmess =~ m#Catalyst/Plugin#) {
 643            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
 644               "plugin's config";
 645         } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
 646            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
 647               "component's config";
 648         } else {
 649            $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}('${name}'), " .
 650               "but if you really wanted to search, pass in a regexp as the argument " .
 651               "like so: \$c->${warn_for}(qr/${name}/)";
 652         }
 653         $c->log->warn( "${msg}$shortmess" );
 654     }
 655
 656     return @result;
 657 }
 658
 659 # Find possible names for a prefix
 660 sub _comp_names {
 661     my ( $c, @prefixes ) = @_;
 662     my $appclass = ref $c || $c;
 663
 664     my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 665
 666     my @names = map { s{$filter}{}; $_; }
 667         $c->_comp_names_search_prefixes( undef, @prefixes );
 668
 669     return @names;
 670 }
 671
 672 # Filter a component before returning by calling ACCEPT_CONTEXT if available
 673 sub _filter_component {
 674     my ( $c, $comp, @args ) = @_;
 675
 676     if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
 677         return $comp->ACCEPT_CONTEXT( $c, @args );
 678     }
 679
 680     return $comp;
 681 }
 682
 683 =head2 COMPONENT ACCESSORS
 684
 685 =head2 $c->controller($name)
 686
 687 Gets a L<Catalyst::Controller> instance by name.
 688
 689     $c->controller('Foo')->do_stuff;
 690
 691 If the name is omitted, will return the controller for the dispatched
 692 action.
 693
 694 If you want to search for controllers, pass in a regexp as the argument.
 695
 696     # find all controllers that start with Foo
 697     my @foo_controllers = $c->controller(qr{^Foo});
 698
 699
 700 =cut
 701
 702 sub controller {
 703     my ( $c, $name, @args ) = @_;
 704
 705     my $appclass = ref($c) || $c;
 706     if( $name ) {
 707         unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
 708             my $comps = $c->components;
 709             my $check = $appclass."::Controller::".$name;
 710             return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
 711         }
 712         my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
 713         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 714         return $c->_filter_component( $result[ 0 ], @args );
 715     }
 716
 717     return $c->component( $c->action->class );
 718 }
 719
 720 =head2 $c->model($name)
 721
 722 Gets a L<Catalyst::Model> instance by name.
 723
 724     $c->model('Foo')->do_stuff;
 725
 726 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 727
 728 If the name is omitted, it will look for
 729  - a model object in $c->stash->{current_model_instance}, then
 730  - a model name in $c->stash->{current_model}, then
 731  - a config setting 'default_model', or
 732  - check if there is only one model, and return it if that's the case.
 733
 734 If you want to search for models, pass in a regexp as the argument.
 735
 736     # find all models that start with Foo
 737     my @foo_models = $c->model(qr{^Foo});
 738
 739 =cut
 740
 741 sub model {
 742     my ( $c, $name, @args ) = @_;
 743     my $appclass = ref($c) || $c;
 744     if( $name ) {
 745         unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
 746             my $comps = $c->components;
 747             my $check = $appclass."::Model::".$name;
 748             return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check};
 749         }
 750         my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
 751         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 752         return $c->_filter_component( $result[ 0 ], @args );
 753     }
 754
 755     if (ref $c) {
 756         return $c->stash->{current_model_instance}
 757           if $c->stash->{current_model_instance};
 758         return $c->model( $c->stash->{current_model} )
 759           if $c->stash->{current_model};
 760     }
 761     return $c->model( $appclass->config->{default_model} )
 762       if $appclass->config->{default_model};
 763
 764     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
 765
 766     if( $rest ) {
 767         $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
 768         $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' );
 769         $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
 770         $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
 771         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
 772     }
 773
 774     return $c->_filter_component( $comp );
 775 }
 776
 777
 778 =head2 $c->view($name)
 779
 780 Gets a L<Catalyst::View> instance by name.
 781
 782     $c->view('Foo')->do_stuff;
 783
 784 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 785
 786 If the name is omitted, it will look for
 787  - a view object in $c->stash->{current_view_instance}, then
 788  - a view name in $c->stash->{current_view}, then
 789  - a config setting 'default_view', or
 790  - check if there is only one view, and return it if that's the case.
 791
 792 If you want to search for views, pass in a regexp as the argument.
 793
 794     # find all views that start with Foo
 795     my @foo_views = $c->view(qr{^Foo});
 796
 797 =cut
 798
 799 sub view {
 800     my ( $c, $name, @args ) = @_;
 801
 802     my $appclass = ref($c) || $c;
 803     if( $name ) {
 804         unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps
 805             my $comps = $c->components;
 806             my $check = $appclass."::View::".$name;
 807             if( exists $comps->{$check} ) {
 808                 return $c->_filter_component( $comps->{$check}, @args );
 809             }
 810             else {
 811                 $c->log->warn( "Attempted to use view '$check', but does not exist" );
 812             }
 813         }
 814         my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
 815         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 816         return $c->_filter_component( $result[ 0 ], @args );
 817     }
 818
 819     if (ref $c) {
 820         return $c->stash->{current_view_instance}
 821           if $c->stash->{current_view_instance};
 822         return $c->view( $c->stash->{current_view} )
 823           if $c->stash->{current_view};
 824     }
 825     return $c->view( $appclass->config->{default_view} )
 826       if $appclass->config->{default_view};
 827
 828     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
 829
 830     if( $rest ) {
 831         $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
 832         $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
 833         $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
 834         $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
 835         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
 836     }
 837
 838     return $c->_filter_component( $comp );
 839 }
 840
 841 =head2 $c->controllers
 842
 843 Returns the available names which can be passed to $c->controller
 844
 845 =cut
 846
 847 sub controllers {
 848     my ( $c ) = @_;
 849     return $c->_comp_names(qw/Controller C/);
 850 }
 851
 852 =head2 $c->models
 853
 854 Returns the available names which can be passed to $c->model
 855
 856 =cut
 857
 858 sub models {
 859     my ( $c ) = @_;
 860     return $c->_comp_names(qw/Model M/);
 861 }
 862
 863
 864 =head2 $c->views
 865
 866 Returns the available names which can be passed to $c->view
 867
 868 =cut
 869
 870 sub views {
 871     my ( $c ) = @_;
 872     return $c->_comp_names(qw/View V/);
 873 }
 874
 875 =head2 $c->comp($name)
 876
 877 =head2 $c->component($name)
 878
 879 Gets a component object by name. This method is not recommended,
 880 unless you want to get a specific component by full
 881 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
 882 should be used instead.
 883
 884 If C<$name> is a regexp, a list of components matched against the full
 885 component name will be returned.
 886
 887 If Catalyst can't find a component by name, it will fallback to regex
 888 matching by default. To disable this behaviour set
 889 disable_component_resolution_regex_fallback to a true value.
 890
 891     __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 );
 892
 893 =cut
 894
 895 sub component {
 896     my ( $c, $name, @args ) = @_;
 897
 898     if( $name ) {
 899         my $comps = $c->components;
 900
 901         if( !ref $name ) {
 902             # is it the exact name?
 903             return $c->_filter_component( $comps->{ $name }, @args )
 904                        if exists $comps->{ $name };
 905
 906             # perhaps we just omitted "MyApp"?
 907             my $composed = ( ref $c || $c ) . "::${name}";
 908             return $c->_filter_component( $comps->{ $composed }, @args )
 909                        if exists $comps->{ $composed };
 910
 911             # search all of the models, views and controllers
 912             my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
 913             return $c->_filter_component( $comp, @args ) if $comp;
 914         }
 915
 916         return
 917             if $c->config->{disable_component_resolution_regex_fallback};
 918
 919         # This is here so $c->comp( '::M::' ) works
 920         my $query = ref $name ? $name : qr{$name}i;
 921
 922         my @result = grep { m{$query} } keys %{ $c->components };
 923         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 924
 925         if( $result[ 0 ] ) {
 926             $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
 927             $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
 928             $c->log->warn( 'is unreliable and unsafe. You have been warned' );
 929             return $c->_filter_component( $result[ 0 ], @args );
 930         }
 931
 932         # I would expect to return an empty list here, but that breaks back-compat
 933     }
 934
 935     # fallback
 936     return sort keys %{ $c->components };
 937 }
 938
 939 =head2 CLASS DATA AND HELPER CLASSES
 940
 941 =head2 $c->config
 942
 943 Returns or takes a hashref containing the application's configuration.
 944
 945     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
 946
 947 You can also use a C<YAML>, C<XML> or L<Config::General> config file
 948 like C<myapp.conf> in your applications home directory. See
 949 L<Catalyst::Plugin::ConfigLoader>.
 950
 951 =head3 Cascading configuration
 952
 953 The config method is present on all Catalyst components, and configuration
 954 will be merged when an application is started. Configuration loaded with
 955 L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
 956 followed by configuration in your top level C<MyApp> class. These two
 957 configurations are merged, and then configuration data whose hash key matches a
 958 component name is merged with configuration for that component.
 959
 960 The configuration for a component is then passed to the C<new> method when a
 961 component is constructed.
 962
 963 For example:
 964
 965     MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
 966     MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
 967
 968 will mean that C<MyApp::Model::Foo> receives the following data when
 969 constructed:
 970
 971     MyApp::Model::Foo->new({
 972         bar => 'baz',
 973         quux => 'frob',
 974         overrides => 'me',
 975     });
 976
 977 It's common practice to use a Moose attribute
 978 on the receiving component to access the config value.
 979
 980     package MyApp::Model::Foo;
 981
 982     use Moose;
 983
 984     # this attr will receive 'baz' at construction time
 985     has 'bar' => (
 986         is  => 'rw',
 987         isa => 'Str',
 988     );
 989
 990 You can then get the value 'baz' by calling $c->model('Foo')->bar
 991 (or $self->bar inside code in the model).
 992
 993 B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
 994 as a way of reading config within your code, as this B<will not> give you the
 995 correctly merged config back. You B<MUST> take the config values supplied to
 996 the constructor and use those instead.
 997
 998 =cut
 999
1000 around config => sub {
1001     my $orig = shift;
1002     my $c = shift;
1003
1004     croak('Setting config after setup has been run is not allowed.')
1005         if ( @_ and $c->setup_finished );
1006
1007     $c->$orig(@_);
1008 };
1009
1010 =head2 $c->log
1011
1012 Returns the logging object instance. Unless it is already set, Catalyst
1013 sets this up with a L<Catalyst::Log> object. To use your own log class,
1014 set the logger with the C<< __PACKAGE__->log >> method prior to calling
1015 C<< __PACKAGE__->setup >>.
1016
1017  __PACKAGE__->log( MyLogger->new );
1018  __PACKAGE__->setup;
1019
1020 And later:
1021
1022     $c->log->info( 'Now logging with my own logger!' );
1023
1024 Your log class should implement the methods described in
1025 L<Catalyst::Log>.
1026
1027 =head2 encoding
1028
1029 Sets or gets the application encoding.
1030
1031 =cut
1032
1033 sub encoding {
1034     my $c = shift;
1035     my $encoding;
1036
1037     if ( scalar @_ ) {
1038         # Let it be set to undef
1039         if (my $wanted = shift)  {
1040             $encoding = Encode::find_encoding($wanted)
1041               or Carp::croak( qq/Unknown encoding '$wanted'/ );
1042             binmode(STDERR, ':encoding(' . $encoding->name . ')');
1043         }
1044         else {
1045             binmode(STDERR);
1046         }
1047
1048         $encoding = ref $c
1049                   ? $c->{encoding} = $encoding
1050                   : $c->_encoding($encoding);
1051     } else {
1052       $encoding = ref $c && exists $c->{encoding}
1053                 ? $c->{encoding}
1054                 : $c->_encoding;
1055     }
1056
1057     return $encoding;
1058 }
1059
1060 =head2 $c->debug
1061
1062 Returns 1 if debug mode is enabled, 0 otherwise.
1063
1064 You can enable debug mode in several ways:
1065
1066 =over
1067
1068 =item By calling myapp_server.pl with the -d flag
1069
1070 =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
1071
1072 =item The -Debug option in your MyApp.pm
1073
1074 =item By declaring C<sub debug { 1 }> in your MyApp.pm.
1075
1076 =back
1077
1078 The first three also set the log level to 'debug'.
1079
1080 Calling C<< $c->debug(1) >> has no effect.
1081
1082 =cut
1083
1084 sub debug { 0 }
1085
1086 =head2 $c->dispatcher
1087
1088 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
1089
1090 =head2 $c->engine
1091
1092 Returns the engine instance. See L<Catalyst::Engine>.
1093
1094
1095 =head2 UTILITY METHODS
1096
1097 =head2 $c->path_to(@path)
1098
1099 Merges C<@path> with C<< $c->config->{home} >> and returns a
1100 L<Path::Class::Dir> object. Note you can usually use this object as
1101 a filename, but sometimes you will have to explicitly stringify it
1102 yourself by calling the C<< ->stringify >> method.
1103
1104 For example:
1105
1106     $c->path_to( 'db', 'sqlite.db' );
1107
1108 =cut
1109
1110 sub path_to {
1111     my ( $c, @path ) = @_;
1112     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
1113     if ( -d $path ) { return $path }
1114     else { return Path::Class::File->new( $c->config->{home}, @path ) }
1115 }
1116
1117 sub plugin {
1118     my ( $class, $name, $plugin, @args ) = @_;
1119
1120     # See block comment in t/unit_core_plugin.t
1121     $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in a future release/);
1122
1123     $class->_register_plugin( $plugin, 1 );
1124
1125     eval { $plugin->import };
1126     $class->mk_classdata($name);
1127     my $obj;
1128     eval { $obj = $plugin->new(@args) };
1129
1130     if ($@) {
1131         Catalyst::Exception->throw( message =>
1132               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
1133     }
1134
1135     $class->$name($obj);
1136     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
1137       if $class->debug;
1138 }
1139
1140 =head2 MyApp->setup
1141
1142 Initializes the dispatcher and engine, loads any plugins, and loads the
1143 model, view, and controller components. You may also specify an array
1144 of plugins to load here, if you choose to not load them in the C<use
1145 Catalyst> line.
1146
1147     MyApp->setup;
1148     MyApp->setup( qw/-Debug/ );
1149
1150 B<Note:> You B<should not> wrap this method with method modifiers
1151 or bad things will happen - wrap the C<setup_finalize> method instead.
1152
1153 =cut
1154
1155 sub setup {
1156     my ( $class, @arguments ) = @_;
1157     croak('Running setup more than once')
1158         if ( $class->setup_finished );
1159
1160     unless ( $class->isa('Catalyst') ) {
1161
1162         Catalyst::Exception->throw(
1163             message => qq/'$class' does not inherit from Catalyst/ );
1164     }
1165
1166     if ( $class->arguments ) {
1167         @arguments = ( @arguments, @{ $class->arguments } );
1168     }
1169
1170     # Process options
1171     my $flags = {};
1172
1173     foreach (@arguments) {
1174
1175         if (/^-Debug$/) {
1176             $flags->{log} =
1177               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
1178         }
1179         elsif (/^-(\w+)=?(.*)$/) {
1180             $flags->{ lc $1 } = $2;
1181         }
1182         else {
1183             push @{ $flags->{plugins} }, $_;
1184         }
1185     }
1186
1187     $class->setup_home( delete $flags->{home} );
1188
1189     $class->setup_log( delete $flags->{log} );
1190     $class->setup_plugins( delete $flags->{plugins} );
1191
1192     $class->setup_data_handlers();
1193     $class->setup_dispatcher( delete $flags->{dispatcher} );
1194     if (my $engine = delete $flags->{engine}) {
1195         $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading");
1196     }
1197     $class->setup_engine();
1198     $class->setup_stats( delete $flags->{stats} );
1199
1200     for my $flag ( sort keys %{$flags} ) {
1201
1202         if ( my $code = $class->can( 'setup_' . $flag ) ) {
1203             &$code( $class, delete $flags->{$flag} );
1204         }
1205         else {
1206             $class->log->warn(qq/Unknown flag "$flag"/);
1207         }
1208     }
1209
1210     eval { require Catalyst::Devel; };
1211     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1212         $class->log->warn(<<"EOF");
1213 You are running an old script!
1214
1215   Please update by running (this will overwrite existing files):
1216     catalyst.pl -force -scripts $class
1217
1218   or (this will not overwrite existing files):
1219     catalyst.pl -scripts $class
1220
1221 EOF
1222     }
1223
1224     # Call plugins setup, this is stupid and evil.
1225     # Also screws C3 badly on 5.10, hack to avoid.
1226     {
1227         no warnings qw/redefine/;
1228         local *setup = sub { };
1229         $class->setup unless $Catalyst::__AM_RESTARTING;
1230     }
1231
1232     # If you are expecting configuration info as part of your setup, it needs
1233     # to get called here and below, since we need the above line to support
1234     # ConfigLoader based configs.
1235
1236     $class->setup_encoding();
1237     $class->setup_middleware();
1238
1239     # Initialize our data structure
1240     $class->components( {} );
1241
1242     $class->setup_components;
1243
1244     if ( $class->debug ) {
1245         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
1246
1247         if (@plugins) {
1248             my $column_width = Catalyst::Utils::term_width() - 6;
1249             my $t = Text::SimpleTable->new($column_width);
1250             $t->row($_) for @plugins;
1251             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
1252         }
1253
1254         my @middleware = map {
1255           ref $_ eq 'CODE' ?
1256             "Inline Coderef" :
1257               (ref($_) .'  '. ($_->can('VERSION') ? $_->VERSION || '' : '')
1258                 || '')  } $class->registered_middlewares;
1259
1260         if (@middleware) {
1261             my $column_width = Catalyst::Utils::term_width() - 6;
1262             my $t = Text::SimpleTable->new($column_width);
1263             $t->row($_) for @middleware;
1264             $class->log->debug( "Loaded PSGI Middleware:\n" . $t->draw . "\n" );
1265         }
1266
1267         my %dh = $class->registered_data_handlers;
1268         if (my @data_handlers = keys %dh) {
1269             my $column_width = Catalyst::Utils::term_width() - 6;
1270             my $t = Text::SimpleTable->new($column_width);
1271             $t->row($_) for @data_handlers;
1272             $class->log->debug( "Loaded Request Data Handlers:\n" . $t->draw . "\n" );
1273         }
1274
1275         my $dispatcher = $class->dispatcher;
1276         my $engine     = $class->engine;
1277         my $home       = $class->config->{home};
1278
1279         $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1280         $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1281
1282         $home
1283           ? ( -d $home )
1284           ? $class->log->debug(qq/Found home "$home"/)
1285           : $class->log->debug(qq/Home "$home" doesn't exist/)
1286           : $class->log->debug(q/Couldn't find home/);
1287
1288         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1289         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1290         for my $comp ( sort keys %{ $class->components } ) {
1291             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1292             $t->row( $comp, $type );
1293         }
1294         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1295           if ( keys %{ $class->components } );
1296     }
1297
1298     # Add our self to components, since we are also a component
1299     if( $class->isa('Catalyst::Controller') ){
1300       $class->components->{$class} = $class;
1301     }
1302
1303     $class->setup_actions;
1304
1305     if ( $class->debug ) {
1306         my $name = $class->config->{name} || 'Application';
1307         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1308     }
1309
1310     if ($class->config->{case_sensitive}) {
1311         $class->log->warn($class . "->config->{case_sensitive} is set.");
1312         $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1313     }
1314
1315     $class->setup_finalize;
1316
1317     # Flush the log for good measure (in case something turned off 'autoflush' early)
1318     $class->log->_flush() if $class->log->can('_flush');
1319
1320     return $class || 1; # Just in case someone named their Application 0...
1321 }
1322
1323 =head2 $app->setup_finalize
1324
1325 A hook to attach modifiers to. This method does not do anything except set the
1326 C<setup_finished> accessor.
1327
1328 Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
1329
1330 Example:
1331
1332     after setup_finalize => sub {
1333         my $app = shift;
1334
1335         ## do stuff here..
1336     };
1337
1338 =cut
1339
1340 sub setup_finalize {
1341     my ($class) = @_;
1342     $class->setup_finished(1);
1343 }
1344
1345 =head2 $c->uri_for( $path?, @args?, \%query_values? )
1346
1347 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1348
1349 Constructs an absolute L<URI> object based on the application root, the
1350 provided path, and the additional arguments and query parameters provided.
1351 When used as a string, provides a textual URI.  If you need more flexibility
1352 than this (i.e. the option to provide relative URIs etc.) see
1353 L<Catalyst::Plugin::SmartURI>.
1354
1355 If no arguments are provided, the URI for the current action is returned.
1356 To return the current action and also provide @args, use
1357 C<< $c->uri_for( $c->action, @args ) >>.
1358
1359 If the first argument is a string, it is taken as a public URI path relative
1360 to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
1361 relative to the application root (if it does). It is then merged with
1362 C<< $c->request->base >>; any C<@args> are appended as additional path
1363 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1364
1365 If the first argument is a L<Catalyst::Action> it represents an action which
1366 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1367 optional C<\@captures> argument (an arrayref) allows passing the captured
1368 variables that are needed to fill in the paths of Chained and Regex actions;
1369 once the path is resolved, C<uri_for> continues as though a path was
1370 provided, appending any arguments or parameters and creating an absolute
1371 URI.
1372
1373 The captures for the current request can be found in
1374 C<< $c->request->captures >>, and actions can be resolved using
1375 C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1376 path, use C<< $c->uri_for_action >> instead.
1377
1378   # Equivalent to $c->req->uri
1379   $c->uri_for($c->action, $c->req->captures,
1380       @{ $c->req->args }, $c->req->params);
1381
1382   # For the Foo action in the Bar controller
1383   $c->uri_for($c->controller('Bar')->action_for('Foo'));
1384
1385   # Path to a static resource
1386   $c->uri_for('/static/images/logo.png');
1387
1388 =cut
1389
1390 sub uri_for {
1391     my ( $c, $path, @args ) = @_;
1392
1393     if ( $path->$_isa('Catalyst::Controller') ) {
1394         $path = $path->path_prefix;
1395         $path =~ s{/+\z}{};
1396         $path .= '/';
1397     }
1398
1399     undef($path) if (defined $path && $path eq '');
1400
1401     my $params =
1402       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1403
1404     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1405     foreach my $arg (@args) {
1406         utf8::encode($arg) if utf8::is_utf8($arg);
1407         $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1408     }
1409
1410     if ( $path->$_isa('Catalyst::Action') ) { # action object
1411         s|/|%2F|g for @args;
1412         my $captures = [ map { s|/|%2F|g; $_; }
1413                         ( scalar @args && ref $args[0] eq 'ARRAY'
1414                          ? @{ shift(@args) }
1415                          : ()) ];
1416
1417         foreach my $capture (@$captures) {
1418             utf8::encode($capture) if utf8::is_utf8($capture);
1419             $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1420         }
1421
1422         my $action = $path;
1423         # ->uri_for( $action, \@captures_and_args, \%query_values? )
1424         if( !@args && $action->number_of_args ) {
1425             my $expanded_action = $c->dispatcher->expand_action( $action );
1426
1427             my $num_captures = $expanded_action->number_of_captures;
1428             unshift @args, splice @$captures, $num_captures;
1429         }
1430
1431        $path = $c->dispatcher->uri_for_action($action, $captures);
1432         if (not defined $path) {
1433             $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1434                 if $c->debug;
1435             return undef;
1436         }
1437         $path = '/' if $path eq '';
1438     }
1439
1440     unshift(@args, $path);
1441
1442     unless (defined $path && $path =~ s!^/!!) { # in-place strip
1443         my $namespace = $c->namespace;
1444         if (defined $path) { # cheesy hack to handle path '../foo'
1445            $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1446         }
1447         unshift(@args, $namespace || '');
1448     }
1449
1450     # join args with '/', or a blank string
1451     my $args = join('/', grep { defined($_) } @args);
1452     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1453     $args =~ s!^/+!!;
1454
1455     my ($base, $class) = ('/', 'URI::_generic');
1456     if(blessed($c)) {
1457       $base = $c->req->base;
1458       $class = ref($base);
1459       $base =~ s{(?<!/)$}{/};
1460     }
1461
1462     my $query = '';
1463
1464     if (my @keys = keys %$params) {
1465       # somewhat lifted from URI::_query's query_form
1466       $query = '?'.join('&', map {
1467           my $val = $params->{$_};
1468           s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1469           s/ /+/g;
1470           my $key = $_;
1471           $val = '' unless defined $val;
1472           (map {
1473               my $param = "$_";
1474               utf8::encode( $param ) if utf8::is_utf8($param);
1475               # using the URI::Escape pattern here so utf8 chars survive
1476               $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1477               $param =~ s/ /+/g;
1478               "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1479       } @keys);
1480     }
1481
1482     my $res = bless(\"${base}${args}${query}", $class);
1483     $res;
1484 }
1485
1486 =head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? )
1487
1488 =head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? )
1489
1490 =over
1491
1492 =item $path
1493
1494 A private path to the Catalyst action you want to create a URI for.
1495
1496 This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1497 >> and passing the resulting C<$action> and the remaining arguments to C<<
1498 $c->uri_for >>.
1499
1500 You can also pass in a Catalyst::Action object, in which case it is passed to
1501 C<< $c->uri_for >>.
1502
1503 Note 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.
1504
1505 For example, if the action looks like:
1506
1507  package MyApp::Controller::Users;
1508
1509  sub lst : Path('the-list') {}
1510
1511 You can use:
1512
1513  $c->uri_for_action('/users/lst')
1514
1515 and it will create the URI /users/the-list.
1516
1517 =item \@captures_and_args?
1518
1519 Optional array reference of Captures (i.e. C<<CaptureArgs or $c->req->captures>)
1520 and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained>
1521 to interpolate all the parameters in the URI.
1522
1523 =item @args?
1524
1525 Optional list of extra arguments - can be supplied in the
1526 C<< \@captures_and_args? >> array ref, or here - whichever is easier for your
1527 code.
1528
1529 Your action can have zero, a fixed or a variable number of args (e.g.
1530 C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number)..
1531
1532 =item \%query_values?
1533
1534 Optional array reference of query parameters to append. E.g.
1535
1536   { foo => 'bar' }
1537
1538 will generate
1539
1540   /rest/of/your/uri?foo=bar
1541
1542 =back
1543
1544 =cut
1545
1546 sub uri_for_action {
1547     my ( $c, $path, @args ) = @_;
1548     my $action = blessed($path)
1549       ? $path
1550       : $c->dispatcher->get_action_by_path($path);
1551     unless (defined $action) {
1552       croak "Can't find action for path '$path'";
1553     }
1554     return $c->uri_for( $action, @args );
1555 }
1556
1557 =head2 $c->welcome_message
1558
1559 Returns the Catalyst welcome HTML page.
1560
1561 =cut
1562
1563 sub welcome_message {
1564     my $c      = shift;
1565     my $name   = $c->config->{name};
1566     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
1567     my $prefix = Catalyst::Utils::appprefix( ref $c );
1568     $c->response->content_type('text/html; charset=utf-8');
1569     return <<"EOF";
1570 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1571     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1572 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1573     <head>
1574     <meta http-equiv="Content-Language" content="en" />
1575     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1576         <title>$name on Catalyst $VERSION</title>
1577         <style type="text/css">
1578             body {
1579                 color: #000;
1580                 background-color: #eee;
1581             }
1582             div#content {
1583                 width: 640px;
1584                 margin-left: auto;
1585                 margin-right: auto;
1586                 margin-top: 10px;
1587                 margin-bottom: 10px;
1588                 text-align: left;
1589                 background-color: #ccc;
1590                 border: 1px solid #aaa;
1591             }
1592             p, h1, h2 {
1593                 margin-left: 20px;
1594                 margin-right: 20px;
1595                 font-family: verdana, tahoma, sans-serif;
1596             }
1597             a {
1598                 font-family: verdana, tahoma, sans-serif;
1599             }
1600             :link, :visited {
1601                     text-decoration: none;
1602                     color: #b00;
1603                     border-bottom: 1px dotted #bbb;
1604             }
1605             :link:hover, :visited:hover {
1606                     color: #555;
1607             }
1608             div#topbar {
1609                 margin: 0px;
1610             }
1611             pre {
1612                 margin: 10px;
1613                 padding: 8px;
1614             }
1615             div#answers {
1616                 padding: 8px;
1617                 margin: 10px;
1618                 background-color: #fff;
1619                 border: 1px solid #aaa;
1620             }
1621             h1 {
1622                 font-size: 0.9em;
1623                 font-weight: normal;
1624                 text-align: center;
1625             }
1626             h2 {
1627                 font-size: 1.0em;
1628             }
1629             p {
1630                 font-size: 0.9em;
1631             }
1632             p img {
1633                 float: right;
1634                 margin-left: 10px;
1635             }
1636             span#appname {
1637                 font-weight: bold;
1638                 font-size: 1.6em;
1639             }
1640         </style>
1641     </head>
1642     <body>
1643         <div id="content">
1644             <div id="topbar">
1645                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1646                     $VERSION</h1>
1647              </div>
1648              <div id="answers">
1649                  <p>
1650                  <img src="$logo" alt="Catalyst Logo" />
1651                  </p>
1652                  <p>Welcome to the  world of Catalyst.
1653                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1654                     framework will make web development something you had
1655                     never expected it to be: Fun, rewarding, and quick.</p>
1656                  <h2>What to do now?</h2>
1657                  <p>That really depends  on what <b>you</b> want to do.
1658                     We do, however, provide you with a few starting points.</p>
1659                  <p>If you want to jump right into web development with Catalyst
1660                     you might want to start with a tutorial.</p>
1661 <pre>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Tutorial">Catalyst::Manual::Tutorial</a></code>
1662 </pre>
1663 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1664 <pre>
1665 <code>perldoc <a href="https://metacpan.org/module/Catalyst::Manual::Intro">Catalyst::Manual::Intro</a>
1666 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1667 </code></pre>
1668                  <h2>What to do next?</h2>
1669                  <p>Next it's time to write an actual application. Use the
1670                     helper scripts to generate <a href="https://metacpan.org/search?q=Catalyst%3A%3AController">controllers</a>,
1671                     <a href="https://metacpan.org/search?q=Catalyst%3A%3AModel">models</a>, and
1672                     <a href="https://metacpan.org/search?q=Catalyst%3A%3AView">views</a>;
1673                     they can save you a lot of work.</p>
1674                     <pre><code>script/${prefix}_create.pl --help</code></pre>
1675                     <p>Also, be sure to check out the vast and growing
1676                     collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1677                     you are likely to find what you need there.
1678                     </p>
1679
1680                  <h2>Need help?</h2>
1681                  <p>Catalyst has a very active community. Here are the main places to
1682                     get in touch with us.</p>
1683                  <ul>
1684                      <li>
1685                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1686                      </li>
1687                      <li>
1688                          <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1689                      </li>
1690                      <li>
1691                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1692                      </li>
1693                  </ul>
1694                  <h2>In conclusion</h2>
1695                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1696                     as we enjoyed making it. Please contact us if you have ideas
1697                     for improvement or other feedback.</p>
1698              </div>
1699          </div>
1700     </body>
1701 </html>
1702 EOF
1703 }
1704
1705 =head2 run_options
1706
1707 Contains a hash of options passed from the application script, including
1708 the original ARGV the script received, the processed values from that
1709 ARGV and any extra arguments to the script which were not processed.
1710
1711 This can be used to add custom options to your application's scripts
1712 and setup your application differently depending on the values of these
1713 options.
1714
1715 =head1 INTERNAL METHODS
1716
1717 These methods are not meant to be used by end users.
1718
1719 =head2 $c->components
1720
1721 Returns a hash of components.
1722
1723 =head2 $c->context_class
1724
1725 Returns or sets the context class.
1726
1727 =head2 $c->counter
1728
1729 Returns a hashref containing coderefs and execution counts (needed for
1730 deep recursion detection).
1731
1732 =head2 $c->depth
1733
1734 Returns the number of actions on the current internal execution stack.
1735
1736 =head2 $c->dispatch
1737
1738 Dispatches a request to actions.
1739
1740 =cut
1741
1742 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1743
1744 =head2 $c->dispatcher_class
1745
1746 Returns or sets the dispatcher class.
1747
1748 =head2 $c->dump_these
1749
1750 Returns a list of 2-element array references (name, structure) pairs
1751 that will be dumped on the error page in debug mode.
1752
1753 =cut
1754
1755 sub dump_these {
1756     my $c = shift;
1757     [ Request => $c->req ],
1758     [ Response => $c->res ],
1759     [ Stash => $c->stash ],
1760     [ Config => $c->config ];
1761 }
1762
1763 =head2 $c->engine_class
1764
1765 Returns or sets the engine class.
1766
1767 =head2 $c->execute( $class, $coderef )
1768
1769 Execute a coderef in given class and catch exceptions. Errors are available
1770 via $c->error.
1771
1772 =cut
1773
1774 sub execute {
1775     my ( $c, $class, $code ) = @_;
1776     $class = $c->component($class) || $class;
1777     $c->state(0);
1778
1779     if ( $c->depth >= $RECURSION ) {
1780         my $action = $code->reverse();
1781         $action = "/$action" unless $action =~ /->/;
1782         my $error = qq/Deep recursion detected calling "${action}"/;
1783         $c->log->error($error);
1784         $c->error($error);
1785         $c->state(0);
1786         return $c->state;
1787     }
1788
1789     my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1790
1791     push( @{ $c->stack }, $code );
1792
1793     no warnings 'recursion';
1794     # N.B. This used to be combined, but I have seen $c get clobbered if so, and
1795     #      I have no idea how, ergo $ret (which appears to fix the issue)
1796     eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
1797
1798     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1799
1800     my $last = pop( @{ $c->stack } );
1801
1802     if ( my $error = $@ ) {
1803         #rethow if this can be handled by middleware
1804         if ( $c->_handle_http_exception($error) ) {
1805             foreach my $err (@{$c->error}) {
1806                 $c->log->error($err);
1807             }
1808             $c->clear_errors;
1809             $c->log->_flush if $c->log->can('_flush');
1810
1811             $error->can('rethrow') ? $error->rethrow : croak $error;
1812         }
1813         if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
1814             $error->rethrow if $c->depth > 1;
1815         }
1816         elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
1817             $error->rethrow if $c->depth > 0;
1818         }
1819         else {
1820             unless ( ref $error ) {
1821                 no warnings 'uninitialized';
1822                 chomp $error;
1823                 my $class = $last->class;
1824                 my $name  = $last->name;
1825                 $error = qq/Caught exception in $class->$name "$error"/;
1826             }
1827             $c->error($error);
1828         }
1829         $c->state(0);
1830     }
1831     return $c->state;
1832 }
1833
1834 sub _stats_start_execute {
1835     my ( $c, $code ) = @_;
1836     my $appclass = ref($c) || $c;
1837     return if ( ( $code->name =~ /^_.*/ )
1838         && ( !$appclass->config->{show_internal_actions} ) );
1839
1840     my $action_name = $code->reverse();
1841     $c->counter->{$action_name}++;
1842
1843     my $action = $action_name;
1844     $action = "/$action" unless $action =~ /->/;
1845
1846     # determine if the call was the result of a forward
1847     # this is done by walking up the call stack and looking for a calling
1848     # sub of Catalyst::forward before the eval
1849     my $callsub = q{};
1850     for my $index ( 2 .. 11 ) {
1851         last
1852         if ( ( caller($index) )[0] eq 'Catalyst'
1853             && ( caller($index) )[3] eq '(eval)' );
1854
1855         if ( ( caller($index) )[3] =~ /forward$/ ) {
1856             $callsub = ( caller($index) )[3];
1857             $action  = "-> $action";
1858             last;
1859         }
1860     }
1861
1862     my $uid = $action_name . $c->counter->{$action_name};
1863
1864     # is this a root-level call or a forwarded call?
1865     if ( $callsub =~ /forward$/ ) {
1866         my $parent = $c->stack->[-1];
1867
1868         # forward, locate the caller
1869         if ( defined $parent && exists $c->counter->{"$parent"} ) {
1870             $c->stats->profile(
1871                 begin  => $action,
1872                 parent => "$parent" . $c->counter->{"$parent"},
1873                 uid    => $uid,
1874             );
1875         }
1876         else {
1877
1878             # forward with no caller may come from a plugin
1879             $c->stats->profile(
1880                 begin => $action,
1881                 uid   => $uid,
1882             );
1883         }
1884     }
1885     else {
1886
1887         # root-level call
1888         $c->stats->profile(
1889             begin => $action,
1890             uid   => $uid,
1891         );
1892     }
1893     return $action;
1894
1895 }
1896
1897 sub _stats_finish_execute {
1898     my ( $c, $info ) = @_;
1899     $c->stats->profile( end => $info );
1900 }
1901
1902 =head2 $c->finalize
1903
1904 Finalizes the request.
1905
1906 =cut
1907
1908 sub finalize {
1909     my $c = shift;
1910
1911     for my $error ( @{ $c->error } ) {
1912         $c->log->error($error);
1913     }
1914
1915     # Support skipping finalize for psgix.io style 'jailbreak'.  Used to support
1916     # stuff like cometd and websockets
1917
1918     if($c->request->_has_io_fh) {
1919       $c->log_response;
1920       return;
1921     }
1922
1923     # Allow engine to handle finalize flow (for POE)
1924     my $engine = $c->engine;
1925     if ( my $code = $engine->can('finalize') ) {
1926         $engine->$code($c);
1927     }
1928     else {
1929
1930         $c->finalize_uploads;
1931
1932         # Error
1933         if ( $#{ $c->error } >= 0 ) {
1934             $c->finalize_error;
1935         }
1936
1937         $c->finalize_encoding;
1938         $c->finalize_headers unless $c->response->finalized_headers;
1939         $c->finalize_body;
1940     }
1941
1942     $c->log_response;
1943
1944     if ($c->use_stats) {
1945         my $elapsed = $c->stats->elapsed;
1946         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1947         $c->log->info(
1948             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1949     }
1950
1951     return $c->response->status;
1952 }
1953
1954 =head2 $c->finalize_body
1955
1956 Finalizes body.
1957
1958 =cut
1959
1960 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1961
1962 =head2 $c->finalize_cookies
1963
1964 Finalizes cookies.
1965
1966 =cut
1967
1968 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1969
1970 =head2 $c->finalize_error
1971
1972 Finalizes error.  If there is only one error in L</error> and it is an object that
1973 does C<as_psgi> or C<code> we rethrow the error and presume it caught by middleware
1974 up the ladder.  Otherwise we return the debugging error page (in debug mode) or we
1975 return the default error page (production mode).
1976
1977 =cut
1978
1979 sub finalize_error {
1980     my $c = shift;
1981     if($#{$c->error} > 0) {
1982         $c->engine->finalize_error( $c, @_ );
1983     } else {
1984         my ($error) = @{$c->error};
1985         if ( $c->_handle_http_exception($error) ) {
1986             # In the case where the error 'knows what it wants', becauses its PSGI
1987             # aware, just rethow and let middleware catch it
1988             $error->can('rethrow') ? $error->rethrow : croak $error;
1989         } else {
1990             $c->engine->finalize_error( $c, @_ )
1991         }
1992     }
1993 }
1994
1995 =head2 $c->finalize_headers
1996
1997 Finalizes headers.
1998
1999 =cut
2000
2001 sub finalize_headers {
2002     my $c = shift;
2003
2004     my $response = $c->response; #accessor calls can add up?
2005
2006     # Check if we already finalized headers
2007     return if $response->finalized_headers;
2008
2009     # Handle redirects
2010     if ( my $location = $response->redirect ) {
2011         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
2012         $response->header( Location => $location );
2013     }
2014
2015     # Remove incorrectly added body and content related meta data when returning
2016     # an information response, or a response the is required to not include a body
2017
2018     $c->finalize_cookies;
2019
2020     $c->response->finalize_headers();
2021
2022     # Done
2023     $response->finalized_headers(1);
2024 }
2025
2026 =head2 $c->finalize_encoding
2027
2028 Make sure your headers and body are encoded properly IF you set an encoding.
2029 See L</ENCODING>.
2030
2031 =cut
2032
2033 sub finalize_encoding {
2034     my $c = shift;
2035
2036     my $body = $c->response->body;
2037
2038     return unless defined($body);
2039
2040     my $enc = $c->encoding;
2041
2042     return unless $enc;
2043
2044     my ($ct, $ct_enc) = $c->response->content_type;
2045
2046     # Only touch 'text-like' contents
2047     return unless $c->response->content_type =~ /^text|xml$|javascript$/;
2048
2049     if ($ct_enc && $ct_enc =~ /charset=([^;]*)/) {
2050         if (uc($1) ne uc($enc->mime_name)) {
2051             $c->log->debug("Unicode::Encoding is set to encode in '" .
2052                            $enc->mime_name .
2053                            "', content type is '$1', not encoding ");
2054             return;
2055         }
2056     } else {
2057         $c->res->content_type($c->res->content_type . "; charset=" . $enc->mime_name);
2058     }
2059
2060     # Oh my, I wonder what filehandle responses and streams do... - jnap.
2061     # Encode expects plain scalars (IV, NV or PV) and segfaults on ref's
2062     $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) )
2063         if ref(\$body) eq 'SCALAR';
2064 }
2065
2066 =head2 $c->finalize_output
2067
2068 An alias for finalize_body.
2069
2070 =head2 $c->finalize_read
2071
2072 Finalizes the input after reading is complete.
2073
2074 =cut
2075
2076 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
2077
2078 =head2 $c->finalize_uploads
2079
2080 Finalizes uploads. Cleans up any temporary files.
2081
2082 =cut
2083
2084 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
2085
2086 =head2 $c->get_action( $action, $namespace )
2087
2088 Gets an action in a given namespace.
2089
2090 =cut
2091
2092 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
2093
2094 =head2 $c->get_actions( $action, $namespace )
2095
2096 Gets all actions of a given name in a namespace and all parent
2097 namespaces.
2098
2099 =cut
2100
2101 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
2102
2103 =head2 $app->handle_request( @arguments )
2104
2105 Called to handle each HTTP request.
2106
2107 =cut
2108
2109 sub handle_request {
2110     my ( $class, @arguments ) = @_;
2111
2112     # Always expect worst case!
2113     my $status = -1;
2114     try {
2115         if ($class->debug) {
2116             my $secs = time - $START || 1;
2117             my $av = sprintf '%.3f', $COUNT / $secs;
2118             my $time = localtime time;
2119             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
2120         }
2121
2122         my $c = $class->prepare(@arguments);
2123         $c->dispatch;
2124         $status = $c->finalize;
2125     } catch {
2126         #rethow if this can be handled by middleware
2127         if ( $class->_handle_http_exception($_) ) {
2128             $_->can('rethrow') ? $_->rethrow : croak $_;
2129         }
2130         chomp(my $error = $_);
2131         $class->log->error(qq/Caught exception in engine "$error"/);
2132     };
2133
2134     $COUNT++;
2135
2136     if(my $coderef = $class->log->can('_flush')){
2137         $class->log->$coderef();
2138     }
2139     return $status;
2140 }
2141
2142 =head2 $class->prepare( @arguments )
2143
2144 Creates a Catalyst context from an engine-specific request (Apache, CGI,
2145 etc.).
2146
2147 =cut
2148
2149 has _uploadtmp => (
2150     is => 'ro',
2151     predicate => '_has_uploadtmp',
2152 );
2153
2154 sub prepare {
2155     my ( $class, @arguments ) = @_;
2156
2157     # XXX
2158     # After the app/ctxt split, this should become an attribute based on something passed
2159     # into the application.
2160     $class->context_class( ref $class || $class ) unless $class->context_class;
2161
2162     my $uploadtmp = $class->config->{uploadtmp};
2163     my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
2164
2165     $c->response->_context($c);
2166
2167     #surely this is not the most efficient way to do things...
2168     $c->stats($class->stats_class->new)->enable($c->use_stats);
2169     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
2170         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
2171     }
2172
2173     try {
2174         # Allow engine to direct the prepare flow (for POE)
2175         if ( my $prepare = $c->engine->can('prepare') ) {
2176             $c->engine->$prepare( $c, @arguments );
2177         }
2178         else {
2179             $c->prepare_request(@arguments);
2180             $c->prepare_connection;
2181             $c->prepare_query_parameters;
2182             $c->prepare_headers; # Just hooks, no longer needed - they just
2183             $c->prepare_cookies; # cause the lazy attribute on req to build
2184             $c->prepare_path;
2185
2186             # Prepare the body for reading, either by prepare_body
2187             # or the user, if they are using $c->read
2188             $c->prepare_read;
2189
2190             # Parse the body unless the user wants it on-demand
2191             unless ( ref($c)->config->{parse_on_demand} ) {
2192                 $c->prepare_body;
2193             }
2194         }
2195         $c->prepare_action;
2196     }
2197     # VERY ugly and probably shouldn't rely on ->finalize actually working
2198     catch {
2199         # failed prepare is always due to an invalid request, right?
2200         $c->response->status(400);
2201         $c->response->content_type('text/plain');
2202         $c->response->body('Bad Request');
2203         # Note we call finalize and then die here, which escapes
2204         # finalize being called in the enclosing block..
2205         # It in fact couldn't be called, as we don't return $c..
2206         # This is a mess - but I'm unsure you can fix this without
2207         # breaking compat for people doing crazy things (we should set
2208         # the 400 and just return the ctx here IMO, letting finalize get called
2209         # above...
2210         $c->finalize;
2211         die $_;
2212     };
2213
2214     $c->log_request;
2215
2216     return $c;
2217 }
2218
2219 =head2 $c->prepare_action
2220
2221 Prepares action. See L<Catalyst::Dispatcher>.
2222
2223 =cut
2224
2225 sub prepare_action {
2226     my $c = shift;
2227     my $ret = $c->dispatcher->prepare_action( $c, @_);
2228
2229     if($c->encoding) {
2230         foreach (@{$c->req->arguments}, @{$c->req->captures}) {
2231           $_ = $c->_handle_param_unicode_decoding($_);
2232         }
2233     }
2234
2235     return $ret;
2236 }
2237
2238
2239 =head2 $c->prepare_body
2240
2241 Prepares message body.
2242
2243 =cut
2244
2245 sub prepare_body {
2246     my $c = shift;
2247
2248     return if $c->request->_has_body;
2249
2250     # Initialize on-demand data
2251     $c->engine->prepare_body( $c, @_ );
2252     $c->prepare_parameters;
2253     $c->prepare_uploads;
2254 }
2255
2256 =head2 $c->prepare_body_chunk( $chunk )
2257
2258 Prepares a chunk of data before sending it to L<HTTP::Body>.
2259
2260 See L<Catalyst::Engine>.
2261
2262 =cut
2263
2264 sub prepare_body_chunk {
2265     my $c = shift;
2266     $c->engine->prepare_body_chunk( $c, @_ );
2267 }
2268
2269 =head2 $c->prepare_body_parameters
2270
2271 Prepares body parameters.
2272
2273 =cut
2274
2275 sub prepare_body_parameters {
2276     my $c = shift;
2277     $c->engine->prepare_body_parameters( $c, @_ );
2278 }
2279
2280 =head2 $c->prepare_connection
2281
2282 Prepares connection.
2283
2284 =cut
2285
2286 sub prepare_connection {
2287     my $c = shift;
2288     $c->request->prepare_connection($c);
2289 }
2290
2291 =head2 $c->prepare_cookies
2292
2293 Prepares cookies by ensuring that the attribute on the request
2294 object has been built.
2295
2296 =cut
2297
2298 sub prepare_cookies { my $c = shift; $c->request->cookies }
2299
2300 =head2 $c->prepare_headers
2301
2302 Prepares request headers by ensuring that the attribute on the request
2303 object has been built.
2304
2305 =cut
2306
2307 sub prepare_headers { my $c = shift; $c->request->headers }
2308
2309 =head2 $c->prepare_parameters
2310
2311 Prepares parameters.
2312
2313 =cut
2314
2315 sub prepare_parameters {
2316     my $c = shift;
2317     $c->prepare_body_parameters;
2318     $c->engine->prepare_parameters( $c, @_ );
2319 }
2320
2321 =head2 $c->prepare_path
2322
2323 Prepares path and base.
2324
2325 =cut
2326
2327 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2328
2329 =head2 $c->prepare_query_parameters
2330
2331 Prepares query parameters.
2332
2333 =cut
2334
2335 sub prepare_query_parameters {
2336     my $c = shift;
2337
2338     $c->engine->prepare_query_parameters( $c, @_ );
2339 }
2340
2341 =head2 $c->log_request
2342
2343 Writes information about the request to the debug logs.  This includes:
2344
2345 =over 4
2346
2347 =item * Request method, path, and remote IP address
2348
2349 =item * Query keywords (see L<Catalyst::Request/query_keywords>)
2350
2351 =item * Request parameters
2352
2353 =item * File uploads
2354
2355 =back
2356
2357 =cut
2358
2359 sub log_request {
2360     my $c = shift;
2361
2362     return unless $c->debug;
2363
2364     my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2365     my $request = $dump->[1];
2366
2367     my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
2368     $method ||= '';
2369     $path = '/' unless length $path;
2370     $address ||= '';
2371     $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2372
2373     $c->log_request_headers($request->headers);
2374
2375     if ( my $keywords = $request->query_keywords ) {
2376         $c->log->debug("Query keywords are: $keywords");
2377     }
2378
2379     $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
2380
2381     $c->log_request_uploads($request);
2382 }
2383
2384 =head2 $c->log_response
2385
2386 Writes information about the response to the debug logs by calling
2387 C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
2388
2389 =cut
2390
2391 sub log_response {
2392     my $c = shift;
2393
2394     return unless $c->debug;
2395
2396     my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2397     my $response = $dump->[1];
2398
2399     $c->log_response_status_line($response);
2400     $c->log_response_headers($response->headers);
2401 }
2402
2403 =head2 $c->log_response_status_line($response)
2404
2405 Writes one line of information about the response to the debug logs.  This includes:
2406
2407 =over 4
2408
2409 =item * Response status code
2410
2411 =item * Content-Type header (if present)
2412
2413 =item * Content-Length header (if present)
2414
2415 =back
2416
2417 =cut
2418
2419 sub log_response_status_line {
2420     my ($c, $response) = @_;
2421
2422     $c->log->debug(
2423         sprintf(
2424             'Response Code: %s; Content-Type: %s; Content-Length: %s',
2425             $response->status                            || 'unknown',
2426             $response->headers->header('Content-Type')   || 'unknown',
2427             $response->headers->header('Content-Length') || 'unknown'
2428         )
2429     );
2430 }
2431
2432 =head2 $c->log_response_headers($headers);
2433
2434 Hook method which can be wrapped by plugins to log the response headers.
2435 No-op in the default implementation.
2436
2437 =cut
2438
2439 sub log_response_headers {}
2440
2441 =head2 $c->log_request_parameters( query => {}, body => {} )
2442
2443 Logs request parameters to debug logs
2444
2445 =cut
2446
2447 sub log_request_parameters {
2448     my $c          = shift;
2449     my %all_params = @_;
2450
2451     return unless $c->debug;
2452
2453     my $column_width = Catalyst::Utils::term_width() - 44;
2454     foreach my $type (qw(query body)) {
2455         my $params = $all_params{$type};
2456         next if ! keys %$params;
2457         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
2458         for my $key ( sort keys %$params ) {
2459             my $param = $params->{$key};
2460             my $value = defined($param) ? $param : '';
2461             $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2462         }
2463         $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2464     }
2465 }
2466
2467 =head2 $c->log_request_uploads
2468
2469 Logs file uploads included in the request to the debug logs.
2470 The parameter name, filename, file type, and file size are all included in
2471 the debug logs.
2472
2473 =cut
2474
2475 sub log_request_uploads {
2476     my $c = shift;
2477     my $request = shift;
2478     return unless $c->debug;
2479     my $uploads = $request->uploads;
2480     if ( keys %$uploads ) {
2481         my $t = Text::SimpleTable->new(
2482             [ 12, 'Parameter' ],
2483             [ 26, 'Filename' ],
2484             [ 18, 'Type' ],
2485             [ 9,  'Size' ]
2486         );
2487         for my $key ( sort keys %$uploads ) {
2488             my $upload = $uploads->{$key};
2489             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2490                 $t->row( $key, $u->filename, $u->type, $u->size );
2491             }
2492         }
2493         $c->log->debug( "File Uploads are:\n" . $t->draw );
2494     }
2495 }
2496
2497 =head2 $c->log_request_headers($headers);
2498
2499 Hook method which can be wrapped by plugins to log the request headers.
2500 No-op in the default implementation.
2501
2502 =cut
2503
2504 sub log_request_headers {}
2505
2506 =head2 $c->log_headers($type => $headers)
2507
2508 Logs L<HTTP::Headers> (either request or response) to the debug logs.
2509
2510 =cut
2511
2512 sub log_headers {
2513     my $c       = shift;
2514     my $type    = shift;
2515     my $headers = shift;    # an HTTP::Headers instance
2516
2517     return unless $c->debug;
2518
2519     my $column_width = Catalyst::Utils::term_width() - 28;
2520     my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
2521     $headers->scan(
2522         sub {
2523             my ( $name, $value ) = @_;
2524             $t->row( $name, $value );
2525         }
2526     );
2527     $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2528 }
2529
2530
2531 =head2 $c->prepare_read
2532
2533 Prepares the input for reading.
2534
2535 =cut
2536
2537 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2538
2539 =head2 $c->prepare_request
2540
2541 Prepares the engine request.
2542
2543 =cut
2544
2545 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2546
2547 =head2 $c->prepare_uploads
2548
2549 Prepares uploads.
2550
2551 =cut
2552
2553 sub prepare_uploads {
2554     my $c = shift;
2555     $c->engine->prepare_uploads( $c, @_ );
2556
2557     my $enc = $c->encoding;
2558     return unless $enc;
2559
2560     # Uggg we hook prepare uploads to do the encoding crap on post and query
2561     # parameters!  Sorry -jnap
2562     for my $key (qw/ parameters query_parameters body_parameters /) {
2563         for my $value ( values %{ $c->request->{$key} } ) {
2564             # N.B. Check if already a character string and if so do not try to double decode.
2565             #      http://www.mail-archive.com/catalyst@lists.scsys.co.uk/msg02350.html
2566             #      this avoids exception if we have already decoded content, and is _not_ the
2567             #      same as not encoding on output which is bad news (as it does the wrong thing
2568             #      for latin1 chars for example)..
2569             $value = $c->_handle_unicode_decoding($value);
2570         }
2571     }
2572     for my $value ( values %{ $c->request->uploads } ) {
2573         # skip if it fails for uploads, as we don't usually want uploads touched
2574         # in any way
2575         for my $inner_value ( ref($value) eq 'ARRAY' ? @{$value} : $value ) {
2576             $inner_value->{filename} = try {
2577                 $enc->decode( $inner_value->{filename}, $c->_encode_check )
2578             } catch {
2579                 $c->handle_unicode_encoding_exception({
2580                     param_value => $inner_value->{filename},
2581                     error_msg => $_,
2582                     encoding_step => 'uploads',
2583                 });
2584             };
2585         }
2586     }
2587 }
2588
2589 =head2 $c->prepare_write
2590
2591 Prepares the output for writing.
2592
2593 =cut
2594
2595 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2596
2597 =head2 $c->request_class
2598
2599 Returns or sets the request class. Defaults to L<Catalyst::Request>.
2600
2601 =head2 $c->response_class
2602
2603 Returns or sets the response class. Defaults to L<Catalyst::Response>.
2604
2605 =head2 $c->read( [$maxlength] )
2606
2607 Reads a chunk of data from the request body. This method is designed to
2608 be used in a while loop, reading C<$maxlength> bytes on every call.
2609 C<$maxlength> defaults to the size of the request if not specified.
2610
2611 You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
2612 directly.
2613
2614 Warning: If you use read(), Catalyst will not process the body,
2615 so you will not be able to access POST parameters or file uploads via
2616 $c->request.  You must handle all body parsing yourself.
2617
2618 =cut
2619
2620 sub read { my $c = shift; return $c->request->read( @_ ) }
2621
2622 =head2 $c->run
2623
2624 Starts the engine.
2625
2626 =cut
2627
2628 sub run {
2629   my $app = shift;
2630   $app->_make_immutable_if_needed;
2631   $app->engine_loader->needs_psgi_engine_compat_hack ?
2632     $app->engine->run($app, @_) :
2633       $app->engine->run( $app, $app->_finalized_psgi_app, @_ );
2634 }
2635
2636 sub _make_immutable_if_needed {
2637     my $class = shift;
2638     my $meta = find_meta($class);
2639     my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
2640     if (
2641         $meta->is_immutable
2642         && ! { $meta->immutable_options }->{replace_constructor}
2643         && $isa_ca
2644     ) {
2645         warn("You made your application class ($class) immutable, "
2646             . "but did not inline the\nconstructor. "
2647             . "This will break catalyst, as your app \@ISA "
2648             . "Class::Accessor(::Fast)?\nPlease pass "
2649             . "(replace_constructor => 1)\nwhen making your class immutable.\n");
2650     }
2651     unless ($meta->is_immutable) {
2652         # XXX - FIXME warning here as you should make your app immutable yourself.
2653         $meta->make_immutable(
2654             replace_constructor => 1,
2655         );
2656     }
2657 }
2658
2659 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2660
2661 Sets an action in a given namespace.
2662
2663 =cut
2664
2665 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2666
2667 =head2 $c->setup_actions($component)
2668
2669 Sets up actions for a component.
2670
2671 =cut
2672
2673 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2674
2675 =head2 $c->setup_components
2676
2677 This method is called internally to set up the application's components.
2678
2679 It finds modules by calling the L<locate_components> method, expands them to
2680 package names with the L<expand_component_module> method, and then installs
2681 each component into the application.
2682
2683 The C<setup_components> config option is passed to both of the above methods.
2684
2685 Installation of each component is performed by the L<setup_component> method,
2686 below.
2687
2688 =cut
2689
2690 sub setup_components {
2691     my $class = shift;
2692
2693     my $config  = $class->config->{ setup_components };
2694
2695     my @comps = $class->locate_components($config);
2696     my %comps = map { $_ => 1 } @comps;
2697
2698     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
2699     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2700         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2701     ) if $deprecatedcatalyst_component_names;
2702
2703     for my $component ( @comps ) {
2704
2705         # We pass ignore_loaded here so that overlay files for (e.g.)
2706         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2707         # we know M::P::O found a file on disk so this is safe
2708
2709         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2710     }
2711
2712     for my $component (@comps) {
2713         my $instance = $class->components->{ $component } = $class->setup_component($component);
2714         my @expanded_components = $instance->can('expand_modules')
2715             ? $instance->expand_modules( $component, $config )
2716             : $class->expand_component_module( $component, $config );
2717         for my $component (@expanded_components) {
2718             next if $comps{$component};
2719             $class->components->{ $component } = $class->setup_component($component);
2720         }
2721     }
2722 }
2723
2724 =head2 $c->locate_components( $setup_component_config )
2725
2726 This method is meant to provide a list of component modules that should be
2727 setup for the application.  By default, it will use L<Module::Pluggable>.
2728
2729 Specify a C<setup_components> config option to pass additional options directly
2730 to L<Module::Pluggable>. To add additional search paths, specify a key named
2731 C<search_extra> as an array reference. Items in the array beginning with C<::>
2732 will have the application class name prepended to them.
2733
2734 =cut
2735
2736 sub locate_components {
2737     my $class  = shift;
2738     my $config = shift;
2739
2740     my @paths   = qw( ::M ::Model ::V ::View ::C ::Controller );
2741     my $extra   = delete $config->{ search_extra } || [];
2742
2743     unshift @paths, @$extra;
2744
2745     my @comps = map { sort { length($a) <=> length($b) } Module::Pluggable::Object->new(
2746       search_path => [ map { s/^(?=::)/$class/; $_; } ($_) ],
2747       %$config
2748     )->plugins } @paths;
2749
2750     return @comps;
2751 }
2752
2753 =head2 $c->expand_component_module( $component, $setup_component_config )
2754
2755 Components found by C<locate_components> will be passed to this method, which
2756 is expected to return a list of component (package) names to be set up.
2757
2758 =cut
2759
2760 sub expand_component_module {
2761     my ($class, $module) = @_;
2762     return Devel::InnerPackage::list_packages( $module );
2763 }
2764
2765 =head2 $c->setup_component
2766
2767 =cut
2768
2769 sub setup_component {
2770     my( $class, $component ) = @_;
2771
2772     unless ( $component->can( 'COMPONENT' ) ) {
2773         return $component;
2774     }
2775
2776     my $suffix = Catalyst::Utils::class2classsuffix( $component );
2777     my $config = $class->config->{ $suffix } || {};
2778     # Stash catalyst_component_name in the config here, so that custom COMPONENT
2779     # methods also pass it. local to avoid pointlessly shitting in config
2780     # for the debug screen, as $component is already the key name.
2781     local $config->{catalyst_component_name} = $component;
2782
2783     my $instance = eval { $component->COMPONENT( $class, $config ); };
2784
2785     if ( my $error = $@ ) {
2786         chomp $error;
2787         Catalyst::Exception->throw(
2788             message => qq/Couldn't instantiate component "$component", "$error"/
2789         );
2790     }
2791
2792     unless (blessed $instance) {
2793         my $metaclass = Moose::Util::find_meta($component);
2794         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2795         my $component_method_from = $method_meta->associated_metaclass->name;
2796         my $value = defined($instance) ? $instance : 'undef';
2797         Catalyst::Exception->throw(
2798             message =>
2799             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2800         );
2801     }
2802     return $instance;
2803 }
2804
2805 =head2 $c->setup_dispatcher
2806
2807 Sets up dispatcher.
2808
2809 =cut
2810
2811 sub setup_dispatcher {
2812     my ( $class, $dispatcher ) = @_;
2813
2814     if ($dispatcher) {
2815         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2816     }
2817
2818     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2819         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2820     }
2821
2822     unless ($dispatcher) {
2823         $dispatcher = $class->dispatcher_class;
2824     }
2825
2826     load_class($dispatcher);
2827
2828     # dispatcher instance
2829     $class->dispatcher( $dispatcher->new );
2830 }
2831
2832 =head2 $c->setup_engine
2833
2834 Sets up engine.
2835
2836 =cut
2837
2838 sub engine_class {
2839     my ($class, $requested_engine) = @_;
2840
2841     if (!$class->engine_loader || $requested_engine) {
2842         $class->engine_loader(
2843             Catalyst::EngineLoader->new({
2844                 application_name => $class,
2845                 (defined $requested_engine
2846                      ? (catalyst_engine_class => $requested_engine) : ()),
2847             }),
2848         );
2849     }
2850
2851     $class->engine_loader->catalyst_engine_class;
2852 }
2853
2854 sub setup_engine {
2855     my ($class, $requested_engine) = @_;
2856
2857     my $engine = do {
2858         my $loader = $class->engine_loader;
2859
2860         if (!$loader || $requested_engine) {
2861             $loader = Catalyst::EngineLoader->new({
2862                 application_name => $class,
2863                 (defined $requested_engine
2864                      ? (requested_engine => $requested_engine) : ()),
2865             }),
2866
2867             $class->engine_loader($loader);
2868         }
2869
2870         $loader->catalyst_engine_class;
2871     };
2872
2873     # Don't really setup_engine -- see _setup_psgi_app for explanation.
2874     return if $class->loading_psgi_file;
2875
2876     load_class($engine);
2877
2878     if ($ENV{MOD_PERL}) {
2879         my $apache = $class->engine_loader->auto;
2880
2881         my $meta = find_meta($class);
2882         my $was_immutable = $meta->is_immutable;
2883         my %immutable_options = $meta->immutable_options;
2884         $meta->make_mutable if $was_immutable;
2885
2886         $meta->add_method(handler => sub {
2887             my $r = shift;
2888             my $psgi_app = $class->_finalized_psgi_app;
2889             $apache->call_app($r, $psgi_app);
2890         });
2891
2892         $meta->make_immutable(%immutable_options) if $was_immutable;
2893     }
2894
2895     $class->engine( $engine->new );
2896
2897     return;
2898 }
2899
2900 ## This exists just to supply a prebuild psgi app for mod_perl and for the
2901 ## build in server support (back compat support for pre psgi port behavior).
2902 ## This is so that we don't build a new psgi app for each request when using
2903 ## the mod_perl handler or the built in servers (http and fcgi, etc).
2904
2905 sub _finalized_psgi_app {
2906     my ($app) = @_;
2907
2908     unless ($app->_psgi_app) {
2909         my $psgi_app = $app->_setup_psgi_app;
2910         $app->_psgi_app($psgi_app);
2911     }
2912
2913     return $app->_psgi_app;
2914 }
2915
2916 ## Look for a psgi file like 'myapp_web.psgi' (if the app is MyApp::Web) in the
2917 ## home directory and load that and return it (just assume it is doing the
2918 ## right thing :) ).  If that does not exist, call $app->psgi_app, wrap that
2919 ## in default_middleware and return it ( this is for backward compatibility
2920 ## with pre psgi port behavior ).
2921
2922 sub _setup_psgi_app {
2923     my ($app) = @_;
2924
2925     for my $home (Path::Class::Dir->new($app->config->{home})) {
2926         my $psgi_file = $home->file(
2927             Catalyst::Utils::appprefix($app) . '.psgi',
2928         );
2929
2930         next unless -e $psgi_file;
2931
2932         # If $psgi_file calls ->setup_engine, it's doing so to load
2933         # Catalyst::Engine::PSGI. But if it does that, we're only going to
2934         # throw away the loaded PSGI-app and load the 5.9 Catalyst::Engine
2935         # anyway. So set a flag (ick) that tells setup_engine not to populate
2936         # $c->engine or do any other things we might regret.
2937
2938         $app->loading_psgi_file(1);
2939         my $psgi_app = Plack::Util::load_psgi($psgi_file);
2940         $app->loading_psgi_file(0);
2941
2942         return $psgi_app
2943             unless $app->engine_loader->needs_psgi_engine_compat_hack;
2944
2945         warn <<"EOW";
2946 Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}.
2947
2948 Its content has been ignored. Please consult the Catalyst::Upgrading
2949 documentation on how to upgrade from Catalyst::Engine::PSGI.
2950 EOW
2951     }
2952
2953     return $app->apply_default_middlewares($app->psgi_app);
2954 }
2955
2956 =head2 $c->apply_default_middlewares
2957
2958 Adds the following L<Plack> middlewares to your application, since they are
2959 useful and commonly needed:
2960
2961 L<Plack::Middleware::ReverseProxy>, (conditionally added based on the status
2962 of your $ENV{REMOTE_ADDR}, and can be forced on with C<using_frontend_proxy>
2963 or forced off with C<ignore_frontend_proxy>), L<Plack::Middleware::LighttpdScriptNameFix>
2964 (if you are using Lighttpd), L<Plack::Middleware::IIS6ScriptNameFix> (always
2965 applied since this middleware is smart enough to conditionally apply itself).
2966
2967 Additionally if we detect we are using Nginx, we add a bit of custom middleware
2968 to solve some problems with the way that server handles $ENV{PATH_INFO} and
2969 $ENV{SCRIPT_NAME}
2970
2971 =cut
2972
2973
2974 sub apply_default_middlewares {
2975     my ($app, $psgi_app) = @_;
2976
2977     $psgi_app = Plack::Middleware::Conditional->wrap(
2978         $psgi_app,
2979         builder   => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) },
2980         condition => sub {
2981             my ($env) = @_;
2982             return if $app->config->{ignore_frontend_proxy};
2983             return $env->{REMOTE_ADDR} eq '127.0.0.1'
2984                 || $app->config->{using_frontend_proxy};
2985         },
2986     );
2987
2988     # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME
2989     # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html
2990     $psgi_app = Plack::Middleware::Conditional->wrap(
2991         $psgi_app,
2992         builder   => sub { Plack::Middleware::LighttpdScriptNameFix->wrap($_[0]) },
2993         condition => sub {
2994             my ($env) = @_;
2995             return unless $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!lighttpd[-/]1\.(\d+\.\d+)!;
2996             return unless $1 < 4.23;
2997             1;
2998         },
2999     );
3000
3001     # we're applying this unconditionally as the middleware itself already makes
3002     # sure it doesn't fuck things up if it's not running under one of the right
3003     # IIS versions
3004     $psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app);
3005
3006     # And another IIS issue, this time with IIS7.
3007     $psgi_app = Plack::Middleware::Conditional->wrap(
3008         $psgi_app,
3009         builder => sub { Plack::Middleware::IIS7KeepAliveFix->wrap($_[0]) },
3010         condition => sub {
3011             my ($env) = @_;
3012             return $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!IIS/7\.[0-9]!;
3013         },
3014     );
3015
3016     return $psgi_app;
3017 }
3018
3019 =head2 $c->psgi_app
3020
3021 Returns a PSGI application code reference for the catalyst application
3022 C<$c>. This is the bare application without any middlewares
3023 applied. C<${myapp}.psgi> is not taken into account.
3024
3025 This is what you want to be using to retrieve the PSGI application code
3026 reference of your Catalyst application for use in F<.psgi> files.
3027
3028 =cut
3029
3030 sub psgi_app {
3031     my ($app) = @_;
3032     my $psgi = $app->engine->build_psgi_app($app);
3033     return $app->Catalyst::Utils::apply_registered_middleware($psgi);
3034 }
3035
3036 =head2 $c->setup_home
3037
3038 Sets up the home directory.
3039
3040 =cut
3041
3042 sub setup_home {
3043     my ( $class, $home ) = @_;
3044
3045     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
3046         $home = $env;
3047     }
3048
3049     $home ||= Catalyst::Utils::home($class);
3050
3051     if ($home) {
3052         #I remember recently being scolded for assigning config values like this
3053         $class->config->{home} ||= $home;
3054         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
3055     }
3056 }
3057
3058 =head2 $c->setup_encoding
3059
3060 Sets up the input/output encoding. See L<ENCODING>
3061
3062 =cut
3063
3064 sub setup_encoding {
3065     my $c = shift;
3066     my $enc = delete $c->config->{encoding};
3067     $c->encoding( $enc ) if defined $enc;
3068 }
3069
3070 =head2 handle_unicode_encoding_exception
3071
3072 Hook to let you customize how encoding errors are handled.  By default
3073 we just throw an exception.  Receives a hashref of debug information.
3074 Example:
3075
3076     $c->handle_unicode_encoding_exception({
3077         param_value => $value,
3078         error_msg => $_,
3079             encoding_step => 'params',
3080         });
3081
3082 =cut
3083
3084 sub handle_unicode_encoding_exception {
3085     my ( $self, $exception_ctx ) = @_;
3086     die $exception_ctx->{error_msg};
3087 }
3088
3089 # Some unicode helpers cargo culted from the old plugin.  These could likely
3090 # be neater.
3091
3092 sub _handle_unicode_decoding {
3093     my ( $self, $value ) = @_;
3094
3095     return unless defined $value;
3096
3097     ## I think this mess is to support the old nested
3098     if ( ref $value eq 'ARRAY' ) {
3099         foreach ( @$value ) {
3100             $_ = $self->_handle_unicode_decoding($_);
3101         }
3102         return $value;
3103     }
3104     elsif ( ref $value eq 'HASH' ) {
3105         foreach ( values %$value ) {
3106             $_ = $self->_handle_unicode_decoding($_);
3107         }
3108         return $value;
3109     }
3110     else {
3111         return $self->_handle_param_unicode_decoding($value);
3112     }
3113 }
3114
3115 sub _handle_param_unicode_decoding {
3116     my ( $self, $value ) = @_;
3117     return unless defined $value; # not in love with just ignoring undefs - jnap
3118
3119     my $enc = $self->encoding;
3120     return try {
3121         Encode::is_utf8( $value ) ?
3122             $value
3123         : $enc->decode( $value, $self->_encode_check );
3124     }
3125     catch {
3126         $self->handle_unicode_encoding_exception({
3127             param_value => $value,
3128             error_msg => $_,
3129             encoding_step => 'params',
3130         });
3131     };
3132 }
3133
3134 =head2 $c->setup_log
3135
3136 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
3137 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
3138 log to.
3139
3140 This method also installs a C<debug> method that returns a true value into the
3141 catalyst subclass if the "debug" level is passed in the comma-delimited list,
3142 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
3143
3144 Note that if the log has already been setup, by either a previous call to
3145 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
3146 that this method won't actually set up the log object.
3147
3148 =cut
3149
3150 sub setup_log {
3151     my ( $class, $levels ) = @_;
3152
3153     $levels ||= '';
3154     $levels =~ s/^\s+//;
3155     $levels =~ s/\s+$//;
3156     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
3157
3158     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
3159     if ( defined $env_debug ) {
3160         $levels{debug} = 1 if $env_debug; # Ugly!
3161         delete($levels{debug}) unless $env_debug;
3162     }
3163
3164     unless ( $class->log ) {
3165         $class->log( Catalyst::Log->new(keys %levels) );
3166     }
3167
3168     if ( $levels{debug} ) {
3169         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
3170         $class->log->debug('Debug messages enabled');
3171     }
3172 }
3173
3174 =head2 $c->setup_plugins
3175
3176 Sets up plugins.
3177
3178 =cut
3179
3180 =head2 $c->setup_stats
3181
3182 Sets up timing statistics class.
3183
3184 =cut
3185
3186 sub setup_stats {
3187     my ( $class, $stats ) = @_;
3188
3189     Catalyst::Utils::ensure_class_loaded($class->stats_class);
3190
3191     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
3192     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
3193         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
3194         $class->log->debug('Statistics enabled');
3195     }
3196 }
3197
3198
3199 =head2 $c->registered_plugins
3200
3201 Returns a sorted list of the plugins which have either been stated in the
3202 import list.
3203
3204 If passed a given plugin name, it will report a boolean value indicating
3205 whether or not that plugin is loaded.  A fully qualified name is required if
3206 the plugin name does not begin with C<Catalyst::Plugin::>.
3207
3208  if ($c->registered_plugins('Some::Plugin')) {
3209      ...
3210  }
3211
3212 =cut
3213
3214 {
3215
3216     sub registered_plugins {
3217         my $proto = shift;
3218         return sort keys %{ $proto->_plugins } unless @_;
3219         my $plugin = shift;
3220         return 1 if exists $proto->_plugins->{$plugin};
3221         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
3222     }
3223
3224     sub _register_plugin {
3225         my ( $proto, $plugin, $instant ) = @_;
3226         my $class = ref $proto || $proto;
3227
3228         load_class( $plugin );
3229         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
3230             if $plugin->isa( 'Catalyst::Component' );
3231         my $plugin_meta = Moose::Meta::Class->create($plugin);
3232         if (!$plugin_meta->has_method('new')
3233             && ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) {
3234             $plugin_meta->add_method('new', Moose::Object->meta->get_method('new'))
3235         }
3236         if (!$instant && !$proto->_plugins->{$plugin}) {
3237             my $meta = Class::MOP::get_metaclass_by_name($class);
3238             $meta->superclasses($plugin, $meta->superclasses);
3239         }
3240         $proto->_plugins->{$plugin} = 1;
3241         return $class;
3242     }
3243
3244     sub _default_plugins { return qw() }
3245
3246     sub setup_plugins {
3247         my ( $class, $plugins ) = @_;
3248
3249         $class->_plugins( {} ) unless $class->_plugins;
3250         $plugins = [ grep {
3251             m/Unicode::Encoding/ ? do {
3252                 $class->log->warn(
3253                     'Unicode::Encoding plugin is auto-applied,'
3254                     . ' please remove this from your appclass'
3255                     . ' and make sure to define "encoding" config'
3256                 );
3257                 unless (exists $class->config->{'encoding'}) {
3258                   $class->config->{'encoding'} = 'UTF-8';
3259                 }
3260                 () }
3261                 : $_
3262         } @$plugins ];
3263         push @$plugins, $class->_default_plugins;
3264         $plugins = Data::OptList::mkopt($plugins || []);
3265
3266         my @plugins = map {
3267             [ Catalyst::Utils::resolve_namespace(
3268                   $class . '::Plugin',
3269                   'Catalyst::Plugin', $_->[0]
3270               ),
3271               $_->[1],
3272             ]
3273          } @{ $plugins };
3274
3275         for my $plugin ( reverse @plugins ) {
3276             load_class($plugin->[0], $plugin->[1]);
3277             my $meta = find_meta($plugin->[0]);
3278             next if $meta && $meta->isa('Moose::Meta::Role');
3279
3280             $class->_register_plugin($plugin->[0]);
3281         }
3282
3283         my @roles =
3284             map  { $_->[0]->name, $_->[1] }
3285             grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') }
3286             map  { [find_meta($_->[0]), $_->[1]] }
3287             @plugins;
3288
3289         Moose::Util::apply_all_roles(
3290             $class => @roles
3291         ) if @roles;
3292     }
3293 }
3294
3295 =head2 registered_middlewares
3296
3297 Read only accessor that returns an array of all the middleware in the order
3298 that they were added (which is the REVERSE of the order they will be applied).
3299
3300 The values returned will be either instances of L<Plack::Middleware> or of a
3301 compatible interface, or a coderef, which is assumed to be inlined middleware
3302
3303 =head2 setup_middleware (?@middleware)
3304
3305 Read configuration information stored in configuration key C<psgi_middleware> or
3306 from passed @args.
3307
3308 See under L</CONFIGURATION> information regarding C<psgi_middleware> and how
3309 to use it to enable L<Plack::Middleware>
3310
3311 This method is automatically called during 'setup' of your application, so
3312 you really don't need to invoke it.  However you may do so if you find the idea
3313 of loading middleware via configuration weird :).  For example:
3314
3315     package MyApp;
3316
3317     use Catalyst;
3318
3319     __PACKAGE__->setup_middleware('Head');
3320     __PACKAGE__->setup;
3321
3322 When we read middleware definitions from configuration, we reverse the list
3323 which sounds odd but is likely how you expect it to work if you have prior
3324 experience with L<Plack::Builder> or if you previously used the plugin
3325 L<Catalyst::Plugin::EnableMiddleware> (which is now considered deprecated)
3326
3327 So basically your middleware handles an incoming request from the first
3328 registered middleware, down and handles the response from the last middleware
3329 up.
3330
3331 =cut
3332
3333 sub registered_middlewares {
3334     my $class = shift;
3335     if(my $middleware = $class->_psgi_middleware) {
3336         return (
3337           Catalyst::Middleware::Stash->new,
3338           Plack::Middleware::HTTPExceptions->new,
3339           Plack::Middleware::RemoveRedundantBody->new,
3340           Plack::Middleware::FixMissingBodyInRedirect->new,
3341           Plack::Middleware::ContentLength->new,
3342           Plack::Middleware::MethodOverride->new,
3343           Plack::Middleware::Head->new,
3344           @$middleware);
3345     } else {
3346         die "You cannot call ->registered_middlewares until middleware has been setup";
3347     }
3348 }
3349
3350 sub setup_middleware {
3351     my $class = shift;
3352     my @middleware_definitions = @_ ?
3353       reverse(@_) : reverse(@{$class->config->{'psgi_middleware'}||[]});
3354
3355     my @middleware = ();
3356     while(my $next = shift(@middleware_definitions)) {
3357         if(ref $next) {
3358             if(Scalar::Util::blessed $next && $next->can('wrap')) {
3359                 push @middleware, $next;
3360             } elsif(ref $next eq 'CODE') {
3361                 push @middleware, $next;
3362             } elsif(ref $next eq 'HASH') {
3363                 my $namespace = shift @middleware_definitions;
3364                 my $mw = $class->Catalyst::Utils::build_middleware($namespace, %$next);
3365                 push @middleware, $mw;
3366             } else {
3367               die "I can't handle middleware definition ${\ref $next}";
3368             }
3369         } else {
3370           my $mw = $class->Catalyst::Utils::build_middleware($next);
3371           push @middleware, $mw;
3372         }
3373     }
3374
3375     my @existing = @{$class->_psgi_middleware || []};
3376     $class->_psgi_middleware([@middleware,@existing,]);
3377 }
3378
3379 =head2 registered_data_handlers
3380
3381 A read only copy of registered Data Handlers returned as a Hash, where each key
3382 is a content type and each value is a subref that attempts to decode that content
3383 type.
3384
3385 =head2 setup_data_handlers (?@data_handler)
3386
3387 Read configuration information stored in configuration key C<data_handlers> or
3388 from passed @args.
3389
3390 See under L</CONFIGURATION> information regarding C<data_handlers>.
3391
3392 This method is automatically called during 'setup' of your application, so
3393 you really don't need to invoke it.
3394
3395 =head2 default_data_handlers
3396
3397 Default Data Handlers that come bundled with L<Catalyst>.  Currently there are
3398 only two default data handlers, for 'application/json' and an alternative to
3399 'application/x-www-form-urlencoded' which supposed nested form parameters via
3400 L<CGI::Struct> or via L<CGI::Struct::XS> IF you've installed it.
3401
3402 The 'application/json' data handler is used to parse incoming JSON into a Perl
3403 data structure.  It used either L<JSON::MaybeXS> or L<JSON>, depending on which
3404 is installed.  This allows you to fail back to L<JSON:PP>, which is a Pure Perl
3405 JSON decoder, and has the smallest dependency impact.
3406
3407 Because we don't wish to add more dependencies to L<Catalyst>, if you wish to
3408 use this new feature we recommend installing L<JSON> or L<JSON::MaybeXS> in
3409 order to get the best performance.  You should add either to your dependency
3410 list (Makefile.PL, dist.ini, cpanfile, etc.)
3411
3412 =cut
3413
3414 sub registered_data_handlers {
3415     my $class = shift;
3416     if(my $data_handlers = $class->_data_handlers) {
3417         return %$data_handlers;
3418     } else {
3419         $class->setup_data_handlers;
3420         return $class->registered_data_handlers;
3421     }
3422 }
3423
3424 sub setup_data_handlers {
3425     my ($class, %data_handler_callbacks) = @_;
3426     %data_handler_callbacks = (
3427       %{$class->default_data_handlers},
3428       %{$class->config->{'data_handlers'}||+{}},
3429       %data_handler_callbacks);
3430
3431     $class->_data_handlers(\%data_handler_callbacks);
3432 }
3433
3434 sub default_data_handlers {
3435     my ($class) = @_;
3436     return +{
3437       'application/x-www-form-urlencoded' => sub {
3438           my ($fh, $req) = @_;
3439           my $params = $req->_use_hash_multivalue ? $req->body_parameters->mixed : $req->body_parameters;
3440           Class::Load::load_first_existing_class('CGI::Struct::XS', 'CGI::Struct')
3441             ->can('build_cgi_struct')->($params);
3442       },
3443       'application/json' => sub {
3444           my ($fh, $req) = @_;
3445           my $parser = Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON');
3446           my $slurped;
3447           return eval {
3448             local $/;
3449             $slurped = $fh->getline;
3450             $parser->can("decode_json")->($slurped);
3451           } || Catalyst::Exception->throw(sprintf "Error Parsing POST '%s', Error: %s", (defined($slurped) ? $slurped : 'undef') ,$@);
3452         },
3453     };
3454 }
3455
3456 sub _handle_http_exception {
3457     my ( $self, $error ) = @_;
3458     if (
3459            !$self->config->{always_catch_http_exceptions}
3460         && blessed $error
3461         && (
3462             $error->can('as_psgi')
3463             || (   $error->can('code')
3464                 && $error->code =~ m/^[1-5][0-9][0-9]$/ )
3465         )
3466       )
3467     {
3468         return 1;
3469     }
3470 }
3471
3472 =head2 $c->stack
3473
3474 Returns an arrayref of the internal execution stack (actions that are
3475 currently executing).
3476
3477 =head2 $c->stats
3478
3479 Returns the current timing statistics object. By default Catalyst uses
3480 L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with
3481 L<< stats_class|/"$c->stats_class" >>.
3482
3483 Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still
3484 available. By enabling it with C< $c->stats->enabled(1) >, it can be used to
3485 profile explicitly, although MyApp.pm still won't profile nor output anything
3486 by itself.
3487
3488 =head2 $c->stats_class
3489
3490 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
3491
3492 =head2 $c->use_stats
3493
3494 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
3495
3496 Note that this is a static method, not an accessor and should be overridden
3497 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
3498
3499 =cut
3500
3501 sub use_stats { 0 }
3502
3503
3504 =head2 $c->write( $data )
3505
3506 Writes $data to the output stream. When using this method directly, you
3507 will need to manually set the C<Content-Length> header to the length of
3508 your output data, if known.
3509
3510 =cut
3511
3512 sub write {
3513     my $c = shift;
3514
3515     # Finalize headers if someone manually writes output (for compat)
3516     $c->finalize_headers;
3517
3518     return $c->response->write( @_ );
3519 }
3520
3521 =head2 version
3522
3523 Returns the Catalyst version number. Mostly useful for "powered by"
3524 messages in template systems.
3525
3526 =cut
3527
3528 sub version { return $Catalyst::VERSION }
3529
3530 =head1 CONFIGURATION
3531
3532 There are a number of 'base' config variables which can be set:
3533
3534 =over
3535
3536 =item *
3537
3538 C<always_catch_http_exceptions> - As of version 5.90060 Catalyst
3539 rethrows errors conforming to the interface described by
3540 L<Plack::Middleware::HTTPExceptions> and lets the middleware deal with it.
3541 Set true to get the deprecated behaviour and have Catalyst catch HTTP exceptions.
3542
3543 =item *
3544
3545 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
3546
3547 =item *
3548
3549 C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>.
3550
3551 =item *
3552
3553 C<disable_component_resolution_regex_fallback> - Turns
3554 off the deprecated component resolution functionality so
3555 that if any of the component methods (e.g. C<< $c->controller('Foo') >>)
3556 are called then regex search will not be attempted on string values and
3557 instead C<undef> will be returned.
3558
3559 =item *
3560
3561 C<home> - The application home directory. In an uninstalled application,
3562 this is the top level application directory. In an installed application,
3563 this will be the directory containing C<< MyApp.pm >>.
3564
3565 =item *
3566
3567 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
3568
3569 =item *
3570
3571 C<name> - The name of the application in debug messages and the debug and
3572 welcome screens
3573
3574 =item *
3575
3576 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
3577 until it is accessed. This allows you to (for example) check authentication (and reject
3578 the upload) before actually receiving all the data. See L</ON-DEMAND PARSER>
3579
3580 =item *
3581
3582 C<root> - The root directory for templates. Usually this is just a
3583 subdirectory of the home directory, but you can set it to change the
3584 templates to a different directory.
3585
3586 =item *
3587
3588 C<search_extra> - Array reference passed to Module::Pluggable to for additional
3589 namespaces from which components will be loaded (and constructed and stored in
3590 C<< $c->components >>).
3591
3592 =item *
3593
3594 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
3595 to be shown in hit debug tables in the test server.
3596
3597 =item *
3598
3599 C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment
3600 variable should be used for determining the request path.
3601
3602 Most web server environments pass the requested path to the application using environment variables,
3603 from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
3604 exposed as C<< $c->request->base >>) and the request path below that base.
3605
3606 There are two methods of doing this, both of which have advantages and disadvantages. Which method is used
3607 is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false).
3608
3609 =over
3610
3611 =item use_request_uri_for_path => 0
3612
3613 This is the default (and the) traditional method that Catalyst has used for determining the path information.
3614 The path is generated from a combination of the C<PATH_INFO> and C<SCRIPT_NAME> environment variables.
3615 The allows the application to behave correctly when C<mod_rewrite> is being used to redirect requests
3616 into the application, as these variables are adjusted by mod_rewrite to take account for the redirect.
3617
3618 However this method has the major disadvantage that it is impossible to correctly decode some elements
3619 of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot
3620 contain path-segment parameters. >>" This means PATH_INFO is B<always> decoded, and therefore Catalyst
3621 can't distinguish / vs %2F in paths (in addition to other encoded values).
3622
3623 =item use_request_uri_for_path => 1
3624
3625 This method uses the C<REQUEST_URI> and C<SCRIPT_NAME> environment variables. As C<REQUEST_URI> is never
3626 decoded, this means that applications using this mode can correctly handle URIs including the %2F character
3627 (i.e. with C<AllowEncodedSlashes> set to C<On> in Apache).
3628
3629 Given that this method of path resolution is provably more correct, it is recommended that you use
3630 this unless you have a specific need to deploy your application in a non-standard environment, and you are
3631 aware of the implications of not being able to handle encoded URI paths correctly.
3632
3633 However it also means that in a number of cases when the app isn't installed directly at a path, but instead
3634 is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a
3635 .htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed
3636 at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
3637 C<< $c->request->base >> will be incorrect.
3638
3639 =back
3640
3641 =item *
3642
3643 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
3644
3645 =item *
3646
3647 C<encoding> - See L</ENCODING>
3648
3649 =item *
3650
3651 C<abort_chain_on_error_fix>
3652
3653 When there is an error in an action chain, the default behavior is to continue
3654 processing the remaining actions and then catch the error upon chain end.  This
3655 can lead to running actions when the application is in an unexpected state.  If
3656 you have this issue, setting this config value to true will promptly exit a
3657 chain when there is an error raised in any action (thus terminating the chain
3658 early.)
3659
3660 use like:
3661
3662     __PACKAGE__->config(abort_chain_on_error_fix => 1);
3663
3664 In the future this might become the default behavior.
3665
3666 =item *
3667
3668 C<use_hash_multivalue_in_request>
3669
3670 In L<Catalyst::Request> the methods C<query_parameters>, C<body_parametes>
3671 and C<parameters> return a hashref where values might be scalar or an arrayref
3672 depending on the incoming data.  In many cases this can be undesirable as it
3673 leads one to writing defensive code like the following:
3674
3675     my ($val) = ref($c->req->parameters->{a}) ?
3676       @{$c->req->parameters->{a}} :
3677         $c->req->parameters->{a};
3678
3679 Setting this configuration item to true will make L<Catalyst> populate the
3680 attributes underlying these methods with an instance of L<Hash::MultiValue>
3681 which is used by L<Plack::Request> and others to solve this very issue.  You
3682 may prefer this behavior to the default, if so enable this option (be warned
3683 if you enable it in a legacy application we are not sure if it is completely
3684 backwardly compatible).
3685
3686 =item *
3687
3688 C<psgi_middleware> - See L<PSGI MIDDLEWARE>.
3689
3690 =item *
3691
3692 C<data_handlers> - See L<DATA HANDLERS>.
3693
3694 =back
3695
3696 =head1 EXCEPTIONS
3697
3698 Generally when you throw an exception inside an Action (or somewhere in
3699 your stack, such as in a model that an Action is calling) that exception
3700 is caught by Catalyst and unless you either catch it yourself (via eval
3701 or something like L<Try::Tiny> or by reviewing the L</error> stack, it
3702 will eventually reach L</finalize_errors> and return either the debugging
3703 error stack page, or the default error page.  However, if your exception
3704 can be caught by L<Plack::Middleware::HTTPExceptions>, L<Catalyst> will
3705 instead rethrow it so that it can be handled by that middleware (which
3706 is part of the default middleware).  For example this would allow
3707
3708     use HTTP::Throwable::Factory 'http_throw';
3709
3710     sub throws_exception :Local {
3711       my ($self, $c) = @_;
3712
3713       http_throw(SeeOther => { location =>
3714         $c->uri_for($self->action_for('redirect')) });
3715
3716     }
3717
3718 =head1 INTERNAL ACTIONS
3719
3720 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
3721 C<_ACTION>, and C<_END>. These are by default not shown in the private
3722 action table, but you can make them visible with a config parameter.
3723
3724     MyApp->config(show_internal_actions => 1);
3725
3726 =head1 ON-DEMAND PARSER
3727
3728 The request body is usually parsed at the beginning of a request,
3729 but if you want to handle input yourself, you can enable on-demand
3730 parsing with a config parameter.
3731
3732     MyApp->config(parse_on_demand => 1);
3733
3734 =head1 PROXY SUPPORT
3735
3736 Many production servers operate using the common double-server approach,
3737 with a lightweight frontend web server passing requests to a larger
3738 backend server. An application running on the backend server must deal
3739 with two problems: the remote user always appears to be C<127.0.0.1> and
3740 the server's hostname will appear to be C<localhost> regardless of the
3741 virtual host that the user connected through.
3742
3743 Catalyst will automatically detect this situation when you are running
3744 the frontend and backend servers on the same machine. The following
3745 changes are made to the request.
3746
3747     $c->req->address is set to the user's real IP address, as read from
3748     the HTTP X-Forwarded-For header.
3749
3750     The host value for $c->req->base and $c->req->uri is set to the real
3751     host, as read from the HTTP X-Forwarded-Host header.
3752
3753 Additionally, you may be running your backend application on an insecure
3754 connection (port 80) while your frontend proxy is running under SSL.  If there
3755 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
3756 tell Catalyst what port the frontend listens on.  This will allow all URIs to
3757 be created properly.
3758
3759 In the case of passing in:
3760
3761     X-Forwarded-Port: 443
3762
3763 All calls to C<uri_for> will result in an https link, as is expected.
3764
3765 Obviously, your web server must support these headers for this to work.
3766
3767 In a more complex server farm environment where you may have your
3768 frontend proxy server(s) on different machines, you will need to set a
3769 configuration option to tell Catalyst to read the proxied data from the
3770 headers.
3771
3772     MyApp->config(using_frontend_proxy => 1);
3773
3774 If you do not wish to use the proxy support at all, you may set:
3775
3776     MyApp->config(ignore_frontend_proxy => 0);
3777
3778 =head2 Note about psgi files
3779
3780 Note that if you supply your own .psgi file, calling
3781 C<< MyApp->psgi_app(@_); >>, then B<this will not happen automatically>.
3782
3783 You either need to apply L<Plack::Middleware::ReverseProxy> yourself
3784 in your psgi, for example:
3785
3786     builder {
3787         enable "Plack::Middleware::ReverseProxy";
3788         MyApp->psgi_app
3789     };
3790
3791 This will unconditionally add the ReverseProxy support, or you need to call
3792 C<< $app = MyApp->apply_default_middlewares($app) >> (to conditionally
3793 apply the support depending upon your config).
3794
3795 See L<Catalyst::PSGI> for more information.
3796
3797 =head1 THREAD SAFETY
3798
3799 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
3800 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
3801 believe the Catalyst core to be thread-safe.
3802
3803 If you plan to operate in a threaded environment, remember that all other
3804 modules you are using must also be thread-safe. Some modules, most notably
3805 L<DBD::SQLite>, are not thread-safe.
3806
3807 =head1 DATA HANDLERS
3808
3809 The L<Catalyst::Request> object uses L<HTTP::Body> to populate 'classic' HTML
3810 form parameters and URL search query fields.  However it has become common
3811 for various alternative content types to be PUT or POSTed to your controllers
3812 and actions.  People working on RESTful APIs, or using AJAX often use JSON,
3813 XML and other content types when communicating with an application server.  In
3814 order to better support this use case, L<Catalyst> defines a global configuration
3815 option, C<data_handlers>, which lets you associate a content type with a coderef
3816 that parses that content type into something Perl can readily access.
3817
3818     package MyApp::Web;
3819
3820     use Catalyst;
3821     use JSON::Maybe;
3822
3823     __PACKAGE__->config(
3824       data_handlers => {
3825         'application/json' => sub { local $/; decode_json $_->getline },
3826       },
3827       ## Any other configuration.
3828     );
3829
3830     __PACKAGE__->setup;
3831
3832 By default L<Catalyst> comes with a generic JSON data handler similar to the
3833 example given above, which uses L<JSON::Maybe> to provide either L<JSON::PP>
3834 (a pure Perl, dependency free JSON parser) or L<Cpanel::JSON::XS> if you have
3835 it installed (if you want the faster XS parser, add it to you project Makefile.PL
3836 or dist.ini, cpanfile, etc.)
3837
3838 The C<data_handlers> configuration is a hashref whose keys are HTTP Content-Types
3839 (matched against the incoming request type using a regexp such as to be case
3840 insensitive) and whose values are coderefs that receive a localized version of
3841 C<$_> which is a filehandle object pointing to received body.
3842
3843 This feature is considered an early access release and we reserve the right
3844 to alter the interface in order to provide a performant and secure solution to
3845 alternative request body content.  Your reports welcomed!
3846
3847 =head1 PSGI MIDDLEWARE
3848
3849 You can define middleware, defined as L<Plack::Middleware> or a compatible
3850 interface in configuration.  Your middleware definitions are in the form of an
3851 arrayref under the configuration key C<psgi_middleware>.  Here's an example
3852 with details to follow:
3853
3854     package MyApp::Web;
3855
3856     use Catalyst;
3857     use Plack::Middleware::StackTrace;
3858
3859     my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
3860
3861     __PACKAGE__->config(
3862       'psgi_middleware', [
3863         'Debug',
3864         '+MyApp::Custom',
3865         $stacktrace_middleware,
3866         'Session' => {store => 'File'},
3867         sub {
3868           my $app = shift;
3869           return sub {
3870             my $env = shift;
3871             $env->{myapp.customkey} = 'helloworld';
3872             $app->($env);
3873           },
3874         },
3875       ],
3876     );
3877
3878     __PACKAGE__->setup;
3879
3880 So the general form is:
3881
3882     __PACKAGE__->config(psgi_middleware => \@middleware_definitions);
3883
3884 Where C<@middleware> is one or more of the following, applied in the REVERSE of
3885 the order listed (to make it function similarly to L<Plack::Builder>:
3886
3887 Alternatively, you may also define middleware by calling the L</setup_middleware>
3888 package method:
3889
3890     package MyApp::Web;
3891
3892     use Catalyst;
3893
3894     __PACKAGE__->setup_middleware( \@middleware_definitions);
3895     __PACKAGE__->setup;
3896
3897 In the case where you do both (use 'setup_middleware' and configuration) the
3898 package call to setup_middleware will be applied earlier (in other words its
3899 middleware will wrap closer to the application).  Keep this in mind since in
3900 some cases the order of middleware is important.
3901
3902 The two approaches are not exclusive.
3903
3904 =over 4
3905
3906 =item Middleware Object
3907
3908 An already initialized object that conforms to the L<Plack::Middleware>
3909 specification:
3910
3911     my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
3912
3913     __PACKAGE__->config(
3914       'psgi_middleware', [
3915         $stacktrace_middleware,
3916       ]);
3917
3918
3919 =item coderef
3920
3921 A coderef that is an inlined middleware:
3922
3923     __PACKAGE__->config(
3924       'psgi_middleware', [
3925         sub {
3926           my $app = shift;
3927           return sub {
3928             my $env = shift;
3929             if($env->{PATH_INFO} =~m/forced/) {
3930               Plack::App::File
3931                 ->new(file=>TestApp->path_to(qw/share static forced.txt/))
3932                 ->call($env);
3933             } else {
3934               return $app->($env);
3935             }
3936          },
3937       },
3938     ]);
3939
3940
3941
3942 =item a scalar
3943
3944 We assume the scalar refers to a namespace after normalizing it using the
3945 following rules:
3946
3947 (1) If the scalar is prefixed with a "+" (as in C<+MyApp::Foo>) then the full string
3948 is assumed to be 'as is', and we just install and use the middleware.
3949
3950 (2) If the scalar begins with "Plack::Middleware" or your application namespace
3951 (the package name of your Catalyst application subclass), we also assume then
3952 that it is a full namespace, and use it.
3953
3954 (3) Lastly, we then assume that the scalar is a partial namespace, and attempt to
3955 resolve it first by looking for it under your application namespace (for example
3956 if you application is "MyApp::Web" and the scalar is "MyMiddleware", we'd look
3957 under "MyApp::Web::Middleware::MyMiddleware") and if we don't find it there, we
3958 will then look under the regular L<Plack::Middleware> namespace (i.e. for the
3959 previous we'd try "Plack::Middleware::MyMiddleware").  We look under your application
3960 namespace first to let you 'override' common L<Plack::Middleware> locally, should
3961 you find that a good idea.
3962
3963 Examples:
3964
3965     package MyApp::Web;
3966
3967     __PACKAGE__->config(
3968       'psgi_middleware', [
3969         'Debug',  ## MyAppWeb::Middleware::Debug->wrap or Plack::Middleware::Debug->wrap
3970         'Plack::Middleware::Stacktrace', ## Plack::Middleware::Stacktrace->wrap
3971         '+MyApp::Custom',  ## MyApp::Custom->wrap
3972       ],
3973     );
3974
3975 =item a scalar followed by a hashref
3976
3977 Just like the previous, except the following C<HashRef> is used as arguments
3978 to initialize the middleware object.
3979
3980     __PACKAGE__->config(
3981       'psgi_middleware', [
3982          'Session' => {store => 'File'},
3983     ]);
3984
3985 =back
3986
3987 Please see L<PSGI> for more on middleware.
3988
3989 =head1 ENCODING
3990
3991 On request, decodes all params from encoding into a sequence of
3992 logical characters. On response, encodes body into encoding.
3993
3994 =head2 Methods
3995
3996 =over 4
3997
3998 =item encoding
3999
4000 Returns an instance of an C<Encode> encoding
4001
4002     print $c->encoding->name
4003
4004 =item handle_unicode_encoding_exception ($exception_context)
4005
4006 Method called when decoding process for a request fails.
4007
4008 An C<$exception_context> hashref is provided to allow you to override the
4009 behaviour of your application when given data with incorrect encodings.
4010
4011 The default method throws exceptions in the case of invalid request parameters
4012 (resulting in a 500 error), but ignores errors in upload filenames.
4013
4014 The keys passed in the C<$exception_context> hash are:
4015
4016 =over
4017
4018 =item param_value
4019
4020 The value which was not able to be decoded.
4021
4022 =item error_msg
4023
4024 The exception received from L<Encode>.
4025
4026 =item encoding_step
4027
4028 What type of data was being decoded. Valid values are (currently)
4029 C<params> - for request parameters / arguments / captures
4030 and C<uploads> - for request upload filenames.
4031
4032 =back
4033
4034 =back
4035
4036 =head1 SUPPORT
4037
4038 IRC:
4039
4040     Join #catalyst on irc.perl.org.
4041
4042 Mailing Lists:
4043
4044     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
4045     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
4046
4047 Web:
4048
4049     http://catalyst.perl.org
4050
4051 Wiki:
4052
4053     http://dev.catalyst.perl.org
4054
4055 =head1 SEE ALSO
4056
4057 =head2 L<Task::Catalyst> - All you need to start with Catalyst
4058
4059 =head2 L<Catalyst::Manual> - The Catalyst Manual
4060
4061 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
4062
4063 =head2 L<Catalyst::Engine> - Core engine
4064
4065 =head2 L<Catalyst::Log> - Log class.
4066
4067 =head2 L<Catalyst::Request> - Request object
4068
4069 =head2 L<Catalyst::Response> - Response object
4070
4071 =head2 L<Catalyst::Test> - The test suite.
4072
4073 =head1 PROJECT FOUNDER
4074
4075 sri: Sebastian Riedel <sri@cpan.org>
4076
4077 =head1 CONTRIBUTORS
4078
4079 abw: Andy Wardley
4080
4081 acme: Leon Brocard <leon@astray.com>
4082
4083 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
4084
4085 Andrew Bramble
4086
4087 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
4088
4089 Andrew Ruthven
4090
4091 andyg: Andy Grundman <andy@hybridized.org>
4092
4093 audreyt: Audrey Tang
4094
4095 bricas: Brian Cassidy <bricas@cpan.org>
4096
4097 Caelum: Rafael Kitover <rkitover@io.com>
4098
4099 chansen: Christian Hansen
4100
4101 chicks: Christopher Hicks
4102
4103 Chisel Wright C<pause@herlpacker.co.uk>
4104
4105 Danijel Milicevic C<me@danijel.de>
4106
4107 davewood: David Schmidt <davewood@cpan.org>
4108
4109 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
4110
4111 David Naughton, C<naughton@umn.edu>
4112
4113 David E. Wheeler
4114
4115 dhoss: Devin Austin <dhoss@cpan.org>
4116
4117 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
4118
4119 Drew Taylor
4120
4121 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
4122
4123 esskar: Sascha Kiefer
4124
4125 fireartist: Carl Franks <cfranks@cpan.org>
4126
4127 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
4128
4129 gabb: Danijel Milicevic
4130
4131 Gary Ashton Jones
4132
4133 Gavin Henry C<ghenry@perl.me.uk>
4134
4135 Geoff Richards
4136
4137 groditi: Guillermo Roditi <groditi@gmail.com>
4138
4139 hobbs: Andrew Rodland <andrew@cleverdomain.org>
4140
4141 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
4142
4143 jcamacho: Juan Camacho
4144
4145 jester: Jesse Sheidlower C<jester@panix.com>
4146
4147 jhannah: Jay Hannah <jay@jays.net>
4148
4149 Jody Belka
4150
4151 Johan Lindstrom
4152
4153 jon: Jon Schutz <jjschutz@cpan.org>
4154
4155 Jonathan Rockway C<< <jrockway@cpan.org> >>
4156
4157 Kieren Diment C<kd@totaldatasolution.com>
4158
4159 konobi: Scott McWhirter <konobi@cpan.org>
4160
4161 marcus: Marcus Ramberg <mramberg@cpan.org>
4162
4163 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
4164
4165 mgrimes: Mark Grimes <mgrimes@cpan.org>
4166
4167 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
4168
4169 mugwump: Sam Vilain
4170
4171 naughton: David Naughton
4172
4173 ningu: David Kamholz <dkamholz@cpan.org>
4174
4175 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
4176
4177 numa: Dan Sully <daniel@cpan.org>
4178
4179 obra: Jesse Vincent
4180
4181 Octavian Rasnita
4182
4183 omega: Andreas Marienborg
4184
4185 Oleg Kostyuk <cub.uanic@gmail.com>
4186
4187 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
4188
4189 rafl: Florian Ragwitz <rafl@debian.org>
4190
4191 random: Roland Lammel <lammel@cpan.org>
4192
4193 Robert Sedlacek C<< <rs@474.at> >>
4194
4195 SpiceMan: Marcel Montes
4196
4197 sky: Arthur Bergman
4198
4199 szbalint: Balint Szilakszi <szbalint@cpan.org>
4200
4201 t0m: Tomas Doran <bobtfish@bobtfish.net>
4202
4203 Ulf Edvinsson
4204
4205 vanstyn: Henry Van Styn <vanstyn@cpan.org>
4206
4207 Viljo Marrandi C<vilts@yahoo.com>
4208
4209 Will Hawes C<info@whawes.co.uk>
4210
4211 willert: Sebastian Willert <willert@cpan.org>
4212
4213 wreis: Wallace Reis <wreis@cpan.org>
4214
4215 Yuval Kogman, C<nothingmuch@woobling.org>
4216
4217 rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
4218
4219 dd070: Dhaval Dhanani <dhaval070@gmail.com>
4220
4221 Upasana <me@upasana.me>
4222
4223 =head1 COPYRIGHT
4224
4225 Copyright (c) 2005-2014, the above named PROJECT FOUNDER and CONTRIBUTORS.
4226
4227 =head1 LICENSE
4228
4229 This library is free software. You can redistribute it and/or modify it under
4230 the same terms as Perl itself.
4231
4232 =cut
4233
4234 no Moose;
4235
4236 __PACKAGE__->meta->make_immutable;
4237
4238 1;