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