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