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