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