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