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