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