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 bytes;
   8 use B::Hooks::EndOfScope ();
   9 use Catalyst::Exception;
  10 use Catalyst::Exception::Detach;
  11 use Catalyst::Exception::Go;
  12 use Catalyst::Log;
  13 use Catalyst::Request;
  14 use Catalyst::Request::Upload;
  15 use Catalyst::Response;
  16 use Catalyst::Utils;
  17 use Catalyst::Controller;
  18 use Devel::InnerPackage ();
  19 use File::stat;
  20 use Module::Pluggable::Object ();
  21 use Text::SimpleTable ();
  22 use Path::Class::Dir ();
  23 use Path::Class::File ();
  24 use URI ();
  25 use URI::http;
  26 use URI::https;
  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 utf8;
  33 use Carp qw/croak carp shortmess/;
  34
  35 BEGIN { require 5.008004; }
  36
  37 has stack => (is => 'ro', default => sub { [] });
  38 has stash => (is => 'rw', default => sub { {} });
  39 has state => (is => 'rw', default => 0);
  40 has stats => (is => 'rw');
  41 has action => (is => 'rw');
  42 has counter => (is => 'rw', default => sub { {} });
  43 has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
  44 has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
  45 has namespace => (is => 'rw');
  46
  47 sub depth { scalar @{ shift->stack || [] }; }
  48 sub comp { shift->component(@_) }
  49
  50 sub req {
  51     my $self = shift; return $self->request(@_);
  52 }
  53 sub res {
  54     my $self = shift; return $self->response(@_);
  55 }
  56
  57 # For backwards compatibility
  58 sub finalize_output { shift->finalize_body(@_) };
  59
  60 # For statistics
  61 our $COUNT     = 1;
  62 our $START     = time;
  63 our $RECURSION = 1000;
  64 our $DETACH    = Catalyst::Exception::Detach->new;
  65 our $GO        = Catalyst::Exception::Go->new;
  66
  67 #I imagine that very few of these really need to be class variables. if any.
  68 #maybe we should just make them attributes with a default?
  69 __PACKAGE__->mk_classdata($_)
  70   for qw/components arguments dispatcher engine log dispatcher_class
  71   engine_class context_class request_class response_class stats_class
  72   setup_finished/;
  73
  74 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
  75 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
  76 __PACKAGE__->request_class('Catalyst::Request');
  77 __PACKAGE__->response_class('Catalyst::Response');
  78 __PACKAGE__->stats_class('Catalyst::Stats');
  79
  80 # Remember to update this in Catalyst::Runtime as well!
  81
  82 our $VERSION = '5.80012';
  83
  84 {
  85     my $dev_version = $VERSION =~ /_\d{2}$/;
  86     *_IS_DEVELOPMENT_VERSION = sub () { $dev_version };
  87 }
  88
  89 $VERSION = eval $VERSION;
  90
  91 sub import {
  92     my ( $class, @arguments ) = @_;
  93
  94     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
  95     # callers @ISA.
  96     return unless $class eq 'Catalyst';
  97
  98     my $caller = caller();
  99     return if $caller eq 'main';
 100
 101     # Kill Adopt::NEXT warnings if we're a non-RC version
 102     unless (_IS_DEVELOPMENT_VERSION()) {
 103         Class::C3::Adopt::NEXT->unimport(qr/^Catalyst::/);
 104     }
 105
 106     my $meta = Moose::Meta::Class->initialize($caller);
 107     unless ( $caller->isa('Catalyst') ) {
 108         my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
 109         $meta->superclasses(@superclasses);
 110     }
 111     # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
 112     $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
 113
 114     unless( $meta->has_method('meta') ){
 115         $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
 116     }
 117
 118     $caller->arguments( [@arguments] );
 119     $caller->setup_home;
 120 }
 121
 122 sub _application { $_[0] }
 123
 124 =head1 NAME
 125
 126 Catalyst - The Elegant MVC Web Application Framework
 127
 128 =head1 SYNOPSIS
 129
 130 See the L<Catalyst::Manual> distribution for comprehensive
 131 documentation and tutorials.
 132
 133     # Install Catalyst::Devel for helpers and other development tools
 134     # use the helper to create a new application
 135     catalyst.pl MyApp
 136
 137     # add models, views, controllers
 138     script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
 139     script/myapp_create.pl view MyTemplate TT
 140     script/myapp_create.pl controller Search
 141
 142     # built in testserver -- use -r to restart automatically on changes
 143     # --help to see all available options
 144     script/myapp_server.pl
 145
 146     # command line testing interface
 147     script/myapp_test.pl /yada
 148
 149     ### in lib/MyApp.pm
 150     use Catalyst qw/-Debug/; # include plugins here as well
 151
 152     ### In lib/MyApp/Controller/Root.pm (autocreated)
 153     sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
 154         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
 155         $c->stash->{template} = 'foo.tt'; # set the template
 156         # lookup something from db -- stash vars are passed to TT
 157         $c->stash->{data} =
 158           $c->model('Database::Foo')->search( { country => $args[0] } );
 159         if ( $c->req->params->{bar} ) { # access GET or POST parameters
 160             $c->forward( 'bar' ); # process another action
 161             # do something else after forward returns
 162         }
 163     }
 164
 165     # The foo.tt TT template can use the stash data from the database
 166     [% WHILE (item = data.next) %]
 167         [% item.foo %]
 168     [% END %]
 169
 170     # called for /bar/of/soap, /bar/of/soap/10, etc.
 171     sub bar : Path('/bar/of/soap') { ... }
 172
 173     # called for all actions, from the top-most controller downwards
 174     sub auto : Private {
 175         my ( $self, $c ) = @_;
 176         if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
 177             $c->res->redirect( '/login' ); # require login
 178             return 0; # abort request and go immediately to end()
 179         }
 180         return 1; # success; carry on to next action
 181     }
 182
 183     # called after all actions are finished
 184     sub end : Private {
 185         my ( $self, $c ) = @_;
 186         if ( scalar @{ $c->error } ) { ... } # handle errors
 187         return if $c->res->body; # already have a response
 188         $c->forward( 'MyApp::View::TT' ); # render template
 189     }
 190
 191     ### in MyApp/Controller/Foo.pm
 192     # called for /foo/bar
 193     sub bar : Local { ... }
 194
 195     # called for /blargle
 196     sub blargle : Global { ... }
 197
 198     # an index action matches /foo, but not /foo/1, etc.
 199     sub index : Private { ... }
 200
 201     ### in MyApp/Controller/Foo/Bar.pm
 202     # called for /foo/bar/baz
 203     sub baz : Local { ... }
 204
 205     # first Root auto is called, then Foo auto, then this
 206     sub auto : Private { ... }
 207
 208     # powerful regular expression paths are also possible
 209     sub details : Regex('^product/(\w+)/details$') {
 210         my ( $self, $c ) = @_;
 211         # extract the (\w+) from the URI
 212         my $product = $c->req->captures->[0];
 213     }
 214
 215 See L<Catalyst::Manual::Intro> for additional information.
 216
 217 =head1 DESCRIPTION
 218
 219 Catalyst is a modern framework for making web applications without the
 220 pain usually associated with this process. This document is a reference
 221 to the main Catalyst application. If you are a new user, we suggest you
 222 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
 223
 224 See L<Catalyst::Manual> for more documentation.
 225
 226 Catalyst plugins can be loaded by naming them as arguments to the "use
 227 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
 228 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
 229 C<My::Module>.
 230
 231     use Catalyst qw/My::Module/;
 232
 233 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
 234 fully qualify the name by using a unary plus:
 235
 236     use Catalyst qw/
 237         My::Module
 238         +Fully::Qualified::Plugin::Name
 239     /;
 240
 241 Special flags like C<-Debug> and C<-Engine> can also be specified as
 242 arguments when Catalyst is loaded:
 243
 244     use Catalyst qw/-Debug My::Module/;
 245
 246 The position of plugins and flags in the chain is important, because
 247 they are loaded in the order in which they appear.
 248
 249 The following flags are supported:
 250
 251 =head2 -Debug
 252
 253 Enables debug output. You can also force this setting from the system
 254 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
 255 settings override the application, with <MYAPP>_DEBUG having the highest
 256 priority.
 257
 258 =head2 -Engine
 259
 260 Forces Catalyst to use a specific engine. Omit the
 261 C<Catalyst::Engine::> prefix of the engine name, i.e.:
 262
 263     use Catalyst qw/-Engine=CGI/;
 264
 265 =head2 -Home
 266
 267 Forces Catalyst to use a specific home directory, e.g.:
 268
 269     use Catalyst qw[-Home=/usr/mst];
 270
 271 This can also be done in the shell environment by setting either the
 272 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
 273 is replaced with the uppercased name of your application, any "::" in
 274 the name will be replaced with underscores, e.g. MyApp::Web should use
 275 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 276
 277 =head2 -Log
 278
 279     use Catalyst '-Log=warn,fatal,error';
 280
 281 Specifies a comma-delimited list of log levels.
 282
 283 =head2 -Stats
 284
 285 Enables statistics collection and reporting. You can also force this setting
 286 from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
 287 environment settings override the application, with <MYAPP>_STATS having the
 288 highest priority.
 289
 290 e.g.
 291
 292    use Catalyst qw/-Stats=1/
 293
 294 =head1 METHODS
 295
 296 =head2 INFORMATION ABOUT THE CURRENT REQUEST
 297
 298 =head2 $c->action
 299
 300 Returns a L<Catalyst::Action> object for the current action, which
 301 stringifies to the action name. See L<Catalyst::Action>.
 302
 303 =head2 $c->namespace
 304
 305 Returns the namespace of the current action, i.e., the URI prefix
 306 corresponding to the controller of the current action. For example:
 307
 308     # in Controller::Foo::Bar
 309     $c->namespace; # returns 'foo/bar';
 310
 311 =head2 $c->request
 312
 313 =head2 $c->req
 314
 315 Returns the current L<Catalyst::Request> object, giving access to
 316 information about the current client request (including parameters,
 317 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
 318
 319 =head2 REQUEST FLOW HANDLING
 320
 321 =head2 $c->forward( $action [, \@arguments ] )
 322
 323 =head2 $c->forward( $class, $method, [, \@arguments ] )
 324
 325 Forwards processing to another action, by its private name. If you give a
 326 class name but no method, C<process()> is called. You may also optionally
 327 pass arguments in an arrayref. The action will receive the arguments in
 328 C<@_> and C<< $c->req->args >>. Upon returning from the function,
 329 C<< $c->req->args >> will be restored to the previous values.
 330
 331 Any data C<return>ed from the action forwarded to, will be returned by the
 332 call to forward.
 333
 334     my $foodata = $c->forward('/foo');
 335     $c->forward('index');
 336     $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
 337     $c->forward('MyApp::View::TT');
 338
 339 Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
 340 an C<< eval { } >> around the call (actually
 341 L<< execute|/"$c->execute( $class, $coderef )" >> does), thus de-fatalizing
 342 all 'dies' within the called action. If you want C<die> to propagate you
 343 need to do something like:
 344
 345     $c->forward('foo');
 346     die $c->error if $c->error;
 347
 348 Or make sure to always return true values from your actions and write
 349 your code like this:
 350
 351     $c->forward('foo') || return;
 352
 353 =cut
 354
 355 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
 356
 357 =head2 $c->detach( $action [, \@arguments ] )
 358
 359 =head2 $c->detach( $class, $method, [, \@arguments ] )
 360
 361 =head2 $c->detach()
 362
 363 The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
 364 doesn't return to the previous action when processing is finished.
 365
 366 When called with no arguments it escapes the processing chain entirely.
 367
 368 =cut
 369
 370 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 371
 372 =head2 $c->visit( $action [, \@captures, \@arguments ] )
 373
 374 =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
 375
 376 Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
 377 but does a full dispatch, instead of just calling the new C<$action> /
 378 C<< $class->$method >>. This means that C<begin>, C<auto> and the method
 379 you go to are called, just like a new request.
 380
 381 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
 382 This means, for example, that C<< $c->action >> methods such as
 383 L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
 384 L<reverse|Catalyst::Action/reverse> return information for the visited action
 385 when they are invoked within the visited action.  This is different from the
 386 behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
 387 continues to use the $c->action object from the caller action even when
 388 invoked from the callee.
 389
 390 C<< $c->stash >> is kept unchanged.
 391
 392 In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
 393 allows you to "wrap" another action, just as it would have been called by
 394 dispatching from a URL, while the analogous
 395 L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
 396 transfer control to another action as if it had been reached directly from a URL.
 397
 398 =cut
 399
 400 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
 401
 402 =head2 $c->go( $action [, \@captures, \@arguments ] )
 403
 404 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
 405
 406 Almost the same as L<< detach|/"$c->detach( $action [, \@arguments ] )" >>, but does a full dispatch like L</visit>,
 407 instead of just calling the new C<$action> /
 408 C<< $class->$method >>. This means that C<begin>, C<auto> and the
 409 method you visit are called, just like a new request.
 410
 411 C<< $c->stash >> is kept unchanged.
 412
 413 =cut
 414
 415 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
 416
 417 =head2 $c->response
 418
 419 =head2 $c->res
 420
 421 Returns the current L<Catalyst::Response> object, see there for details.
 422
 423 =head2 $c->stash
 424
 425 Returns a hashref to the stash, which may be used to store data and pass
 426 it between components during a request. You can also set hash keys by
 427 passing arguments. The stash is automatically sent to the view. The
 428 stash is cleared at the end of a request; it cannot be used for
 429 persistent storage (for this you must use a session; see
 430 L<Catalyst::Plugin::Session> for a complete system integrated with
 431 Catalyst).
 432
 433     $c->stash->{foo} = $bar;
 434     $c->stash( { moose => 'majestic', qux => 0 } );
 435     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
 436
 437     # stash is automatically passed to the view for use in a template
 438     $c->forward( 'MyApp::View::TT' );
 439
 440 =cut
 441
 442 around stash => sub {
 443     my $orig = shift;
 444     my $c = shift;
 445     my $stash = $orig->($c);
 446     if (@_) {
 447         my $new_stash = @_ > 1 ? {@_} : $_[0];
 448         croak('stash takes a hash or hashref') unless ref $new_stash;
 449         foreach my $key ( keys %$new_stash ) {
 450           $stash->{$key} = $new_stash->{$key};
 451         }
 452     }
 453
 454     return $stash;
 455 };
 456
 457
 458 =head2 $c->error
 459
 460 =head2 $c->error($error, ...)
 461
 462 =head2 $c->error($arrayref)
 463
 464 Returns an arrayref containing error messages.  If Catalyst encounters an
 465 error while processing a request, it stores the error in $c->error.  This
 466 method should only be used to store fatal error messages.
 467
 468     my @error = @{ $c->error };
 469
 470 Add a new error.
 471
 472     $c->error('Something bad happened');
 473
 474 =cut
 475
 476 sub error {
 477     my $c = shift;
 478     if ( $_[0] ) {
 479         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
 480         croak @$error unless ref $c;
 481         push @{ $c->{error} }, @$error;
 482     }
 483     elsif ( defined $_[0] ) { $c->{error} = undef }
 484     return $c->{error} || [];
 485 }
 486
 487
 488 =head2 $c->state
 489
 490 Contains the return value of the last executed action.
 491
 492 =head2 $c->clear_errors
 493
 494 Clear errors.  You probably don't want to clear the errors unless you are
 495 implementing a custom error screen.
 496
 497 This is equivalent to running
 498
 499     $c->error(0);
 500
 501 =cut
 502
 503 sub clear_errors {
 504     my $c = shift;
 505     $c->error(0);
 506 }
 507
 508 sub _comp_search_prefixes {
 509     my $c = shift;
 510     return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
 511 }
 512
 513 # search components given a name and some prefixes
 514 sub _comp_names_search_prefixes {
 515     my ( $c, $name, @prefixes ) = @_;
 516     my $appclass = ref $c || $c;
 517     my $filter   = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 518     $filter = qr/$filter/; # Compile regex now rather than once per loop
 519
 520     # map the original component name to the sub part that we will search against
 521     my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
 522         grep { /$filter/ } keys %{ $c->components };
 523
 524     # undef for a name will return all
 525     return keys %eligible if !defined $name;
 526
 527     my $query  = ref $name ? $name : qr/^$name$/i;
 528     my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
 529
 530     return @result if @result;
 531
 532     # if we were given a regexp to search against, we're done.
 533     return if ref $name;
 534
 535     # regexp fallback
 536     $query  = qr/$name/i;
 537     @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
 538
 539     # no results? try against full names
 540     if( !@result ) {
 541         @result = grep { m{$query} } keys %eligible;
 542     }
 543
 544     # don't warn if we didn't find any results, it just might not exist
 545     if( @result ) {
 546         # Disgusting hack to work out correct method name
 547         my $warn_for = lc $prefixes[0];
 548         my $msg = "Used regexp fallback for \$c->${warn_for}('${name}'), which found '" .
 549            (join '", "', @result) . "'. Relying on regexp fallback behavior for " .
 550            "component resolution is unreliable and unsafe.";
 551         my $short = $result[0];
 552         $short =~ s/.*?Model:://;
 553         my $shortmess = Carp::shortmess('');
 554         if ($shortmess =~ m#Catalyst/Plugin#) {
 555            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
 556               "plugin's config";
 557         } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) {
 558            $msg .= " You probably need to set '$short' instead of '${name}' in this " .
 559               "component's config";
 560         } else {
 561            $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}({'${name}'}), " .
 562               "but if you really wanted to search, pass in a regexp as the argument " .
 563               "like so: \$c->${warn_for}(qr/${name}/)";
 564         }
 565         $c->log->warn( "${msg}$shortmess" );
 566     }
 567
 568     return @result;
 569 }
 570
 571 # Find possible names for a prefix
 572 sub _comp_names {
 573     my ( $c, @prefixes ) = @_;
 574     my $appclass = ref $c || $c;
 575
 576     my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
 577
 578     my @names = map { s{$filter}{}; $_; }
 579         $c->_comp_names_search_prefixes( undef, @prefixes );
 580
 581     return @names;
 582 }
 583
 584 # Filter a component before returning by calling ACCEPT_CONTEXT if available
 585 sub _filter_component {
 586     my ( $c, $comp, @args ) = @_;
 587
 588     if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
 589         return $comp->ACCEPT_CONTEXT( $c, @args );
 590     }
 591
 592     return $comp;
 593 }
 594
 595 =head2 COMPONENT ACCESSORS
 596
 597 =head2 $c->controller($name)
 598
 599 Gets a L<Catalyst::Controller> instance by name.
 600
 601     $c->controller('Foo')->do_stuff;
 602
 603 If the name is omitted, will return the controller for the dispatched
 604 action.
 605
 606 If you want to search for controllers, pass in a regexp as the argument.
 607
 608     # find all controllers that start with Foo
 609     my @foo_controllers = $c->controller(qr{^Foo});
 610
 611
 612 =cut
 613
 614 sub controller {
 615     my ( $c, $name, @args ) = @_;
 616
 617     if( $name ) {
 618         my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
 619         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 620         return $c->_filter_component( $result[ 0 ], @args );
 621     }
 622
 623     return $c->component( $c->action->class );
 624 }
 625
 626 =head2 $c->model($name)
 627
 628 Gets a L<Catalyst::Model> instance by name.
 629
 630     $c->model('Foo')->do_stuff;
 631
 632 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 633
 634 If the name is omitted, it will look for
 635  - a model object in $c->stash->{current_model_instance}, then
 636  - a model name in $c->stash->{current_model}, then
 637  - a config setting 'default_model', or
 638  - check if there is only one model, and return it if that's the case.
 639
 640 If you want to search for models, pass in a regexp as the argument.
 641
 642     # find all models that start with Foo
 643     my @foo_models = $c->model(qr{^Foo});
 644
 645 =cut
 646
 647 sub model {
 648     my ( $c, $name, @args ) = @_;
 649     my $appclass = ref($c) || $c;
 650     if( $name ) {
 651         my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
 652         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 653         return $c->_filter_component( $result[ 0 ], @args );
 654     }
 655
 656     if (ref $c) {
 657         return $c->stash->{current_model_instance}
 658           if $c->stash->{current_model_instance};
 659         return $c->model( $c->stash->{current_model} )
 660           if $c->stash->{current_model};
 661     }
 662     return $c->model( $appclass->config->{default_model} )
 663       if $appclass->config->{default_model};
 664
 665     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
 666
 667     if( $rest ) {
 668         $c->log->warn( Carp::shortmess('Calling $c->model() will return a random model unless you specify one of:') );
 669         $c->log->warn( '* $c->config(default_model => "the name of the default model to use")' );
 670         $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
 671         $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
 672         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
 673     }
 674
 675     return $c->_filter_component( $comp );
 676 }
 677
 678
 679 =head2 $c->view($name)
 680
 681 Gets a L<Catalyst::View> instance by name.
 682
 683     $c->view('Foo')->do_stuff;
 684
 685 Any extra arguments are directly passed to ACCEPT_CONTEXT.
 686
 687 If the name is omitted, it will look for
 688  - a view object in $c->stash->{current_view_instance}, then
 689  - a view name in $c->stash->{current_view}, then
 690  - a config setting 'default_view', or
 691  - check if there is only one view, and return it if that's the case.
 692
 693 If you want to search for views, pass in a regexp as the argument.
 694
 695     # find all views that start with Foo
 696     my @foo_views = $c->view(qr{^Foo});
 697
 698 =cut
 699
 700 sub view {
 701     my ( $c, $name, @args ) = @_;
 702
 703     my $appclass = ref($c) || $c;
 704     if( $name ) {
 705         my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
 706         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 707         return $c->_filter_component( $result[ 0 ], @args );
 708     }
 709
 710     if (ref $c) {
 711         return $c->stash->{current_view_instance}
 712           if $c->stash->{current_view_instance};
 713         return $c->view( $c->stash->{current_view} )
 714           if $c->stash->{current_view};
 715     }
 716     return $c->view( $appclass->config->{default_view} )
 717       if $appclass->config->{default_view};
 718
 719     my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
 720
 721     if( $rest ) {
 722         $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
 723         $c->log->warn( '* $c->config(default_view => "the name of the default view to use")' );
 724         $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
 725         $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
 726         $c->log->warn( 'NB: in version 5.81, the "random" behavior will not work at all.' );
 727     }
 728
 729     return $c->_filter_component( $comp );
 730 }
 731
 732 =head2 $c->controllers
 733
 734 Returns the available names which can be passed to $c->controller
 735
 736 =cut
 737
 738 sub controllers {
 739     my ( $c ) = @_;
 740     return $c->_comp_names(qw/Controller C/);
 741 }
 742
 743 =head2 $c->models
 744
 745 Returns the available names which can be passed to $c->model
 746
 747 =cut
 748
 749 sub models {
 750     my ( $c ) = @_;
 751     return $c->_comp_names(qw/Model M/);
 752 }
 753
 754
 755 =head2 $c->views
 756
 757 Returns the available names which can be passed to $c->view
 758
 759 =cut
 760
 761 sub views {
 762     my ( $c ) = @_;
 763     return $c->_comp_names(qw/View V/);
 764 }
 765
 766 =head2 $c->comp($name)
 767
 768 =head2 $c->component($name)
 769
 770 Gets a component object by name. This method is not recommended,
 771 unless you want to get a specific component by full
 772 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
 773 should be used instead.
 774
 775 If C<$name> is a regexp, a list of components matched against the full
 776 component name will be returned.
 777
 778 =cut
 779
 780 sub component {
 781     my ( $c, $name, @args ) = @_;
 782
 783     if( $name ) {
 784         my $comps = $c->components;
 785
 786         if( !ref $name ) {
 787             # is it the exact name?
 788             return $c->_filter_component( $comps->{ $name }, @args )
 789                        if exists $comps->{ $name };
 790
 791             # perhaps we just omitted "MyApp"?
 792             my $composed = ( ref $c || $c ) . "::${name}";
 793             return $c->_filter_component( $comps->{ $composed }, @args )
 794                        if exists $comps->{ $composed };
 795
 796             # search all of the models, views and controllers
 797             my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
 798             return $c->_filter_component( $comp, @args ) if $comp;
 799         }
 800
 801         # This is here so $c->comp( '::M::' ) works
 802         my $query = ref $name ? $name : qr{$name}i;
 803
 804         my @result = grep { m{$query} } keys %{ $c->components };
 805         return map { $c->_filter_component( $_, @args ) } @result if ref $name;
 806
 807         if( $result[ 0 ] ) {
 808             $c->log->warn( Carp::shortmess(qq(Found results for "${name}" using regexp fallback)) );
 809             $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
 810             $c->log->warn( 'is unreliable and unsafe. You have been warned' );
 811             return $c->_filter_component( $result[ 0 ], @args );
 812         }
 813
 814         # I would expect to return an empty list here, but that breaks back-compat
 815     }
 816
 817     # fallback
 818     return sort keys %{ $c->components };
 819 }
 820
 821 =head2 CLASS DATA AND HELPER CLASSES
 822
 823 =head2 $c->config
 824
 825 Returns or takes a hashref containing the application's configuration.
 826
 827     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
 828
 829 You can also use a C<YAML>, C<XML> or L<Config::General> config file
 830 like C<myapp.conf> in your applications home directory. See
 831 L<Catalyst::Plugin::ConfigLoader>.
 832
 833 =head3 Cascading configuration
 834
 835 The config method is present on all Catalyst components, and configuration
 836 will be merged when an application is started. Configuration loaded with
 837 L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
 838 followed by configuration in your top level C<MyApp> class. These two
 839 configurations are merged, and then configuration data whose hash key matches a
 840 component name is merged with configuration for that component.
 841
 842 The configuration for a component is then passed to the C<new> method when a
 843 component is constructed.
 844
 845 For example:
 846
 847     MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
 848     MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
 849
 850 will mean that C<MyApp::Model::Foo> receives the following data when
 851 constructed:
 852
 853     MyApp::Model::Foo->new({
 854         bar => 'baz',
 855         quux => 'frob',
 856         overrides => 'me',
 857     });
 858
 859 =cut
 860
 861 around config => sub {
 862     my $orig = shift;
 863     my $c = shift;
 864
 865     croak('Setting config after setup has been run is not allowed.')
 866         if ( @_ and $c->setup_finished );
 867
 868     $c->$orig(@_);
 869 };
 870
 871 =head2 $c->log
 872
 873 Returns the logging object instance. Unless it is already set, Catalyst
 874 sets this up with a L<Catalyst::Log> object. To use your own log class,
 875 set the logger with the C<< __PACKAGE__->log >> method prior to calling
 876 C<< __PACKAGE__->setup >>.
 877
 878  __PACKAGE__->log( MyLogger->new );
 879  __PACKAGE__->setup;
 880
 881 And later:
 882
 883     $c->log->info( 'Now logging with my own logger!' );
 884
 885 Your log class should implement the methods described in
 886 L<Catalyst::Log>.
 887
 888
 889 =head2 $c->debug
 890
 891 Returns 1 if debug mode is enabled, 0 otherwise.
 892
 893 You can enable debug mode in several ways:
 894
 895 =over
 896
 897 =item By calling myapp_server.pl with the -d flag
 898
 899 =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
 900
 901 =item The -Debug option in your MyApp.pm
 902
 903 =item By declaring C<sub debug { 1 }> in your MyApp.pm.
 904
 905 =back
 906
 907 Calling C<< $c->debug(1) >> has no effect.
 908
 909 =cut
 910
 911 sub debug { 0 }
 912
 913 =head2 $c->dispatcher
 914
 915 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
 916
 917 =head2 $c->engine
 918
 919 Returns the engine instance. See L<Catalyst::Engine>.
 920
 921
 922 =head2 UTILITY METHODS
 923
 924 =head2 $c->path_to(@path)
 925
 926 Merges C<@path> with C<< $c->config->{home} >> and returns a
 927 L<Path::Class::Dir> object. Note you can usually use this object as
 928 a filename, but sometimes you will have to explicitly stringify it
 929 yourself by calling the C<< ->stringify >> method.
 930
 931 For example:
 932
 933     $c->path_to( 'db', 'sqlite.db' );
 934
 935 =cut
 936
 937 sub path_to {
 938     my ( $c, @path ) = @_;
 939     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
 940     if ( -d $path ) { return $path }
 941     else { return Path::Class::File->new( $c->config->{home}, @path ) }
 942 }
 943
 944 =head2 $c->plugin( $name, $class, @args )
 945
 946 Helper method for plugins. It creates a class data accessor/mutator and
 947 loads and instantiates the given class.
 948
 949     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 950
 951     $c->prototype->define_javascript_functions;
 952
 953 B<Note:> This method of adding plugins is deprecated. The ability
 954 to add plugins like this B<will be removed> in a Catalyst 5.81.
 955 Please do not use this functionality in new code.
 956
 957 =cut
 958
 959 sub plugin {
 960     my ( $class, $name, $plugin, @args ) = @_;
 961
 962     # See block comment in t/unit_core_plugin.t
 963     $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
 964
 965     $class->_register_plugin( $plugin, 1 );
 966
 967     eval { $plugin->import };
 968     $class->mk_classdata($name);
 969     my $obj;
 970     eval { $obj = $plugin->new(@args) };
 971
 972     if ($@) {
 973         Catalyst::Exception->throw( message =>
 974               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
 975     }
 976
 977     $class->$name($obj);
 978     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 979       if $class->debug;
 980 }
 981
 982 =head2 MyApp->setup
 983
 984 Initializes the dispatcher and engine, loads any plugins, and loads the
 985 model, view, and controller components. You may also specify an array
 986 of plugins to load here, if you choose to not load them in the C<use
 987 Catalyst> line.
 988
 989     MyApp->setup;
 990     MyApp->setup( qw/-Debug/ );
 991
 992 =cut
 993
 994 sub setup {
 995     my ( $class, @arguments ) = @_;
 996     croak('Running setup more than once')
 997         if ( $class->setup_finished );
 998
 999     unless ( $class->isa('Catalyst') ) {
1000
1001         Catalyst::Exception->throw(
1002             message => qq/'$class' does not inherit from Catalyst/ );
1003     }
1004
1005     if ( $class->arguments ) {
1006         @arguments = ( @arguments, @{ $class->arguments } );
1007     }
1008
1009     # Process options
1010     my $flags = {};
1011
1012     foreach (@arguments) {
1013
1014         if (/^-Debug$/) {
1015             $flags->{log} =
1016               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
1017         }
1018         elsif (/^-(\w+)=?(.*)$/) {
1019             $flags->{ lc $1 } = $2;
1020         }
1021         else {
1022             push @{ $flags->{plugins} }, $_;
1023         }
1024     }
1025
1026     $class->setup_home( delete $flags->{home} );
1027
1028     $class->setup_log( delete $flags->{log} );
1029     $class->setup_plugins( delete $flags->{plugins} );
1030     $class->setup_dispatcher( delete $flags->{dispatcher} );
1031     $class->setup_engine( delete $flags->{engine} );
1032     $class->setup_stats( delete $flags->{stats} );
1033
1034     for my $flag ( sort keys %{$flags} ) {
1035
1036         if ( my $code = $class->can( 'setup_' . $flag ) ) {
1037             &$code( $class, delete $flags->{$flag} );
1038         }
1039         else {
1040             $class->log->warn(qq/Unknown flag "$flag"/);
1041         }
1042     }
1043
1044     eval { require Catalyst::Devel; };
1045     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
1046         $class->log->warn(<<"EOF");
1047 You are running an old script!
1048
1049   Please update by running (this will overwrite existing files):
1050     catalyst.pl -force -scripts $class
1051
1052   or (this will not overwrite existing files):
1053     catalyst.pl -scripts $class
1054
1055 EOF
1056     }
1057
1058     if ( $class->debug ) {
1059         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
1060
1061         if (@plugins) {
1062             my $column_width = Catalyst::Utils::term_width() - 6;
1063             my $t = Text::SimpleTable->new($column_width);
1064             $t->row($_) for @plugins;
1065             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
1066         }
1067
1068         my $dispatcher = $class->dispatcher;
1069         my $engine     = $class->engine;
1070         my $home       = $class->config->{home};
1071
1072         $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
1073         $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
1074
1075         $home
1076           ? ( -d $home )
1077           ? $class->log->debug(qq/Found home "$home"/)
1078           : $class->log->debug(qq/Home "$home" doesn't exist/)
1079           : $class->log->debug(q/Couldn't find home/);
1080     }
1081
1082     # Call plugins setup, this is stupid and evil.
1083     # Also screws C3 badly on 5.10, hack to avoid.
1084     {
1085         no warnings qw/redefine/;
1086         local *setup = sub { };
1087         $class->setup unless $Catalyst::__AM_RESTARTING;
1088     }
1089
1090     # Initialize our data structure
1091     $class->components( {} );
1092
1093     $class->setup_components;
1094
1095     if ( $class->debug ) {
1096         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
1097         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
1098         for my $comp ( sort keys %{ $class->components } ) {
1099             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1100             $t->row( $comp, $type );
1101         }
1102         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
1103           if ( keys %{ $class->components } );
1104     }
1105
1106     # Add our self to components, since we are also a component
1107     if( $class->isa('Catalyst::Controller') ){
1108       $class->components->{$class} = $class;
1109     }
1110
1111     $class->setup_actions;
1112
1113     if ( $class->debug ) {
1114         my $name = $class->config->{name} || 'Application';
1115         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1116     }
1117     $class->log->_flush() if $class->log->can('_flush');
1118
1119     # Make sure that the application class becomes immutable at this point,
1120     B::Hooks::EndOfScope::on_scope_end {
1121         return if $@;
1122         my $meta = Class::MOP::get_metaclass_by_name($class);
1123         if (
1124             $meta->is_immutable
1125             && ! { $meta->immutable_options }->{replace_constructor}
1126             && (
1127                    $class->isa('Class::Accessor::Fast')
1128                 || $class->isa('Class::Accessor')
1129             )
1130         ) {
1131             warn "You made your application class ($class) immutable, "
1132                 . "but did not inline the\nconstructor. "
1133                 . "This will break catalyst, as your app \@ISA "
1134                 . "Class::Accessor(::Fast)?\nPlease pass "
1135                 . "(replace_constructor => 1)\nwhen making your class immutable.\n";
1136         }
1137         $meta->make_immutable(
1138             replace_constructor => 1,
1139             allow_mutable_ancestors => 1,
1140         ) unless $meta->is_immutable;
1141     };
1142
1143     $class->setup_finalize;
1144 }
1145
1146
1147 =head2 $app->setup_finalize
1148
1149 A hook to attach modifiers to.
1150 Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup.
1151 Also better than C< setup_finished(); >, as that is a getter method.
1152
1153     sub setup_finalize {
1154
1155         my $app = shift;
1156
1157         ## do stuff, i.e., determine a primary key column for sessions stored in a DB
1158
1159         $app->next::method(@_);
1160
1161
1162     }
1163
1164 =cut
1165
1166 sub setup_finalize {
1167     my ($class) = @_;
1168     $class->setup_finished(1);
1169 }
1170
1171 =head2 $c->uri_for( $path, @args?, \%query_values? )
1172
1173 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1174
1175 Constructs an absolute L<URI> object based on the application root, the
1176 provided path, and the additional arguments and query parameters provided.
1177 When used as a string, provides a textual URI.
1178
1179 If the first argument is a string, it is taken as a public URI path relative
1180 to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
1181 relative to the application root (if it does). It is then merged with
1182 C<< $c->request->base >>; any C<@args> are appended as additional path
1183 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1184
1185 If the first argument is a L<Catalyst::Action> it represents an action which
1186 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1187 optional C<\@captures> argument (an arrayref) allows passing the captured
1188 variables that are needed to fill in the paths of Chained and Regex actions;
1189 once the path is resolved, C<uri_for> continues as though a path was
1190 provided, appending any arguments or parameters and creating an absolute
1191 URI.
1192
1193 The captures for the current request can be found in
1194 C<< $c->request->captures >>, and actions can be resolved using
1195 C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1196 path, use C<< $c->uri_for_action >> instead.
1197
1198   # Equivalent to $c->req->uri
1199   $c->uri_for($c->action, $c->req->captures,
1200       @{ $c->req->args }, $c->req->params);
1201
1202   # For the Foo action in the Bar controller
1203   $c->uri_for($c->controller('Bar')->action_for('Foo'));
1204
1205   # Path to a static resource
1206   $c->uri_for('/static/images/logo.png');
1207
1208 =cut
1209
1210 sub uri_for {
1211     my ( $c, $path, @args ) = @_;
1212
1213     if (blessed($path) && $path->isa('Catalyst::Controller')) {
1214         $path = $path->path_prefix;
1215         $path =~ s{/+\z}{};
1216         $path .= '/';
1217     }
1218
1219     if ( blessed($path) ) { # action object
1220         my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
1221                          ? shift(@args)
1222                          : [] );
1223         my $action = $path;
1224         $path = $c->dispatcher->uri_for_action($action, $captures);
1225         if (not defined $path) {
1226             $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1227                 if $c->debug;
1228             return undef;
1229         }
1230         $path = '/' if $path eq '';
1231     }
1232
1233     undef($path) if (defined $path && $path eq '');
1234
1235     my $params =
1236       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1237
1238     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1239     s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
1240
1241     unshift(@args, $path);
1242
1243     unless (defined $path && $path =~ s!^/!!) { # in-place strip
1244         my $namespace = $c->namespace;
1245         if (defined $path) { # cheesy hack to handle path '../foo'
1246            $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1247         }
1248         unshift(@args, $namespace || '');
1249     }
1250
1251     # join args with '/', or a blank string
1252     my $args = join('/', grep { defined($_) } @args);
1253     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1254     $args =~ s!^/+!!;
1255     my $base = $c->req->base;
1256     my $class = ref($base);
1257     $base =~ s{(?<!/)$}{/};
1258
1259     my $query = '';
1260
1261     if (my @keys = keys %$params) {
1262       # somewhat lifted from URI::_query's query_form
1263       $query = '?'.join('&', map {
1264           my $val = $params->{$_};
1265           s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1266           s/ /+/g;
1267           my $key = $_;
1268           $val = '' unless defined $val;
1269           (map {
1270               my $param = "$_";
1271               utf8::encode( $param ) if utf8::is_utf8($param);
1272               # using the URI::Escape pattern here so utf8 chars survive
1273               $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1274               $param =~ s/ /+/g;
1275               "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1276       } @keys);
1277     }
1278
1279     my $res = bless(\"${base}${args}${query}", $class);
1280     $res;
1281 }
1282
1283 =head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
1284
1285 =head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
1286
1287 =over
1288
1289 =item $path
1290
1291 A private path to the Catalyst action you want to create a URI for.
1292
1293 This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1294 >> and passing the resulting C<$action> and the remaining arguments to C<<
1295 $c->uri_for >>.
1296
1297 You can also pass in a Catalyst::Action object, in which case it is passed to
1298 C<< $c->uri_for >>.
1299
1300 =back
1301
1302 =cut
1303
1304 sub uri_for_action {
1305     my ( $c, $path, @args ) = @_;
1306     my $action = blessed($path)
1307       ? $path
1308       : $c->dispatcher->get_action_by_path($path);
1309     unless (defined $action) {
1310       croak "Can't find action for path '$path'";
1311     }
1312     return $c->uri_for( $action, @args );
1313 }
1314
1315 =head2 $c->welcome_message
1316
1317 Returns the Catalyst welcome HTML page.
1318
1319 =cut
1320
1321 sub welcome_message {
1322     my $c      = shift;
1323     my $name   = $c->config->{name};
1324     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
1325     my $prefix = Catalyst::Utils::appprefix( ref $c );
1326     $c->response->content_type('text/html; charset=utf-8');
1327     return <<"EOF";
1328 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1329     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1330 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1331     <head>
1332     <meta http-equiv="Content-Language" content="en" />
1333     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1334         <title>$name on Catalyst $VERSION</title>
1335         <style type="text/css">
1336             body {
1337                 color: #000;
1338                 background-color: #eee;
1339             }
1340             div#content {
1341                 width: 640px;
1342                 margin-left: auto;
1343                 margin-right: auto;
1344                 margin-top: 10px;
1345                 margin-bottom: 10px;
1346                 text-align: left;
1347                 background-color: #ccc;
1348                 border: 1px solid #aaa;
1349             }
1350             p, h1, h2 {
1351                 margin-left: 20px;
1352                 margin-right: 20px;
1353                 font-family: verdana, tahoma, sans-serif;
1354             }
1355             a {
1356                 font-family: verdana, tahoma, sans-serif;
1357             }
1358             :link, :visited {
1359                     text-decoration: none;
1360                     color: #b00;
1361                     border-bottom: 1px dotted #bbb;
1362             }
1363             :link:hover, :visited:hover {
1364                     color: #555;
1365             }
1366             div#topbar {
1367                 margin: 0px;
1368             }
1369             pre {
1370                 margin: 10px;
1371                 padding: 8px;
1372             }
1373             div#answers {
1374                 padding: 8px;
1375                 margin: 10px;
1376                 background-color: #fff;
1377                 border: 1px solid #aaa;
1378             }
1379             h1 {
1380                 font-size: 0.9em;
1381                 font-weight: normal;
1382                 text-align: center;
1383             }
1384             h2 {
1385                 font-size: 1.0em;
1386             }
1387             p {
1388                 font-size: 0.9em;
1389             }
1390             p img {
1391                 float: right;
1392                 margin-left: 10px;
1393             }
1394             span#appname {
1395                 font-weight: bold;
1396                 font-size: 1.6em;
1397             }
1398         </style>
1399     </head>
1400     <body>
1401         <div id="content">
1402             <div id="topbar">
1403                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1404                     $VERSION</h1>
1405              </div>
1406              <div id="answers">
1407                  <p>
1408                  <img src="$logo" alt="Catalyst Logo" />
1409                  </p>
1410                  <p>Welcome to the  world of Catalyst.
1411                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1412                     framework will make web development something you had
1413                     never expected it to be: Fun, rewarding, and quick.</p>
1414                  <h2>What to do now?</h2>
1415                  <p>That really depends  on what <b>you</b> want to do.
1416                     We do, however, provide you with a few starting points.</p>
1417                  <p>If you want to jump right into web development with Catalyst
1418                     you might want to start with a tutorial.</p>
1419 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1420 </pre>
1421 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1422 <pre>
1423 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1424 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1425 </code></pre>
1426                  <h2>What to do next?</h2>
1427                  <p>Next it's time to write an actual application. Use the
1428                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
1429                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1430                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
1431                     they can save you a lot of work.</p>
1432                     <pre><code>script/${prefix}_create.pl -help</code></pre>
1433                     <p>Also, be sure to check out the vast and growing
1434                     collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1435                     you are likely to find what you need there.
1436                     </p>
1437
1438                  <h2>Need help?</h2>
1439                  <p>Catalyst has a very active community. Here are the main places to
1440                     get in touch with us.</p>
1441                  <ul>
1442                      <li>
1443                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1444                      </li>
1445                      <li>
1446                          <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1447                      </li>
1448                      <li>
1449                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1450                      </li>
1451                  </ul>
1452                  <h2>In conclusion</h2>
1453                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1454                     as we enjoyed making it. Please contact us if you have ideas
1455                     for improvement or other feedback.</p>
1456              </div>
1457          </div>
1458     </body>
1459 </html>
1460 EOF
1461 }
1462
1463 =head1 INTERNAL METHODS
1464
1465 These methods are not meant to be used by end users.
1466
1467 =head2 $c->components
1468
1469 Returns a hash of components.
1470
1471 =head2 $c->context_class
1472
1473 Returns or sets the context class.
1474
1475 =head2 $c->counter
1476
1477 Returns a hashref containing coderefs and execution counts (needed for
1478 deep recursion detection).
1479
1480 =head2 $c->depth
1481
1482 Returns the number of actions on the current internal execution stack.
1483
1484 =head2 $c->dispatch
1485
1486 Dispatches a request to actions.
1487
1488 =cut
1489
1490 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1491
1492 =head2 $c->dispatcher_class
1493
1494 Returns or sets the dispatcher class.
1495
1496 =head2 $c->dump_these
1497
1498 Returns a list of 2-element array references (name, structure) pairs
1499 that will be dumped on the error page in debug mode.
1500
1501 =cut
1502
1503 sub dump_these {
1504     my $c = shift;
1505     [ Request => $c->req ],
1506     [ Response => $c->res ],
1507     [ Stash => $c->stash ],
1508     [ Config => $c->config ];
1509 }
1510
1511 =head2 $c->engine_class
1512
1513 Returns or sets the engine class.
1514
1515 =head2 $c->execute( $class, $coderef )
1516
1517 Execute a coderef in given class and catch exceptions. Errors are available
1518 via $c->error.
1519
1520 =cut
1521
1522 sub execute {
1523     my ( $c, $class, $code ) = @_;
1524     $class = $c->component($class) || $class;
1525     $c->state(0);
1526
1527     if ( $c->depth >= $RECURSION ) {
1528         my $action = $code->reverse();
1529         $action = "/$action" unless $action =~ /->/;
1530         my $error = qq/Deep recursion detected calling "${action}"/;
1531         $c->log->error($error);
1532         $c->error($error);
1533         $c->state(0);
1534         return $c->state;
1535     }
1536
1537     my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1538
1539     push( @{ $c->stack }, $code );
1540
1541     no warnings 'recursion';
1542     eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
1543
1544     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1545
1546     my $last = pop( @{ $c->stack } );
1547
1548     if ( my $error = $@ ) {
1549         if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
1550             $error->rethrow if $c->depth > 1;
1551         }
1552         elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
1553             $error->rethrow if $c->depth > 0;
1554         }
1555         else {
1556             unless ( ref $error ) {
1557                 no warnings 'uninitialized';
1558                 chomp $error;
1559                 my $class = $last->class;
1560                 my $name  = $last->name;
1561                 $error = qq/Caught exception in $class->$name "$error"/;
1562             }
1563             $c->error($error);
1564             $c->state(0);
1565         }
1566     }
1567     return $c->state;
1568 }
1569
1570 sub _stats_start_execute {
1571     my ( $c, $code ) = @_;
1572     my $appclass = ref($c) || $c;
1573     return if ( ( $code->name =~ /^_.*/ )
1574         && ( !$appclass->config->{show_internal_actions} ) );
1575
1576     my $action_name = $code->reverse();
1577     $c->counter->{$action_name}++;
1578
1579     my $action = $action_name;
1580     $action = "/$action" unless $action =~ /->/;
1581
1582     # determine if the call was the result of a forward
1583     # this is done by walking up the call stack and looking for a calling
1584     # sub of Catalyst::forward before the eval
1585     my $callsub = q{};
1586     for my $index ( 2 .. 11 ) {
1587         last
1588         if ( ( caller($index) )[0] eq 'Catalyst'
1589             && ( caller($index) )[3] eq '(eval)' );
1590
1591         if ( ( caller($index) )[3] =~ /forward$/ ) {
1592             $callsub = ( caller($index) )[3];
1593             $action  = "-> $action";
1594             last;
1595         }
1596     }
1597
1598     my $uid = $action_name . $c->counter->{$action_name};
1599
1600     # is this a root-level call or a forwarded call?
1601     if ( $callsub =~ /forward$/ ) {
1602
1603         # forward, locate the caller
1604         if ( my $parent = $c->stack->[-1] ) {
1605             $c->stats->profile(
1606                 begin  => $action,
1607                 parent => "$parent" . $c->counter->{"$parent"},
1608                 uid    => $uid,
1609             );
1610         }
1611         else {
1612
1613             # forward with no caller may come from a plugin
1614             $c->stats->profile(
1615                 begin => $action,
1616                 uid   => $uid,
1617             );
1618         }
1619     }
1620     else {
1621
1622         # root-level call
1623         $c->stats->profile(
1624             begin => $action,
1625             uid   => $uid,
1626         );
1627     }
1628     return $action;
1629
1630 }
1631
1632 sub _stats_finish_execute {
1633     my ( $c, $info ) = @_;
1634     $c->stats->profile( end => $info );
1635 }
1636
1637 =head2 $c->finalize
1638
1639 Finalizes the request.
1640
1641 =cut
1642
1643 sub finalize {
1644     my $c = shift;
1645
1646     for my $error ( @{ $c->error } ) {
1647         $c->log->error($error);
1648     }
1649
1650     # Allow engine to handle finalize flow (for POE)
1651     my $engine = $c->engine;
1652     if ( my $code = $engine->can('finalize') ) {
1653         $engine->$code($c);
1654     }
1655     else {
1656
1657         $c->finalize_uploads;
1658
1659         # Error
1660         if ( $#{ $c->error } >= 0 ) {
1661             $c->finalize_error;
1662         }
1663
1664         $c->finalize_headers;
1665
1666         # HEAD request
1667         if ( $c->request->method eq 'HEAD' ) {
1668             $c->response->body('');
1669         }
1670
1671         $c->finalize_body;
1672     }
1673
1674     if ($c->use_stats) {
1675         my $elapsed = sprintf '%f', $c->stats->elapsed;
1676         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1677         $c->log->info(
1678             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1679     }
1680
1681     return $c->response->status;
1682 }
1683
1684 =head2 $c->finalize_body
1685
1686 Finalizes body.
1687
1688 =cut
1689
1690 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1691
1692 =head2 $c->finalize_cookies
1693
1694 Finalizes cookies.
1695
1696 =cut
1697
1698 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1699
1700 =head2 $c->finalize_error
1701
1702 Finalizes error.
1703
1704 =cut
1705
1706 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1707
1708 =head2 $c->finalize_headers
1709
1710 Finalizes headers.
1711
1712 =cut
1713
1714 sub finalize_headers {
1715     my $c = shift;
1716
1717     my $response = $c->response; #accessor calls can add up?
1718
1719     # Check if we already finalized headers
1720     return if $response->finalized_headers;
1721
1722     # Handle redirects
1723     if ( my $location = $response->redirect ) {
1724         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1725         $response->header( Location => $location );
1726
1727         if ( !$response->has_body ) {
1728             # Add a default body if none is already present
1729             $response->body(
1730                 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
1731             );
1732         }
1733     }
1734
1735     # Content-Length
1736     if ( $response->body && !$response->content_length ) {
1737
1738         # get the length from a filehandle
1739         if ( blessed( $response->body ) && $response->body->can('read') )
1740         {
1741             my $stat = stat $response->body;
1742             if ( $stat && $stat->size > 0 ) {
1743                 $response->content_length( $stat->size );
1744             }
1745             else {
1746                 $c->log->warn('Serving filehandle without a content-length');
1747             }
1748         }
1749         else {
1750             # everything should be bytes at this point, but just in case
1751             $response->content_length( bytes::length( $response->body ) );
1752         }
1753     }
1754
1755     # Errors
1756     if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1757         $response->headers->remove_header("Content-Length");
1758         $response->body('');
1759     }
1760
1761     $c->finalize_cookies;
1762
1763     $c->engine->finalize_headers( $c, @_ );
1764
1765     # Done
1766     $response->finalized_headers(1);
1767 }
1768
1769 =head2 $c->finalize_output
1770
1771 An alias for finalize_body.
1772
1773 =head2 $c->finalize_read
1774
1775 Finalizes the input after reading is complete.
1776
1777 =cut
1778
1779 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1780
1781 =head2 $c->finalize_uploads
1782
1783 Finalizes uploads. Cleans up any temporary files.
1784
1785 =cut
1786
1787 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1788
1789 =head2 $c->get_action( $action, $namespace )
1790
1791 Gets an action in a given namespace.
1792
1793 =cut
1794
1795 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1796
1797 =head2 $c->get_actions( $action, $namespace )
1798
1799 Gets all actions of a given name in a namespace and all parent
1800 namespaces.
1801
1802 =cut
1803
1804 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1805
1806 =head2 $c->handle_request( $class, @arguments )
1807
1808 Called to handle each HTTP request.
1809
1810 =cut
1811
1812 sub handle_request {
1813     my ( $class, @arguments ) = @_;
1814
1815     # Always expect worst case!
1816     my $status = -1;
1817     eval {
1818         if ($class->debug) {
1819             my $secs = time - $START || 1;
1820             my $av = sprintf '%.3f', $COUNT / $secs;
1821             my $time = localtime time;
1822             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1823         }
1824
1825         my $c = $class->prepare(@arguments);
1826         $c->dispatch;
1827         $status = $c->finalize;
1828     };
1829
1830     if ( my $error = $@ ) {
1831         chomp $error;
1832         $class->log->error(qq/Caught exception in engine "$error"/);
1833     }
1834
1835     $COUNT++;
1836
1837     if(my $coderef = $class->log->can('_flush')){
1838         $class->log->$coderef();
1839     }
1840     return $status;
1841 }
1842
1843 =head2 $c->prepare( @arguments )
1844
1845 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1846 etc.).
1847
1848 =cut
1849
1850 sub prepare {
1851     my ( $class, @arguments ) = @_;
1852
1853     # XXX
1854     # After the app/ctxt split, this should become an attribute based on something passed
1855     # into the application.
1856     $class->context_class( ref $class || $class ) unless $class->context_class;
1857
1858     my $c = $class->context_class->new({});
1859
1860     # For on-demand data
1861     $c->request->_context($c);
1862     $c->response->_context($c);
1863
1864     #surely this is not the most efficient way to do things...
1865     $c->stats($class->stats_class->new)->enable($c->use_stats);
1866     if ( $c->debug ) {
1867         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1868     }
1869
1870     #XXX reuse coderef from can
1871     # Allow engine to direct the prepare flow (for POE)
1872     if ( $c->engine->can('prepare') ) {
1873         $c->engine->prepare( $c, @arguments );
1874     }
1875     else {
1876         $c->prepare_request(@arguments);
1877         $c->prepare_connection;
1878         $c->prepare_query_parameters;
1879         $c->prepare_headers;
1880         $c->prepare_cookies;
1881         $c->prepare_path;
1882
1883         # Prepare the body for reading, either by prepare_body
1884         # or the user, if they are using $c->read
1885         $c->prepare_read;
1886
1887         # Parse the body unless the user wants it on-demand
1888         unless ( ref($c)->config->{parse_on_demand} ) {
1889             $c->prepare_body;
1890         }
1891     }
1892
1893     my $method  = $c->req->method  || '';
1894     my $path    = $c->req->path;
1895     $path       = '/' unless length $path;
1896     my $address = $c->req->address || '';
1897
1898     $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1899       if $c->debug;
1900
1901     $c->prepare_action;
1902
1903     return $c;
1904 }
1905
1906 =head2 $c->prepare_action
1907
1908 Prepares action. See L<Catalyst::Dispatcher>.
1909
1910 =cut
1911
1912 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1913
1914 =head2 $c->prepare_body
1915
1916 Prepares message body.
1917
1918 =cut
1919
1920 sub prepare_body {
1921     my $c = shift;
1922
1923     return if $c->request->_has_body;
1924
1925     # Initialize on-demand data
1926     $c->engine->prepare_body( $c, @_ );
1927     $c->prepare_parameters;
1928     $c->prepare_uploads;
1929
1930     if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1931         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1932         for my $key ( sort keys %{ $c->req->body_parameters } ) {
1933             my $param = $c->req->body_parameters->{$key};
1934             my $value = defined($param) ? $param : '';
1935             $t->row( $key,
1936                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1937         }
1938         $c->log->debug( "Body Parameters are:\n" . $t->draw );
1939     }
1940 }
1941
1942 =head2 $c->prepare_body_chunk( $chunk )
1943
1944 Prepares a chunk of data before sending it to L<HTTP::Body>.
1945
1946 See L<Catalyst::Engine>.
1947
1948 =cut
1949
1950 sub prepare_body_chunk {
1951     my $c = shift;
1952     $c->engine->prepare_body_chunk( $c, @_ );
1953 }
1954
1955 =head2 $c->prepare_body_parameters
1956
1957 Prepares body parameters.
1958
1959 =cut
1960
1961 sub prepare_body_parameters {
1962     my $c = shift;
1963     $c->engine->prepare_body_parameters( $c, @_ );
1964 }
1965
1966 =head2 $c->prepare_connection
1967
1968 Prepares connection.
1969
1970 =cut
1971
1972 sub prepare_connection {
1973     my $c = shift;
1974     $c->engine->prepare_connection( $c, @_ );
1975 }
1976
1977 =head2 $c->prepare_cookies
1978
1979 Prepares cookies.
1980
1981 =cut
1982
1983 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1984
1985 =head2 $c->prepare_headers
1986
1987 Prepares headers.
1988
1989 =cut
1990
1991 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1992
1993 =head2 $c->prepare_parameters
1994
1995 Prepares parameters.
1996
1997 =cut
1998
1999 sub prepare_parameters {
2000     my $c = shift;
2001     $c->prepare_body_parameters;
2002     $c->engine->prepare_parameters( $c, @_ );
2003 }
2004
2005 =head2 $c->prepare_path
2006
2007 Prepares path and base.
2008
2009 =cut
2010
2011 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
2012
2013 =head2 $c->prepare_query_parameters
2014
2015 Prepares query parameters.
2016
2017 =cut
2018
2019 sub prepare_query_parameters {
2020     my $c = shift;
2021
2022     $c->engine->prepare_query_parameters( $c, @_ );
2023
2024     if ( $c->debug && keys %{ $c->request->query_parameters } ) {
2025         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
2026         for my $key ( sort keys %{ $c->req->query_parameters } ) {
2027             my $param = $c->req->query_parameters->{$key};
2028             my $value = defined($param) ? $param : '';
2029             $t->row( $key,
2030                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2031         }
2032         $c->log->debug( "Query Parameters are:\n" . $t->draw );
2033     }
2034 }
2035
2036 =head2 $c->prepare_read
2037
2038 Prepares the input for reading.
2039
2040 =cut
2041
2042 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2043
2044 =head2 $c->prepare_request
2045
2046 Prepares the engine request.
2047
2048 =cut
2049
2050 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2051
2052 =head2 $c->prepare_uploads
2053
2054 Prepares uploads.
2055
2056 =cut
2057
2058 sub prepare_uploads {
2059     my $c = shift;
2060
2061     $c->engine->prepare_uploads( $c, @_ );
2062
2063     if ( $c->debug && keys %{ $c->request->uploads } ) {
2064         my $t = Text::SimpleTable->new(
2065             [ 12, 'Parameter' ],
2066             [ 26, 'Filename' ],
2067             [ 18, 'Type' ],
2068             [ 9,  'Size' ]
2069         );
2070         for my $key ( sort keys %{ $c->request->uploads } ) {
2071             my $upload = $c->request->uploads->{$key};
2072             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2073                 $t->row( $key, $u->filename, $u->type, $u->size );
2074             }
2075         }
2076         $c->log->debug( "File Uploads are:\n" . $t->draw );
2077     }
2078 }
2079
2080 =head2 $c->prepare_write
2081
2082 Prepares the output for writing.
2083
2084 =cut
2085
2086 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2087
2088 =head2 $c->request_class
2089
2090 Returns or sets the request class.
2091
2092 =head2 $c->response_class
2093
2094 Returns or sets the response class.
2095
2096 =head2 $c->read( [$maxlength] )
2097
2098 Reads a chunk of data from the request body. This method is designed to
2099 be used in a while loop, reading C<$maxlength> bytes on every call.
2100 C<$maxlength> defaults to the size of the request if not specified.
2101
2102 You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
2103 directly.
2104
2105 Warning: If you use read(), Catalyst will not process the body,
2106 so you will not be able to access POST parameters or file uploads via
2107 $c->request.  You must handle all body parsing yourself.
2108
2109 =cut
2110
2111 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2112
2113 =head2 $c->run
2114
2115 Starts the engine.
2116
2117 =cut
2118
2119 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
2120
2121 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2122
2123 Sets an action in a given namespace.
2124
2125 =cut
2126
2127 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2128
2129 =head2 $c->setup_actions($component)
2130
2131 Sets up actions for a component.
2132
2133 =cut
2134
2135 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2136
2137 =head2 $c->setup_components
2138
2139 This method is called internally to set up the application's components.
2140
2141 It finds modules by calling the L<locate_components> method, expands them to
2142 package names with the L<expand_component_module> method, and then installs
2143 each component into the application.
2144
2145 The C<setup_components> config option is passed to both of the above methods.
2146
2147 Installation of each component is performed by the L<setup_component> method,
2148 below.
2149
2150 =cut
2151
2152 sub setup_components {
2153     my $class = shift;
2154
2155     my $config  = $class->config->{ setup_components };
2156
2157     my @comps = sort { length $a <=> length $b }
2158                 $class->locate_components($config);
2159     my %comps = map { $_ => 1 } @comps;
2160
2161     my $deprecatedcatalyst_component_names = grep { /::[CMV]::/ } @comps;
2162     $class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
2163         qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
2164     ) if $deprecatedcatalyst_component_names;
2165
2166     for my $component ( @comps ) {
2167
2168         # We pass ignore_loaded here so that overlay files for (e.g.)
2169         # Model::DBI::Schema sub-classes are loaded - if it's in @comps
2170         # we know M::P::O found a file on disk so this is safe
2171
2172         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
2173
2174         # Needs to be done as soon as the component is loaded, as loading a sub-component
2175         # (next time round the loop) can cause us to get the wrong metaclass..
2176         $class->_controller_init_base_classes($component);
2177     }
2178
2179     for my $component (@comps) {
2180         $class->components->{ $component } = $class->setup_component($component);
2181         for my $component ($class->expand_component_module( $component, $config )) {
2182             next if $comps{$component};
2183             $class->_controller_init_base_classes($component); # Also cover inner packages
2184             $class->components->{ $component } = $class->setup_component($component);
2185         }
2186     }
2187 }
2188
2189 =head2 $c->locate_components( $setup_component_config )
2190
2191 This method is meant to provide a list of component modules that should be
2192 setup for the application.  By default, it will use L<Module::Pluggable>.
2193
2194 Specify a C<setup_components> config option to pass additional options directly
2195 to L<Module::Pluggable>. To add additional search paths, specify a key named
2196 C<search_extra> as an array reference. Items in the array beginning with C<::>
2197 will have the application class name prepended to them.
2198
2199 =cut
2200
2201 sub locate_components {
2202     my $class  = shift;
2203     my $config = shift;
2204
2205     my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
2206     my $extra   = delete $config->{ search_extra } || [];
2207
2208     push @paths, @$extra;
2209
2210     my $locator = Module::Pluggable::Object->new(
2211         search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
2212         %$config
2213     );
2214
2215     my @comps = $locator->plugins;
2216
2217     return @comps;
2218 }
2219
2220 =head2 $c->expand_component_module( $component, $setup_component_config )
2221
2222 Components found by C<locate_components> will be passed to this method, which
2223 is expected to return a list of component (package) names to be set up.
2224
2225 =cut
2226
2227 sub expand_component_module {
2228     my ($class, $module) = @_;
2229     return Devel::InnerPackage::list_packages( $module );
2230 }
2231
2232 =head2 $c->setup_component
2233
2234 =cut
2235
2236 # FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes
2237 #         nearest to Catalyst::Controller first, no matter what order stuff happens
2238 #         to be loaded. There are TODO tests in Moose for this, see
2239 #         f2391d17574eff81d911b97be15ea51080500003
2240 sub _controller_init_base_classes {
2241     my ($app_class, $component) = @_;
2242     return unless $component->isa('Catalyst::Controller');
2243     foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) {
2244         Moose::Meta::Class->initialize( $class )
2245             unless find_meta($class);
2246     }
2247 }
2248
2249 sub setup_component {
2250     my( $class, $component ) = @_;
2251
2252     unless ( $component->can( 'COMPONENT' ) ) {
2253         return $component;
2254     }
2255
2256     my $suffix = Catalyst::Utils::class2classsuffix( $component );
2257     my $config = $class->config->{ $suffix } || {};
2258     # Stash catalyst_component_name in the config here, so that custom COMPONENT
2259     # methods also pass it. local to avoid pointlessly shitting in config
2260     # for the debug screen, as $component is already the key name.
2261     local $config->{catalyst_component_name} = $component;
2262
2263     my $instance = eval { $component->COMPONENT( $class, $config ); };
2264
2265     if ( my $error = $@ ) {
2266         chomp $error;
2267         Catalyst::Exception->throw(
2268             message => qq/Couldn't instantiate component "$component", "$error"/
2269         );
2270     }
2271
2272     unless (blessed $instance) {
2273         my $metaclass = Moose::Util::find_meta($component);
2274         my $method_meta = $metaclass->find_method_by_name('COMPONENT');
2275         my $component_method_from = $method_meta->associated_metaclass->name;
2276         my $value = defined($instance) ? $instance : 'undef';
2277         Catalyst::Exception->throw(
2278             message =>
2279             qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./
2280         );
2281     }
2282     return $instance;
2283 }
2284
2285 =head2 $c->setup_dispatcher
2286
2287 Sets up dispatcher.
2288
2289 =cut
2290
2291 sub setup_dispatcher {
2292     my ( $class, $dispatcher ) = @_;
2293
2294     if ($dispatcher) {
2295         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2296     }
2297
2298     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2299         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2300     }
2301
2302     unless ($dispatcher) {
2303         $dispatcher = $class->dispatcher_class;
2304     }
2305
2306     Class::MOP::load_class($dispatcher);
2307
2308     # dispatcher instance
2309     $class->dispatcher( $dispatcher->new );
2310 }
2311
2312 =head2 $c->setup_engine
2313
2314 Sets up engine.
2315
2316 =cut
2317
2318 sub setup_engine {
2319     my ( $class, $engine ) = @_;
2320
2321     if ($engine) {
2322         $engine = 'Catalyst::Engine::' . $engine;
2323     }
2324
2325     if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2326         $engine = 'Catalyst::Engine::' . $env;
2327     }
2328
2329     if ( $ENV{MOD_PERL} ) {
2330         my $meta = Class::MOP::get_metaclass_by_name($class);
2331
2332         # create the apache method
2333         $meta->add_method('apache' => sub { shift->engine->apache });
2334
2335         my ( $software, $version ) =
2336           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2337
2338         $version =~ s/_//g;
2339         $version =~ s/(\.[^.]+)\./$1/g;
2340
2341         if ( $software eq 'mod_perl' ) {
2342
2343             if ( !$engine ) {
2344
2345                 if ( $version >= 1.99922 ) {
2346                     $engine = 'Catalyst::Engine::Apache2::MP20';
2347                 }
2348
2349                 elsif ( $version >= 1.9901 ) {
2350                     $engine = 'Catalyst::Engine::Apache2::MP19';
2351                 }
2352
2353                 elsif ( $version >= 1.24 ) {
2354                     $engine = 'Catalyst::Engine::Apache::MP13';
2355                 }
2356
2357                 else {
2358                     Catalyst::Exception->throw( message =>
2359                           qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2360                 }
2361
2362             }
2363
2364             # install the correct mod_perl handler
2365             if ( $version >= 1.9901 ) {
2366                 *handler = sub  : method {
2367                     shift->handle_request(@_);
2368                 };
2369             }
2370             else {
2371                 *handler = sub ($$) { shift->handle_request(@_) };
2372             }
2373
2374         }
2375
2376         elsif ( $software eq 'Zeus-Perl' ) {
2377             $engine = 'Catalyst::Engine::Zeus';
2378         }
2379
2380         else {
2381             Catalyst::Exception->throw(
2382                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2383         }
2384     }
2385
2386     unless ($engine) {
2387         $engine = $class->engine_class;
2388     }
2389
2390     Class::MOP::load_class($engine);
2391
2392     # check for old engines that are no longer compatible
2393     my $old_engine;
2394     if ( $engine->isa('Catalyst::Engine::Apache')
2395         && !Catalyst::Engine::Apache->VERSION )
2396     {
2397         $old_engine = 1;
2398     }
2399
2400     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2401         && Catalyst::Engine::Server->VERSION le '0.02' )
2402     {
2403         $old_engine = 1;
2404     }
2405
2406     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2407         && $engine->VERSION eq '0.01' )
2408     {
2409         $old_engine = 1;
2410     }
2411
2412     elsif ($engine->isa('Catalyst::Engine::Zeus')
2413         && $engine->VERSION eq '0.01' )
2414     {
2415         $old_engine = 1;
2416     }
2417
2418     if ($old_engine) {
2419         Catalyst::Exception->throw( message =>
2420               qq/Engine "$engine" is not supported by this version of Catalyst/
2421         );
2422     }
2423
2424     # engine instance
2425     $class->engine( $engine->new );
2426 }
2427
2428 =head2 $c->setup_home
2429
2430 Sets up the home directory.
2431
2432 =cut
2433
2434 sub setup_home {
2435     my ( $class, $home ) = @_;
2436
2437     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2438         $home = $env;
2439     }
2440
2441     $home ||= Catalyst::Utils::home($class);
2442
2443     if ($home) {
2444         #I remember recently being scolded for assigning config values like this
2445         $class->config->{home} ||= $home;
2446         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2447     }
2448 }
2449
2450 =head2 $c->setup_log
2451
2452 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2453 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2454 log to.
2455
2456 This method also installs a C<debug> method that returns a true value into the
2457 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2458 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2459
2460 Note that if the log has already been setup, by either a previous call to
2461 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2462 that this method won't actually set up the log object.
2463
2464 =cut
2465
2466 sub setup_log {
2467     my ( $class, $levels ) = @_;
2468
2469     $levels ||= '';
2470     $levels =~ s/^\s+//;
2471     $levels =~ s/\s+$//;
2472     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
2473
2474     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2475     if ( defined $env_debug ) {
2476         $levels{debug} = 1 if $env_debug; # Ugly!
2477         delete($levels{debug}) unless $env_debug;
2478     }
2479
2480     unless ( $class->log ) {
2481         $class->log( Catalyst::Log->new(keys %levels) );
2482     }
2483
2484     if ( $levels{debug} ) {
2485         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2486         $class->log->debug('Debug messages enabled');
2487     }
2488 }
2489
2490 =head2 $c->setup_plugins
2491
2492 Sets up plugins.
2493
2494 =cut
2495
2496 =head2 $c->setup_stats
2497
2498 Sets up timing statistics class.
2499
2500 =cut
2501
2502 sub setup_stats {
2503     my ( $class, $stats ) = @_;
2504
2505     Catalyst::Utils::ensure_class_loaded($class->stats_class);
2506
2507     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2508     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2509         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2510         $class->log->debug('Statistics enabled');
2511     }
2512 }
2513
2514
2515 =head2 $c->registered_plugins
2516
2517 Returns a sorted list of the plugins which have either been stated in the
2518 import list or which have been added via C<< MyApp->plugin(@args); >>.
2519
2520 If passed a given plugin name, it will report a boolean value indicating
2521 whether or not that plugin is loaded.  A fully qualified name is required if
2522 the plugin name does not begin with C<Catalyst::Plugin::>.
2523
2524  if ($c->registered_plugins('Some::Plugin')) {
2525      ...
2526  }
2527
2528 =cut
2529
2530 {
2531
2532     sub registered_plugins {
2533         my $proto = shift;
2534         return sort keys %{ $proto->_plugins } unless @_;
2535         my $plugin = shift;
2536         return 1 if exists $proto->_plugins->{$plugin};
2537         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2538     }
2539
2540     sub _register_plugin {
2541         my ( $proto, $plugin, $instant ) = @_;
2542         my $class = ref $proto || $proto;
2543
2544         Class::MOP::load_class( $plugin );
2545
2546         $proto->_plugins->{$plugin} = 1;
2547         unless ($instant) {
2548             no strict 'refs';
2549             if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) {
2550               my @superclasses = ($plugin, $meta->superclasses );
2551               $meta->superclasses(@superclasses);
2552             } else {
2553               unshift @{"$class\::ISA"}, $plugin;
2554             }
2555         }
2556         return $class;
2557     }
2558
2559     sub setup_plugins {
2560         my ( $class, $plugins ) = @_;
2561
2562         $class->_plugins( {} ) unless $class->_plugins;
2563         $plugins ||= [];
2564
2565         my @plugins = Catalyst::Utils::resolve_namespace($class . '::Plugin', 'Catalyst::Plugin', @$plugins);
2566
2567         for my $plugin ( reverse @plugins ) {
2568             Class::MOP::load_class($plugin);
2569             my $meta = find_meta($plugin);
2570             next if $meta && $meta->isa('Moose::Meta::Role');
2571
2572             $class->_register_plugin($plugin);
2573         }
2574
2575         my @roles =
2576             map { $_->name }
2577             grep { $_ && blessed($_) && $_->isa('Moose::Meta::Role') }
2578             map { find_meta($_) }
2579             @plugins;
2580
2581         Moose::Util::apply_all_roles(
2582             $class => @roles
2583         ) if @roles;
2584     }
2585 }
2586
2587 =head2 $c->stack
2588
2589 Returns an arrayref of the internal execution stack (actions that are
2590 currently executing).
2591
2592 =head2 $c->stats_class
2593
2594 Returns or sets the stats (timing statistics) class.
2595
2596 =head2 $c->use_stats
2597
2598 Returns 1 when stats collection is enabled.  Stats collection is enabled
2599 when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2600 environment variable is set.
2601
2602 Note that this is a static method, not an accessor and should be overridden
2603 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
2604
2605 =cut
2606
2607 sub use_stats { 0 }
2608
2609
2610 =head2 $c->write( $data )
2611
2612 Writes $data to the output stream. When using this method directly, you
2613 will need to manually set the C<Content-Length> header to the length of
2614 your output data, if known.
2615
2616 =cut
2617
2618 sub write {
2619     my $c = shift;
2620
2621     # Finalize headers if someone manually writes output
2622     $c->finalize_headers;
2623
2624     return $c->engine->write( $c, @_ );
2625 }
2626
2627 =head2 version
2628
2629 Returns the Catalyst version number. Mostly useful for "powered by"
2630 messages in template systems.
2631
2632 =cut
2633
2634 sub version { return $Catalyst::VERSION }
2635
2636 =head1 INTERNAL ACTIONS
2637
2638 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2639 C<_ACTION>, and C<_END>. These are by default not shown in the private
2640 action table, but you can make them visible with a config parameter.
2641
2642     MyApp->config(show_internal_actions => 1);
2643
2644 =head1 CASE SENSITIVITY
2645
2646 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2647 mapped to C</foo/bar>. You can activate case sensitivity with a config
2648 parameter.
2649
2650     MyApp->config(case_sensitive => 1);
2651
2652 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2653
2654 =head1 ON-DEMAND PARSER
2655
2656 The request body is usually parsed at the beginning of a request,
2657 but if you want to handle input yourself, you can enable on-demand
2658 parsing with a config parameter.
2659
2660     MyApp->config(parse_on_demand => 1);
2661
2662 =head1 PROXY SUPPORT
2663
2664 Many production servers operate using the common double-server approach,
2665 with a lightweight frontend web server passing requests to a larger
2666 backend server. An application running on the backend server must deal
2667 with two problems: the remote user always appears to be C<127.0.0.1> and
2668 the server's hostname will appear to be C<localhost> regardless of the
2669 virtual host that the user connected through.
2670
2671 Catalyst will automatically detect this situation when you are running
2672 the frontend and backend servers on the same machine. The following
2673 changes are made to the request.
2674
2675     $c->req->address is set to the user's real IP address, as read from
2676     the HTTP X-Forwarded-For header.
2677
2678     The host value for $c->req->base and $c->req->uri is set to the real
2679     host, as read from the HTTP X-Forwarded-Host header.
2680
2681 Additionally, you may be running your backend application on an insecure
2682 connection (port 80) while your frontend proxy is running under SSL.  If there
2683 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
2684 tell Catalyst what port the frontend listens on.  This will allow all URIs to
2685 be created properly.
2686
2687 In the case of passing in:
2688
2689     X-Forwarded-Port: 443
2690
2691 All calls to C<uri_for> will result in an https link, as is expected.
2692
2693 Obviously, your web server must support these headers for this to work.
2694
2695 In a more complex server farm environment where you may have your
2696 frontend proxy server(s) on different machines, you will need to set a
2697 configuration option to tell Catalyst to read the proxied data from the
2698 headers.
2699
2700     MyApp->config(using_frontend_proxy => 1);
2701
2702 If you do not wish to use the proxy support at all, you may set:
2703
2704     MyApp->config(ignore_frontend_proxy => 1);
2705
2706 =head1 THREAD SAFETY
2707
2708 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2709 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2710 believe the Catalyst core to be thread-safe.
2711
2712 If you plan to operate in a threaded environment, remember that all other
2713 modules you are using must also be thread-safe. Some modules, most notably
2714 L<DBD::SQLite>, are not thread-safe.
2715
2716 =head1 SUPPORT
2717
2718 IRC:
2719
2720     Join #catalyst on irc.perl.org.
2721
2722 Mailing Lists:
2723
2724     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2725     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
2726
2727 Web:
2728
2729     http://catalyst.perl.org
2730
2731 Wiki:
2732
2733     http://dev.catalyst.perl.org
2734
2735 =head1 SEE ALSO
2736
2737 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2738
2739 =head2 L<Catalyst::Manual> - The Catalyst Manual
2740
2741 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
2742
2743 =head2 L<Catalyst::Engine> - Core engine
2744
2745 =head2 L<Catalyst::Log> - Log class.
2746
2747 =head2 L<Catalyst::Request> - Request object
2748
2749 =head2 L<Catalyst::Response> - Response object
2750
2751 =head2 L<Catalyst::Test> - The test suite.
2752
2753 =head1 PROJECT FOUNDER
2754
2755 sri: Sebastian Riedel <sri@cpan.org>
2756
2757 =head1 CONTRIBUTORS
2758
2759 abw: Andy Wardley
2760
2761 acme: Leon Brocard <leon@astray.com>
2762
2763 Andrew Bramble
2764
2765 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
2766
2767 Andrew Ruthven
2768
2769 andyg: Andy Grundman <andy@hybridized.org>
2770
2771 audreyt: Audrey Tang
2772
2773 bricas: Brian Cassidy <bricas@cpan.org>
2774
2775 Caelum: Rafael Kitover <rkitover@io.com>
2776
2777 chansen: Christian Hansen
2778
2779 chicks: Christopher Hicks
2780
2781 Chisel Wright C<pause@herlpacker.co.uk>
2782
2783 Danijel Milicevic C<me@danijel.de>
2784
2785 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
2786
2787 David Naughton, C<naughton@umn.edu>
2788
2789 David E. Wheeler
2790
2791 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
2792
2793 Drew Taylor
2794
2795 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
2796
2797 esskar: Sascha Kiefer
2798
2799 fireartist: Carl Franks <cfranks@cpan.org>
2800
2801 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
2802
2803 gabb: Danijel Milicevic
2804
2805 Gary Ashton Jones
2806
2807 Gavin Henry C<ghenry@perl.me.uk>
2808
2809 Geoff Richards
2810
2811 groditi: Guillermo Roditi <groditi@gmail.com>
2812
2813 hobbs: Andrew Rodland <andrew@cleverdomain.org>
2814
2815 ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2816
2817 jcamacho: Juan Camacho
2818
2819 jester: Jesse Sheidlower C<jester@panix.com>
2820
2821 jhannah: Jay Hannah <jay@jays.net>
2822
2823 Jody Belka
2824
2825 Johan Lindstrom
2826
2827 jon: Jon Schutz <jjschutz@cpan.org>
2828
2829 Jonathan Rockway C<< <jrockway@cpan.org> >>
2830
2831 Kieren Diment C<kd@totaldatasolution.com>
2832
2833 konobi: Scott McWhirter <konobi@cpan.org>
2834
2835 marcus: Marcus Ramberg <mramberg@cpan.org>
2836
2837 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
2838
2839 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
2840
2841 mugwump: Sam Vilain
2842
2843 naughton: David Naughton
2844
2845 ningu: David Kamholz <dkamholz@cpan.org>
2846
2847 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
2848
2849 numa: Dan Sully <daniel@cpan.org>
2850
2851 obra: Jesse Vincent
2852
2853 omega: Andreas Marienborg
2854
2855 Oleg Kostyuk <cub.uanic@gmail.com>
2856
2857 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
2858
2859 rafl: Florian Ragwitz <rafl@debian.org>
2860
2861 random: Roland Lammel <lammel@cpan.org>
2862
2863 Robert Sedlacek C<< <rs@474.at> >>
2864
2865 sky: Arthur Bergman
2866
2867 t0m: Tomas Doran <bobtfish@bobtfish.net>
2868
2869 Ulf Edvinsson
2870
2871 Viljo Marrandi C<vilts@yahoo.com>
2872
2873 Will Hawes C<info@whawes.co.uk>
2874
2875 willert: Sebastian Willert <willert@cpan.org>
2876
2877 Yuval Kogman, C<nothingmuch@woobling.org>
2878
2879 =head1 LICENSE
2880
2881 This library is free software. You can redistribute it and/or modify it under
2882 the same terms as Perl itself.
2883
2884 =cut
2885
2886 no Moose;
2887
2888 __PACKAGE__->meta->make_immutable;
2889
2890 1;