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