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