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