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