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