lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use strict;
   4 use base 'Catalyst::Component';
   5 use bytes;
   6 use Catalyst::Exception;
   7 use Catalyst::Log;
   8 use Catalyst::Request;
   9 use Catalyst::Request::Upload;
  10 use Catalyst::Response;
  11 use Catalyst::Utils;
  12 use Catalyst::Controller;
  13 use Devel::InnerPackage ();
  14 use File::stat;
  15 use Module::Pluggable::Object ();
  16 use NEXT;
  17 use Text::SimpleTable ();
  18 use Path::Class::Dir ();
  19 use Path::Class::File ();
  20 use Time::HiRes qw/gettimeofday tv_interval/;
  21 use URI ();
  22 use Scalar::Util qw/weaken blessed/;
  23 use Tree::Simple qw/use_weak_refs/;
  24 use Tree::Simple::Visitor::FindByUID;
  25 use attributes;
  26 use utf8;
  27 use Carp qw/croak/;
  28
  29 BEGIN { require 5.008001; }
  30
  31 __PACKAGE__->mk_accessors(
  32     qw/counter request response state action stack namespace stats/
  33 );
  34
  35 attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
  36
  37 sub depth { scalar @{ shift->stack || [] }; }
  38
  39 # Laziness++
  40 *comp = \&component;
  41 *req  = \&request;
  42 *res  = \&response;
  43
  44 # For backwards compatibility
  45 *finalize_output = \&finalize_body;
  46
  47 # For statistics
  48 our $COUNT     = 1;
  49 our $START     = time;
  50 our $RECURSION = 1000;
  51 our $DETACH    = "catalyst_detach\n";
  52
  53 __PACKAGE__->mk_classdata($_)
  54   for qw/components arguments dispatcher engine log dispatcher_class
  55   engine_class context_class request_class response_class setup_finished/;
  56
  57 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
  58 __PACKAGE__->engine_class('Catalyst::Engine::CGI');
  59 __PACKAGE__->request_class('Catalyst::Request');
  60 __PACKAGE__->response_class('Catalyst::Response');
  61
  62 # Remember to update this in Catalyst::Runtime as well!
  63
  64 our $VERSION = '5.7007';
  65
  66 sub import {
  67     my ( $class, @arguments ) = @_;
  68
  69     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
  70     # callers @ISA.
  71     return unless $class eq 'Catalyst';
  72
  73     my $caller = caller(0);
  74
  75     unless ( $caller->isa('Catalyst') ) {
  76         no strict 'refs';
  77         push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
  78     }
  79
  80     $caller->arguments( [@arguments] );
  81     $caller->setup_home;
  82 }
  83
  84 =head1 NAME
  85
  86 Catalyst - The Elegant MVC Web Application Framework
  87
  88 =head1 SYNOPSIS
  89
  90 See the L<Catalyst::Manual> distribution for comprehensive
  91 documentation and tutorials.
  92
  93     # Install Catalyst::Devel for helpers and other development tools
  94     # use the helper to create a new application
  95     catalyst.pl MyApp
  96
  97     # add models, views, controllers
  98     script/myapp_create.pl model MyDatabase DBIC::Schema create=dynamic dbi:SQLite:/path/to/db
  99     script/myapp_create.pl view MyTemplate TT
 100     script/myapp_create.pl controller Search
 101
 102     # built in testserver -- use -r to restart automatically on changes
 103     # --help to see all available options
 104     script/myapp_server.pl
 105
 106     # command line testing interface
 107     script/myapp_test.pl /yada
 108
 109     ### in lib/MyApp.pm
 110     use Catalyst qw/-Debug/; # include plugins here as well
 111
 112         ### In lib/MyApp/Controller/Root.pm (autocreated)
 113     sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
 114         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
 115         $c->stash->{template} = 'foo.tt'; # set the template
 116         # lookup something from db -- stash vars are passed to TT
 117         $c->stash->{data} =
 118           $c->model('Database::Foo')->search( { country => $args[0] } );
 119         if ( $c->req->params->{bar} ) { # access GET or POST parameters
 120             $c->forward( 'bar' ); # process another action
 121             # do something else after forward returns
 122         }
 123     }
 124
 125     # The foo.tt TT template can use the stash data from the database
 126     [% WHILE (item = data.next) %]
 127         [% item.foo %]
 128     [% END %]
 129
 130     # called for /bar/of/soap, /bar/of/soap/10, etc.
 131     sub bar : Path('/bar/of/soap') { ... }
 132
 133     # called for all actions, from the top-most controller downwards
 134     sub auto : Private {
 135         my ( $self, $c ) = @_;
 136         if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
 137             $c->res->redirect( '/login' ); # require login
 138             return 0; # abort request and go immediately to end()
 139         }
 140         return 1; # success; carry on to next action
 141     }
 142
 143     # called after all actions are finished
 144     sub end : Private {
 145         my ( $self, $c ) = @_;
 146         if ( scalar @{ $c->error } ) { ... } # handle errors
 147         return if $c->res->body; # already have a response
 148         $c->forward( 'MyApp::View::TT' ); # render template
 149     }
 150
 151     ### in MyApp/Controller/Foo.pm
 152     # called for /foo/bar
 153     sub bar : Local { ... }
 154
 155     # called for /blargle
 156     sub blargle : Global { ... }
 157
 158     # an index action matches /foo, but not /foo/1, etc.
 159     sub index : Private { ... }
 160
 161     ### in MyApp/Controller/Foo/Bar.pm
 162     # called for /foo/bar/baz
 163     sub baz : Local { ... }
 164
 165     # first Root auto is called, then Foo auto, then this
 166     sub auto : Private { ... }
 167
 168     # powerful regular expression paths are also possible
 169     sub details : Regex('^product/(\w+)/details$') {
 170         my ( $self, $c ) = @_;
 171         # extract the (\w+) from the URI
 172         my $product = $c->req->captures->[0];
 173     }
 174
 175 See L<Catalyst::Manual::Intro> for additional information.
 176
 177 =head1 DESCRIPTION
 178
 179 Catalyst is a modern framework for making web applications without the
 180 pain usually associated with this process. This document is a reference
 181 to the main Catalyst application. If you are a new user, we suggest you
 182 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
 183
 184 See L<Catalyst::Manual> for more documentation.
 185
 186 Catalyst plugins can be loaded by naming them as arguments to the "use
 187 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
 188 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
 189 C<My::Module>.
 190
 191     use Catalyst qw/My::Module/;
 192
 193 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
 194 fully qualify the name by using a unary plus:
 195
 196     use Catalyst qw/
 197         My::Module
 198         +Fully::Qualified::Plugin::Name
 199     /;
 200
 201 Special flags like C<-Debug> and C<-Engine> can also be specified as
 202 arguments when Catalyst is loaded:
 203
 204     use Catalyst qw/-Debug My::Module/;
 205
 206 The position of plugins and flags in the chain is important, because
 207 they are loaded in the order in which they appear.
 208
 209 The following flags are supported:
 210
 211 =head2 -Debug
 212
 213 Enables debug output. You can also force this setting from the system
 214 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
 215 settings override the application, with <MYAPP>_DEBUG having the highest
 216 priority.
 217
 218 =head2 -Engine
 219
 220 Forces Catalyst to use a specific engine. Omit the
 221 C<Catalyst::Engine::> prefix of the engine name, i.e.:
 222
 223     use Catalyst qw/-Engine=CGI/;
 224
 225 =head2 -Home
 226
 227 Forces Catalyst to use a specific home directory, e.g.:
 228
 229     use Catalyst qw[-Home=/usr/mst];
 230
 231 This can also be done in the shell environment by setting either the
 232 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
 233 is replaced with the uppercased name of your application, any "::" in
 234 the name will be replaced with underscores, e.g. MyApp::Web should use
 235 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
 236
 237 =head2 -Log
 238
 239 Specifies log level.
 240
 241 =head1 METHODS
 242
 243 =head2 INFORMATION ABOUT THE CURRENT REQUEST
 244
 245 =head2 $c->action
 246
 247 Returns a L<Catalyst::Action> object for the current action, which
 248 stringifies to the action name. See L<Catalyst::Action>.
 249
 250 =head2 $c->namespace
 251
 252 Returns the namespace of the current action, i.e., the URI prefix
 253 corresponding to the controller of the current action. For example:
 254
 255     # in Controller::Foo::Bar
 256     $c->namespace; # returns 'foo/bar';
 257
 258 =head2 $c->request
 259
 260 =head2 $c->req
 261
 262 Returns the current L<Catalyst::Request> object, giving access to
 263 information about the current client request (including parameters,
 264 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
 265
 266 =head2 REQUEST FLOW HANDLING
 267
 268 =head2 $c->forward( $action [, \@arguments ] )
 269
 270 =head2 $c->forward( $class, $method, [, \@arguments ] )
 271
 272 Forwards processing to another action, by its private name. If you give a
 273 class name but no method, C<process()> is called. You may also optionally
 274 pass arguments in an arrayref. The action will receive the arguments in
 275 C<@_> and C<< $c->req->args >>. Upon returning from the function,
 276 C<< $c->req->args >> will be restored to the previous values.
 277
 278 Any data C<return>ed from the action forwarded to, will be returned by the
 279 call to forward.
 280
 281     my $foodata = $c->forward('/foo');
 282     $c->forward('index');
 283     $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
 284     $c->forward('MyApp::View::TT');
 285
 286 Note that forward implies an C<<eval { }>> around the call (actually
 287 C<execute> does), thus de-fatalizing all 'dies' within the called
 288 action. If you want C<die> to propagate you need to do something like:
 289
 290     $c->forward('foo');
 291     die $c->error if $c->error;
 292
 293 Or make sure to always return true values from your actions and write
 294 your code like this:
 295
 296     $c->forward('foo') || return;
 297
 298 =cut
 299
 300 sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
 301
 302 =head2 $c->detach( $action [, \@arguments ] )
 303
 304 =head2 $c->detach( $class, $method, [, \@arguments ] )
 305
 306 =head2 $c->detach()
 307
 308 The same as C<forward>, but doesn't return to the previous action when
 309 processing is finished.
 310
 311 When called with no arguments it escapes the processing chain entirely.
 312
 313 =cut
 314
 315 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
 316
 317 =head2 $c->response
 318
 319 =head2 $c->res
 320
 321 Returns the current L<Catalyst::Response> object, see there for details.
 322
 323 =head2 $c->stash
 324
 325 Returns a hashref to the stash, which may be used to store data and pass
 326 it between components during a request. You can also set hash keys by
 327 passing arguments. The stash is automatically sent to the view. The
 328 stash is cleared at the end of a request; it cannot be used for
 329 persistent storage (for this you must use a session; see
 330 L<Catalyst::Plugin::Session> for a complete system integrated with
 331 Catalyst).
 332
 333     $c->stash->{foo} = $bar;
 334     $c->stash( { moose => 'majestic', qux => 0 } );
 335     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
 336
 337     # stash is automatically passed to the view for use in a template
 338     $c->forward( 'MyApp::View::TT' );
 339
 340 =cut
 341
 342 sub stash {
 343     my $c = shift;
 344     if (@_) {
 345         my $stash = @_ > 1 ? {@_} : $_[0];
 346         croak('stash takes a hash or hashref') unless ref $stash;
 347         foreach my $key ( keys %$stash ) {
 348             $c->{stash}->{$key} = $stash->{$key};
 349         }
 350     }
 351     return $c->{stash};
 352 }
 353
 354 =head2 $c->error
 355
 356 =head2 $c->error($error, ...)
 357
 358 =head2 $c->error($arrayref)
 359
 360 Returns an arrayref containing error messages.  If Catalyst encounters an
 361 error while processing a request, it stores the error in $c->error.  This
 362 method should only be used to store fatal error messages.
 363
 364     my @error = @{ $c->error };
 365
 366 Add a new error.
 367
 368     $c->error('Something bad happened');
 369
 370 =cut
 371
 372 sub error {
 373     my $c = shift;
 374     if ( $_[0] ) {
 375         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
 376         croak @$error unless ref $c;
 377         push @{ $c->{error} }, @$error;
 378     }
 379     elsif ( defined $_[0] ) { $c->{error} = undef }
 380     return $c->{error} || [];
 381 }
 382
 383
 384 =head2 $c->state
 385
 386 Contains the return value of the last executed action.
 387
 388 =head2 $c->clear_errors
 389
 390 Clear errors.  You probably don't want to clear the errors unless you are
 391 implementing a custom error screen.
 392
 393 This is equivalent to running
 394
 395     $c->error(0);
 396
 397 =cut
 398
 399 sub clear_errors {
 400     my $c = shift;
 401     $c->error(0);
 402 }
 403
 404
 405 # search via regex
 406 sub _comp_search {
 407     my ( $c, @names ) = @_;
 408
 409     foreach my $name (@names) {
 410         foreach my $component ( keys %{ $c->components } ) {
 411             return $c->components->{$component} if $component =~ /$name/i;
 412         }
 413     }
 414
 415     return undef;
 416 }
 417
 418 # try explicit component names
 419 sub _comp_explicit {
 420     my ( $c, @names ) = @_;
 421
 422     foreach my $try (@names) {
 423         return $c->components->{$try} if ( exists $c->components->{$try} );
 424     }
 425
 426     return undef;
 427 }
 428
 429 # like component, but try just these prefixes before regex searching,
 430 #  and do not try to return "sort keys %{ $c->components }"
 431 sub _comp_prefixes {
 432     my ( $c, $name, @prefixes ) = @_;
 433
 434     my $appclass = ref $c || $c;
 435
 436     my @names = map { "${appclass}::${_}::${name}" } @prefixes;
 437
 438     my $comp = $c->_comp_explicit(@names);
 439     return $comp if defined($comp);
 440     $comp = $c->_comp_search($name);
 441     return $comp;
 442 }
 443
 444 # Find possible names for a prefix
 445
 446 sub _comp_names {
 447     my ( $c, @prefixes ) = @_;
 448
 449     my $appclass = ref $c || $c;
 450
 451     my @pre = map { "${appclass}::${_}::" } @prefixes;
 452
 453     my @names;
 454
 455     COMPONENT: foreach my $comp ($c->component) {
 456         foreach my $p (@pre) {
 457             if ($comp =~ s/^$p//) {
 458                 push(@names, $comp);
 459                 next COMPONENT;
 460             }
 461         }
 462     }
 463
 464     return @names;
 465 }
 466
 467 # Return a component if only one matches.
 468 sub _comp_singular {
 469     my ( $c, @prefixes ) = @_;
 470
 471     my $appclass = ref $c || $c;
 472
 473     my ( $comp, $rest ) =
 474       map { $c->_comp_search("^${appclass}::${_}::") } @prefixes;
 475     return $comp unless $rest;
 476 }
 477
 478 # Filter a component before returning by calling ACCEPT_CONTEXT if available
 479 sub _filter_component {
 480     my ( $c, $comp, @args ) = @_;
 481     if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
 482         return $comp->ACCEPT_CONTEXT( $c, @args );
 483     }
 484     else { return $comp }
 485 }
 486
 487 =head2 COMPONENT ACCESSORS
 488
 489 =head2 $c->controller($name)
 490
 491 Gets a L<Catalyst::Controller> instance by name.
 492
 493     $c->controller('Foo')->do_stuff;
 494
 495 If the name is omitted, will return the controller for the dispatched
 496 action.
 497
 498 =cut
 499
 500 sub controller {
 501     my ( $c, $name, @args ) = @_;
 502     return $c->_filter_component( $c->_comp_prefixes( $name, qw/Controller C/ ),
 503         @args )
 504       if ($name);
 505     return $c->component( $c->action->class );
 506 }
 507
 508 =head2 $c->model($name)
 509
 510 Gets a L<Catalyst::Model> instance by name.
 511
 512     $c->model('Foo')->do_stuff;
 513
 514 If the name is omitted, it will look for
 515  - a model object in $c->stash{current_model_instance}, then
 516  - a model name in $c->stash->{current_model}, then
 517  - a config setting 'default_model', or
 518  - check if there is only one model, and return it if that's the case.
 519
 520 =cut
 521
 522 sub model {
 523     my ( $c, $name, @args ) = @_;
 524     return $c->_filter_component( $c->_comp_prefixes( $name, qw/Model M/ ),
 525         @args )
 526       if $name;
 527     if (ref $c) {
 528         return $c->stash->{current_model_instance}
 529           if $c->stash->{current_model_instance};
 530         return $c->model( $c->stash->{current_model} )
 531           if $c->stash->{current_model};
 532         return $c->model( $c->config->{default_model} )
 533           if $c->config->{default_model};
 534     }
 535     return $c->_filter_component( $c->_comp_singular(qw/Model M/), @args );
 536
 537 }
 538
 539 =head2 $c->controllers
 540
 541 Returns the available names which can be passed to $c->controller
 542
 543 =cut
 544
 545 sub controllers {
 546     my ( $c ) = @_;
 547     return $c->_comp_names(qw/Controller C/);
 548 }
 549
 550
 551 =head2 $c->view($name)
 552
 553 Gets a L<Catalyst::View> instance by name.
 554
 555     $c->view('Foo')->do_stuff;
 556
 557 If the name is omitted, it will look for
 558  - a view object in $c->stash{current_view_instance}, then
 559  - a view name in $c->stash->{current_view}, then
 560  - a config setting 'default_view', or
 561  - check if there is only one view, and return it if that's the case.
 562
 563 =cut
 564
 565 sub view {
 566     my ( $c, $name, @args ) = @_;
 567     return $c->_filter_component( $c->_comp_prefixes( $name, qw/View V/ ),
 568         @args )
 569       if $name;
 570     if (ref $c) {
 571         return $c->stash->{current_view_instance}
 572           if $c->stash->{current_view_instance};
 573         return $c->view( $c->stash->{current_view} )
 574           if $c->stash->{current_view};
 575         return $c->view( $c->config->{default_view} )
 576           if $c->config->{default_view};
 577     }
 578     return $c->_filter_component( $c->_comp_singular(qw/View V/) );
 579 }
 580
 581 =head2 $c->models
 582
 583 Returns the available names which can be passed to $c->model
 584
 585 =cut
 586
 587 sub models {
 588     my ( $c ) = @_;
 589     return $c->_comp_names(qw/Model M/);
 590 }
 591
 592
 593 =head2 $c->views
 594
 595 Returns the available names which can be passed to $c->view
 596
 597 =cut
 598
 599 sub views {
 600     my ( $c ) = @_;
 601     return $c->_comp_names(qw/View V/);
 602 }
 603
 604 =head2 $c->comp($name)
 605
 606 =head2 $c->component($name)
 607
 608 Gets a component object by name. This method is not recommended,
 609 unless you want to get a specific component by full
 610 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
 611 should be used instead.
 612
 613 =cut
 614
 615 sub component {
 616     my $c = shift;
 617
 618     if (@_) {
 619
 620         my $name = shift;
 621
 622         my $appclass = ref $c || $c;
 623
 624         my @names = (
 625             $name, "${appclass}::${name}",
 626             map { "${appclass}::${_}::${name}" }
 627               qw/Model M Controller C View V/
 628         );
 629
 630         my $comp = $c->_comp_explicit(@names);
 631         return $c->_filter_component( $comp, @_ ) if defined($comp);
 632
 633         $comp = $c->_comp_search($name);
 634         return $c->_filter_component( $comp, @_ ) if defined($comp);
 635     }
 636
 637     return sort keys %{ $c->components };
 638 }
 639
 640
 641
 642 =head2 CLASS DATA AND HELPER CLASSES
 643
 644 =head2 $c->config
 645
 646 Returns or takes a hashref containing the application's configuration.
 647
 648     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
 649
 650 You can also use a C<YAML>, C<XML> or C<Config::General> config file
 651 like myapp.yml in your applications home directory. See
 652 L<Catalyst::Plugin::ConfigLoader>.
 653
 654     ---
 655     db: dsn:SQLite:foo.db
 656
 657
 658 =cut
 659
 660 sub config {
 661     my $c = shift;
 662
 663     $c->log->warn("Setting config after setup has been run is not a good idea.")
 664       if ( @_ and $c->setup_finished );
 665
 666     $c->NEXT::config(@_);
 667 }
 668
 669 =head2 $c->log
 670
 671 Returns the logging object instance. Unless it is already set, Catalyst
 672 sets this up with a L<Catalyst::Log> object. To use your own log class,
 673 set the logger with the C<< __PACKAGE__->log >> method prior to calling
 674 C<< __PACKAGE__->setup >>.
 675
 676  __PACKAGE__->log( MyLogger->new );
 677  __PACKAGE__->setup;
 678
 679 And later:
 680
 681     $c->log->info( 'Now logging with my own logger!' );
 682
 683 Your log class should implement the methods described in
 684 L<Catalyst::Log>.
 685
 686
 687 =head2 $c->debug
 688
 689 Overload to enable debug messages (same as -Debug option).
 690
 691 Note that this is a static method, not an accessor and should be overloaded
 692 by declaring "sub debug { 1 }" in your MyApp.pm, not by calling $c->debug(1).
 693
 694 =cut
 695
 696 sub debug { 0 }
 697
 698 =head2 $c->dispatcher
 699
 700 Returns the dispatcher instance. Stringifies to class name. See
 701 L<Catalyst::Dispatcher>.
 702
 703 =head2 $c->engine
 704
 705 Returns the engine instance. Stringifies to the class name. See
 706 L<Catalyst::Engine>.
 707
 708
 709 =head2 UTILITY METHODS
 710
 711 =head2 $c->path_to(@path)
 712
 713 Merges C<@path> with C<< $c->config->{home} >> and returns a
 714 L<Path::Class::Dir> object.
 715
 716 For example:
 717
 718     $c->path_to( 'db', 'sqlite.db' );
 719
 720 =cut
 721
 722 sub path_to {
 723     my ( $c, @path ) = @_;
 724     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
 725     if ( -d $path ) { return $path }
 726     else { return Path::Class::File->new( $c->config->{home}, @path ) }
 727 }
 728
 729 =head2 $c->plugin( $name, $class, @args )
 730
 731 Helper method for plugins. It creates a classdata accessor/mutator and
 732 loads and instantiates the given class.
 733
 734     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 735
 736     $c->prototype->define_javascript_functions;
 737
 738 =cut
 739
 740 sub plugin {
 741     my ( $class, $name, $plugin, @args ) = @_;
 742     $class->_register_plugin( $plugin, 1 );
 743
 744     eval { $plugin->import };
 745     $class->mk_classdata($name);
 746     my $obj;
 747     eval { $obj = $plugin->new(@args) };
 748
 749     if ($@) {
 750         Catalyst::Exception->throw( message =>
 751               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
 752     }
 753
 754     $class->$name($obj);
 755     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 756       if $class->debug;
 757 }
 758
 759 =head2 MyApp->setup
 760
 761 Initializes the dispatcher and engine, loads any plugins, and loads the
 762 model, view, and controller components. You may also specify an array
 763 of plugins to load here, if you choose to not load them in the C<use
 764 Catalyst> line.
 765
 766     MyApp->setup;
 767     MyApp->setup( qw/-Debug/ );
 768
 769 =cut
 770
 771 sub setup {
 772     my ( $class, @arguments ) = @_;
 773
 774     $class->log->warn("Running setup twice is not a good idea.")
 775       if ( $class->setup_finished );
 776
 777     unless ( $class->isa('Catalyst') ) {
 778
 779         Catalyst::Exception->throw(
 780             message => qq/'$class' does not inherit from Catalyst/ );
 781     }
 782
 783     if ( $class->arguments ) {
 784         @arguments = ( @arguments, @{ $class->arguments } );
 785     }
 786
 787     # Process options
 788     my $flags = {};
 789
 790     foreach (@arguments) {
 791
 792         if (/^-Debug$/) {
 793             $flags->{log} =
 794               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
 795         }
 796         elsif (/^-(\w+)=?(.*)$/) {
 797             $flags->{ lc $1 } = $2;
 798         }
 799         else {
 800             push @{ $flags->{plugins} }, $_;
 801         }
 802     }
 803
 804     $class->setup_home( delete $flags->{home} );
 805
 806     $class->setup_log( delete $flags->{log} );
 807     $class->setup_plugins( delete $flags->{plugins} );
 808     $class->setup_dispatcher( delete $flags->{dispatcher} );
 809     $class->setup_engine( delete $flags->{engine} );
 810
 811     for my $flag ( sort keys %{$flags} ) {
 812
 813         if ( my $code = $class->can( 'setup_' . $flag ) ) {
 814             &$code( $class, delete $flags->{$flag} );
 815         }
 816         else {
 817             $class->log->warn(qq/Unknown flag "$flag"/);
 818         }
 819     }
 820
 821     eval { require Catalyst::Devel; };
 822     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
 823         $class->log->warn(<<"EOF");
 824 You are running an old script!
 825
 826   Please update by running (this will overwrite existing files):
 827     catalyst.pl -force -scripts $class
 828
 829   or (this will not overwrite existing files):
 830     catalyst.pl -scripts $class
 831
 832 EOF
 833     }
 834
 835     if ( $class->debug ) {
 836         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
 837
 838         if (@plugins) {
 839             my $t = Text::SimpleTable->new(74);
 840             $t->row($_) for @plugins;
 841             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
 842         }
 843
 844         my $dispatcher = $class->dispatcher;
 845         my $engine     = $class->engine;
 846         my $home       = $class->config->{home};
 847
 848         $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
 849         $class->log->debug(qq/Loaded engine "$engine"/);
 850
 851         $home
 852           ? ( -d $home )
 853           ? $class->log->debug(qq/Found home "$home"/)
 854           : $class->log->debug(qq/Home "$home" doesn't exist/)
 855           : $class->log->debug(q/Couldn't find home/);
 856     }
 857
 858     # Call plugins setup
 859     {
 860         no warnings qw/redefine/;
 861         local *setup = sub { };
 862         $class->setup;
 863     }
 864
 865     # Initialize our data structure
 866     $class->components( {} );
 867
 868     $class->setup_components;
 869
 870     if ( $class->debug ) {
 871         my $t = Text::SimpleTable->new( [ 63, 'Class' ], [ 8, 'Type' ] );
 872         for my $comp ( sort keys %{ $class->components } ) {
 873             my $type = ref $class->components->{$comp} ? 'instance' : 'class';
 874             $t->row( $comp, $type );
 875         }
 876         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
 877           if ( keys %{ $class->components } );
 878     }
 879
 880     # Add our self to components, since we are also a component
 881     $class->components->{$class} = $class;
 882
 883     $class->setup_actions;
 884
 885     if ( $class->debug ) {
 886         my $name = $class->config->{name} || 'Application';
 887         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
 888     }
 889     $class->log->_flush() if $class->log->can('_flush');
 890
 891     $class->setup_finished(1);
 892 }
 893
 894 =head2 $c->uri_for( $path, @args?, \%query_values? )
 895
 896 Merges path with C<< $c->request->base >> for absolute URIs and with
 897 C<< $c->namespace >> for relative URIs, then returns a normalized L<URI>
 898 object. If any args are passed, they are added at the end of the path.
 899 If the last argument to C<uri_for> is a hash reference, it is assumed to
 900 contain GET parameter key/value pairs, which will be appended to the URI
 901 in standard fashion.
 902
 903 Instead of C<$path>, you can also optionally pass a C<$action> object
 904 which will be resolved to a path using
 905 C<< $c->dispatcher->uri_for_action >>; if the first element of
 906 C<@args> is an arrayref it is treated as a list of captures to be passed
 907 to C<uri_for_action>.
 908
 909 =cut
 910
 911 sub uri_for {
 912     my ( $c, $path, @args ) = @_;
 913     my $base     = $c->request->base->clone;
 914     my $basepath = $base->path;
 915     $basepath =~ s/\/$//;
 916     $basepath .= '/';
 917     my $namespace = $c->namespace || '';
 918
 919     if ( Scalar::Util::blessed($path) ) { # action object
 920         my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
 921                          ? shift(@args)
 922                          : [] );
 923         $path = $c->dispatcher->uri_for_action($path, $captures);
 924         return undef unless defined($path);
 925         $path = '/' if $path eq '';
 926     }
 927
 928     # massage namespace, empty if absolute path
 929     $namespace =~ s/^\/// if $namespace;
 930     $namespace .= '/' if $namespace;
 931     $path ||= '';
 932     $namespace = '' if $path =~ /^\//;
 933     $path =~ s/^\///;
 934     $path =~ s/\?/%3F/g;
 935
 936     my $params =
 937       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
 938
 939     for my $value ( values %$params ) {
 940         next unless defined $value;
 941         for ( ref $value eq 'ARRAY' ? @$value : $value ) {
 942             $_ = "$_";
 943             utf8::encode( $_ );
 944         }
 945     };
 946
 947     # join args with '/', or a blank string
 948     my $args = ( scalar @args ? '/' . join( '/', map {s/\?/%3F/g; $_} @args ) : '' );
 949     $args =~ s/^\/// unless $path;
 950     my $res =
 951       URI->new_abs( URI->new_abs( "$path$args", "$basepath$namespace" ), $base )
 952       ->canonical;
 953     $res->query_form(%$params);
 954     $res;
 955 }
 956
 957 =head2 $c->welcome_message
 958
 959 Returns the Catalyst welcome HTML page.
 960
 961 =cut
 962
 963 sub welcome_message {
 964     my $c      = shift;
 965     my $name   = $c->config->{name};
 966     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
 967     my $prefix = Catalyst::Utils::appprefix( ref $c );
 968     $c->response->content_type('text/html; charset=utf-8');
 969     return <<"EOF";
 970 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 971     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
 972 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
 973     <head>
 974         <meta http-equiv="Content-Language" content="en" />
 975         <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
 976         <title>$name on Catalyst $VERSION</title>
 977         <style type="text/css">
 978             body {
 979                 color: #000;
 980                 background-color: #eee;
 981             }
 982             div#content {
 983                 width: 640px;
 984                 margin-left: auto;
 985                 margin-right: auto;
 986                 margin-top: 10px;
 987                 margin-bottom: 10px;
 988                 text-align: left;
 989                 background-color: #ccc;
 990                 border: 1px solid #aaa;
 991             }
 992             p, h1, h2 {
 993                 margin-left: 20px;
 994                 margin-right: 20px;
 995                 font-family: verdana, tahoma, sans-serif;
 996             }
 997             a {
 998                 font-family: verdana, tahoma, sans-serif;
 999             }
1000             :link, :visited {
1001                     text-decoration: none;
1002                     color: #b00;
1003                     border-bottom: 1px dotted #bbb;
1004             }
1005             :link:hover, :visited:hover {
1006                     color: #555;
1007             }
1008             div#topbar {
1009                 margin: 0px;
1010             }
1011             pre {
1012                 margin: 10px;
1013                 padding: 8px;
1014             }
1015             div#answers {
1016                 padding: 8px;
1017                 margin: 10px;
1018                 background-color: #fff;
1019                 border: 1px solid #aaa;
1020             }
1021             h1 {
1022                 font-size: 0.9em;
1023                 font-weight: normal;
1024                 text-align: center;
1025             }
1026             h2 {
1027                 font-size: 1.0em;
1028             }
1029             p {
1030                 font-size: 0.9em;
1031             }
1032             p img {
1033                 float: right;
1034                 margin-left: 10px;
1035             }
1036             span#appname {
1037                 font-weight: bold;
1038                 font-size: 1.6em;
1039             }
1040         </style>
1041     </head>
1042     <body>
1043         <div id="content">
1044             <div id="topbar">
1045                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1046                     $VERSION</h1>
1047              </div>
1048              <div id="answers">
1049                  <p>
1050                  <img src="$logo" alt="Catalyst Logo" />
1051                  </p>
1052                  <p>Welcome to the  world of Catalyst.
1053                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1054                     framework will make web development something you had
1055                     never expected it to be: Fun, rewarding, and quick.</p>
1056                  <h2>What to do now?</h2>
1057                  <p>That really depends  on what <b>you</b> want to do.
1058                     We do, however, provide you with a few starting points.</p>
1059                  <p>If you want to jump right into web development with Catalyst
1060                     you might want want to start with a tutorial.</p>
1061 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1062 </pre>
1063 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1064 <pre>
1065 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1066 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1067 </code></pre>
1068                  <h2>What to do next?</h2>
1069                  <p>Next it's time to write an actual application. Use the
1070                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
1071                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1072                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
1073                     they can save you a lot of work.</p>
1074                     <pre><code>script/${prefix}_create.pl -help</code></pre>
1075                     <p>Also, be sure to check out the vast and growing
1076                     collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&amp;mode=all">plugins for Catalyst on CPAN</a>;
1077                     you are likely to find what you need there.
1078                     </p>
1079
1080                  <h2>Need help?</h2>
1081                  <p>Catalyst has a very active community. Here are the main places to
1082                     get in touch with us.</p>
1083                  <ul>
1084                      <li>
1085                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1086                      </li>
1087                      <li>
1088                          <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
1089                      </li>
1090                      <li>
1091                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1092                      </li>
1093                  </ul>
1094                  <h2>In conclusion</h2>
1095                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1096                     as we enjoyed making it. Please contact us if you have ideas
1097                     for improvement or other feedback.</p>
1098              </div>
1099          </div>
1100     </body>
1101 </html>
1102 EOF
1103 }
1104
1105 =head1 INTERNAL METHODS
1106
1107 These methods are not meant to be used by end users.
1108
1109 =head2 $c->components
1110
1111 Returns a hash of components.
1112
1113 =head2 $c->context_class
1114
1115 Returns or sets the context class.
1116
1117 =head2 $c->counter
1118
1119 Returns a hashref containing coderefs and execution counts (needed for
1120 deep recursion detection).
1121
1122 =head2 $c->depth
1123
1124 Returns the number of actions on the current internal execution stack.
1125
1126 =head2 $c->dispatch
1127
1128 Dispatches a request to actions.
1129
1130 =cut
1131
1132 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1133
1134 =head2 $c->dispatcher_class
1135
1136 Returns or sets the dispatcher class.
1137
1138 =head2 $c->dump_these
1139
1140 Returns a list of 2-element array references (name, structure) pairs
1141 that will be dumped on the error page in debug mode.
1142
1143 =cut
1144
1145 sub dump_these {
1146     my $c = shift;
1147     [ Request => $c->req ],
1148     [ Response => $c->res ],
1149     [ Stash => $c->stash ],
1150     [ Config => $c->config ];
1151 }
1152
1153 =head2 $c->engine_class
1154
1155 Returns or sets the engine class.
1156
1157 =head2 $c->execute( $class, $coderef )
1158
1159 Execute a coderef in given class and catch exceptions. Errors are available
1160 via $c->error.
1161
1162 =cut
1163
1164 sub execute {
1165     my ( $c, $class, $code ) = @_;
1166     $class = $c->component($class) || $class;
1167     $c->state(0);
1168
1169     if ( $c->depth >= $RECURSION ) {
1170         my $action = "$code";
1171         $action = "/$action" unless $action =~ /->/;
1172         my $error = qq/Deep recursion detected calling "$action"/;
1173         $c->log->error($error);
1174         $c->error($error);
1175         $c->state(0);
1176         return $c->state;
1177     }
1178
1179     my $stats_info = $c->_stats_start_execute( $code ) if $c->debug;
1180
1181     push( @{ $c->stack }, $code );
1182
1183     eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
1184
1185     $c->_stats_finish_execute( $stats_info ) if $c->debug and $stats_info;
1186
1187     my $last = pop( @{ $c->stack } );
1188
1189     if ( my $error = $@ ) {
1190         if ( !ref($error) and $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
1191         else {
1192             unless ( ref $error ) {
1193                 no warnings 'uninitialized';
1194                 chomp $error;
1195                 my $class = $last->class;
1196                 my $name  = $last->name;
1197                 $error = qq/Caught exception in $class->$name "$error"/;
1198             }
1199             $c->error($error);
1200             $c->state(0);
1201         }
1202     }
1203     return $c->state;
1204 }
1205
1206 sub _stats_start_execute {
1207     my ( $c, $code ) = @_;
1208
1209     return if ( ( $code->name =~ /^_.*/ )
1210         && ( !$c->config->{show_internal_actions} ) );
1211
1212     $c->counter->{"$code"}++;
1213
1214     my $action = "$code";
1215     $action = "/$action" unless $action =~ /->/;
1216
1217     # determine if the call was the result of a forward
1218     # this is done by walking up the call stack and looking for a calling
1219     # sub of Catalyst::forward before the eval
1220     my $callsub = q{};
1221     for my $index ( 2 .. 11 ) {
1222         last
1223         if ( ( caller($index) )[0] eq 'Catalyst'
1224             && ( caller($index) )[3] eq '(eval)' );
1225
1226         if ( ( caller($index) )[3] =~ /forward$/ ) {
1227             $callsub = ( caller($index) )[3];
1228             $action  = "-> $action";
1229             last;
1230         }
1231     }
1232
1233     my $node = Tree::Simple->new(
1234         {
1235             action  => $action,
1236             elapsed => undef,     # to be filled in later
1237             comment => "",
1238         }
1239     );
1240     $node->setUID( "$code" . $c->counter->{"$code"} );
1241
1242     # is this a root-level call or a forwarded call?
1243     if ( $callsub =~ /forward$/ ) {
1244
1245         # forward, locate the caller
1246         if ( my $parent = $c->stack->[-1] ) {
1247             my $visitor = Tree::Simple::Visitor::FindByUID->new;
1248             $visitor->searchForUID(
1249                 "$parent" . $c->counter->{"$parent"} );
1250             $c->stats->accept($visitor);
1251             if ( my $result = $visitor->getResult ) {
1252                 $result->addChild($node);
1253             }
1254         }
1255         else {
1256
1257             # forward with no caller may come from a plugin
1258             $c->stats->addChild($node);
1259         }
1260     }
1261     else {
1262
1263         # root-level call
1264         $c->stats->addChild($node);
1265     }
1266
1267     return {
1268         start   => [gettimeofday],
1269         node    => $node,
1270     };
1271 }
1272
1273 sub _stats_finish_execute {
1274     my ( $c, $info ) = @_;
1275     my $elapsed = tv_interval $info->{start};
1276     my $value = $info->{node}->getNodeValue;
1277     $value->{elapsed} = sprintf( '%fs', $elapsed );
1278 }
1279
1280 =head2 $c->_localize_fields( sub { }, \%keys );
1281
1282 =cut
1283
1284 sub _localize_fields {
1285     my ( $c, $localized, $code ) = ( @_ );
1286
1287     my $request = delete $localized->{request} || {};
1288     my $response = delete $localized->{response} || {};
1289
1290     local @{ $c }{ keys %$localized } = values %$localized;
1291     local @{ $c->request }{ keys %$request } = values %$request;
1292     local @{ $c->response }{ keys %$response } = values %$response;
1293
1294     $code->();
1295 }
1296
1297 =head2 $c->finalize
1298
1299 Finalizes the request.
1300
1301 =cut
1302
1303 sub finalize {
1304     my $c = shift;
1305
1306     for my $error ( @{ $c->error } ) {
1307         $c->log->error($error);
1308     }
1309
1310     # Allow engine to handle finalize flow (for POE)
1311     if ( $c->engine->can('finalize') ) {
1312         $c->engine->finalize($c);
1313     }
1314     else {
1315
1316         $c->finalize_uploads;
1317
1318         # Error
1319         if ( $#{ $c->error } >= 0 ) {
1320             $c->finalize_error;
1321         }
1322
1323         $c->finalize_headers;
1324
1325         # HEAD request
1326         if ( $c->request->method eq 'HEAD' ) {
1327             $c->response->body('');
1328         }
1329
1330         $c->finalize_body;
1331     }
1332
1333     if ($c->debug) {
1334         my $elapsed = sprintf '%f', tv_interval($c->stats->getNodeValue);
1335         my $av = sprintf '%.3f', ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
1336
1337         my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
1338         $c->stats->traverse(
1339             sub {
1340                 my $action = shift;
1341                 my $stat   = $action->getNodeValue;
1342                 $t->row( ( q{ } x $action->getDepth ) . $stat->{action} . $stat->{comment},
1343                     $stat->{elapsed} || '??' );
1344             }
1345         );
1346
1347         $c->log->info(
1348             "Request took ${elapsed}s ($av/s)\n" . $t->draw . "\n" );
1349     }
1350
1351     return $c->response->status;
1352 }
1353
1354 =head2 $c->finalize_body
1355
1356 Finalizes body.
1357
1358 =cut
1359
1360 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1361
1362 =head2 $c->finalize_cookies
1363
1364 Finalizes cookies.
1365
1366 =cut
1367
1368 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1369
1370 =head2 $c->finalize_error
1371
1372 Finalizes error.
1373
1374 =cut
1375
1376 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1377
1378 =head2 $c->finalize_headers
1379
1380 Finalizes headers.
1381
1382 =cut
1383
1384 sub finalize_headers {
1385     my $c = shift;
1386
1387     # Check if we already finalized headers
1388     return if $c->response->{_finalized_headers};
1389
1390     # Handle redirects
1391     if ( my $location = $c->response->redirect ) {
1392         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1393         $c->response->header( Location => $location );
1394     }
1395
1396     # Content-Length
1397     if ( $c->response->body && !$c->response->content_length ) {
1398
1399         # get the length from a filehandle
1400         if ( blessed( $c->response->body ) && $c->response->body->can('read') )
1401         {
1402             if ( my $stat = stat $c->response->body ) {
1403                 $c->response->content_length( $stat->size );
1404             }
1405             else {
1406                 $c->log->warn('Serving filehandle without a content-length');
1407             }
1408         }
1409         else {
1410             $c->response->content_length( bytes::length( $c->response->body ) );
1411         }
1412     }
1413
1414     # Errors
1415     if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1416         $c->response->headers->remove_header("Content-Length");
1417         $c->response->body('');
1418     }
1419
1420     $c->finalize_cookies;
1421
1422     $c->engine->finalize_headers( $c, @_ );
1423
1424     # Done
1425     $c->response->{_finalized_headers} = 1;
1426 }
1427
1428 =head2 $c->finalize_output
1429
1430 An alias for finalize_body.
1431
1432 =head2 $c->finalize_read
1433
1434 Finalizes the input after reading is complete.
1435
1436 =cut
1437
1438 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1439
1440 =head2 $c->finalize_uploads
1441
1442 Finalizes uploads. Cleans up any temporary files.
1443
1444 =cut
1445
1446 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1447
1448 =head2 $c->get_action( $action, $namespace )
1449
1450 Gets an action in a given namespace.
1451
1452 =cut
1453
1454 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1455
1456 =head2 $c->get_actions( $action, $namespace )
1457
1458 Gets all actions of a given name in a namespace and all parent
1459 namespaces.
1460
1461 =cut
1462
1463 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1464
1465 =head2 $c->handle_request( $class, @arguments )
1466
1467 Called to handle each HTTP request.
1468
1469 =cut
1470
1471 sub handle_request {
1472     my ( $class, @arguments ) = @_;
1473
1474     # Always expect worst case!
1475     my $status = -1;
1476     eval {
1477         if ($class->debug) {
1478             my $secs = time - $START || 1;
1479             my $av = sprintf '%.3f', $COUNT / $secs;
1480             my $time = localtime time;
1481             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1482         }
1483
1484         my $c = $class->prepare(@arguments);
1485         $c->dispatch;
1486         $status = $c->finalize;
1487     };
1488
1489     if ( my $error = $@ ) {
1490         chomp $error;
1491         $class->log->error(qq/Caught exception in engine "$error"/);
1492     }
1493
1494     $COUNT++;
1495     $class->log->_flush() if $class->log->can('_flush');
1496     return $status;
1497 }
1498
1499 =head2 $c->prepare( @arguments )
1500
1501 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1502 etc.).
1503
1504 =cut
1505
1506 sub prepare {
1507     my ( $class, @arguments ) = @_;
1508
1509     $class->context_class( ref $class || $class ) unless $class->context_class;
1510     my $c = $class->context_class->new(
1511         {
1512             counter => {},
1513             stack   => [],
1514             request => $class->request_class->new(
1515                 {
1516                     arguments        => [],
1517                     body_parameters  => {},
1518                     cookies          => {},
1519                     headers          => HTTP::Headers->new,
1520                     parameters       => {},
1521                     query_parameters => {},
1522                     secure           => 0,
1523                     captures         => [],
1524                     uploads          => {}
1525                 }
1526             ),
1527             response => $class->response_class->new(
1528                 {
1529                     body    => '',
1530                     cookies => {},
1531                     headers => HTTP::Headers->new(),
1532                     status  => 200
1533                 }
1534             ),
1535             stash => {},
1536             state => 0
1537         }
1538     );
1539
1540     if ( $c->debug ) {
1541         $c->stats(Tree::Simple->new([gettimeofday]));
1542         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1543     }
1544
1545     # For on-demand data
1546     $c->request->{_context}  = $c;
1547     $c->response->{_context} = $c;
1548     weaken( $c->request->{_context} );
1549     weaken( $c->response->{_context} );
1550
1551     # Allow engine to direct the prepare flow (for POE)
1552     if ( $c->engine->can('prepare') ) {
1553         $c->engine->prepare( $c, @arguments );
1554     }
1555     else {
1556         $c->prepare_request(@arguments);
1557         $c->prepare_connection;
1558         $c->prepare_query_parameters;
1559         $c->prepare_headers;
1560         $c->prepare_cookies;
1561         $c->prepare_path;
1562
1563         # On-demand parsing
1564         $c->prepare_body unless $c->config->{parse_on_demand};
1565     }
1566
1567     my $method  = $c->req->method  || '';
1568     my $path    = $c->req->path    || '/';
1569     my $address = $c->req->address || '';
1570
1571     $c->log->debug(qq/"$method" request for "$path" from "$address"/)
1572       if $c->debug;
1573
1574     $c->prepare_action;
1575
1576     return $c;
1577 }
1578
1579 =head2 $c->prepare_action
1580
1581 Prepares action. See L<Catalyst::Dispatcher>.
1582
1583 =cut
1584
1585 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1586
1587 =head2 $c->prepare_body
1588
1589 Prepares message body.
1590
1591 =cut
1592
1593 sub prepare_body {
1594     my $c = shift;
1595
1596     # Do we run for the first time?
1597     return if defined $c->request->{_body};
1598
1599     # Initialize on-demand data
1600     $c->engine->prepare_body( $c, @_ );
1601     $c->prepare_parameters;
1602     $c->prepare_uploads;
1603
1604     if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1605         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1606         for my $key ( sort keys %{ $c->req->body_parameters } ) {
1607             my $param = $c->req->body_parameters->{$key};
1608             my $value = defined($param) ? $param : '';
1609             $t->row( $key,
1610                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1611         }
1612         $c->log->debug( "Body Parameters are:\n" . $t->draw );
1613     }
1614 }
1615
1616 =head2 $c->prepare_body_chunk( $chunk )
1617
1618 Prepares a chunk of data before sending it to L<HTTP::Body>.
1619
1620 See L<Catalyst::Engine>.
1621
1622 =cut
1623
1624 sub prepare_body_chunk {
1625     my $c = shift;
1626     $c->engine->prepare_body_chunk( $c, @_ );
1627 }
1628
1629 =head2 $c->prepare_body_parameters
1630
1631 Prepares body parameters.
1632
1633 =cut
1634
1635 sub prepare_body_parameters {
1636     my $c = shift;
1637     $c->engine->prepare_body_parameters( $c, @_ );
1638 }
1639
1640 =head2 $c->prepare_connection
1641
1642 Prepares connection.
1643
1644 =cut
1645
1646 sub prepare_connection {
1647     my $c = shift;
1648     $c->engine->prepare_connection( $c, @_ );
1649 }
1650
1651 =head2 $c->prepare_cookies
1652
1653 Prepares cookies.
1654
1655 =cut
1656
1657 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1658
1659 =head2 $c->prepare_headers
1660
1661 Prepares headers.
1662
1663 =cut
1664
1665 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1666
1667 =head2 $c->prepare_parameters
1668
1669 Prepares parameters.
1670
1671 =cut
1672
1673 sub prepare_parameters {
1674     my $c = shift;
1675     $c->prepare_body_parameters;
1676     $c->engine->prepare_parameters( $c, @_ );
1677 }
1678
1679 =head2 $c->prepare_path
1680
1681 Prepares path and base.
1682
1683 =cut
1684
1685 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1686
1687 =head2 $c->prepare_query_parameters
1688
1689 Prepares query parameters.
1690
1691 =cut
1692
1693 sub prepare_query_parameters {
1694     my $c = shift;
1695
1696     $c->engine->prepare_query_parameters( $c, @_ );
1697
1698     if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1699         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
1700         for my $key ( sort keys %{ $c->req->query_parameters } ) {
1701             my $param = $c->req->query_parameters->{$key};
1702             my $value = defined($param) ? $param : '';
1703             $t->row( $key,
1704                 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1705         }
1706         $c->log->debug( "Query Parameters are:\n" . $t->draw );
1707     }
1708 }
1709
1710 =head2 $c->prepare_read
1711
1712 Prepares the input for reading.
1713
1714 =cut
1715
1716 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1717
1718 =head2 $c->prepare_request
1719
1720 Prepares the engine request.
1721
1722 =cut
1723
1724 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1725
1726 =head2 $c->prepare_uploads
1727
1728 Prepares uploads.
1729
1730 =cut
1731
1732 sub prepare_uploads {
1733     my $c = shift;
1734
1735     $c->engine->prepare_uploads( $c, @_ );
1736
1737     if ( $c->debug && keys %{ $c->request->uploads } ) {
1738         my $t = Text::SimpleTable->new(
1739             [ 12, 'Parameter' ],
1740             [ 26, 'Filename' ],
1741             [ 18, 'Type' ],
1742             [ 9,  'Size' ]
1743         );
1744         for my $key ( sort keys %{ $c->request->uploads } ) {
1745             my $upload = $c->request->uploads->{$key};
1746             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
1747                 $t->row( $key, $u->filename, $u->type, $u->size );
1748             }
1749         }
1750         $c->log->debug( "File Uploads are:\n" . $t->draw );
1751     }
1752 }
1753
1754 =head2 $c->prepare_write
1755
1756 Prepares the output for writing.
1757
1758 =cut
1759
1760 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1761
1762 =head2 $c->request_class
1763
1764 Returns or sets the request class.
1765
1766 =head2 $c->response_class
1767
1768 Returns or sets the response class.
1769
1770 =head2 $c->read( [$maxlength] )
1771
1772 Reads a chunk of data from the request body. This method is designed to
1773 be used in a while loop, reading C<$maxlength> bytes on every call.
1774 C<$maxlength> defaults to the size of the request if not specified.
1775
1776 You have to set C<< MyApp->config->{parse_on_demand} >> to use this
1777 directly.
1778
1779 =cut
1780
1781 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1782
1783 =head2 $c->run
1784
1785 Starts the engine.
1786
1787 =cut
1788
1789 sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1790
1791 =head2 $c->set_action( $action, $code, $namespace, $attrs )
1792
1793 Sets an action in a given namespace.
1794
1795 =cut
1796
1797 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1798
1799 =head2 $c->setup_actions($component)
1800
1801 Sets up actions for a component.
1802
1803 =cut
1804
1805 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1806
1807 =head2 $c->setup_components
1808
1809 Sets up components. Specify a C<setup_components> config option to pass
1810 additional options directly to L<Module::Pluggable>. To add additional
1811 search paths, specify a key named C<search_extra> as an array
1812 reference. Items in the array beginning with C<::> will have the
1813 application class name prepended to them.
1814
1815 =cut
1816
1817 sub setup_components {
1818     my $class = shift;
1819
1820     my @paths   = qw( ::Controller ::C ::Model ::M ::View ::V );
1821     my $config  = $class->config->{ setup_components };
1822     my $extra   = delete $config->{ search_extra } || [];
1823
1824     push @paths, @$extra;
1825
1826     my $locator = Module::Pluggable::Object->new(
1827         search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
1828         %$config
1829     );
1830
1831     for my $component ( sort { length $a <=> length $b } $locator->plugins ) {
1832         Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
1833
1834         my $module  = $class->setup_component( $component );
1835         my %modules = (
1836             $component => $module,
1837             map {
1838                 $_ => $class->setup_component( $_ )
1839             } Devel::InnerPackage::list_packages( $component )
1840         );
1841
1842         for my $key ( keys %modules ) {
1843             $class->components->{ $key } = $modules{ $key };
1844         }
1845     }
1846 }
1847
1848 =head2 $c->setup_component
1849
1850 =cut
1851
1852 sub setup_component {
1853     my( $class, $component ) = @_;
1854
1855     unless ( $component->can( 'COMPONENT' ) ) {
1856         return $component;
1857     }
1858
1859     my $suffix = Catalyst::Utils::class2classsuffix( $component );
1860     my $config = $class->config->{ $suffix } || {};
1861
1862     my $instance = eval { $component->COMPONENT( $class, $config ); };
1863
1864     if ( my $error = $@ ) {
1865         chomp $error;
1866         Catalyst::Exception->throw(
1867             message => qq/Couldn't instantiate component "$component", "$error"/
1868         );
1869     }
1870
1871     Catalyst::Exception->throw(
1872         message =>
1873         qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
1874     ) unless eval { $instance->can( 'can' ) };
1875
1876     return $instance;
1877 }
1878
1879 =head2 $c->setup_dispatcher
1880
1881 Sets up dispatcher.
1882
1883 =cut
1884
1885 sub setup_dispatcher {
1886     my ( $class, $dispatcher ) = @_;
1887
1888     if ($dispatcher) {
1889         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1890     }
1891
1892     if ( $ENV{CATALYST_DISPATCHER} ) {
1893         $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1894     }
1895
1896     if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1897         $dispatcher =
1898           'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1899     }
1900
1901     unless ($dispatcher) {
1902         $dispatcher = $class->dispatcher_class;
1903     }
1904
1905     unless (Class::Inspector->loaded($dispatcher)) {
1906         require Class::Inspector->filename($dispatcher);
1907     }
1908
1909     # dispatcher instance
1910     $class->dispatcher( $dispatcher->new );
1911 }
1912
1913 =head2 $c->setup_engine
1914
1915 Sets up engine.
1916
1917 =cut
1918
1919 sub setup_engine {
1920     my ( $class, $engine ) = @_;
1921
1922     if ($engine) {
1923         $engine = 'Catalyst::Engine::' . $engine;
1924     }
1925
1926     if ( $ENV{CATALYST_ENGINE} ) {
1927         $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1928     }
1929
1930     if ( $ENV{ uc($class) . '_ENGINE' } ) {
1931         $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1932     }
1933
1934     if ( $ENV{MOD_PERL} ) {
1935
1936         # create the apache method
1937         {
1938             no strict 'refs';
1939             *{"$class\::apache"} = sub { shift->engine->apache };
1940         }
1941
1942         my ( $software, $version ) =
1943           $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1944
1945         $version =~ s/_//g;
1946         $version =~ s/(\.[^.]+)\./$1/g;
1947
1948         if ( $software eq 'mod_perl' ) {
1949
1950             if ( !$engine ) {
1951
1952                 if ( $version >= 1.99922 ) {
1953                     $engine = 'Catalyst::Engine::Apache2::MP20';
1954                 }
1955
1956                 elsif ( $version >= 1.9901 ) {
1957                     $engine = 'Catalyst::Engine::Apache2::MP19';
1958                 }
1959
1960                 elsif ( $version >= 1.24 ) {
1961                     $engine = 'Catalyst::Engine::Apache::MP13';
1962                 }
1963
1964                 else {
1965                     Catalyst::Exception->throw( message =>
1966                           qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1967                 }
1968
1969             }
1970
1971             # install the correct mod_perl handler
1972             if ( $version >= 1.9901 ) {
1973                 *handler = sub  : method {
1974                     shift->handle_request(@_);
1975                 };
1976             }
1977             else {
1978                 *handler = sub ($$) { shift->handle_request(@_) };
1979             }
1980
1981         }
1982
1983         elsif ( $software eq 'Zeus-Perl' ) {
1984             $engine = 'Catalyst::Engine::Zeus';
1985         }
1986
1987         else {
1988             Catalyst::Exception->throw(
1989                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1990         }
1991     }
1992
1993     unless ($engine) {
1994         $engine = $class->engine_class;
1995     }
1996
1997     unless (Class::Inspector->loaded($engine)) {
1998         require Class::Inspector->filename($engine);
1999     }
2000
2001     # check for old engines that are no longer compatible
2002     my $old_engine;
2003     if ( $engine->isa('Catalyst::Engine::Apache')
2004         && !Catalyst::Engine::Apache->VERSION )
2005     {
2006         $old_engine = 1;
2007     }
2008
2009     elsif ( $engine->isa('Catalyst::Engine::Server::Base')
2010         && Catalyst::Engine::Server->VERSION le '0.02' )
2011     {
2012         $old_engine = 1;
2013     }
2014
2015     elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2016         && $engine->VERSION eq '0.01' )
2017     {
2018         $old_engine = 1;
2019     }
2020
2021     elsif ($engine->isa('Catalyst::Engine::Zeus')
2022         && $engine->VERSION eq '0.01' )
2023     {
2024         $old_engine = 1;
2025     }
2026
2027     if ($old_engine) {
2028         Catalyst::Exception->throw( message =>
2029               qq/Engine "$engine" is not supported by this version of Catalyst/
2030         );
2031     }
2032
2033     # engine instance
2034     $class->engine( $engine->new );
2035 }
2036
2037 =head2 $c->setup_home
2038
2039 Sets up the home directory.
2040
2041 =cut
2042
2043 sub setup_home {
2044     my ( $class, $home ) = @_;
2045
2046     if ( $ENV{CATALYST_HOME} ) {
2047         $home = $ENV{CATALYST_HOME};
2048     }
2049
2050     if ( $ENV{ uc($class) . '_HOME' } ) {
2051         $class =~ s/::/_/g;
2052         $home = $ENV{ uc($class) . '_HOME' };
2053     }
2054
2055     unless ($home) {
2056         $home = Catalyst::Utils::home($class);
2057     }
2058
2059     if ($home) {
2060         $class->config->{home} ||= $home;
2061         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2062     }
2063 }
2064
2065 =head2 $c->setup_log
2066
2067 Sets up log.
2068
2069 =cut
2070
2071 sub setup_log {
2072     my ( $class, $debug ) = @_;
2073
2074     unless ( $class->log ) {
2075         $class->log( Catalyst::Log->new );
2076     }
2077
2078     my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
2079
2080     if (
2081           ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
2082         ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
2083         : $debug
2084       )
2085     {
2086         no strict 'refs';
2087         *{"$class\::debug"} = sub { 1 };
2088         $class->log->debug('Debug messages enabled');
2089     }
2090 }
2091
2092 =head2 $c->setup_plugins
2093
2094 Sets up plugins.
2095
2096 =cut
2097
2098 =head2 $c->registered_plugins
2099
2100 Returns a sorted list of the plugins which have either been stated in the
2101 import list or which have been added via C<< MyApp->plugin(@args); >>.
2102
2103 If passed a given plugin name, it will report a boolean value indicating
2104 whether or not that plugin is loaded.  A fully qualified name is required if
2105 the plugin name does not begin with C<Catalyst::Plugin::>.
2106
2107  if ($c->registered_plugins('Some::Plugin')) {
2108      ...
2109  }
2110
2111 =cut
2112
2113 {
2114
2115     sub registered_plugins {
2116         my $proto = shift;
2117         return sort keys %{ $proto->_plugins } unless @_;
2118         my $plugin = shift;
2119         return 1 if exists $proto->_plugins->{$plugin};
2120         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2121     }
2122
2123     sub _register_plugin {
2124         my ( $proto, $plugin, $instant ) = @_;
2125         my $class = ref $proto || $proto;
2126
2127         unless (Class::Inspector->loaded($plugin)) {
2128             require Class::Inspector->filename($plugin);
2129         }
2130
2131         $proto->_plugins->{$plugin} = 1;
2132         unless ($instant) {
2133             no strict 'refs';
2134             unshift @{"$class\::ISA"}, $plugin;
2135         }
2136         return $class;
2137     }
2138
2139     sub setup_plugins {
2140         my ( $class, $plugins ) = @_;
2141
2142         $class->_plugins( {} ) unless $class->_plugins;
2143         $plugins ||= [];
2144         for my $plugin ( reverse @$plugins ) {
2145
2146             unless ( $plugin =~ s/\A\+// ) {
2147                 $plugin = "Catalyst::Plugin::$plugin";
2148             }
2149
2150             $class->_register_plugin($plugin);
2151         }
2152     }
2153 }
2154
2155 =head2 $c->stack
2156
2157 Returns an arrayref of the internal execution stack (actions that are
2158 currently executing).
2159
2160 =head2 $c->write( $data )
2161
2162 Writes $data to the output stream. When using this method directly, you
2163 will need to manually set the C<Content-Length> header to the length of
2164 your output data, if known.
2165
2166 =cut
2167
2168 sub write {
2169     my $c = shift;
2170
2171     # Finalize headers if someone manually writes output
2172     $c->finalize_headers;
2173
2174     return $c->engine->write( $c, @_ );
2175 }
2176
2177 =head2 version
2178
2179 Returns the Catalyst version number. Mostly useful for "powered by"
2180 messages in template systems.
2181
2182 =cut
2183
2184 sub version { return $Catalyst::VERSION }
2185
2186 =head1 INTERNAL ACTIONS
2187
2188 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2189 C<_ACTION>, and C<_END>. These are by default not shown in the private
2190 action table, but you can make them visible with a config parameter.
2191
2192     MyApp->config->{show_internal_actions} = 1;
2193
2194 =head1 CASE SENSITIVITY
2195
2196 By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
2197 mapped to C</foo/bar>. You can activate case sensitivity with a config
2198 parameter.
2199
2200     MyApp->config->{case_sensitive} = 1;
2201
2202 This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
2203
2204 =head1 ON-DEMAND PARSER
2205
2206 The request body is usually parsed at the beginning of a request,
2207 but if you want to handle input yourself or speed things up a bit,
2208 you can enable on-demand parsing with a config parameter.
2209
2210     MyApp->config->{parse_on_demand} = 1;
2211
2212 =head1 PROXY SUPPORT
2213
2214 Many production servers operate using the common double-server approach,
2215 with a lightweight frontend web server passing requests to a larger
2216 backend server. An application running on the backend server must deal
2217 with two problems: the remote user always appears to be C<127.0.0.1> and
2218 the server's hostname will appear to be C<localhost> regardless of the
2219 virtual host that the user connected through.
2220
2221 Catalyst will automatically detect this situation when you are running
2222 the frontend and backend servers on the same machine. The following
2223 changes are made to the request.
2224
2225     $c->req->address is set to the user's real IP address, as read from
2226     the HTTP X-Forwarded-For header.
2227
2228     The host value for $c->req->base and $c->req->uri is set to the real
2229     host, as read from the HTTP X-Forwarded-Host header.
2230
2231 Obviously, your web server must support these headers for this to work.
2232
2233 In a more complex server farm environment where you may have your
2234 frontend proxy server(s) on different machines, you will need to set a
2235 configuration option to tell Catalyst to read the proxied data from the
2236 headers.
2237
2238     MyApp->config->{using_frontend_proxy} = 1;
2239
2240 If you do not wish to use the proxy support at all, you may set:
2241
2242     MyApp->config->{ignore_frontend_proxy} = 1;
2243
2244 =head1 THREAD SAFETY
2245
2246 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2247 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2248 believe the Catalyst core to be thread-safe.
2249
2250 If you plan to operate in a threaded environment, remember that all other
2251 modules you are using must also be thread-safe. Some modules, most notably
2252 L<DBD::SQLite>, are not thread-safe.
2253
2254 =head1 SUPPORT
2255
2256 IRC:
2257
2258     Join #catalyst on irc.perl.org.
2259
2260 Mailing Lists:
2261
2262     http://lists.rawmode.org/mailman/listinfo/catalyst
2263     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
2264
2265 Web:
2266
2267     http://catalyst.perl.org
2268
2269 Wiki:
2270
2271     http://dev.catalyst.perl.org
2272
2273 =head1 SEE ALSO
2274
2275 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2276
2277 =head2 L<Catalyst::Manual> - The Catalyst Manual
2278
2279 =head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
2280
2281 =head2 L<Catalyst::Engine> - Core engine
2282
2283 =head2 L<Catalyst::Log> - Log class.
2284
2285 =head2 L<Catalyst::Request> - Request object
2286
2287 =head2 L<Catalyst::Response> - Response object
2288
2289 =head2 L<Catalyst::Test> - The test suite.
2290
2291 =head1 CREDITS
2292
2293 Andy Grundman
2294
2295 Andy Wardley
2296
2297 Andreas Marienborg
2298
2299 Andrew Bramble
2300
2301 Andrew Ford
2302
2303 Andrew Ruthven
2304
2305 Arthur Bergman
2306
2307 Autrijus Tang
2308
2309 Brian Cassidy
2310
2311 Carl Franks
2312
2313 Christian Hansen
2314
2315 Christopher Hicks
2316
2317 Dan Sully
2318
2319 Danijel Milicevic
2320
2321 David Kamholz
2322
2323 David Naughton
2324
2325 Drew Taylor
2326
2327 Gary Ashton Jones
2328
2329 Geoff Richards
2330
2331 Jesse Sheidlower
2332
2333 Jesse Vincent
2334
2335 Jody Belka
2336
2337 Johan Lindstrom
2338
2339 Juan Camacho
2340
2341 Leon Brocard
2342
2343 Marcus Ramberg
2344
2345 Matt S Trout
2346
2347 Robert Sedlacek
2348
2349 Sam Vilain
2350
2351 Sascha Kiefer
2352
2353 Tatsuhiko Miyagawa
2354
2355 Ulf Edvinsson
2356
2357 Yuval Kogman
2358
2359 =head1 AUTHOR
2360
2361 Sebastian Riedel, C<sri@oook.de>
2362
2363 =head1 LICENSE
2364
2365 This library is free software, you can redistribute it and/or modify it under
2366 the same terms as Perl itself.
2367
2368 =cut
2369
2370 1;