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