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