Fixed debug messages
[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}",
e3a13771 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
fbcc39ad 1204 my $method = $c->req->method || '';
1205 my $path = $c->req->path || '';
1206 my $address = $c->req->address || '';
1207
e3a13771 1208 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
fbcc39ad 1209 if $c->debug;
1210
e3a13771 1211 $c->prepare_action;
1212
fbcc39ad 1213 return $c;
1214}
1215
1216=item $c->prepare_action
1217
e7f1cf73 1218Prepares action.
fbcc39ad 1219
1220=cut
1221
1222sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1223
1224=item $c->prepare_body
1225
e7f1cf73 1226Prepares message body.
fbcc39ad 1227
1228=cut
1229
1230sub prepare_body {
1231 my $c = shift;
1232
1233 # Do we run for the first time?
1234 return if defined $c->request->{_body};
1235
1236 # Initialize on-demand data
1237 $c->engine->prepare_body( $c, @_ );
1238 $c->prepare_parameters;
1239 $c->prepare_uploads;
1240
1241 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
8c113188 1242 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
fbcc39ad 1243 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1244 my $param = $c->req->body_parameters->{$key};
1245 my $value = defined($param) ? $param : '';
8c113188 1246 $t->row( $key,
fbcc39ad 1247 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1248 }
1249 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1250 }
1251}
1252
4bd82c41 1253=item $c->prepare_body_chunk( $chunk )
1254
e7f1cf73 1255Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 1256
1257=cut
1258
4f5ebacd 1259sub prepare_body_chunk {
1260 my $c = shift;
4bd82c41 1261 $c->engine->prepare_body_chunk( $c, @_ );
1262}
1263
fbcc39ad 1264=item $c->prepare_body_parameters
1265
e7f1cf73 1266Prepares body parameters.
fbcc39ad 1267
1268=cut
1269
1270sub prepare_body_parameters {
1271 my $c = shift;
1272 $c->engine->prepare_body_parameters( $c, @_ );
1273}
1274
1275=item $c->prepare_connection
1276
e7f1cf73 1277Prepares connection.
fbcc39ad 1278
1279=cut
1280
1281sub prepare_connection {
1282 my $c = shift;
1283 $c->engine->prepare_connection( $c, @_ );
1284}
1285
1286=item $c->prepare_cookies
1287
e7f1cf73 1288Prepares cookies.
fbcc39ad 1289
1290=cut
1291
1292sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1293
1294=item $c->prepare_headers
1295
e7f1cf73 1296Prepares headers.
fbcc39ad 1297
1298=cut
1299
1300sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1301
1302=item $c->prepare_parameters
1303
e7f1cf73 1304Prepares parameters.
fbcc39ad 1305
1306=cut
1307
1308sub prepare_parameters {
1309 my $c = shift;
1310 $c->prepare_body_parameters;
1311 $c->engine->prepare_parameters( $c, @_ );
1312}
1313
1314=item $c->prepare_path
1315
e7f1cf73 1316Prepares path and base.
fbcc39ad 1317
1318=cut
1319
1320sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1321
1322=item $c->prepare_query_parameters
1323
e7f1cf73 1324Prepares query parameters.
fbcc39ad 1325
1326=cut
1327
1328sub prepare_query_parameters {
1329 my $c = shift;
1330
1331 $c->engine->prepare_query_parameters( $c, @_ );
1332
1333 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
8c113188 1334 my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
fbcc39ad 1335 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1336 my $param = $c->req->query_parameters->{$key};
1337 my $value = defined($param) ? $param : '';
8c113188 1338 $t->row( $key,
fbcc39ad 1339 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1340 }
1341 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1342 }
1343}
1344
1345=item $c->prepare_read
1346
e7f1cf73 1347Prepares the input for reading.
fbcc39ad 1348
1349=cut
1350
1351sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1352
1353=item $c->prepare_request
1354
e7f1cf73 1355Prepares the engine request.
fbcc39ad 1356
1357=cut
1358
1359sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1360
1361=item $c->prepare_uploads
1362
e7f1cf73 1363Prepares uploads.
fbcc39ad 1364
1365=cut
1366
1367sub prepare_uploads {
1368 my $c = shift;
1369
1370 $c->engine->prepare_uploads( $c, @_ );
1371
1372 if ( $c->debug && keys %{ $c->request->uploads } ) {
8c113188 1373 my $t = Text::SimpleTable->new(
1374 [ 12, 'Key' ],
1375 [ 28, 'Filename' ],
1376 [ 18, 'Type' ],
1377 [ 9, 'Size' ]
1378 );
fbcc39ad 1379 for my $key ( sort keys %{ $c->request->uploads } ) {
1380 my $upload = $c->request->uploads->{$key};
1381 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 1382 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 1383 }
1384 }
1385 $c->log->debug( "File Uploads are:\n" . $t->draw );
1386 }
1387}
1388
1389=item $c->prepare_write
1390
e7f1cf73 1391Prepares the output for writing.
fbcc39ad 1392
1393=cut
1394
1395sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1396
e7f1cf73 1397=item $c->request_class
1f9cb7c1 1398
e7f1cf73 1399Returns or sets the request class.
1f9cb7c1 1400
e7f1cf73 1401=item $c->response_class
1f9cb7c1 1402
e7f1cf73 1403Returns or sets the response class.
1f9cb7c1 1404
fbcc39ad 1405=item $c->read( [$maxlength] )
1406
e7f1cf73 1407Reads a chunk of data from the request body. This method is designed to be
fbcc39ad 1408used in a while loop, reading $maxlength bytes on every call. $maxlength
1409defaults to the size of the request if not specified.
1410
1411You have to set MyApp->config->{parse_on_demand} to use this directly.
1412
1413=cut
1414
1415sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1416
1417=item $c->run
1418
1419Starts the engine.
1420
1421=cut
1422
1423sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1424
1425=item $c->set_action( $action, $code, $namespace, $attrs )
1426
e7f1cf73 1427Sets an action in a given namespace.
fbcc39ad 1428
1429=cut
1430
1431sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1432
1433=item $c->setup_actions($component)
1434
e7f1cf73 1435Sets up actions for a component.
fbcc39ad 1436
1437=cut
1438
1439sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1440
1441=item $c->setup_components
1442
e7f1cf73 1443Sets up components.
fbcc39ad 1444
1445=cut
1446
1447sub setup_components {
1448 my $class = shift;
1449
1450 my $callback = sub {
1451 my ( $component, $context ) = @_;
1452
6deb49e9 1453 unless ( $component->isa('Catalyst::Component') ) {
fbcc39ad 1454 return $component;
1455 }
1456
76cb6276 1457 my $suffix = Catalyst::Utils::class2classsuffix($component);
fbcc39ad 1458 my $config = $class->config->{$suffix} || {};
1459
1460 my $instance;
1461
1462 eval { $instance = $component->new( $context, $config ); };
1463
1464 if ( my $error = $@ ) {
1465
1466 chomp $error;
1467
1468 Catalyst::Exception->throw( message =>
1469 qq/Couldn't instantiate component "$component", "$error"/ );
1470 }
1471
1472 Catalyst::Exception->throw( message =>
1473qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1474 )
1475 unless ref $instance;
1476 return $instance;
1477 };
1478
1479 eval {
1480 Module::Pluggable::Fast->import(
1481 name => '_catalyst_components',
1482 search => [
1483 "$class\::Controller", "$class\::C",
1484 "$class\::Model", "$class\::M",
1485 "$class\::View", "$class\::V"
1486 ],
1487 callback => $callback
1488 );
1489 };
1490
1491 if ( my $error = $@ ) {
1492
1493 chomp $error;
1494
1495 Catalyst::Exception->throw(
1496 message => qq/Couldn't load components "$error"/ );
1497 }
1498
1499 for my $component ( $class->_catalyst_components($class) ) {
1500 $class->components->{ ref $component || $component } = $component;
1501 }
1502}
1503
1504=item $c->setup_dispatcher
1505
1506=cut
1507
1508sub setup_dispatcher {
1509 my ( $class, $dispatcher ) = @_;
1510
1511 if ($dispatcher) {
1512 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1513 }
1514
1515 if ( $ENV{CATALYST_DISPATCHER} ) {
1516 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1517 }
1518
1519 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1520 $dispatcher =
1521 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1522 }
1523
1524 unless ($dispatcher) {
cb0354c6 1525 $dispatcher = $class->dispatcher_class;
fbcc39ad 1526 }
1527
1528 $dispatcher->require;
1529
1530 if ($@) {
1531 Catalyst::Exception->throw(
1532 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1533 }
1534
1535 # dispatcher instance
1536 $class->dispatcher( $dispatcher->new );
1537}
1538
1539=item $c->setup_engine
1540
1541=cut
1542
1543sub setup_engine {
1544 my ( $class, $engine ) = @_;
1545
1546 if ($engine) {
1547 $engine = 'Catalyst::Engine::' . $engine;
1548 }
1549
1550 if ( $ENV{CATALYST_ENGINE} ) {
1551 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1552 }
1553
1554 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1555 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1556 }
1557
1558 if ( !$engine && $ENV{MOD_PERL} ) {
1559
1560 # create the apache method
1561 {
1562 no strict 'refs';
1563 *{"$class\::apache"} = sub { shift->engine->apache };
1564 }
1565
1566 my ( $software, $version ) =
1567 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1568
1569 $version =~ s/_//g;
1570 $version =~ s/(\.[^.]+)\./$1/g;
1571
1572 if ( $software eq 'mod_perl' ) {
1573
1574 if ( $version >= 1.99922 ) {
1575 $engine = 'Catalyst::Engine::Apache2::MP20';
1576 }
1577
1578 elsif ( $version >= 1.9901 ) {
1579 $engine = 'Catalyst::Engine::Apache2::MP19';
1580 }
1581
1582 elsif ( $version >= 1.24 ) {
1583 $engine = 'Catalyst::Engine::Apache::MP13';
1584 }
1585
1586 else {
1587 Catalyst::Exception->throw( message =>
1588 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1589 }
1590
1591 # install the correct mod_perl handler
1592 if ( $version >= 1.9901 ) {
1593 *handler = sub : method {
1594 shift->handle_request(@_);
1595 };
1596 }
1597 else {
1598 *handler = sub ($$) { shift->handle_request(@_) };
1599 }
1600
1601 }
1602
1603 elsif ( $software eq 'Zeus-Perl' ) {
1604 $engine = 'Catalyst::Engine::Zeus';
1605 }
1606
1607 else {
1608 Catalyst::Exception->throw(
1609 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1610 }
1611 }
1612
1613 unless ($engine) {
cb0354c6 1614 $engine = $class->engine_class;
fbcc39ad 1615 }
1616
1617 $engine->require;
1618
1619 if ($@) {
1620 Catalyst::Exception->throw( message =>
1621qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1622 );
1623 }
0e7f5826 1624
d54484bf 1625 # check for old engines that are no longer compatible
1626 my $old_engine;
0e7f5826 1627 if ( $engine->isa('Catalyst::Engine::Apache')
1628 && !Catalyst::Engine::Apache->VERSION )
d54484bf 1629 {
1630 $old_engine = 1;
1631 }
0e7f5826 1632
d54484bf 1633 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
0e7f5826 1634 && Catalyst::Engine::Server->VERSION le '0.02' )
d54484bf 1635 {
1636 $old_engine = 1;
1637 }
0e7f5826 1638
1639 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
1640 && $engine->VERSION eq '0.01' )
d54484bf 1641 {
1642 $old_engine = 1;
1643 }
0e7f5826 1644
1645 elsif ($engine->isa('Catalyst::Engine::Zeus')
1646 && $engine->VERSION eq '0.01' )
d54484bf 1647 {
1648 $old_engine = 1;
1649 }
fbcc39ad 1650
d54484bf 1651 if ($old_engine) {
1652 Catalyst::Exception->throw( message =>
0e7f5826 1653 qq/Engine "$engine" is not supported by this version of Catalyst/
d54484bf 1654 );
1655 }
0e7f5826 1656
fbcc39ad 1657 # engine instance
1658 $class->engine( $engine->new );
1659}
1660
1661=item $c->setup_home
1662
1663=cut
1664
1665sub setup_home {
1666 my ( $class, $home ) = @_;
1667
1668 if ( $ENV{CATALYST_HOME} ) {
1669 $home = $ENV{CATALYST_HOME};
1670 }
1671
1672 if ( $ENV{ uc($class) . '_HOME' } ) {
1673 $home = $ENV{ uc($class) . '_HOME' };
1674 }
1675
1676 unless ($home) {
1677 $home = Catalyst::Utils::home($class);
1678 }
1679
1680 if ($home) {
1681 $class->config->{home} ||= $home;
1682 $class->config->{root} ||= dir($home)->subdir('root');
1683 }
1684}
1685
1686=item $c->setup_log
1687
1688=cut
1689
1690sub setup_log {
1691 my ( $class, $debug ) = @_;
1692
1693 unless ( $class->log ) {
1694 $class->log( Catalyst::Log->new );
1695 }
af3ff00e 1696
71f074a9 1697 my $app_flag = Catalyst::Utils::class2env($class) . '_DEBUG';
71f074a9 1698
af3ff00e 1699 if (
1700 ( defined( $ENV{CATALYST_DEBUG} ) || defined( $ENV{$app_flag} ) )
1701 ? ( $ENV{CATALYST_DEBUG} || $ENV{$app_flag} )
1702 : $debug
1703 )
1704 {
fbcc39ad 1705 no strict 'refs';
1706 *{"$class\::debug"} = sub { 1 };
1707 $class->log->debug('Debug messages enabled');
1708 }
1709}
1710
1711=item $c->setup_plugins
1712
1713=cut
1714
1715sub setup_plugins {
1716 my ( $class, $plugins ) = @_;
1717
1718 $plugins ||= [];
1719 for my $plugin ( reverse @$plugins ) {
1720
1721 $plugin = "Catalyst::Plugin::$plugin";
1722
1723 $plugin->require;
1724
1725 if ($@) {
1726 Catalyst::Exception->throw(
1727 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1728 }
1729
1730 {
1731 no strict 'refs';
1732 unshift @{"$class\::ISA"}, $plugin;
1733 }
1734 }
1735}
1736
8767c5a3 1737=item $c->stack
1738
0ef52a96 1739Returns the stack.
8767c5a3 1740
fbcc39ad 1741=item $c->write( $data )
1742
1743Writes $data to the output stream. When using this method directly, you will
1744need to manually set the Content-Length header to the length of your output
1745data, if known.
1746
1747=cut
1748
4f5ebacd 1749sub write {
1750 my $c = shift;
1751
1752 # Finalize headers if someone manually writes output
1753 $c->finalize_headers;
1754
1755 return $c->engine->write( $c, @_ );
1756}
fbcc39ad 1757
bf88a181 1758=item version
1759
e7f1cf73 1760Returns the Catalyst version number. Mostly useful for "powered by" messages
bf88a181 1761in template systems.
1762
1763=cut
1764
1765sub version { return $Catalyst::VERSION }
1766
23f9d934 1767=back
1768
b0bb11ec 1769=head1 INTERNAL ACTIONS
1770
1771Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>
3e705254 1772C<_ACTION> and C<_END>. These are by default not shown in the private
1773action table, but you can make them visible with a config parameter.
b0bb11ec 1774
1775 MyApp->config->{show_internal_actions} = 1;
1776
d2ee9760 1777=head1 CASE SENSITIVITY
1778
3e705254 1779By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
1780mapped to C</foo/bar>. You can activate case sensitivity with a config
1781parameter.
d2ee9760 1782
1783 MyApp->config->{case_sensitive} = 1;
1784
3e705254 1785This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
fbcc39ad 1786
1787=head1 ON-DEMAND PARSER
1788
1789The request body is usually parsed at the beginning of a request,
3e705254 1790but if you want to handle input yourself or speed things up a bit,
fbcc39ad 1791you can enable on-demand parsing with a config parameter.
1792
1793 MyApp->config->{parse_on_demand} = 1;
1794
1795=head1 PROXY SUPPORT
1796
1797Many production servers operate using the common double-server approach, with
1798a lightweight frontend web server passing requests to a larger backend
1799server. An application running on the backend server must deal with two
3e705254 1800problems: the remote user always appears to be C<127.0.0.1> and the server's
1801hostname will appear to be C<localhost> regardless of the virtual host that
1802the user connected through.
fbcc39ad 1803
3e705254 1804Catalyst will automatically detect this situation when you are running the
1805frontend and backend servers on the same machine. The following changes
fbcc39ad 1806are made to the request.
1807
1808 $c->req->address is set to the user's real IP address, as read from the
3e705254 1809 HTTP X-Forwarded-For header.
fbcc39ad 1810
1811 The host value for $c->req->base and $c->req->uri is set to the real host,
3e705254 1812 as read from the HTTP X-Forwarded-Host header.
fbcc39ad 1813
3e705254 1814Obviously, your web server must support these headers for this to work.
fbcc39ad 1815
1816In a more complex server farm environment where you may have your frontend
1817proxy server(s) on different machines, you will need to set a configuration
1818option to tell Catalyst to read the proxied data from the headers.
1819
1820 MyApp->config->{using_frontend_proxy} = 1;
1821
1822If you do not wish to use the proxy support at all, you may set:
d1a31ac6 1823
fbcc39ad 1824 MyApp->config->{ignore_frontend_proxy} = 1;
1825
1826=head1 THREAD SAFETY
1827
1828Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
3e705254 1829and the standalone forking HTTP server on Windows. We believe the Catalyst
fbcc39ad 1830core to be thread-safe.
1831
1832If you plan to operate in a threaded environment, remember that all other
3e705254 1833modules you are using must also be thread-safe. Some modules, most notably
1834L<DBD::SQLite>, are not thread-safe.
d1a31ac6 1835
3cb1db8c 1836=head1 SUPPORT
1837
1838IRC:
1839
1840 Join #catalyst on irc.perl.org.
1841
3e705254 1842Mailing Lists:
3cb1db8c 1843
1844 http://lists.rawmode.org/mailman/listinfo/catalyst
1845 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1985c30b 1846
432d507d 1847Web:
1848
1849 http://catalyst.perl.org
1850
0ef52a96 1851Wiki:
1852
1853 http://dev.catalyst.perl.org
1854
fc7ec1d9 1855=head1 SEE ALSO
1856
61b1e958 1857=over 4
1858
1859=item L<Catalyst::Manual> - The Catalyst Manual
1860
e7f1cf73 1861=item L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
1862
61b1e958 1863=item L<Catalyst::Engine> - Core Engine
1864
1865=item L<Catalyst::Log> - The Log Class.
1866
1867=item L<Catalyst::Request> - The Request Object
1868
1869=item L<Catalyst::Response> - The Response Object
1870
1871=item L<Catalyst::Test> - The test suite.
1872
1873=back
fc7ec1d9 1874
15f0b5b7 1875=head1 CREDITS
fc7ec1d9 1876
15f0b5b7 1877Andy Grundman
1878
fbcc39ad 1879Andy Wardley
1880
33108eaf 1881Andreas Marienborg
1882
f4a57de4 1883Andrew Bramble
1884
15f0b5b7 1885Andrew Ford
1886
1887Andrew Ruthven
1888
fbcc39ad 1889Arthur Bergman
1890
15f0b5b7 1891Autrijus Tang
1892
0cf56dbc 1893Brian Cassidy
1894
15f0b5b7 1895Christian Hansen
1896
1897Christopher Hicks
1898
1899Dan Sully
1900
1901Danijel Milicevic
1902
0ef52a96 1903David Kamholz
1904
15f0b5b7 1905David Naughton
1906
1907Gary Ashton Jones
1908
1909Geoff Richards
1910
1911Jesse Sheidlower
1912
fbcc39ad 1913Jesse Vincent
1914
15f0b5b7 1915Jody Belka
1916
1917Johan Lindstrom
1918
1919Juan Camacho
1920
1921Leon Brocard
1922
1923Marcus Ramberg
1924
1925Matt S Trout
1926
71c3bcc3 1927Robert Sedlacek
1928
a727119f 1929Sam Vilain
1930
1cf1c56a 1931Sascha Kiefer
1932
15f0b5b7 1933Tatsuhiko Miyagawa
fc7ec1d9 1934
51f0308d 1935Ulf Edvinsson
1936
bdcb95ef 1937Yuval Kogman
1938
51f0308d 1939=head1 AUTHOR
1940
1941Sebastian Riedel, C<sri@oook.de>
1942
fc7ec1d9 1943=head1 LICENSE
1944
9ce5ab63 1945This library is free software, you can redistribute it and/or modify it under
41ca9ba7 1946the same terms as Perl itself.
fc7ec1d9 1947
1948=cut
1949
19501;