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