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