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