prepared for 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
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
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
884 utf8::encode( $_ ) for $isa_ref ? @$value : $value;\r
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;
1085 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
1086}
1087
b5ecfcf0 1088=head2 $c->engine_class
1f9cb7c1 1089
e7f1cf73 1090Returns or sets the engine class.
1f9cb7c1 1091
b5ecfcf0 1092=head2 $c->execute( $class, $coderef )
fbcc39ad 1093
0ef52a96 1094Execute a coderef in given class and catch exceptions. Errors are available
1095via $c->error.
fbcc39ad 1096
1097=cut
1098
1099sub execute {
1100 my ( $c, $class, $code ) = @_;
858828dd 1101 $class = $c->component($class) || $class;
fbcc39ad 1102 $c->state(0);
a0eca838 1103
197bd788 1104 if ( $c->depth >= $RECURSION ) {
1627551a 1105 my $action = "$code";
1106 $action = "/$action" unless $action =~ /\-\>/;
1107 my $error = qq/Deep recursion detected calling "$action"/;
1108 $c->log->error($error);
1109 $c->error($error);
1110 $c->state(0);
1111 return $c->state;
1112 }
1113
7a7d7af5 1114 my $stats_info = $c->_stats_start_execute( $code );
22247e54 1115
8767c5a3 1116 push( @{ $c->stack }, $code );
7a7d7af5 1117
245ae014 1118 eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
22247e54 1119
7a7d7af5 1120 $c->_stats_finish_execute( $stats_info );
1121
f59def82 1122 my $last = ${ $c->stack }[-1];
8767c5a3 1123 pop( @{ $c->stack } );
fbcc39ad 1124
1125 if ( my $error = $@ ) {
28591cd7 1126 if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
fbcc39ad 1127 else {
1128 unless ( ref $error ) {
1129 chomp $error;
f59def82 1130 my $class = $last->class;
1131 my $name = $last->name;
1132 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 1133 }
fbcc39ad 1134 $c->error($error);
1135 $c->state(0);
1136 }
1137 }
1138 return $c->state;
1139}
1140
7a7d7af5 1141sub _stats_start_execute {
1142 my ( $c, $code ) = @_;
1143
1144 return unless $c->debug;
1145
1146 my $action = "$code";
1147
1148 $action = "/$action" unless $action =~ /\-\>/;
1149 $c->counter->{"$code"}++;
1150
1151 # determine if the call was the result of a forward
1152 # this is done by walking up the call stack and looking for a calling
1153 # sub of Catalyst::forward before the eval
1154 my $callsub = q{};
1155 for my $index ( 2 .. 11 ) {
1156 last
1157 if ( ( caller($index) )[0] eq 'Catalyst'
1158 && ( caller($index) )[3] eq '(eval)' );
1159
1160 if ( ( caller($index) )[3] =~ /forward$/ ) {
1161 $callsub = ( caller($index) )[3];
1162 $action = "-> $action";
1163 last;
1164 }
1165 }
1166
1167 my $node = Tree::Simple->new(
1168 {
1169 action => $action,
1170 elapsed => undef, # to be filled in later
1171 comment => "",
1172 }
1173 );
1174 $node->setUID( "$code" . $c->counter->{"$code"} );
1175
1176 unless ( ( $code->name =~ /^_.*/ )
1177 && ( !$c->config->{show_internal_actions} ) )
1178 {
1179 # is this a root-level call or a forwarded call?
1180 if ( $callsub =~ /forward$/ ) {
1181
1182 # forward, locate the caller
1183 if ( my $parent = $c->stack->[-1] ) {
1184 my $visitor = Tree::Simple::Visitor::FindByUID->new;
1185 $visitor->searchForUID(
1186 "$parent" . $c->counter->{"$parent"} );
1187 $c->stats->accept($visitor);
1188 if ( my $result = $visitor->getResult ) {
1189 $result->addChild($node);
1190 }
1191 }
1192 else {
1193
1194 # forward with no caller may come from a plugin
1195 $c->stats->addChild($node);
1196 }
1197 }
1198 else {
1199
1200 # root-level call
1201 $c->stats->addChild($node);
1202 }
1203 }
1204
1205 my $start = [gettimeofday];
1206 my $elapsed = tv_interval($start);
1207
1208 return {
1209 code => $code,
1210 elapsed => $elapsed,
1211 start => $start,
1212 node => $node,
1213 }
1214}
1215
1216sub _stats_finish_execute {
1217 my ( $c, $info ) = @_;
1218
1219 return unless $c->debug;
1220
1221 my ( $code, $start, $elapsed ) = @{ $info }{qw/code start elapsed/};
1222
1223 unless ( ( $code->name =~ /^_.*/ )
1224 && ( !$c->config->{show_internal_actions} ) )
1225 {
1226
1227 # FindByUID uses an internal die, so we save the existing error
1228 my $error = $@;
1229
1230 # locate the node in the tree and update the elapsed time
1231 my $visitor = Tree::Simple::Visitor::FindByUID->new;
1232 $visitor->searchForUID( "$code" . $c->counter->{"$code"} );
1233 $c->stats->accept($visitor);
1234 if ( my $result = $visitor->getResult ) {
1235 my $value = $result->getNodeValue;
1236 $value->{elapsed} = sprintf( '%fs', $elapsed );
1237 $result->setNodeValue($value);
1238 }
1239
1240 # restore error
1241 $@ = $error || undef;
1242 }
1243}
1244
3d0d6d21 1245=head2 $c->_localize_fields( sub { }, \%keys );
1246
1247=cut
1248
1249sub _localize_fields {
1250 my ( $c, $localized, $code ) = ( @_ );
1251
1252 my $request = delete $localized->{request} || {};
1253 my $response = delete $localized->{response} || {};
1254
1255 local @{ $c }{ keys %$localized } = values %$localized;
1256 local @{ $c->request }{ keys %$request } = values %$request;
1257 local @{ $c->response }{ keys %$response } = values %$response;
1258
1259 $code->();
1260}
1261
b5ecfcf0 1262=head2 $c->finalize
fbcc39ad 1263
e7f1cf73 1264Finalizes the request.
fbcc39ad 1265
1266=cut
1267
1268sub finalize {
1269 my $c = shift;
1270
369c09bc 1271 for my $error ( @{ $c->error } ) {
1272 $c->log->error($error);
1273 }
1274
5050d7a7 1275 # Allow engine to handle finalize flow (for POE)
1276 if ( $c->engine->can('finalize') ) {
1277 $c->engine->finalize( $c );
fbcc39ad 1278 }
5050d7a7 1279 else {
fbcc39ad 1280
5050d7a7 1281 $c->finalize_uploads;
fbcc39ad 1282
5050d7a7 1283 # Error
1284 if ( $#{ $c->error } >= 0 ) {
1285 $c->finalize_error;
1286 }
1287
1288 $c->finalize_headers;
fbcc39ad 1289
5050d7a7 1290 # HEAD request
1291 if ( $c->request->method eq 'HEAD' ) {
1292 $c->response->body('');
1293 }
1294
1295 $c->finalize_body;
1296 }
fbcc39ad 1297
1298 return $c->response->status;
1299}
1300
b5ecfcf0 1301=head2 $c->finalize_body
fbcc39ad 1302
e7f1cf73 1303Finalizes body.
fbcc39ad 1304
1305=cut
1306
1307sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1308
b5ecfcf0 1309=head2 $c->finalize_cookies
fbcc39ad 1310
e7f1cf73 1311Finalizes cookies.
fbcc39ad 1312
1313=cut
1314
147821ea 1315sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 1316
b5ecfcf0 1317=head2 $c->finalize_error
fbcc39ad 1318
e7f1cf73 1319Finalizes error.
fbcc39ad 1320
1321=cut
1322
1323sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1324
b5ecfcf0 1325=head2 $c->finalize_headers
fbcc39ad 1326
e7f1cf73 1327Finalizes headers.
fbcc39ad 1328
1329=cut
1330
1331sub finalize_headers {
1332 my $c = shift;
1333
1334 # Check if we already finalized headers
1335 return if $c->response->{_finalized_headers};
1336
1337 # Handle redirects
1338 if ( my $location = $c->response->redirect ) {
1339 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1340 $c->response->header( Location => $location );
1341 }
1342
1343 # Content-Length
1344 if ( $c->response->body && !$c->response->content_length ) {
775878ac 1345
8f62c91a 1346 # get the length from a filehandle
197bd788 1347 if ( blessed( $c->response->body ) && $c->response->body->can('read') )
1348 {
8f62c91a 1349 if ( my $stat = stat $c->response->body ) {
1350 $c->response->content_length( $stat->size );
1351 }
1352 else {
775878ac 1353 $c->log->warn('Serving filehandle without a content-length');
8f62c91a 1354 }
1355 }
1356 else {
775878ac 1357 $c->response->content_length( bytes::length( $c->response->body ) );
8f62c91a 1358 }
fbcc39ad 1359 }
1360
1361 # Errors
1362 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1363 $c->response->headers->remove_header("Content-Length");
1364 $c->response->body('');
1365 }
1366
1367 $c->finalize_cookies;
1368
1369 $c->engine->finalize_headers( $c, @_ );
1370
1371 # Done
1372 $c->response->{_finalized_headers} = 1;
1373}
1374
b5ecfcf0 1375=head2 $c->finalize_output
fbcc39ad 1376
1377An alias for finalize_body.
1378
b5ecfcf0 1379=head2 $c->finalize_read
fbcc39ad 1380
e7f1cf73 1381Finalizes the input after reading is complete.
fbcc39ad 1382
1383=cut
1384
1385sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1386
b5ecfcf0 1387=head2 $c->finalize_uploads
fbcc39ad 1388
ae1e6b59 1389Finalizes uploads. Cleans up any temporary files.
fbcc39ad 1390
1391=cut
1392
1393sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1394
b5ecfcf0 1395=head2 $c->get_action( $action, $namespace )
fbcc39ad 1396
e7f1cf73 1397Gets an action in a given namespace.
fbcc39ad 1398
1399=cut
1400
684d10ed 1401sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 1402
b5ecfcf0 1403=head2 $c->get_actions( $action, $namespace )
a9dc674c 1404
ae1e6b59 1405Gets all actions of a given name in a namespace and all parent
1406namespaces.
a9dc674c 1407
1408=cut
1409
1410sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1411
f7b672ef 1412=head2 $c->handle_request( $class, @arguments )
fbcc39ad 1413
e7f1cf73 1414Called to handle each HTTP request.
fbcc39ad 1415
1416=cut
1417
1418sub handle_request {
1419 my ( $class, @arguments ) = @_;
1420
1421 # Always expect worst case!
1422 my $status = -1;
1423 eval {
22247e54 1424 my $stats = ( $class->debug ) ? Tree::Simple->new: q{};
fbcc39ad 1425
1426 my $handler = sub {
1427 my $c = $class->prepare(@arguments);
7a7d7af5 1428 $c->stats($stats);
fbcc39ad 1429 $c->dispatch;
1430 return $c->finalize;
1431 };
1432
1433 if ( $class->debug ) {
245ae014 1434 my $start = [gettimeofday];
1435 $status = &$handler;
1436 my $elapsed = tv_interval $start;
fbcc39ad 1437 $elapsed = sprintf '%f', $elapsed;
1438 my $av = sprintf '%.3f',
1439 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
8c113188 1440 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
22247e54 1441
1442 $stats->traverse(
1443 sub {
1444 my $action = shift;
1445 my $stat = $action->getNodeValue;
7a7d7af5 1446 $t->row( ( q{ } x $action->getDepth ) . $stat->{action} . $stat->{comment},
22247e54 1447 $stat->{elapsed} || '??' );
1448 }
1449 );
1450
fbcc39ad 1451 $class->log->info(
1452 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1453 }
1454 else { $status = &$handler }
1455
1456 };
1457
1458 if ( my $error = $@ ) {
1459 chomp $error;
1460 $class->log->error(qq/Caught exception in engine "$error"/);
1461 }
1462
1463 $COUNT++;
1464 $class->log->_flush() if $class->log->can('_flush');
1465 return $status;
1466}
1467
b5ecfcf0 1468=head2 $c->prepare( @arguments )
fbcc39ad 1469
ae1e6b59 1470Creates a Catalyst context from an engine-specific request (Apache, CGI,
1471etc.).
fbcc39ad 1472
1473=cut
1474
1475sub prepare {
1476 my ( $class, @arguments ) = @_;
1477
3cec521a 1478 $class->context_class( ref $class || $class ) unless $class->context_class;
1479 my $c = $class->context_class->new(
1480 {
1481 counter => {},
28591cd7 1482 stack => [],
3cec521a 1483 request => $class->request_class->new(
1484 {
1485 arguments => [],
1486 body_parameters => {},
1487 cookies => {},
1488 headers => HTTP::Headers->new,
1489 parameters => {},
1490 query_parameters => {},
1491 secure => 0,
1492 snippets => [],
1493 uploads => {}
1494 }
1495 ),
1496 response => $class->response_class->new(
1497 {
1498 body => '',
1499 cookies => {},
1500 headers => HTTP::Headers->new(),
1501 status => 200
1502 }
1503 ),
1504 stash => {},
1505 state => 0
1506 }
1507 );
fbcc39ad 1508
1509 # For on-demand data
1510 $c->request->{_context} = $c;
1511 $c->response->{_context} = $c;
1512 weaken( $c->request->{_context} );
1513 weaken( $c->response->{_context} );
1514
1515 if ( $c->debug ) {
1516 my $secs = time - $START || 1;
1517 my $av = sprintf '%.3f', $COUNT / $secs;
1518 $c->log->debug('**********************************');
1519 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1520 $c->log->debug('**********************************');
1521 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1522 }
1523
5050d7a7 1524 # Allow engine to direct the prepare flow (for POE)
1525 if ( $c->engine->can('prepare') ) {
1526 $c->engine->prepare( $c, @arguments );
1527 }
1528 else {
1529 $c->prepare_request(@arguments);
1530 $c->prepare_connection;
1531 $c->prepare_query_parameters;
1532 $c->prepare_headers;
1533 $c->prepare_cookies;
1534 $c->prepare_path;
1535
1536 # On-demand parsing
1537 $c->prepare_body unless $c->config->{parse_on_demand};
1538 }
fbcc39ad 1539
fbcc39ad 1540 my $method = $c->req->method || '';
1541 my $path = $c->req->path || '';
1542 my $address = $c->req->address || '';
1543
e3a13771 1544 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
fbcc39ad 1545 if $c->debug;
1546
e3a13771 1547 $c->prepare_action;
1548
fbcc39ad 1549 return $c;
1550}
1551
b5ecfcf0 1552=head2 $c->prepare_action
fbcc39ad 1553
b4b01a8a 1554Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 1555
1556=cut
1557
1558sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1559
b5ecfcf0 1560=head2 $c->prepare_body
fbcc39ad 1561
e7f1cf73 1562Prepares message body.
fbcc39ad 1563
1564=cut
1565
1566sub prepare_body {
1567 my $c = shift;
1568
1569 # Do we run for the first time?
1570 return if defined $c->request->{_body};
1571
1572 # Initialize on-demand data
1573 $c->engine->prepare_body( $c, @_ );
1574 $c->prepare_parameters;
1575 $c->prepare_uploads;
1576
1577 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
8c113188 1578 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
fbcc39ad 1579 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1580 my $param = $c->req->body_parameters->{$key};
1581 my $value = defined($param) ? $param : '';
8c113188 1582 $t->row( $key,
fbcc39ad 1583 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1584 }
1585 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1586 }
1587}
1588
b5ecfcf0 1589=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 1590
e7f1cf73 1591Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 1592
b4b01a8a 1593See L<Catalyst::Engine>.
1594
4bd82c41 1595=cut
1596
4f5ebacd 1597sub prepare_body_chunk {
1598 my $c = shift;
4bd82c41 1599 $c->engine->prepare_body_chunk( $c, @_ );
1600}
1601
b5ecfcf0 1602=head2 $c->prepare_body_parameters
fbcc39ad 1603
e7f1cf73 1604Prepares body parameters.
fbcc39ad 1605
1606=cut
1607
1608sub prepare_body_parameters {
1609 my $c = shift;
1610 $c->engine->prepare_body_parameters( $c, @_ );
1611}
1612
b5ecfcf0 1613=head2 $c->prepare_connection
fbcc39ad 1614
e7f1cf73 1615Prepares connection.
fbcc39ad 1616
1617=cut
1618
1619sub prepare_connection {
1620 my $c = shift;
1621 $c->engine->prepare_connection( $c, @_ );
1622}
1623
b5ecfcf0 1624=head2 $c->prepare_cookies
fbcc39ad 1625
e7f1cf73 1626Prepares cookies.
fbcc39ad 1627
1628=cut
1629
1630sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1631
b5ecfcf0 1632=head2 $c->prepare_headers
fbcc39ad 1633
e7f1cf73 1634Prepares headers.
fbcc39ad 1635
1636=cut
1637
1638sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1639
b5ecfcf0 1640=head2 $c->prepare_parameters
fbcc39ad 1641
e7f1cf73 1642Prepares parameters.
fbcc39ad 1643
1644=cut
1645
1646sub prepare_parameters {
1647 my $c = shift;
1648 $c->prepare_body_parameters;
1649 $c->engine->prepare_parameters( $c, @_ );
1650}
1651
b5ecfcf0 1652=head2 $c->prepare_path
fbcc39ad 1653
e7f1cf73 1654Prepares path and base.
fbcc39ad 1655
1656=cut
1657
1658sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1659
b5ecfcf0 1660=head2 $c->prepare_query_parameters
fbcc39ad 1661
e7f1cf73 1662Prepares query parameters.
fbcc39ad 1663
1664=cut
1665
1666sub prepare_query_parameters {
1667 my $c = shift;
1668
1669 $c->engine->prepare_query_parameters( $c, @_ );
1670
1671 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
8c113188 1672 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
fbcc39ad 1673 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1674 my $param = $c->req->query_parameters->{$key};
1675 my $value = defined($param) ? $param : '';
8c113188 1676 $t->row( $key,
fbcc39ad 1677 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1678 }
1679 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1680 }
1681}
1682
b5ecfcf0 1683=head2 $c->prepare_read
fbcc39ad 1684
e7f1cf73 1685Prepares the input for reading.
fbcc39ad 1686
1687=cut
1688
1689sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1690
b5ecfcf0 1691=head2 $c->prepare_request
fbcc39ad 1692
e7f1cf73 1693Prepares the engine request.
fbcc39ad 1694
1695=cut
1696
1697sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1698
b5ecfcf0 1699=head2 $c->prepare_uploads
fbcc39ad 1700
e7f1cf73 1701Prepares uploads.
fbcc39ad 1702
1703=cut
1704
1705sub prepare_uploads {
1706 my $c = shift;
1707
1708 $c->engine->prepare_uploads( $c, @_ );
1709
1710 if ( $c->debug && keys %{ $c->request->uploads } ) {
8c113188 1711 my $t = Text::SimpleTable->new(
1712 [ 12, 'Key' ],
1713 [ 28, 'Filename' ],
1714 [ 18, 'Type' ],
1715 [ 9, 'Size' ]
1716 );
fbcc39ad 1717 for my $key ( sort keys %{ $c->request->uploads } ) {
1718 my $upload = $c->request->uploads->{$key};
1719 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 1720 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 1721 }
1722 }
1723 $c->log->debug( "File Uploads are:\n" . $t->draw );
1724 }
1725}
1726
b5ecfcf0 1727=head2 $c->prepare_write
fbcc39ad 1728
e7f1cf73 1729Prepares the output for writing.
fbcc39ad 1730
1731=cut
1732
1733sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1734
b5ecfcf0 1735=head2 $c->request_class
1f9cb7c1 1736
e7f1cf73 1737Returns or sets the request class.
1f9cb7c1 1738
b5ecfcf0 1739=head2 $c->response_class
1f9cb7c1 1740
e7f1cf73 1741Returns or sets the response class.
1f9cb7c1 1742
b5ecfcf0 1743=head2 $c->read( [$maxlength] )
fbcc39ad 1744
ae1e6b59 1745Reads a chunk of data from the request body. This method is designed to
1746be used in a while loop, reading C<$maxlength> bytes on every call.
1747C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 1748
ae1e6b59 1749You have to set C<MyApp-E<gt>config-E<gt>{parse_on_demand}> to use this
1750directly.
fbcc39ad 1751
1752=cut
1753
1754sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1755
b5ecfcf0 1756=head2 $c->run
fbcc39ad 1757
1758Starts the engine.
1759
1760=cut
1761
1762sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1763
b5ecfcf0 1764=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 1765
e7f1cf73 1766Sets an action in a given namespace.
fbcc39ad 1767
1768=cut
1769
1770sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1771
b5ecfcf0 1772=head2 $c->setup_actions($component)
fbcc39ad 1773
e7f1cf73 1774Sets up actions for a component.
fbcc39ad 1775
1776=cut
1777
1778sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1779
b5ecfcf0 1780=head2 $c->setup_components
fbcc39ad 1781
e7f1cf73 1782Sets up components.
fbcc39ad 1783
1784=cut
1785
1786sub setup_components {
1787 my $class = shift;
1788
1789 my $callback = sub {
1790 my ( $component, $context ) = @_;
1791
31375184 1792 unless ( $component->can('COMPONENT') ) {
fbcc39ad 1793 return $component;
1794 }
1795
76cb6276 1796 my $suffix = Catalyst::Utils::class2classsuffix($component);
fbcc39ad 1797 my $config = $class->config->{$suffix} || {};
1798
1799 my $instance;
1800
22247e54 1801 eval { $instance = $component->COMPONENT( $context, $config ); };
fbcc39ad 1802
1803 if ( my $error = $@ ) {
1804
1805 chomp $error;
1806
1807 Catalyst::Exception->throw( message =>
1808 qq/Couldn't instantiate component "$component", "$error"/ );
1809 }
1810
1811 Catalyst::Exception->throw( message =>
6c5033cb 1812qq/Couldn't instantiate component "$component", "COMPONENT() didn't return a object"/
fbcc39ad 1813 )
1814 unless ref $instance;
1815 return $instance;
1816 };
1817
6f006bd6 1818 eval "package $class;\n" . q!Module::Pluggable::Fast->import(
fbcc39ad 1819 name => '_catalyst_components',
1820 search => [
1821 "$class\::Controller", "$class\::C",
1822 "$class\::Model", "$class\::M",
1823 "$class\::View", "$class\::V"
1824 ],
1825 callback => $callback
1826 );
4289f674 1827 !;
fbcc39ad 1828
1829 if ( my $error = $@ ) {
1830
1831 chomp $error;
1832
1833 Catalyst::Exception->throw(
1834 message => qq/Couldn't load components "$error"/ );
1835 }
1836
1837 for my $component ( $class->_catalyst_components($class) ) {
1838 $class->components->{ ref $component || $component } = $component;
1839 }
1840}
1841
b5ecfcf0 1842=head2 $c->setup_dispatcher
fbcc39ad 1843
ae1e6b59 1844Sets up dispatcher.
1845
fbcc39ad 1846=cut
1847
1848sub setup_dispatcher {
1849 my ( $class, $dispatcher ) = @_;
1850
1851 if ($dispatcher) {
1852 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1853 }
1854
1855 if ( $ENV{CATALYST_DISPATCHER} ) {
1856 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1857 }
1858
1859 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1860 $dispatcher =
1861 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1862 }
1863
1864 unless ($dispatcher) {
cb0354c6 1865 $dispatcher = $class->dispatcher_class;
fbcc39ad 1866 }
1867
1868 $dispatcher->require;
1869
1870 if ($@) {
1871 Catalyst::Exception->throw(
1872 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1873 }
1874
1875 # dispatcher instance
1876 $class->dispatcher( $dispatcher->new );
1877}
1878
b5ecfcf0 1879=head2 $c->setup_engine
fbcc39ad 1880
ae1e6b59 1881Sets up engine.
1882
fbcc39ad 1883=cut
1884
1885sub setup_engine {
1886 my ( $class, $engine ) = @_;
1887
1888 if ($engine) {
1889 $engine = 'Catalyst::Engine::' . $engine;
1890 }
1891
1892 if ( $ENV{CATALYST_ENGINE} ) {
1893 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1894 }
1895
1896 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1897 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1898 }
1899
9b0a3e0f 1900 if ( $ENV{MOD_PERL} ) {
fbcc39ad 1901
1902 # create the apache method
1903 {
1904 no strict 'refs';
1905 *{"$class\::apache"} = sub { shift->engine->apache };
1906 }
1907
1908 my ( $software, $version ) =
1909 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1910
1911 $version =~ s/_//g;
1912 $version =~ s/(\.[^.]+)\./$1/g;
1913
1914 if ( $software eq 'mod_perl' ) {
1915
9b0a3e0f 1916 if ( !$engine ) {
22247e54 1917
9b0a3e0f 1918 if ( $version >= 1.99922 ) {
1919 $engine = 'Catalyst::Engine::Apache2::MP20';
1920 }
22247e54 1921
9b0a3e0f 1922 elsif ( $version >= 1.9901 ) {
1923 $engine = 'Catalyst::Engine::Apache2::MP19';
1924 }
22247e54 1925
9b0a3e0f 1926 elsif ( $version >= 1.24 ) {
1927 $engine = 'Catalyst::Engine::Apache::MP13';
1928 }
22247e54 1929
9b0a3e0f 1930 else {
1931 Catalyst::Exception->throw( message =>
1932 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1933 }
fbcc39ad 1934
fbcc39ad 1935 }
1936
1937 # install the correct mod_perl handler
1938 if ( $version >= 1.9901 ) {
1939 *handler = sub : method {
1940 shift->handle_request(@_);
1941 };
1942 }
1943 else {
1944 *handler = sub ($$) { shift->handle_request(@_) };
1945 }
1946
1947 }
1948
1949 elsif ( $software eq 'Zeus-Perl' ) {
1950 $engine = 'Catalyst::Engine::Zeus';
1951 }
1952
1953 else {
1954 Catalyst::Exception->throw(
1955 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1956 }
1957 }
1958
1959 unless ($engine) {
cb0354c6 1960 $engine = $class->engine_class;
fbcc39ad 1961 }
1962
1963 $engine->require;
1964
1965 if ($@) {
1966 Catalyst::Exception->throw( message =>
1967qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1968 );
1969 }
0e7f5826 1970
d54484bf 1971 # check for old engines that are no longer compatible
1972 my $old_engine;
0e7f5826 1973 if ( $engine->isa('Catalyst::Engine::Apache')
1974 && !Catalyst::Engine::Apache->VERSION )
d54484bf 1975 {
1976 $old_engine = 1;
1977 }
0e7f5826 1978
d54484bf 1979 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
0e7f5826 1980 && Catalyst::Engine::Server->VERSION le '0.02' )
d54484bf 1981 {
1982 $old_engine = 1;
1983 }
0e7f5826 1984
1985 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1986 && $engine->VERSION eq '0.01' )
d54484bf 1987 {
1988 $old_engine = 1;
1989 }
0e7f5826 1990
1991 elsif ($engine->isa('Catalyst::Engine::Zeus')
1992 && $engine->VERSION eq '0.01' )
d54484bf 1993 {
1994 $old_engine = 1;
1995 }
fbcc39ad 1996
d54484bf 1997 if ($old_engine) {
1998 Catalyst::Exception->throw( message =>
0e7f5826 1999 qq/Engine "$engine" is not supported by this version of Catalyst/
d54484bf 2000 );
2001 }
0e7f5826 2002
fbcc39ad 2003 # engine instance
2004 $class->engine( $engine->new );
2005}
2006
b5ecfcf0 2007=head2 $c->setup_home
fbcc39ad 2008
ae1e6b59 2009Sets up the home directory.
2010
fbcc39ad 2011=cut
2012
2013sub setup_home {
2014 my ( $class, $home ) = @_;
2015
2016 if ( $ENV{CATALYST_HOME} ) {
2017 $home = $ENV{CATALYST_HOME};
2018 }
2019
2020 if ( $ENV{ uc($class) . '_HOME' } ) {
2021 $home = $ENV{ uc($class) . '_HOME' };
2022 }
2023
2024 unless ($home) {
2025 $home = Catalyst::Utils::home($class);
2026 }
2027
2028 if ($home) {
2029 $class->config->{home} ||= $home;
a738ab68 2030 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
fbcc39ad 2031 }
2032}
2033
b5ecfcf0 2034=head2 $c->setup_log
fbcc39ad 2035
ae1e6b59 2036Sets up log.
2037
fbcc39ad 2038=cut
2039
2040sub setup_log {
2041 my ( $class, $debug ) = @_;
2042
2043 unless ( $class->log ) {
2044 $class->log( Catalyst::Log->new );
2045 }
af3ff00e 2046
71f074a9 2047 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
71f074a9 2048
af3ff00e 2049 if (
2050 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
2051 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
2052 : $debug
2053 )
2054 {
fbcc39ad 2055 no strict 'refs';
2056 *{"$class\::debug"} = sub { 1 };
2057 $class->log->debug('Debug messages enabled');
2058 }
2059}
2060
b5ecfcf0 2061=head2 $c->setup_plugins
fbcc39ad 2062
ae1e6b59 2063Sets up plugins.
2064
fbcc39ad 2065=cut
2066
836e1134 2067=head2 $c->registered_plugins
2068
2069Returns a sorted list of the plugins which have either been stated in the
2070import list or which have been added via C<< MyApp->plugin(@args); >>.
2071
2072If passed a given plugin name, it will report a boolean value indicating
2073whether or not that plugin is loaded. A fully qualified name is required if
2074the plugin name does not begin with C<Catalyst::Plugin::>.
2075
2076 if ($c->registered_plugins('Some::Plugin')) {
2077 ...
2078 }
2079
2080=cut
fbcc39ad 2081
836e1134 2082{
97b58e17 2083
2084 sub registered_plugins {
836e1134 2085 my $proto = shift;
197bd788 2086 return sort keys %{ $proto->_plugins } unless @_;
836e1134 2087 my $plugin = shift;
d0d4d785 2088 return 1 if exists $proto->_plugins->{$plugin};
2089 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
836e1134 2090 }
fbcc39ad 2091
836e1134 2092 sub _register_plugin {
2093 my ( $proto, $plugin, $instant ) = @_;
2094 my $class = ref $proto || $proto;
fbcc39ad 2095
2096 $plugin->require;
2097
836e1134 2098 if ( my $error = $@ ) {
2099 my $type = $instant ? "instant " : '';
fbcc39ad 2100 Catalyst::Exception->throw(
836e1134 2101 message => qq/Couldn't load ${type}plugin "$plugin", $error/ );
fbcc39ad 2102 }
2103
197bd788 2104 $proto->_plugins->{$plugin} = 1;
836e1134 2105 unless ($instant) {
fbcc39ad 2106 no strict 'refs';
2107 unshift @{"$class\::ISA"}, $plugin;
2108 }
836e1134 2109 return $class;
2110 }
2111
2112 sub setup_plugins {
2113 my ( $class, $plugins ) = @_;
2114
d0d4d785 2115 $class->_plugins( {} ) unless $class->_plugins;
836e1134 2116 $plugins ||= [];
2117 for my $plugin ( reverse @$plugins ) {
2118
2119 unless ( $plugin =~ s/\A\+// ) {
2120 $plugin = "Catalyst::Plugin::$plugin";
2121 }
2122
2123 $class->_register_plugin($plugin);
2124 }
fbcc39ad 2125 }
2126}
2127
b5ecfcf0 2128=head2 $c->stack
8767c5a3 2129
f7b672ef 2130Returns an arrayref of the internal execution stack (actions that are currently
2131executing).
8767c5a3 2132
b5ecfcf0 2133=head2 $c->write( $data )
fbcc39ad 2134
ae1e6b59 2135Writes $data to the output stream. When using this method directly, you
2136will need to manually set the C<Content-Length> header to the length of
2137your output data, if known.
fbcc39ad 2138
2139=cut
2140
4f5ebacd 2141sub write {
2142 my $c = shift;
2143
2144 # Finalize headers if someone manually writes output
2145 $c->finalize_headers;
2146
2147 return $c->engine->write( $c, @_ );
2148}
fbcc39ad 2149
b5ecfcf0 2150=head2 version
bf88a181 2151
ae1e6b59 2152Returns the Catalyst version number. Mostly useful for "powered by"
2153messages in template systems.
bf88a181 2154
2155=cut
2156
2157sub version { return $Catalyst::VERSION }
2158
b0bb11ec 2159=head1 INTERNAL ACTIONS
2160
ae1e6b59 2161Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2162C<_ACTION>, and C<_END>. These are by default not shown in the private
3e705254 2163action table, but you can make them visible with a config parameter.
b0bb11ec 2164
2165 MyApp->config->{show_internal_actions} = 1;
2166
d2ee9760 2167=head1 CASE SENSITIVITY
2168
3e705254 2169By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
ae1e6b59 2170mapped to C</foo/bar>. You can activate case sensitivity with a config
3e705254 2171parameter.
d2ee9760 2172
2173 MyApp->config->{case_sensitive} = 1;
2174
3e705254 2175This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
fbcc39ad 2176
2177=head1 ON-DEMAND PARSER
2178
2179The request body is usually parsed at the beginning of a request,
3e705254 2180but if you want to handle input yourself or speed things up a bit,
fbcc39ad 2181you can enable on-demand parsing with a config parameter.
2182
2183 MyApp->config->{parse_on_demand} = 1;
2184
2185=head1 PROXY SUPPORT
2186
ae1e6b59 2187Many production servers operate using the common double-server approach,
2188with a lightweight frontend web server passing requests to a larger
2189backend server. An application running on the backend server must deal
2190with two problems: the remote user always appears to be C<127.0.0.1> and
2191the server's hostname will appear to be C<localhost> regardless of the
2192virtual host that the user connected through.
fbcc39ad 2193
ae1e6b59 2194Catalyst will automatically detect this situation when you are running
2195the frontend and backend servers on the same machine. The following
2196changes are made to the request.
fbcc39ad 2197
ae1e6b59 2198 $c->req->address is set to the user's real IP address, as read from
2199 the HTTP X-Forwarded-For header.
fbcc39ad 2200
ae1e6b59 2201 The host value for $c->req->base and $c->req->uri is set to the real
2202 host, as read from the HTTP X-Forwarded-Host header.
fbcc39ad 2203
3e705254 2204Obviously, your web server must support these headers for this to work.
fbcc39ad 2205
ae1e6b59 2206In a more complex server farm environment where you may have your
2207frontend proxy server(s) on different machines, you will need to set a
2208configuration option to tell Catalyst to read the proxied data from the
2209headers.
fbcc39ad 2210
2211 MyApp->config->{using_frontend_proxy} = 1;
2212
2213If you do not wish to use the proxy support at all, you may set:
d1a31ac6 2214
fbcc39ad 2215 MyApp->config->{ignore_frontend_proxy} = 1;
2216
2217=head1 THREAD SAFETY
2218
2219Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
3e705254 2220and the standalone forking HTTP server on Windows. We believe the Catalyst
fbcc39ad 2221core to be thread-safe.
2222
2223If you plan to operate in a threaded environment, remember that all other
3e705254 2224modules you are using must also be thread-safe. Some modules, most notably
2225L<DBD::SQLite>, are not thread-safe.
d1a31ac6 2226
3cb1db8c 2227=head1 SUPPORT
2228
2229IRC:
2230
4eaf7c88 2231 Join #catalyst on irc.perl.org.
3cb1db8c 2232
3e705254 2233Mailing Lists:
3cb1db8c 2234
2235 http://lists.rawmode.org/mailman/listinfo/catalyst
2236 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1985c30b 2237
432d507d 2238Web:
2239
2240 http://catalyst.perl.org
2241
0ef52a96 2242Wiki:
2243
2244 http://dev.catalyst.perl.org
2245
fc7ec1d9 2246=head1 SEE ALSO
2247
829a28ca 2248=head2 L<Task::Catalyst> - All you need to start with Catalyst
2249
b5ecfcf0 2250=head2 L<Catalyst::Manual> - The Catalyst Manual
e7f1cf73 2251
b5ecfcf0 2252=head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
61b1e958 2253
b5ecfcf0 2254=head2 L<Catalyst::Engine> - Core engine
61b1e958 2255
b5ecfcf0 2256=head2 L<Catalyst::Log> - Log class.
61b1e958 2257
b5ecfcf0 2258=head2 L<Catalyst::Request> - Request object
61b1e958 2259
b5ecfcf0 2260=head2 L<Catalyst::Response> - Response object
61b1e958 2261
b5ecfcf0 2262=head2 L<Catalyst::Test> - The test suite.
fc7ec1d9 2263
15f0b5b7 2264=head1 CREDITS
fc7ec1d9 2265
15f0b5b7 2266Andy Grundman
2267
fbcc39ad 2268Andy Wardley
2269
33108eaf 2270Andreas Marienborg
2271
f4a57de4 2272Andrew Bramble
2273
15f0b5b7 2274Andrew Ford
2275
2276Andrew Ruthven
2277
fbcc39ad 2278Arthur Bergman
2279
15f0b5b7 2280Autrijus Tang
2281
0cf56dbc 2282Brian Cassidy
2283
6aaa1c60 2284Carl Franks
2285
15f0b5b7 2286Christian Hansen
2287
2288Christopher Hicks
2289
2290Dan Sully
2291
2292Danijel Milicevic
2293
0ef52a96 2294David Kamholz
2295
15f0b5b7 2296David Naughton
2297
61bef238 2298Drew Taylor
2299
15f0b5b7 2300Gary Ashton Jones
2301
2302Geoff Richards
2303
2304Jesse Sheidlower
2305
fbcc39ad 2306Jesse Vincent
2307
15f0b5b7 2308Jody Belka
2309
2310Johan Lindstrom
2311
2312Juan Camacho
2313
2314Leon Brocard
2315
2316Marcus Ramberg
2317
2318Matt S Trout
2319
71c3bcc3 2320Robert Sedlacek
2321
a727119f 2322Sam Vilain
2323
1cf1c56a 2324Sascha Kiefer
2325
15f0b5b7 2326Tatsuhiko Miyagawa
fc7ec1d9 2327
51f0308d 2328Ulf Edvinsson
2329
bdcb95ef 2330Yuval Kogman
2331
51f0308d 2332=head1 AUTHOR
2333
2334Sebastian Riedel, C<sri@oook.de>
2335
fc7ec1d9 2336=head1 LICENSE
2337
9ce5ab63 2338This library is free software, you can redistribute it and/or modify it under
41ca9ba7 2339the same terms as Perl itself.
fc7ec1d9 2340
2341=cut
2342
23431;