Updated PAR support to use "make catalyst_par", packages are no longer written by...
[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
24b3262a 47our $CATALYST_SCRIPT_GEN = 24;
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 ) {
8f62c91a 1019 # get the length from a filehandle
1020 if ( ref $c->response->body && $c->response->body->can('read') ) {
1021 if ( my $stat = stat $c->response->body ) {
1022 $c->response->content_length( $stat->size );
1023 }
1024 else {
1025 $c->log->warn(
1026 'Serving filehandle without a content-length' );
1027 }
1028 }
1029 else {
1030 $c->response->content_length(
1031 bytes::length( $c->response->body ) );
1032 }
fbcc39ad 1033 }
1034
1035 # Errors
1036 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1037 $c->response->headers->remove_header("Content-Length");
1038 $c->response->body('');
1039 }
1040
1041 $c->finalize_cookies;
1042
1043 $c->engine->finalize_headers( $c, @_ );
1044
1045 # Done
1046 $c->response->{_finalized_headers} = 1;
1047}
1048
b5ecfcf0 1049=head2 $c->finalize_output
fbcc39ad 1050
1051An alias for finalize_body.
1052
b5ecfcf0 1053=head2 $c->finalize_read
fbcc39ad 1054
e7f1cf73 1055Finalizes the input after reading is complete.
fbcc39ad 1056
1057=cut
1058
1059sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1060
b5ecfcf0 1061=head2 $c->finalize_uploads
fbcc39ad 1062
ae1e6b59 1063Finalizes uploads. Cleans up any temporary files.
fbcc39ad 1064
1065=cut
1066
1067sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1068
b5ecfcf0 1069=head2 $c->get_action( $action, $namespace )
fbcc39ad 1070
e7f1cf73 1071Gets an action in a given namespace.
fbcc39ad 1072
1073=cut
1074
684d10ed 1075sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 1076
b5ecfcf0 1077=head2 $c->get_actions( $action, $namespace )
a9dc674c 1078
ae1e6b59 1079Gets all actions of a given name in a namespace and all parent
1080namespaces.
a9dc674c 1081
1082=cut
1083
1084sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1085
b5ecfcf0 1086=head2 handle_request( $class, @arguments )
fbcc39ad 1087
e7f1cf73 1088Called to handle each HTTP request.
fbcc39ad 1089
1090=cut
1091
1092sub handle_request {
1093 my ( $class, @arguments ) = @_;
1094
1095 # Always expect worst case!
1096 my $status = -1;
1097 eval {
1098 my @stats = ();
1099
1100 my $handler = sub {
1101 my $c = $class->prepare(@arguments);
1102 $c->{stats} = \@stats;
1103 $c->dispatch;
1104 return $c->finalize;
1105 };
1106
1107 if ( $class->debug ) {
245ae014 1108 my $start = [gettimeofday];
1109 $status = &$handler;
1110 my $elapsed = tv_interval $start;
fbcc39ad 1111 $elapsed = sprintf '%f', $elapsed;
1112 my $av = sprintf '%.3f',
1113 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
8c113188 1114 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
fbcc39ad 1115
8c113188 1116 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
fbcc39ad 1117 $class->log->info(
1118 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1119 }
1120 else { $status = &$handler }
1121
1122 };
1123
1124 if ( my $error = $@ ) {
1125 chomp $error;
1126 $class->log->error(qq/Caught exception in engine "$error"/);
1127 }
1128
1129 $COUNT++;
1130 $class->log->_flush() if $class->log->can('_flush');
1131 return $status;
1132}
1133
b5ecfcf0 1134=head2 $c->prepare( @arguments )
fbcc39ad 1135
ae1e6b59 1136Creates a Catalyst context from an engine-specific request (Apache, CGI,
1137etc.).
fbcc39ad 1138
1139=cut
1140
1141sub prepare {
1142 my ( $class, @arguments ) = @_;
1143
3cec521a 1144 $class->context_class( ref $class || $class ) unless $class->context_class;
1145 my $c = $class->context_class->new(
1146 {
1147 counter => {},
28591cd7 1148 stack => [],
3cec521a 1149 request => $class->request_class->new(
1150 {
1151 arguments => [],
1152 body_parameters => {},
1153 cookies => {},
1154 headers => HTTP::Headers->new,
1155 parameters => {},
1156 query_parameters => {},
1157 secure => 0,
1158 snippets => [],
1159 uploads => {}
1160 }
1161 ),
1162 response => $class->response_class->new(
1163 {
1164 body => '',
1165 cookies => {},
1166 headers => HTTP::Headers->new(),
1167 status => 200
1168 }
1169 ),
1170 stash => {},
1171 state => 0
1172 }
1173 );
fbcc39ad 1174
1175 # For on-demand data
1176 $c->request->{_context} = $c;
1177 $c->response->{_context} = $c;
1178 weaken( $c->request->{_context} );
1179 weaken( $c->response->{_context} );
1180
1181 if ( $c->debug ) {
1182 my $secs = time - $START || 1;
1183 my $av = sprintf '%.3f', $COUNT / $secs;
1184 $c->log->debug('**********************************');
1185 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1186 $c->log->debug('**********************************');
1187 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1188 }
1189
1190 $c->prepare_request(@arguments);
1191 $c->prepare_connection;
1192 $c->prepare_query_parameters;
1193 $c->prepare_headers;
1194 $c->prepare_cookies;
1195 $c->prepare_path;
1196
1197 # On-demand parsing
1198 $c->prepare_body unless $c->config->{parse_on_demand};
1199
fbcc39ad 1200 my $method = $c->req->method || '';
1201 my $path = $c->req->path || '';
1202 my $address = $c->req->address || '';
1203
e3a13771 1204 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
fbcc39ad 1205 if $c->debug;
1206
e3a13771 1207 $c->prepare_action;
1208
fbcc39ad 1209 return $c;
1210}
1211
b5ecfcf0 1212=head2 $c->prepare_action
fbcc39ad 1213
e7f1cf73 1214Prepares action.
fbcc39ad 1215
1216=cut
1217
1218sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1219
b5ecfcf0 1220=head2 $c->prepare_body
fbcc39ad 1221
e7f1cf73 1222Prepares message body.
fbcc39ad 1223
1224=cut
1225
1226sub prepare_body {
1227 my $c = shift;
1228
1229 # Do we run for the first time?
1230 return if defined $c->request->{_body};
1231
1232 # Initialize on-demand data
1233 $c->engine->prepare_body( $c, @_ );
1234 $c->prepare_parameters;
1235 $c->prepare_uploads;
1236
1237 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
8c113188 1238 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
fbcc39ad 1239 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1240 my $param = $c->req->body_parameters->{$key};
1241 my $value = defined($param) ? $param : '';
8c113188 1242 $t->row( $key,
fbcc39ad 1243 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1244 }
1245 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1246 }
1247}
1248
b5ecfcf0 1249=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 1250
e7f1cf73 1251Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 1252
1253=cut
1254
4f5ebacd 1255sub prepare_body_chunk {
1256 my $c = shift;
4bd82c41 1257 $c->engine->prepare_body_chunk( $c, @_ );
1258}
1259
b5ecfcf0 1260=head2 $c->prepare_body_parameters
fbcc39ad 1261
e7f1cf73 1262Prepares body parameters.
fbcc39ad 1263
1264=cut
1265
1266sub prepare_body_parameters {
1267 my $c = shift;
1268 $c->engine->prepare_body_parameters( $c, @_ );
1269}
1270
b5ecfcf0 1271=head2 $c->prepare_connection
fbcc39ad 1272
e7f1cf73 1273Prepares connection.
fbcc39ad 1274
1275=cut
1276
1277sub prepare_connection {
1278 my $c = shift;
1279 $c->engine->prepare_connection( $c, @_ );
1280}
1281
b5ecfcf0 1282=head2 $c->prepare_cookies
fbcc39ad 1283
e7f1cf73 1284Prepares cookies.
fbcc39ad 1285
1286=cut
1287
1288sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1289
b5ecfcf0 1290=head2 $c->prepare_headers
fbcc39ad 1291
e7f1cf73 1292Prepares headers.
fbcc39ad 1293
1294=cut
1295
1296sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1297
b5ecfcf0 1298=head2 $c->prepare_parameters
fbcc39ad 1299
e7f1cf73 1300Prepares parameters.
fbcc39ad 1301
1302=cut
1303
1304sub prepare_parameters {
1305 my $c = shift;
1306 $c->prepare_body_parameters;
1307 $c->engine->prepare_parameters( $c, @_ );
1308}
1309
b5ecfcf0 1310=head2 $c->prepare_path
fbcc39ad 1311
e7f1cf73 1312Prepares path and base.
fbcc39ad 1313
1314=cut
1315
1316sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1317
b5ecfcf0 1318=head2 $c->prepare_query_parameters
fbcc39ad 1319
e7f1cf73 1320Prepares query parameters.
fbcc39ad 1321
1322=cut
1323
1324sub prepare_query_parameters {
1325 my $c = shift;
1326
1327 $c->engine->prepare_query_parameters( $c, @_ );
1328
1329 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
8c113188 1330 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
fbcc39ad 1331 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1332 my $param = $c->req->query_parameters->{$key};
1333 my $value = defined($param) ? $param : '';
8c113188 1334 $t->row( $key,
fbcc39ad 1335 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1336 }
1337 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1338 }
1339}
1340
b5ecfcf0 1341=head2 $c->prepare_read
fbcc39ad 1342
e7f1cf73 1343Prepares the input for reading.
fbcc39ad 1344
1345=cut
1346
1347sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1348
b5ecfcf0 1349=head2 $c->prepare_request
fbcc39ad 1350
e7f1cf73 1351Prepares the engine request.
fbcc39ad 1352
1353=cut
1354
1355sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1356
b5ecfcf0 1357=head2 $c->prepare_uploads
fbcc39ad 1358
e7f1cf73 1359Prepares uploads.
fbcc39ad 1360
1361=cut
1362
1363sub prepare_uploads {
1364 my $c = shift;
1365
1366 $c->engine->prepare_uploads( $c, @_ );
1367
1368 if ( $c->debug && keys %{ $c->request->uploads } ) {
8c113188 1369 my $t = Text::SimpleTable->new(
1370 [ 12, 'Key' ],
1371 [ 28, 'Filename' ],
1372 [ 18, 'Type' ],
1373 [ 9, 'Size' ]
1374 );
fbcc39ad 1375 for my $key ( sort keys %{ $c->request->uploads } ) {
1376 my $upload = $c->request->uploads->{$key};
1377 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 1378 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 1379 }
1380 }
1381 $c->log->debug( "File Uploads are:\n" . $t->draw );
1382 }
1383}
1384
b5ecfcf0 1385=head2 $c->prepare_write
fbcc39ad 1386
e7f1cf73 1387Prepares the output for writing.
fbcc39ad 1388
1389=cut
1390
1391sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1392
b5ecfcf0 1393=head2 $c->request_class
1f9cb7c1 1394
e7f1cf73 1395Returns or sets the request class.
1f9cb7c1 1396
b5ecfcf0 1397=head2 $c->response_class
1f9cb7c1 1398
e7f1cf73 1399Returns or sets the response class.
1f9cb7c1 1400
b5ecfcf0 1401=head2 $c->read( [$maxlength] )
fbcc39ad 1402
ae1e6b59 1403Reads a chunk of data from the request body. This method is designed to
1404be used in a while loop, reading C<$maxlength> bytes on every call.
1405C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 1406
ae1e6b59 1407You have to set C<MyApp-E<gt>config-E<gt>{parse_on_demand}> to use this
1408directly.
fbcc39ad 1409
1410=cut
1411
1412sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1413
b5ecfcf0 1414=head2 $c->run
fbcc39ad 1415
1416Starts the engine.
1417
1418=cut
1419
1420sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1421
b5ecfcf0 1422=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 1423
e7f1cf73 1424Sets an action in a given namespace.
fbcc39ad 1425
1426=cut
1427
1428sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1429
b5ecfcf0 1430=head2 $c->setup_actions($component)
fbcc39ad 1431
e7f1cf73 1432Sets up actions for a component.
fbcc39ad 1433
1434=cut
1435
1436sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1437
b5ecfcf0 1438=head2 $c->setup_components
fbcc39ad 1439
e7f1cf73 1440Sets up components.
fbcc39ad 1441
1442=cut
1443
1444sub setup_components {
1445 my $class = shift;
1446
1447 my $callback = sub {
1448 my ( $component, $context ) = @_;
1449
6deb49e9 1450 unless ( $component->isa('Catalyst::Component') ) {
fbcc39ad 1451 return $component;
1452 }
1453
76cb6276 1454 my $suffix = Catalyst::Utils::class2classsuffix($component);
fbcc39ad 1455 my $config = $class->config->{$suffix} || {};
1456
1457 my $instance;
1458
1459 eval { $instance = $component->new( $context, $config ); };
1460
1461 if ( my $error = $@ ) {
1462
1463 chomp $error;
1464
1465 Catalyst::Exception->throw( message =>
1466 qq/Couldn't instantiate component "$component", "$error"/ );
1467 }
1468
1469 Catalyst::Exception->throw( message =>
1470qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1471 )
1472 unless ref $instance;
1473 return $instance;
1474 };
1475
6f006bd6 1476 eval "package $class;\n" . q!Module::Pluggable::Fast->import(
fbcc39ad 1477 name => '_catalyst_components',
1478 search => [
1479 "$class\::Controller", "$class\::C",
1480 "$class\::Model", "$class\::M",
1481 "$class\::View", "$class\::V"
1482 ],
1483 callback => $callback
1484 );
4289f674 1485 !;
fbcc39ad 1486
1487 if ( my $error = $@ ) {
1488
1489 chomp $error;
1490
1491 Catalyst::Exception->throw(
1492 message => qq/Couldn't load components "$error"/ );
1493 }
1494
1495 for my $component ( $class->_catalyst_components($class) ) {
1496 $class->components->{ ref $component || $component } = $component;
1497 }
1498}
1499
b5ecfcf0 1500=head2 $c->setup_dispatcher
fbcc39ad 1501
ae1e6b59 1502Sets up dispatcher.
1503
fbcc39ad 1504=cut
1505
1506sub setup_dispatcher {
1507 my ( $class, $dispatcher ) = @_;
1508
1509 if ($dispatcher) {
1510 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1511 }
1512
1513 if ( $ENV{CATALYST_DISPATCHER} ) {
1514 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1515 }
1516
1517 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1518 $dispatcher =
1519 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1520 }
1521
1522 unless ($dispatcher) {
cb0354c6 1523 $dispatcher = $class->dispatcher_class;
fbcc39ad 1524 }
1525
1526 $dispatcher->require;
1527
1528 if ($@) {
1529 Catalyst::Exception->throw(
1530 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1531 }
1532
1533 # dispatcher instance
1534 $class->dispatcher( $dispatcher->new );
1535}
1536
b5ecfcf0 1537=head2 $c->setup_engine
fbcc39ad 1538
ae1e6b59 1539Sets up engine.
1540
fbcc39ad 1541=cut
1542
1543sub setup_engine {
1544 my ( $class, $engine ) = @_;
1545
1546 if ($engine) {
1547 $engine = 'Catalyst::Engine::' . $engine;
1548 }
1549
1550 if ( $ENV{CATALYST_ENGINE} ) {
1551 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1552 }
1553
1554 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1555 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1556 }
1557
1558 if ( !$engine && $ENV{MOD_PERL} ) {
1559
1560 # create the apache method
1561 {
1562 no strict 'refs';
1563 *{"$class\::apache"} = sub { shift->engine->apache };
1564 }
1565
1566 my ( $software, $version ) =
1567 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1568
1569 $version =~ s/_//g;
1570 $version =~ s/(\.[^.]+)\./$1/g;
1571
1572 if ( $software eq 'mod_perl' ) {
1573
1574 if ( $version >= 1.99922 ) {
1575 $engine = 'Catalyst::Engine::Apache2::MP20';
1576 }
1577
1578 elsif ( $version >= 1.9901 ) {
1579 $engine = 'Catalyst::Engine::Apache2::MP19';
1580 }
1581
1582 elsif ( $version >= 1.24 ) {
1583 $engine = 'Catalyst::Engine::Apache::MP13';
1584 }
1585
1586 else {
1587 Catalyst::Exception->throw( message =>
1588 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1589 }
1590
1591 # install the correct mod_perl handler
1592 if ( $version >= 1.9901 ) {
1593 *handler = sub : method {
1594 shift->handle_request(@_);
1595 };
1596 }
1597 else {
1598 *handler = sub ($$) { shift->handle_request(@_) };
1599 }
1600
1601 }
1602
1603 elsif ( $software eq 'Zeus-Perl' ) {
1604 $engine = 'Catalyst::Engine::Zeus';
1605 }
1606
1607 else {
1608 Catalyst::Exception->throw(
1609 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1610 }
1611 }
1612
1613 unless ($engine) {
cb0354c6 1614 $engine = $class->engine_class;
fbcc39ad 1615 }
1616
1617 $engine->require;
1618
1619 if ($@) {
1620 Catalyst::Exception->throw( message =>
1621qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1622 );
1623 }
0e7f5826 1624
d54484bf 1625 # check for old engines that are no longer compatible
1626 my $old_engine;
0e7f5826 1627 if ( $engine->isa('Catalyst::Engine::Apache')
1628 && !Catalyst::Engine::Apache->VERSION )
d54484bf 1629 {
1630 $old_engine = 1;
1631 }
0e7f5826 1632
d54484bf 1633 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
0e7f5826 1634 && Catalyst::Engine::Server->VERSION le '0.02' )
d54484bf 1635 {
1636 $old_engine = 1;
1637 }
0e7f5826 1638
1639 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1640 && $engine->VERSION eq '0.01' )
d54484bf 1641 {
1642 $old_engine = 1;
1643 }
0e7f5826 1644
1645 elsif ($engine->isa('Catalyst::Engine::Zeus')
1646 && $engine->VERSION eq '0.01' )
d54484bf 1647 {
1648 $old_engine = 1;
1649 }
fbcc39ad 1650
d54484bf 1651 if ($old_engine) {
1652 Catalyst::Exception->throw( message =>
0e7f5826 1653 qq/Engine "$engine" is not supported by this version of Catalyst/
d54484bf 1654 );
1655 }
0e7f5826 1656
fbcc39ad 1657 # engine instance
1658 $class->engine( $engine->new );
1659}
1660
b5ecfcf0 1661=head2 $c->setup_home
fbcc39ad 1662
ae1e6b59 1663Sets up the home directory.
1664
fbcc39ad 1665=cut
1666
1667sub setup_home {
1668 my ( $class, $home ) = @_;
1669
1670 if ( $ENV{CATALYST_HOME} ) {
1671 $home = $ENV{CATALYST_HOME};
1672 }
1673
1674 if ( $ENV{ uc($class) . '_HOME' } ) {
1675 $home = $ENV{ uc($class) . '_HOME' };
1676 }
1677
1678 unless ($home) {
1679 $home = Catalyst::Utils::home($class);
1680 }
1681
1682 if ($home) {
1683 $class->config->{home} ||= $home;
1684 $class->config->{root} ||= dir($home)->subdir('root');
1685 }
1686}
1687
b5ecfcf0 1688=head2 $c->setup_log
fbcc39ad 1689
ae1e6b59 1690Sets up log.
1691
fbcc39ad 1692=cut
1693
1694sub setup_log {
1695 my ( $class, $debug ) = @_;
1696
1697 unless ( $class->log ) {
1698 $class->log( Catalyst::Log->new );
1699 }
af3ff00e 1700
71f074a9 1701 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
71f074a9 1702
af3ff00e 1703 if (
1704 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1705 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1706 : $debug
1707 )
1708 {
fbcc39ad 1709 no strict 'refs';
1710 *{"$class\::debug"} = sub { 1 };
1711 $class->log->debug('Debug messages enabled');
1712 }
1713}
1714
b5ecfcf0 1715=head2 $c->setup_plugins
fbcc39ad 1716
ae1e6b59 1717Sets up plugins.
1718
fbcc39ad 1719=cut
1720
1721sub setup_plugins {
1722 my ( $class, $plugins ) = @_;
1723
1724 $plugins ||= [];
1725 for my $plugin ( reverse @$plugins ) {
1726
1727 $plugin = "Catalyst::Plugin::$plugin";
1728
1729 $plugin->require;
1730
1731 if ($@) {
1732 Catalyst::Exception->throw(
1733 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1734 }
1735
1736 {
1737 no strict 'refs';
1738 unshift @{"$class\::ISA"}, $plugin;
1739 }
1740 }
1741}
1742
b5ecfcf0 1743=head2 $c->stack
8767c5a3 1744
0ef52a96 1745Returns the stack.
8767c5a3 1746
b5ecfcf0 1747=head2 $c->write( $data )
fbcc39ad 1748
ae1e6b59 1749Writes $data to the output stream. When using this method directly, you
1750will need to manually set the C<Content-Length> header to the length of
1751your output data, if known.
fbcc39ad 1752
1753=cut
1754
4f5ebacd 1755sub write {
1756 my $c = shift;
1757
1758 # Finalize headers if someone manually writes output
1759 $c->finalize_headers;
1760
1761 return $c->engine->write( $c, @_ );
1762}
fbcc39ad 1763
b5ecfcf0 1764=head2 version
bf88a181 1765
ae1e6b59 1766Returns the Catalyst version number. Mostly useful for "powered by"
1767messages in template systems.
bf88a181 1768
1769=cut
1770
1771sub version { return $Catalyst::VERSION }
1772
b0bb11ec 1773=head1 INTERNAL ACTIONS
1774
ae1e6b59 1775Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
1776C<_ACTION>, and C<_END>. These are by default not shown in the private
3e705254 1777action table, but you can make them visible with a config parameter.
b0bb11ec 1778
1779 MyApp->config->{show_internal_actions} = 1;
1780
d2ee9760 1781=head1 CASE SENSITIVITY
1782
3e705254 1783By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
ae1e6b59 1784mapped to C</foo/bar>. You can activate case sensitivity with a config
3e705254 1785parameter.
d2ee9760 1786
1787 MyApp->config->{case_sensitive} = 1;
1788
3e705254 1789This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
fbcc39ad 1790
1791=head1 ON-DEMAND PARSER
1792
1793The request body is usually parsed at the beginning of a request,
3e705254 1794but if you want to handle input yourself or speed things up a bit,
fbcc39ad 1795you can enable on-demand parsing with a config parameter.
1796
1797 MyApp->config->{parse_on_demand} = 1;
1798
1799=head1 PROXY SUPPORT
1800
ae1e6b59 1801Many production servers operate using the common double-server approach,
1802with a lightweight frontend web server passing requests to a larger
1803backend server. An application running on the backend server must deal
1804with two problems: the remote user always appears to be C<127.0.0.1> and
1805the server's hostname will appear to be C<localhost> regardless of the
1806virtual host that the user connected through.
fbcc39ad 1807
ae1e6b59 1808Catalyst will automatically detect this situation when you are running
1809the frontend and backend servers on the same machine. The following
1810changes are made to the request.
fbcc39ad 1811
ae1e6b59 1812 $c->req->address is set to the user's real IP address, as read from
1813 the HTTP X-Forwarded-For header.
fbcc39ad 1814
ae1e6b59 1815 The host value for $c->req->base and $c->req->uri is set to the real
1816 host, as read from the HTTP X-Forwarded-Host header.
fbcc39ad 1817
3e705254 1818Obviously, your web server must support these headers for this to work.
fbcc39ad 1819
ae1e6b59 1820In a more complex server farm environment where you may have your
1821frontend proxy server(s) on different machines, you will need to set a
1822configuration option to tell Catalyst to read the proxied data from the
1823headers.
fbcc39ad 1824
1825 MyApp->config->{using_frontend_proxy} = 1;
1826
1827If you do not wish to use the proxy support at all, you may set:
d1a31ac6 1828
fbcc39ad 1829 MyApp->config->{ignore_frontend_proxy} = 1;
1830
1831=head1 THREAD SAFETY
1832
1833Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
3e705254 1834and the standalone forking HTTP server on Windows. We believe the Catalyst
fbcc39ad 1835core to be thread-safe.
1836
1837If you plan to operate in a threaded environment, remember that all other
3e705254 1838modules you are using must also be thread-safe. Some modules, most notably
1839L<DBD::SQLite>, are not thread-safe.
d1a31ac6 1840
3cb1db8c 1841=head1 SUPPORT
1842
1843IRC:
1844
1845 Join #catalyst on irc.perl.org.
1846
3e705254 1847Mailing Lists:
3cb1db8c 1848
1849 http://lists.rawmode.org/mailman/listinfo/catalyst
1850 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1985c30b 1851
432d507d 1852Web:
1853
1854 http://catalyst.perl.org
1855
0ef52a96 1856Wiki:
1857
1858 http://dev.catalyst.perl.org
1859
fc7ec1d9 1860=head1 SEE ALSO
1861
829a28ca 1862=head2 L<Task::Catalyst> - All you need to start with Catalyst
1863
b5ecfcf0 1864=head2 L<Catalyst::Manual> - The Catalyst Manual
e7f1cf73 1865
b5ecfcf0 1866=head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
61b1e958 1867
b5ecfcf0 1868=head2 L<Catalyst::Engine> - Core engine
61b1e958 1869
b5ecfcf0 1870=head2 L<Catalyst::Log> - Log class.
61b1e958 1871
b5ecfcf0 1872=head2 L<Catalyst::Request> - Request object
61b1e958 1873
b5ecfcf0 1874=head2 L<Catalyst::Response> - Response object
61b1e958 1875
b5ecfcf0 1876=head2 L<Catalyst::Test> - The test suite.
fc7ec1d9 1877
15f0b5b7 1878=head1 CREDITS
fc7ec1d9 1879
15f0b5b7 1880Andy Grundman
1881
fbcc39ad 1882Andy Wardley
1883
33108eaf 1884Andreas Marienborg
1885
f4a57de4 1886Andrew Bramble
1887
15f0b5b7 1888Andrew Ford
1889
1890Andrew Ruthven
1891
fbcc39ad 1892Arthur Bergman
1893
15f0b5b7 1894Autrijus Tang
1895
0cf56dbc 1896Brian Cassidy
1897
15f0b5b7 1898Christian Hansen
1899
1900Christopher Hicks
1901
1902Dan Sully
1903
1904Danijel Milicevic
1905
0ef52a96 1906David Kamholz
1907
15f0b5b7 1908David Naughton
1909
61bef238 1910Drew Taylor
1911
15f0b5b7 1912Gary Ashton Jones
1913
1914Geoff Richards
1915
1916Jesse Sheidlower
1917
fbcc39ad 1918Jesse Vincent
1919
15f0b5b7 1920Jody Belka
1921
1922Johan Lindstrom
1923
1924Juan Camacho
1925
1926Leon Brocard
1927
1928Marcus Ramberg
1929
1930Matt S Trout
1931
71c3bcc3 1932Robert Sedlacek
1933
a727119f 1934Sam Vilain
1935
1cf1c56a 1936Sascha Kiefer
1937
15f0b5b7 1938Tatsuhiko Miyagawa
fc7ec1d9 1939
51f0308d 1940Ulf Edvinsson
1941
bdcb95ef 1942Yuval Kogman
1943
51f0308d 1944=head1 AUTHOR
1945
1946Sebastian Riedel, C<sri@oook.de>
1947
fc7ec1d9 1948=head1 LICENSE
1949
9ce5ab63 1950This library is free software, you can redistribute it and/or modify it under
41ca9ba7 1951the same terms as Perl itself.
fc7ec1d9 1952
1953=cut
1954
19551;