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