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