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