doc pointer from content_type
[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';
d10c3e60 595 @plugins =
596 map { $_ . ' ' . ( $_->VERSION || '' ) }
597 grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
fbcc39ad 598 }
599
600 if (@plugins) {
8c113188 601 my $t = Text::SimpleTable->new(76);
602 $t->row($_) for @plugins;
fbcc39ad 603 $class->log->debug( "Loaded plugins:\n" . $t->draw );
604 }
605
606 my $dispatcher = $class->dispatcher;
607 my $engine = $class->engine;
608 my $home = $class->config->{home};
609
610 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
611 $class->log->debug(qq/Loaded engine "$engine"/);
612
613 $home
614 ? ( -d $home )
615 ? $class->log->debug(qq/Found home "$home"/)
616 : $class->log->debug(qq/Home "$home" doesn't exist/)
617 : $class->log->debug(q/Couldn't find home/);
618 }
619
620 # Call plugins setup
621 {
622 no warnings qw/redefine/;
623 local *setup = sub { };
624 $class->setup;
625 }
626
627 # Initialize our data structure
628 $class->components( {} );
629
630 $class->setup_components;
631
632 if ( $class->debug ) {
9d3e016e 633 my $t = Text::SimpleTable->new( [ 65, 'Class' ], [ 8, 'Type' ] );
684d10ed 634 for my $comp ( sort keys %{ $class->components } ) {
635 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
636 $t->row( $comp, $type );
637 }
fbcc39ad 638 $class->log->debug( "Loaded components:\n" . $t->draw )
8c113188 639 if ( keys %{ $class->components } );
fbcc39ad 640 }
641
642 # Add our self to components, since we are also a component
643 $class->components->{$class} = $class;
644
645 $class->setup_actions;
646
647 if ( $class->debug ) {
648 my $name = $class->config->{name} || 'Application';
649 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
650 }
651 $class->log->_flush() if $class->log->can('_flush');
652}
653
b5ecfcf0 654=head2 $c->uri_for( $path, [ @args ] )
fbcc39ad 655
ae1e6b59 656Merges path with C<$c-E<gt>request-E<gt>base> for absolute uri's and
ccc9f8aa 657with C<$c-E<gt>namespace> for relative uri's, then returns a
ae1e6b59 658normalized L<URI> object. If any args are passed, they are added at the
659end of the path.
fbcc39ad 660
661=cut
662
663sub uri_for {
00e6a2b7 664 my ( $c, $path, @args ) = @_;
fbcc39ad 665 my $base = $c->request->base->clone;
666 my $basepath = $base->path;
667 $basepath =~ s/\/$//;
fdba7a9d 668 $basepath .= '/';
ccc9f8aa 669 my $namespace = $c->namespace;
00e6a2b7 670
ccc9f8aa 671 # massage namespace, empty if absolute path
672 $namespace =~ s/^\///;
673 $namespace .= '/' if $namespace;
6e0c45c9 674 $path ||= '';
ccc9f8aa 675 $namespace = '' if $path =~ /^\//;
fbcc39ad 676 $path =~ s/^\///;
00e6a2b7 677
189e2a51 678 # join args with '/', or a blank string
00e6a2b7 679 my $args = ( scalar @args ? '/' . join( '/', @args ) : '' );
d3e7a648 680 $args =~ s/^\/// unless $path;
681 my $res =
682 URI->new_abs( URI->new_abs( "$path$args", "$basepath$namespace" ), $base )
683 ->canonical;
684 $res;
fbcc39ad 685}
686
b5ecfcf0 687=head2 $c->welcome_message
ab2374d3 688
689Returns the Catalyst welcome HTML page.
690
691=cut
692
693sub welcome_message {
bf1f2c60 694 my $c = shift;
695 my $name = $c->config->{name};
696 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
697 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 698 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 699 return <<"EOF";
80cdbbff 700<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
701 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
702<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 703 <head>
80cdbbff 704 <meta http-equiv="Content-Language" content="en" />
705 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 706 <title>$name on Catalyst $VERSION</title>
707 <style type="text/css">
708 body {
ab2374d3 709 color: #000;
710 background-color: #eee;
711 }
712 div#content {
713 width: 640px;
80cdbbff 714 margin-left: auto;
715 margin-right: auto;
ab2374d3 716 margin-top: 10px;
717 margin-bottom: 10px;
718 text-align: left;
719 background-color: #ccc;
720 border: 1px solid #aaa;
721 -moz-border-radius: 10px;
722 }
d84c4dab 723 p, h1, h2 {
ab2374d3 724 margin-left: 20px;
725 margin-right: 20px;
16215972 726 font-family: verdana, tahoma, sans-serif;
ab2374d3 727 }
d84c4dab 728 a {
729 font-family: verdana, tahoma, sans-serif;
730 }
d114e033 731 :link, :visited {
732 text-decoration: none;
733 color: #b00;
734 border-bottom: 1px dotted #bbb;
735 }
736 :link:hover, :visited:hover {
d114e033 737 color: #555;
738 }
ab2374d3 739 div#topbar {
740 margin: 0px;
741 }
3e82a295 742 pre {
3e82a295 743 margin: 10px;
744 padding: 8px;
745 }
ab2374d3 746 div#answers {
747 padding: 8px;
748 margin: 10px;
d114e033 749 background-color: #fff;
ab2374d3 750 border: 1px solid #aaa;
751 -moz-border-radius: 10px;
752 }
753 h1 {
33108eaf 754 font-size: 0.9em;
755 font-weight: normal;
ab2374d3 756 text-align: center;
757 }
758 h2 {
759 font-size: 1.0em;
760 }
761 p {
762 font-size: 0.9em;
763 }
ae7c5252 764 p img {
765 float: right;
766 margin-left: 10px;
767 }
9619f23c 768 span#appname {
769 font-weight: bold;
33108eaf 770 font-size: 1.6em;
ab2374d3 771 }
772 </style>
773 </head>
774 <body>
775 <div id="content">
776 <div id="topbar">
9619f23c 777 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 778 $VERSION</h1>
ab2374d3 779 </div>
780 <div id="answers">
ae7c5252 781 <p>
80cdbbff 782 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 783 </p>
4b8cb778 784 <p>Welcome to the wonderful world of Catalyst.
f92fd545 785 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
786 framework will make web development something you had
60dd6e1d 787 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 788 <h2>What to do now?</h2>
4b8cb778 789 <p>That really depends on what <b>you</b> want to do.
ab2374d3 790 We do, however, provide you with a few starting points.</p>
791 <p>If you want to jump right into web development with Catalyst
5db7f9a1 792 you might want to check out the documentation.</p>
bf1f2c60 793 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
794perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
ab2374d3 795 <h2>What to do next?</h2>
f5681c92 796 <p>Next it's time to write an actual application. Use the
80cdbbff 797 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
60dd6e1d 798 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
799 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
bf1f2c60 800 they can save you a lot of work.</p>
801 <pre><code>script/${prefix}_create.pl -help</code></pre>
802 <p>Also, be sure to check out the vast and growing
60dd6e1d 803 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 804 you are likely to find what you need there.
f5681c92 805 </p>
806
82245cc4 807 <h2>Need help?</h2>
f5681c92 808 <p>Catalyst has a very active community. Here are the main places to
809 get in touch with us.</p>
16215972 810 <ul>
811 <li>
2b9a7d76 812 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 813 </li>
814 <li>
815 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
816 </li>
817 <li>
ea7cd80d 818 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 819 </li>
820 </ul>
ab2374d3 821 <h2>In conclusion</h2>
4e7aa2ea 822 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 823 as we enjoyed making it. Please contact us if you have ideas
824 for improvement or other feedback.</p>
ab2374d3 825 </div>
826 </div>
827 </body>
828</html>
829EOF
830}
831
fbcc39ad 832=head1 INTERNAL METHODS
833
ae1e6b59 834These methods are not meant to be used by end users.
835
b5ecfcf0 836=head2 $c->components
fbcc39ad 837
e7f1cf73 838Returns a hash of components.
fbcc39ad 839
b5ecfcf0 840=head2 $c->context_class
1f9cb7c1 841
e7f1cf73 842Returns or sets the context class.
1f9cb7c1 843
b5ecfcf0 844=head2 $c->counter
fbcc39ad 845
ae1e6b59 846Returns a hashref containing coderefs and execution counts (needed for
847deep recursion detection).
fbcc39ad 848
b5ecfcf0 849=head2 $c->depth
fbcc39ad 850
e7f1cf73 851Returns the number of actions on the current internal execution stack.
fbcc39ad 852
b5ecfcf0 853=head2 $c->dispatch
fbcc39ad 854
e7f1cf73 855Dispatches a request to actions.
fbcc39ad 856
857=cut
858
859sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
860
b5ecfcf0 861=head2 $c->dispatcher_class
1f9cb7c1 862
e7f1cf73 863Returns or sets the dispatcher class.
1f9cb7c1 864
b5ecfcf0 865=head2 $c->dump_these
7f92deef 866
ae1e6b59 867Returns a list of 2-element array references (name, structure) pairs
868that will be dumped on the error page in debug mode.
7f92deef 869
870=cut
871
872sub dump_these {
873 my $c = shift;
874 [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ],;
875}
876
b5ecfcf0 877=head2 $c->engine_class
1f9cb7c1 878
e7f1cf73 879Returns or sets the engine class.
1f9cb7c1 880
b5ecfcf0 881=head2 $c->execute( $class, $coderef )
fbcc39ad 882
0ef52a96 883Execute a coderef in given class and catch exceptions. Errors are available
884via $c->error.
fbcc39ad 885
886=cut
887
888sub execute {
889 my ( $c, $class, $code ) = @_;
890 $class = $c->components->{$class} || $class;
891 $c->state(0);
a0eca838 892
893 my $callsub =
894 ( caller(0) )[0]->isa('Catalyst::Action')
895 ? ( caller(2) )[3]
896 : ( caller(1) )[3];
fbcc39ad 897
898 my $action = '';
899 if ( $c->debug ) {
900 $action = "$code";
901 $action = "/$action" unless $action =~ /\-\>/;
902 $c->counter->{"$code"}++;
903
904 if ( $c->counter->{"$code"} > $RECURSION ) {
905 my $error = qq/Deep recursion detected in "$action"/;
906 $c->log->error($error);
907 $c->error($error);
908 $c->state(0);
909 return $c->state;
910 }
911
912 $action = "-> $action" if $callsub =~ /forward$/;
913 }
8767c5a3 914 push( @{ $c->stack }, $code );
245ae014 915 my $elapsed = 0;
916 my $start = 0;
917 $start = [gettimeofday] if $c->debug;
918 eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
919 $elapsed = tv_interval($start) if $c->debug;
920
921 if ( $c->debug ) {
922 unless ( ( $code->name =~ /^_.*/ )
923 && ( !$c->config->{show_internal_actions} ) )
00e6a2b7 924 {
245ae014 925 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
fbcc39ad 926 }
245ae014 927 }
f59def82 928 my $last = ${ $c->stack }[-1];
8767c5a3 929 pop( @{ $c->stack } );
fbcc39ad 930
931 if ( my $error = $@ ) {
932
28591cd7 933 if ( $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
fbcc39ad 934 else {
935 unless ( ref $error ) {
936 chomp $error;
f59def82 937 my $class = $last->class;
938 my $name = $last->name;
939 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 940 }
fbcc39ad 941 $c->error($error);
942 $c->state(0);
943 }
944 }
945 return $c->state;
946}
947
b5ecfcf0 948=head2 $c->finalize
fbcc39ad 949
e7f1cf73 950Finalizes the request.
fbcc39ad 951
952=cut
953
954sub finalize {
955 my $c = shift;
956
369c09bc 957 for my $error ( @{ $c->error } ) {
958 $c->log->error($error);
959 }
960
fbcc39ad 961 $c->finalize_uploads;
962
963 # Error
964 if ( $#{ $c->error } >= 0 ) {
965 $c->finalize_error;
966 }
967
968 $c->finalize_headers;
969
970 # HEAD request
971 if ( $c->request->method eq 'HEAD' ) {
972 $c->response->body('');
973 }
974
975 $c->finalize_body;
976
977 return $c->response->status;
978}
979
b5ecfcf0 980=head2 $c->finalize_body
fbcc39ad 981
e7f1cf73 982Finalizes body.
fbcc39ad 983
984=cut
985
986sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
987
b5ecfcf0 988=head2 $c->finalize_cookies
fbcc39ad 989
e7f1cf73 990Finalizes cookies.
fbcc39ad 991
992=cut
993
147821ea 994sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 995
b5ecfcf0 996=head2 $c->finalize_error
fbcc39ad 997
e7f1cf73 998Finalizes error.
fbcc39ad 999
1000=cut
1001
1002sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1003
b5ecfcf0 1004=head2 $c->finalize_headers
fbcc39ad 1005
e7f1cf73 1006Finalizes headers.
fbcc39ad 1007
1008=cut
1009
1010sub finalize_headers {
1011 my $c = shift;
1012
1013 # Check if we already finalized headers
1014 return if $c->response->{_finalized_headers};
1015
1016 # Handle redirects
1017 if ( my $location = $c->response->redirect ) {
1018 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1019 $c->response->header( Location => $location );
1020 }
1021
1022 # Content-Length
1023 if ( $c->response->body && !$c->response->content_length ) {
775878ac 1024
8f62c91a 1025 # get the length from a filehandle
1026 if ( ref $c->response->body && $c->response->body->can('read') ) {
1027 if ( my $stat = stat $c->response->body ) {
1028 $c->response->content_length( $stat->size );
1029 }
1030 else {
775878ac 1031 $c->log->warn('Serving filehandle without a content-length');
8f62c91a 1032 }
1033 }
1034 else {
775878ac 1035 $c->response->content_length( bytes::length( $c->response->body ) );
8f62c91a 1036 }
fbcc39ad 1037 }
1038
1039 # Errors
1040 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
1041 $c->response->headers->remove_header("Content-Length");
1042 $c->response->body('');
1043 }
1044
1045 $c->finalize_cookies;
1046
1047 $c->engine->finalize_headers( $c, @_ );
1048
1049 # Done
1050 $c->response->{_finalized_headers} = 1;
1051}
1052
b5ecfcf0 1053=head2 $c->finalize_output
fbcc39ad 1054
1055An alias for finalize_body.
1056
b5ecfcf0 1057=head2 $c->finalize_read
fbcc39ad 1058
e7f1cf73 1059Finalizes the input after reading is complete.
fbcc39ad 1060
1061=cut
1062
1063sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1064
b5ecfcf0 1065=head2 $c->finalize_uploads
fbcc39ad 1066
ae1e6b59 1067Finalizes uploads. Cleans up any temporary files.
fbcc39ad 1068
1069=cut
1070
1071sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1072
b5ecfcf0 1073=head2 $c->get_action( $action, $namespace )
fbcc39ad 1074
e7f1cf73 1075Gets an action in a given namespace.
fbcc39ad 1076
1077=cut
1078
684d10ed 1079sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 1080
b5ecfcf0 1081=head2 $c->get_actions( $action, $namespace )
a9dc674c 1082
ae1e6b59 1083Gets all actions of a given name in a namespace and all parent
1084namespaces.
a9dc674c 1085
1086=cut
1087
1088sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1089
b5ecfcf0 1090=head2 handle_request( $class, @arguments )
fbcc39ad 1091
e7f1cf73 1092Called to handle each HTTP request.
fbcc39ad 1093
1094=cut
1095
1096sub handle_request {
1097 my ( $class, @arguments ) = @_;
1098
1099 # Always expect worst case!
1100 my $status = -1;
1101 eval {
1102 my @stats = ();
1103
1104 my $handler = sub {
1105 my $c = $class->prepare(@arguments);
1106 $c->{stats} = \@stats;
1107 $c->dispatch;
1108 return $c->finalize;
1109 };
1110
1111 if ( $class->debug ) {
245ae014 1112 my $start = [gettimeofday];
1113 $status = &$handler;
1114 my $elapsed = tv_interval $start;
fbcc39ad 1115 $elapsed = sprintf '%f', $elapsed;
1116 my $av = sprintf '%.3f',
1117 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
8c113188 1118 my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
fbcc39ad 1119
8c113188 1120 for my $stat (@stats) { $t->row( $stat->[0], $stat->[1] ) }
fbcc39ad 1121 $class->log->info(
1122 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
1123 }
1124 else { $status = &$handler }
1125
1126 };
1127
1128 if ( my $error = $@ ) {
1129 chomp $error;
1130 $class->log->error(qq/Caught exception in engine "$error"/);
1131 }
1132
1133 $COUNT++;
1134 $class->log->_flush() if $class->log->can('_flush');
1135 return $status;
1136}
1137
b5ecfcf0 1138=head2 $c->prepare( @arguments )
fbcc39ad 1139
ae1e6b59 1140Creates a Catalyst context from an engine-specific request (Apache, CGI,
1141etc.).
fbcc39ad 1142
1143=cut
1144
1145sub prepare {
1146 my ( $class, @arguments ) = @_;
1147
3cec521a 1148 $class->context_class( ref $class || $class ) unless $class->context_class;
1149 my $c = $class->context_class->new(
1150 {
1151 counter => {},
28591cd7 1152 stack => [],
3cec521a 1153 request => $class->request_class->new(
1154 {
1155 arguments => [],
1156 body_parameters => {},
1157 cookies => {},
1158 headers => HTTP::Headers->new,
1159 parameters => {},
1160 query_parameters => {},
1161 secure => 0,
1162 snippets => [],
1163 uploads => {}
1164 }
1165 ),
1166 response => $class->response_class->new(
1167 {
1168 body => '',
1169 cookies => {},
1170 headers => HTTP::Headers->new(),
1171 status => 200
1172 }
1173 ),
1174 stash => {},
1175 state => 0
1176 }
1177 );
fbcc39ad 1178
1179 # For on-demand data
1180 $c->request->{_context} = $c;
1181 $c->response->{_context} = $c;
1182 weaken( $c->request->{_context} );
1183 weaken( $c->response->{_context} );
1184
1185 if ( $c->debug ) {
1186 my $secs = time - $START || 1;
1187 my $av = sprintf '%.3f', $COUNT / $secs;
1188 $c->log->debug('**********************************');
1189 $c->log->debug("* Request $COUNT ($av/s) [$$]");
1190 $c->log->debug('**********************************');
1191 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1192 }
1193
1194 $c->prepare_request(@arguments);
1195 $c->prepare_connection;
1196 $c->prepare_query_parameters;
1197 $c->prepare_headers;
1198 $c->prepare_cookies;
1199 $c->prepare_path;
1200
1201 # On-demand parsing
1202 $c->prepare_body unless $c->config->{parse_on_demand};
1203
fbcc39ad 1204 my $method = $c->req->method || '';
1205 my $path = $c->req->path || '';
1206 my $address = $c->req->address || '';
1207
e3a13771 1208 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
fbcc39ad 1209 if $c->debug;
1210
e3a13771 1211 $c->prepare_action;
1212
fbcc39ad 1213 return $c;
1214}
1215
b5ecfcf0 1216=head2 $c->prepare_action
fbcc39ad 1217
e7f1cf73 1218Prepares action.
fbcc39ad 1219
1220=cut
1221
1222sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1223
b5ecfcf0 1224=head2 $c->prepare_body
fbcc39ad 1225
e7f1cf73 1226Prepares message body.
fbcc39ad 1227
1228=cut
1229
1230sub prepare_body {
1231 my $c = shift;
1232
1233 # Do we run for the first time?
1234 return if defined $c->request->{_body};
1235
1236 # Initialize on-demand data
1237 $c->engine->prepare_body( $c, @_ );
1238 $c->prepare_parameters;
1239 $c->prepare_uploads;
1240
1241 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
8c113188 1242 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
fbcc39ad 1243 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1244 my $param = $c->req->body_parameters->{$key};
1245 my $value = defined($param) ? $param : '';
8c113188 1246 $t->row( $key,
fbcc39ad 1247 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1248 }
1249 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1250 }
1251}
1252
b5ecfcf0 1253=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 1254
e7f1cf73 1255Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 1256
1257=cut
1258
4f5ebacd 1259sub prepare_body_chunk {
1260 my $c = shift;
4bd82c41 1261 $c->engine->prepare_body_chunk( $c, @_ );
1262}
1263
b5ecfcf0 1264=head2 $c->prepare_body_parameters
fbcc39ad 1265
e7f1cf73 1266Prepares body parameters.
fbcc39ad 1267
1268=cut
1269
1270sub prepare_body_parameters {
1271 my $c = shift;
1272 $c->engine->prepare_body_parameters( $c, @_ );
1273}
1274
b5ecfcf0 1275=head2 $c->prepare_connection
fbcc39ad 1276
e7f1cf73 1277Prepares connection.
fbcc39ad 1278
1279=cut
1280
1281sub prepare_connection {
1282 my $c = shift;
1283 $c->engine->prepare_connection( $c, @_ );
1284}
1285
b5ecfcf0 1286=head2 $c->prepare_cookies
fbcc39ad 1287
e7f1cf73 1288Prepares cookies.
fbcc39ad 1289
1290=cut
1291
1292sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1293
b5ecfcf0 1294=head2 $c->prepare_headers
fbcc39ad 1295
e7f1cf73 1296Prepares headers.
fbcc39ad 1297
1298=cut
1299
1300sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1301
b5ecfcf0 1302=head2 $c->prepare_parameters
fbcc39ad 1303
e7f1cf73 1304Prepares parameters.
fbcc39ad 1305
1306=cut
1307
1308sub prepare_parameters {
1309 my $c = shift;
1310 $c->prepare_body_parameters;
1311 $c->engine->prepare_parameters( $c, @_ );
1312}
1313
b5ecfcf0 1314=head2 $c->prepare_path
fbcc39ad 1315
e7f1cf73 1316Prepares path and base.
fbcc39ad 1317
1318=cut
1319
1320sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1321
b5ecfcf0 1322=head2 $c->prepare_query_parameters
fbcc39ad 1323
e7f1cf73 1324Prepares query parameters.
fbcc39ad 1325
1326=cut
1327
1328sub prepare_query_parameters {
1329 my $c = shift;
1330
1331 $c->engine->prepare_query_parameters( $c, @_ );
1332
1333 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
8c113188 1334 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
fbcc39ad 1335 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1336 my $param = $c->req->query_parameters->{$key};
1337 my $value = defined($param) ? $param : '';
8c113188 1338 $t->row( $key,
fbcc39ad 1339 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1340 }
1341 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1342 }
1343}
1344
b5ecfcf0 1345=head2 $c->prepare_read
fbcc39ad 1346
e7f1cf73 1347Prepares the input for reading.
fbcc39ad 1348
1349=cut
1350
1351sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1352
b5ecfcf0 1353=head2 $c->prepare_request
fbcc39ad 1354
e7f1cf73 1355Prepares the engine request.
fbcc39ad 1356
1357=cut
1358
1359sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1360
b5ecfcf0 1361=head2 $c->prepare_uploads
fbcc39ad 1362
e7f1cf73 1363Prepares uploads.
fbcc39ad 1364
1365=cut
1366
1367sub prepare_uploads {
1368 my $c = shift;
1369
1370 $c->engine->prepare_uploads( $c, @_ );
1371
1372 if ( $c->debug && keys %{ $c->request->uploads } ) {
8c113188 1373 my $t = Text::SimpleTable->new(
1374 [ 12, 'Key' ],
1375 [ 28, 'Filename' ],
1376 [ 18, 'Type' ],
1377 [ 9, 'Size' ]
1378 );
fbcc39ad 1379 for my $key ( sort keys %{ $c->request->uploads } ) {
1380 my $upload = $c->request->uploads->{$key};
1381 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 1382 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 1383 }
1384 }
1385 $c->log->debug( "File Uploads are:\n" . $t->draw );
1386 }
1387}
1388
b5ecfcf0 1389=head2 $c->prepare_write
fbcc39ad 1390
e7f1cf73 1391Prepares the output for writing.
fbcc39ad 1392
1393=cut
1394
1395sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1396
b5ecfcf0 1397=head2 $c->request_class
1f9cb7c1 1398
e7f1cf73 1399Returns or sets the request class.
1f9cb7c1 1400
b5ecfcf0 1401=head2 $c->response_class
1f9cb7c1 1402
e7f1cf73 1403Returns or sets the response class.
1f9cb7c1 1404
b5ecfcf0 1405=head2 $c->read( [$maxlength] )
fbcc39ad 1406
ae1e6b59 1407Reads a chunk of data from the request body. This method is designed to
1408be used in a while loop, reading C<$maxlength> bytes on every call.
1409C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 1410
ae1e6b59 1411You have to set C<MyApp-E<gt>config-E<gt>{parse_on_demand}> to use this
1412directly.
fbcc39ad 1413
1414=cut
1415
1416sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1417
b5ecfcf0 1418=head2 $c->run
fbcc39ad 1419
1420Starts the engine.
1421
1422=cut
1423
1424sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1425
b5ecfcf0 1426=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 1427
e7f1cf73 1428Sets an action in a given namespace.
fbcc39ad 1429
1430=cut
1431
1432sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1433
b5ecfcf0 1434=head2 $c->setup_actions($component)
fbcc39ad 1435
e7f1cf73 1436Sets up actions for a component.
fbcc39ad 1437
1438=cut
1439
1440sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1441
b5ecfcf0 1442=head2 $c->setup_components
fbcc39ad 1443
e7f1cf73 1444Sets up components.
fbcc39ad 1445
1446=cut
1447
1448sub setup_components {
1449 my $class = shift;
1450
1451 my $callback = sub {
1452 my ( $component, $context ) = @_;
1453
6deb49e9 1454 unless ( $component->isa('Catalyst::Component') ) {
fbcc39ad 1455 return $component;
1456 }
1457
76cb6276 1458 my $suffix = Catalyst::Utils::class2classsuffix($component);
fbcc39ad 1459 my $config = $class->config->{$suffix} || {};
1460
1461 my $instance;
1462
1463 eval { $instance = $component->new( $context, $config ); };
1464
1465 if ( my $error = $@ ) {
1466
1467 chomp $error;
1468
1469 Catalyst::Exception->throw( message =>
1470 qq/Couldn't instantiate component "$component", "$error"/ );
1471 }
1472
1473 Catalyst::Exception->throw( message =>
1474qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1475 )
1476 unless ref $instance;
1477 return $instance;
1478 };
1479
6f006bd6 1480 eval "package $class;\n" . q!Module::Pluggable::Fast->import(
fbcc39ad 1481 name => '_catalyst_components',
1482 search => [
1483 "$class\::Controller", "$class\::C",
1484 "$class\::Model", "$class\::M",
1485 "$class\::View", "$class\::V"
1486 ],
1487 callback => $callback
1488 );
4289f674 1489 !;
fbcc39ad 1490
1491 if ( my $error = $@ ) {
1492
1493 chomp $error;
1494
1495 Catalyst::Exception->throw(
1496 message => qq/Couldn't load components "$error"/ );
1497 }
1498
1499 for my $component ( $class->_catalyst_components($class) ) {
1500 $class->components->{ ref $component || $component } = $component;
1501 }
1502}
1503
b5ecfcf0 1504=head2 $c->setup_dispatcher
fbcc39ad 1505
ae1e6b59 1506Sets up dispatcher.
1507
fbcc39ad 1508=cut
1509
1510sub setup_dispatcher {
1511 my ( $class, $dispatcher ) = @_;
1512
1513 if ($dispatcher) {
1514 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1515 }
1516
1517 if ( $ENV{CATALYST_DISPATCHER} ) {
1518 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1519 }
1520
1521 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1522 $dispatcher =
1523 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1524 }
1525
1526 unless ($dispatcher) {
cb0354c6 1527 $dispatcher = $class->dispatcher_class;
fbcc39ad 1528 }
1529
1530 $dispatcher->require;
1531
1532 if ($@) {
1533 Catalyst::Exception->throw(
1534 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1535 }
1536
1537 # dispatcher instance
1538 $class->dispatcher( $dispatcher->new );
1539}
1540
b5ecfcf0 1541=head2 $c->setup_engine
fbcc39ad 1542
ae1e6b59 1543Sets up engine.
1544
fbcc39ad 1545=cut
1546
1547sub setup_engine {
1548 my ( $class, $engine ) = @_;
1549
1550 if ($engine) {
1551 $engine = 'Catalyst::Engine::' . $engine;
1552 }
1553
1554 if ( $ENV{CATALYST_ENGINE} ) {
1555 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1556 }
1557
1558 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1559 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1560 }
1561
9b0a3e0f 1562 if ( $ENV{MOD_PERL} ) {
fbcc39ad 1563
1564 # create the apache method
1565 {
1566 no strict 'refs';
1567 *{"$class\::apache"} = sub { shift->engine->apache };
1568 }
1569
1570 my ( $software, $version ) =
1571 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1572
1573 $version =~ s/_//g;
1574 $version =~ s/(\.[^.]+)\./$1/g;
1575
1576 if ( $software eq 'mod_perl' ) {
1577
9b0a3e0f 1578 if ( !$engine ) {
1579
1580 if ( $version >= 1.99922 ) {
1581 $engine = 'Catalyst::Engine::Apache2::MP20';
1582 }
1583
1584 elsif ( $version >= 1.9901 ) {
1585 $engine = 'Catalyst::Engine::Apache2::MP19';
1586 }
1587
1588 elsif ( $version >= 1.24 ) {
1589 $engine = 'Catalyst::Engine::Apache::MP13';
1590 }
1591
1592 else {
1593 Catalyst::Exception->throw( message =>
1594 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1595 }
fbcc39ad 1596
fbcc39ad 1597 }
1598
1599 # install the correct mod_perl handler
1600 if ( $version >= 1.9901 ) {
1601 *handler = sub : method {
1602 shift->handle_request(@_);
1603 };
1604 }
1605 else {
1606 *handler = sub ($$) { shift->handle_request(@_) };
1607 }
1608
1609 }
1610
1611 elsif ( $software eq 'Zeus-Perl' ) {
1612 $engine = 'Catalyst::Engine::Zeus';
1613 }
1614
1615 else {
1616 Catalyst::Exception->throw(
1617 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1618 }
1619 }
1620
1621 unless ($engine) {
cb0354c6 1622 $engine = $class->engine_class;
fbcc39ad 1623 }
1624
1625 $engine->require;
1626
1627 if ($@) {
1628 Catalyst::Exception->throw( message =>
1629qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1630 );
1631 }
0e7f5826 1632
d54484bf 1633 # check for old engines that are no longer compatible
1634 my $old_engine;
0e7f5826 1635 if ( $engine->isa('Catalyst::Engine::Apache')
1636 && !Catalyst::Engine::Apache->VERSION )
d54484bf 1637 {
1638 $old_engine = 1;
1639 }
0e7f5826 1640
d54484bf 1641 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
0e7f5826 1642 && Catalyst::Engine::Server->VERSION le '0.02' )
d54484bf 1643 {
1644 $old_engine = 1;
1645 }
0e7f5826 1646
1647 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1648 && $engine->VERSION eq '0.01' )
d54484bf 1649 {
1650 $old_engine = 1;
1651 }
0e7f5826 1652
1653 elsif ($engine->isa('Catalyst::Engine::Zeus')
1654 && $engine->VERSION eq '0.01' )
d54484bf 1655 {
1656 $old_engine = 1;
1657 }
fbcc39ad 1658
d54484bf 1659 if ($old_engine) {
1660 Catalyst::Exception->throw( message =>
0e7f5826 1661 qq/Engine "$engine" is not supported by this version of Catalyst/
d54484bf 1662 );
1663 }
0e7f5826 1664
fbcc39ad 1665 # engine instance
1666 $class->engine( $engine->new );
1667}
1668
b5ecfcf0 1669=head2 $c->setup_home
fbcc39ad 1670
ae1e6b59 1671Sets up the home directory.
1672
fbcc39ad 1673=cut
1674
1675sub setup_home {
1676 my ( $class, $home ) = @_;
1677
1678 if ( $ENV{CATALYST_HOME} ) {
1679 $home = $ENV{CATALYST_HOME};
1680 }
1681
1682 if ( $ENV{ uc($class) . '_HOME' } ) {
1683 $home = $ENV{ uc($class) . '_HOME' };
1684 }
1685
1686 unless ($home) {
1687 $home = Catalyst::Utils::home($class);
1688 }
1689
1690 if ($home) {
1691 $class->config->{home} ||= $home;
1692 $class->config->{root} ||= dir($home)->subdir('root');
1693 }
1694}
1695
b5ecfcf0 1696=head2 $c->setup_log
fbcc39ad 1697
ae1e6b59 1698Sets up log.
1699
fbcc39ad 1700=cut
1701
1702sub setup_log {
1703 my ( $class, $debug ) = @_;
1704
1705 unless ( $class->log ) {
1706 $class->log( Catalyst::Log->new );
1707 }
af3ff00e 1708
71f074a9 1709 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
71f074a9 1710
af3ff00e 1711 if (
1712 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1713 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1714 : $debug
1715 )
1716 {
fbcc39ad 1717 no strict 'refs';
1718 *{"$class\::debug"} = sub { 1 };
1719 $class->log->debug('Debug messages enabled');
1720 }
1721}
1722
b5ecfcf0 1723=head2 $c->setup_plugins
fbcc39ad 1724
ae1e6b59 1725Sets up plugins.
1726
fbcc39ad 1727=cut
1728
1729sub setup_plugins {
1730 my ( $class, $plugins ) = @_;
1731
1732 $plugins ||= [];
1733 for my $plugin ( reverse @$plugins ) {
1734
1735 $plugin = "Catalyst::Plugin::$plugin";
1736
1737 $plugin->require;
1738
1739 if ($@) {
1740 Catalyst::Exception->throw(
1741 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1742 }
1743
1744 {
1745 no strict 'refs';
1746 unshift @{"$class\::ISA"}, $plugin;
1747 }
1748 }
1749}
1750
b5ecfcf0 1751=head2 $c->stack
8767c5a3 1752
0ef52a96 1753Returns the stack.
8767c5a3 1754
b5ecfcf0 1755=head2 $c->write( $data )
fbcc39ad 1756
ae1e6b59 1757Writes $data to the output stream. When using this method directly, you
1758will need to manually set the C<Content-Length> header to the length of
1759your output data, if known.
fbcc39ad 1760
1761=cut
1762
4f5ebacd 1763sub write {
1764 my $c = shift;
1765
1766 # Finalize headers if someone manually writes output
1767 $c->finalize_headers;
1768
1769 return $c->engine->write( $c, @_ );
1770}
fbcc39ad 1771
b5ecfcf0 1772=head2 version
bf88a181 1773
ae1e6b59 1774Returns the Catalyst version number. Mostly useful for "powered by"
1775messages in template systems.
bf88a181 1776
1777=cut
1778
1779sub version { return $Catalyst::VERSION }
1780
b0bb11ec 1781=head1 INTERNAL ACTIONS
1782
ae1e6b59 1783Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
1784C<_ACTION>, and C<_END>. These are by default not shown in the private
3e705254 1785action table, but you can make them visible with a config parameter.
b0bb11ec 1786
1787 MyApp->config->{show_internal_actions} = 1;
1788
d2ee9760 1789=head1 CASE SENSITIVITY
1790
3e705254 1791By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
ae1e6b59 1792mapped to C</foo/bar>. You can activate case sensitivity with a config
3e705254 1793parameter.
d2ee9760 1794
1795 MyApp->config->{case_sensitive} = 1;
1796
3e705254 1797This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
fbcc39ad 1798
1799=head1 ON-DEMAND PARSER
1800
1801The request body is usually parsed at the beginning of a request,
3e705254 1802but if you want to handle input yourself or speed things up a bit,
fbcc39ad 1803you can enable on-demand parsing with a config parameter.
1804
1805 MyApp->config->{parse_on_demand} = 1;
1806
1807=head1 PROXY SUPPORT
1808
ae1e6b59 1809Many production servers operate using the common double-server approach,
1810with a lightweight frontend web server passing requests to a larger
1811backend server. An application running on the backend server must deal
1812with two problems: the remote user always appears to be C<127.0.0.1> and
1813the server's hostname will appear to be C<localhost> regardless of the
1814virtual host that the user connected through.
fbcc39ad 1815
ae1e6b59 1816Catalyst will automatically detect this situation when you are running
1817the frontend and backend servers on the same machine. The following
1818changes are made to the request.
fbcc39ad 1819
ae1e6b59 1820 $c->req->address is set to the user's real IP address, as read from
1821 the HTTP X-Forwarded-For header.
fbcc39ad 1822
ae1e6b59 1823 The host value for $c->req->base and $c->req->uri is set to the real
1824 host, as read from the HTTP X-Forwarded-Host header.
fbcc39ad 1825
3e705254 1826Obviously, your web server must support these headers for this to work.
fbcc39ad 1827
ae1e6b59 1828In a more complex server farm environment where you may have your
1829frontend proxy server(s) on different machines, you will need to set a
1830configuration option to tell Catalyst to read the proxied data from the
1831headers.
fbcc39ad 1832
1833 MyApp->config->{using_frontend_proxy} = 1;
1834
1835If you do not wish to use the proxy support at all, you may set:
d1a31ac6 1836
fbcc39ad 1837 MyApp->config->{ignore_frontend_proxy} = 1;
1838
1839=head1 THREAD SAFETY
1840
1841Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
3e705254 1842and the standalone forking HTTP server on Windows. We believe the Catalyst
fbcc39ad 1843core to be thread-safe.
1844
1845If you plan to operate in a threaded environment, remember that all other
3e705254 1846modules you are using must also be thread-safe. Some modules, most notably
1847L<DBD::SQLite>, are not thread-safe.
d1a31ac6 1848
3cb1db8c 1849=head1 SUPPORT
1850
1851IRC:
1852
1853 Join #catalyst on irc.perl.org.
1854
3e705254 1855Mailing Lists:
3cb1db8c 1856
1857 http://lists.rawmode.org/mailman/listinfo/catalyst
1858 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1985c30b 1859
432d507d 1860Web:
1861
1862 http://catalyst.perl.org
1863
0ef52a96 1864Wiki:
1865
1866 http://dev.catalyst.perl.org
1867
fc7ec1d9 1868=head1 SEE ALSO
1869
829a28ca 1870=head2 L<Task::Catalyst> - All you need to start with Catalyst
1871
b5ecfcf0 1872=head2 L<Catalyst::Manual> - The Catalyst Manual
e7f1cf73 1873
b5ecfcf0 1874=head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
61b1e958 1875
b5ecfcf0 1876=head2 L<Catalyst::Engine> - Core engine
61b1e958 1877
b5ecfcf0 1878=head2 L<Catalyst::Log> - Log class.
61b1e958 1879
b5ecfcf0 1880=head2 L<Catalyst::Request> - Request object
61b1e958 1881
b5ecfcf0 1882=head2 L<Catalyst::Response> - Response object
61b1e958 1883
b5ecfcf0 1884=head2 L<Catalyst::Test> - The test suite.
fc7ec1d9 1885
15f0b5b7 1886=head1 CREDITS
fc7ec1d9 1887
15f0b5b7 1888Andy Grundman
1889
fbcc39ad 1890Andy Wardley
1891
33108eaf 1892Andreas Marienborg
1893
f4a57de4 1894Andrew Bramble
1895
15f0b5b7 1896Andrew Ford
1897
1898Andrew Ruthven
1899
fbcc39ad 1900Arthur Bergman
1901
15f0b5b7 1902Autrijus Tang
1903
0cf56dbc 1904Brian Cassidy
1905
15f0b5b7 1906Christian Hansen
1907
1908Christopher Hicks
1909
1910Dan Sully
1911
1912Danijel Milicevic
1913
0ef52a96 1914David Kamholz
1915
15f0b5b7 1916David Naughton
1917
61bef238 1918Drew Taylor
1919
15f0b5b7 1920Gary Ashton Jones
1921
1922Geoff Richards
1923
1924Jesse Sheidlower
1925
fbcc39ad 1926Jesse Vincent
1927
15f0b5b7 1928Jody Belka
1929
1930Johan Lindstrom
1931
1932Juan Camacho
1933
1934Leon Brocard
1935
1936Marcus Ramberg
1937
1938Matt S Trout
1939
71c3bcc3 1940Robert Sedlacek
1941
a727119f 1942Sam Vilain
1943
1cf1c56a 1944Sascha Kiefer
1945
15f0b5b7 1946Tatsuhiko Miyagawa
fc7ec1d9 1947
51f0308d 1948Ulf Edvinsson
1949
bdcb95ef 1950Yuval Kogman
1951
51f0308d 1952=head1 AUTHOR
1953
1954Sebastian Riedel, C<sri@oook.de>
1955
fc7ec1d9 1956=head1 LICENSE
1957
9ce5ab63 1958This library is free software, you can redistribute it and/or modify it under
41ca9ba7 1959the same terms as Perl itself.
fc7ec1d9 1960
1961=cut
1962
19631;