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