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