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