Fix pointless warning from test
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
1 package Catalyst;
2
3 use Moose;
4 use Moose::Meta::Class ();
5 extends 'Catalyst::Component';
6 use Moose::Util qw/find_meta/;
7 use B::Hooks::EndOfScope ();
8 use Catalyst::Exception;
9 use Catalyst::Exception::Detach;
10 use Catalyst::Exception::Go;
11 use Catalyst::Log;
12 use Catalyst::Request;
13 use Catalyst::Request::Upload;
14 use Catalyst::Response;
15 use Catalyst::Utils;
16 use Catalyst::Controller;
17 use Data::OptList;
18 use File::stat;
19 use Text::SimpleTable ();
20 use Path::Class::Dir ();
21 use Path::Class::File ();
22 use URI ();
23 use URI::http;
24 use URI::https;
25 use Tree::Simple qw/use_weak_refs/;
26 use Tree::Simple::Visitor::FindByUID;
27 use Class::C3::Adopt::NEXT;
28 use List::MoreUtils qw/uniq/;
29 use attributes;
30 use String::RewritePrefix;
31 use Catalyst::EngineLoader;
32 use utf8;
33 use Carp qw/croak carp shortmess/;
34 use Try::Tiny;
35 use Plack::Middleware::Conditional;
36 use Plack::Middleware::ReverseProxy;
37 use Plack::Middleware::IIS6ScriptNameFix;
38 use Plack::Middleware::LighttpdScriptNameFix;
39
40 BEGIN { require 5.008004; }
41
42 has stack => (is => 'ro', default => sub { [] });
43 has stash => (is => 'rw', default => sub { {} });
44 has state => (is => 'rw', default => 0);
45 has stats => (is => 'rw');
46 has action => (is => 'rw');
47 has counter => (is => 'rw', default => sub { {} });
48 has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
49 has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
50 has namespace => (is => 'rw');
51
52 sub depth { scalar @{ shift->stack || [] }; }
53 sub comp { shift->component(@_) }
54
55 sub req {
56     my $self = shift; return $self->request(@_);
57 }
58 sub res {
59     my $self = shift; return $self->response(@_);
60 }
61
62 # For backwards compatibility
63 sub finalize_output { shift->finalize_body(@_) };
64
65 # For statistics
66 our $COUNT     = 1;
67 our $START     = time;
68 our $RECURSION = 1000;
69 our $DETACH    = Catalyst::Exception::Detach->new;
70 our $GO        = Catalyst::Exception::Go->new;
71
72 #I imagine that very few of these really need to be class variables. if any.
73 #maybe we should just make them attributes with a default?
74 __PACKAGE__->mk_classdata($_)
75   for qw/container arguments dispatcher engine log dispatcher_class
76   engine_loader context_class request_class response_class stats_class
77   setup_finished _psgi_app loading_psgi_file/;
78
79 __PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
80 __PACKAGE__->request_class('Catalyst::Request');
81 __PACKAGE__->response_class('Catalyst::Response');
82 __PACKAGE__->stats_class('Catalyst::Stats');
83
84 # Remember to update this in Catalyst::Runtime as well!
85
86 our $VERSION = '5.90005';
87
88 sub import {
89     my ( $class, @arguments ) = @_;
90
91     # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
92     # callers @ISA.
93     return unless $class eq 'Catalyst';
94
95     my $caller = caller();
96     return if $caller eq 'main';
97
98     my $meta = Moose::Meta::Class->initialize($caller);
99
100     unless ( $caller->isa('Catalyst') ) { # XXX - Remove!
101         my @superclasses = ($meta->superclasses, $class, 'Catalyst::Component'); # XXX - Remove!
102         $meta->superclasses(@superclasses); # XXX - Remove!
103     } # XXX - Remove!
104
105     # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp
106     $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses);
107
108     unless( $meta->has_method('meta') ){
109         if ($Moose::VERSION >= 1.15) {
110             $meta->_add_meta_method('meta');
111         }
112         else {
113             $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
114         }
115     }
116
117     $caller->arguments( [@arguments] );
118     $caller->setup_home;
119 }
120
121 sub MODIFY_CODE_ATTRIBUTES {
122     Catalyst::Exception->throw(
123         "Catalyst applications (aka MyApp) cannot be controllers anymore. " .
124         "That has been deprecated and removed. You should create a " .
125         "controller class called Root.pm, and move relevant code to that class."
126     );
127 }
128
129
130 sub _application { $_[0] }
131
132 =head1 NAME
133
134 Catalyst - The Elegant MVC Web Application Framework
135
136 =head1 SYNOPSIS
137
138 See the L<Catalyst::Manual> distribution for comprehensive
139 documentation and tutorials.
140
141     # Install Catalyst::Devel for helpers and other development tools
142     # use the helper to create a new application
143     catalyst.pl MyApp
144
145     # add models, views, controllers
146     script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
147     script/myapp_create.pl view MyTemplate TT
148     script/myapp_create.pl controller Search
149
150     # built in testserver -- use -r to restart automatically on changes
151     # --help to see all available options
152     script/myapp_server.pl
153
154     # command line testing interface
155     script/myapp_test.pl /yada
156
157     ### in lib/MyApp.pm
158     use Catalyst qw/-Debug/; # include plugins here as well
159
160     ### In lib/MyApp/Controller/Root.pm (autocreated)
161     sub foo : Chained('/') Args() { # called for /foo, /foo/1, /foo/1/2, etc.
162         my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
163         $c->stash->{template} = 'foo.tt'; # set the template
164         # lookup something from db -- stash vars are passed to TT
165         $c->stash->{data} =
166           $c->model('Database::Foo')->search( { country => $args[0] } );
167         if ( $c->req->params->{bar} ) { # access GET or POST parameters
168             $c->forward( 'bar' ); # process another action
169             # do something else after forward returns
170         }
171     }
172
173     # The foo.tt TT template can use the stash data from the database
174     [% WHILE (item = data.next) %]
175         [% item.foo %]
176     [% END %]
177
178     # called for /bar/of/soap, /bar/of/soap/10, etc.
179     sub bar : Chained('/') PathPart('/bar/of/soap') Args() { ... }
180
181     # called after all actions are finished
182     sub end : Action {
183         my ( $self, $c ) = @_;
184         if ( scalar @{ $c->error } ) { ... } # handle errors
185         return if $c->res->body; # already have a response
186         $c->forward( 'MyApp::View::TT' ); # render template
187     }
188
189 See L<Catalyst::Manual::Intro> for additional information.
190
191 =head1 DESCRIPTION
192
193 Catalyst is a modern framework for making web applications without the
194 pain usually associated with this process. This document is a reference
195 to the main Catalyst application. If you are a new user, we suggest you
196 start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
197
198 See L<Catalyst::Manual> for more documentation.
199
200 Catalyst plugins can be loaded by naming them as arguments to the "use
201 Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
202 plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
203 C<My::Module>.
204
205     use Catalyst qw/My::Module/;
206
207 If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
208 fully qualify the name by using a unary plus:
209
210     use Catalyst qw/
211         My::Module
212         +Fully::Qualified::Plugin::Name
213     /;
214
215 Special flags like C<-Debug> can also be specified as
216 arguments when Catalyst is loaded:
217
218     use Catalyst qw/-Debug My::Module/;
219
220 The position of plugins and flags in the chain is important, because
221 they are loaded in the order in which they appear.
222
223 The following flags are supported:
224
225 =head2 -Debug
226
227 Enables debug output. You can also force this setting from the system
228 environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
229 settings override the application, with <MYAPP>_DEBUG having the highest
230 priority.
231
232 This sets the log level to 'debug' and enables full debug output on the
233 error screen. If you only want the latter, see L<< $c->debug >>.
234
235 =head2 -Home
236
237 Forces Catalyst to use a specific home directory, e.g.:
238
239     use Catalyst qw[-Home=/usr/mst];
240
241 This can also be done in the shell environment by setting either the
242 C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
243 is replaced with the uppercased name of your application, any "::" in
244 the name will be replaced with underscores, e.g. MyApp::Web should use
245 MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
246
247 If none of these are set, Catalyst will attempt to automatically detect the
248 home directory. If you are working in a development environment, Catalyst
249 will try and find the directory containing either Makefile.PL, Build.PL or
250 dist.ini. If the application has been installed into the system (i.e.
251 you have done C<make install>), then Catalyst will use the path to your
252 application module, without the .pm extension (e.g., /foo/MyApp if your
253 application was installed at /foo/MyApp.pm)
254
255 =head2 -Log
256
257     use Catalyst '-Log=warn,fatal,error';
258
259 Specifies a comma-delimited list of log levels.
260
261 =head2 -Stats
262
263 Enables statistics collection and reporting.
264
265    use Catalyst qw/-Stats=1/;
266
267 You can also force this setting from the system environment with CATALYST_STATS
268 or <MYAPP>_STATS. The environment settings override the application, with
269 <MYAPP>_STATS having the highest priority.
270
271 Stats are also enabled if L<< debugging |/"-Debug" >> is enabled.
272
273 =head1 METHODS
274
275 =head2 INFORMATION ABOUT THE CURRENT REQUEST
276
277 =head2 $c->action
278
279 Returns a L<Catalyst::Action> object for the current action, which
280 stringifies to the action name. See L<Catalyst::Action>.
281
282 =head2 $c->namespace
283
284 Returns the namespace of the current action, i.e., the URI prefix
285 corresponding to the controller of the current action. For example:
286
287     # in Controller::Foo::Bar
288     $c->namespace; # returns 'foo/bar';
289
290 =head2 $c->request
291
292 =head2 $c->req
293
294 Returns the current L<Catalyst::Request> object, giving access to
295 information about the current client request (including parameters,
296 cookies, HTTP headers, etc.). See L<Catalyst::Request>.
297
298 =head2 REQUEST FLOW HANDLING
299
300 =head2 $c->forward( $action [, \@arguments ] )
301
302 =head2 $c->forward( $class, $method, [, \@arguments ] )
303
304 Forwards processing to another action, by its private name. If you give a
305 class name but no method, C<process()> is called. You may also optionally
306 pass arguments in an arrayref. The action will receive the arguments in
307 C<@_> and C<< $c->req->args >>. Upon returning from the function,
308 C<< $c->req->args >> will be restored to the previous values.
309
310 Any data C<return>ed from the action forwarded to, will be returned by the
311 call to forward.
312
313     my $foodata = $c->forward('/foo');
314     $c->forward('index');
315     $c->forward(qw/Model::DBIC::Foo do_stuff/);
316     $c->forward('View::TT');
317
318 Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies
319 an C<< eval { } >> around the call (actually
320 L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all
321 exceptions thrown by the called action non-fatal and pushing them onto
322 $c->error instead. If you want C<die> to propagate you need to do something
323 like:
324
325     $c->forward('foo');
326     die join "\n", @{ $c->error } if @{ $c->error };
327
328 Or make sure to always return true values from your actions and write
329 your code like this:
330
331     $c->forward('foo') || return;
332
333 Another note is that C<< $c->forward >> always returns a scalar because it
334 actually returns $c->state which operates in a scalar context.
335 Thus, something like:
336
337     return @array;
338
339 in an action that is forwarded to is going to return a scalar,
340 i.e. how many items are in that array, which is probably not what you want.
341 If you need to return an array then return a reference to it,
342 or stash it like so:
343
344     $c->stash->{array} = \@array;
345
346 and access it from the stash.
347
348 Keep in mind that the C<end> method used is that of the caller action. So a C<$c-E<gt>detach> inside a forwarded action would run the C<end> method from the original action requested.
349
350 =cut
351
352 sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
353
354 =head2 $c->detach( $action [, \@arguments ] )
355
356 =head2 $c->detach( $class, $method, [, \@arguments ] )
357
358 =head2 $c->detach()
359
360 The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but
361 doesn't return to the previous action when processing is finished.
362
363 When called with no arguments it escapes the processing chain entirely.
364
365 =cut
366
367 sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
368
369 =head2 $c->visit( $action [, \@captures, \@arguments ] )
370
371 =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
372
373 Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>,
374 but does a full dispatch, instead of just calling the new C<$action> /
375 C<< $class->$method >>. This means that C<begin>, C<auto> and the method
376 you go to are called, just like a new request.
377
378 In addition both C<< $c->action >> and C<< $c->namespace >> are localized.
379 This means, for example, that C<< $c->action >> methods such as
380 L<name|Catalyst::Action/name>, L<class|Catalyst::Action/class> and
381 L<reverse|Catalyst::Action/reverse> return information for the visited action
382 when they are invoked within the visited action.  This is different from the
383 behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which
384 continues to use the $c->action object from the caller action even when
385 invoked from the called action.
386
387 C<< $c->stash >> is kept unchanged.
388
389 In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >>
390 allows you to "wrap" another action, just as it would have been called by
391 dispatching from a URL, while the analogous
392 L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to
393 transfer control to another action as if it had been reached directly from a URL.
394
395 =cut
396
397 sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
398
399 =head2 $c->go( $action [, \@captures, \@arguments ] )
400
401 =head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
402
403 The relationship between C<go> and
404 L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as
405 the relationship between
406 L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and
407 L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
408 C<< $c->go >> will perform a full dispatch on the specified action or method,
409 with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
410 C<go> escapes the processing of the current request chain on completion, and
411 does not return to its caller.
412
413 @arguments are arguments to the final destination of $action. @captures are
414 arguments to the intermediate steps, if any, on the way to the final sub of
415 $action.
416
417 =cut
418
419 sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
420
421 =head2 $c->response
422
423 =head2 $c->res
424
425 Returns the current L<Catalyst::Response> object, see there for details.
426
427 =head2 $c->stash
428
429 Returns a hashref to the stash, which may be used to store data and pass
430 it between components during a request. You can also set hash keys by
431 passing arguments. The stash is automatically sent to the view. The
432 stash is cleared at the end of a request; it cannot be used for
433 persistent storage (for this you must use a session; see
434 L<Catalyst::Plugin::Session> for a complete system integrated with
435 Catalyst).
436
437     $c->stash->{foo} = $bar;
438     $c->stash( { moose => 'majestic', qux => 0 } );
439     $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
440
441     # stash is automatically passed to the view for use in a template
442     $c->forward( 'MyApp::View::TT' );
443
444 =cut
445
446 around stash => sub {
447     my $orig = shift;
448     my $c = shift;
449     my $stash = $orig->($c);
450     if (@_) {
451         my $new_stash = @_ > 1 ? {@_} : $_[0];
452         croak('stash takes a hash or hashref') unless ref $new_stash;
453         foreach my $key ( keys %$new_stash ) {
454           $stash->{$key} = $new_stash->{$key};
455         }
456     }
457
458     return $stash;
459 };
460
461
462 =head2 $c->error
463
464 =head2 $c->error($error, ...)
465
466 =head2 $c->error($arrayref)
467
468 Returns an arrayref containing error messages.  If Catalyst encounters an
469 error while processing a request, it stores the error in $c->error.  This
470 method should only be used to store fatal error messages.
471
472     my @error = @{ $c->error };
473
474 Add a new error.
475
476     $c->error('Something bad happened');
477
478 =cut
479
480 sub error {
481     my $c = shift;
482     if ( $_[0] ) {
483         my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
484         croak @$error unless ref $c;
485         push @{ $c->{error} }, @$error;
486     }
487     elsif ( defined $_[0] ) { $c->{error} = undef }
488     return $c->{error} || [];
489 }
490
491
492 =head2 $c->state
493
494 Contains the return value of the last executed action.
495 Note that << $c->state >> operates in a scalar context which means that all
496 values it returns are scalar.
497
498 =head2 $c->clear_errors
499
500 Clear errors.  You probably don't want to clear the errors unless you are
501 implementing a custom error screen.
502
503 This is equivalent to running
504
505     $c->error(0);
506
507 =cut
508
509 sub clear_errors {
510     my $c = shift;
511     $c->error(0);
512 }
513
514 =head2 COMPONENT ACCESSORS
515
516 =head2 $c->controller($name)
517
518 Gets a L<Catalyst::Controller> instance by name.
519
520     $c->controller('Foo')->do_stuff;
521
522 If the name is omitted, will return the controller for the dispatched
523 action.
524
525 If you want to search for controllers, pass in a regexp as the argument.
526
527     # find all controllers that start with Foo
528     my @foo_controllers = $c->controller(qr{^Foo});
529
530
531 =cut
532
533 sub controller { shift->_lookup_mvc('controller', @_) }
534
535 =head2 $c->model($name)
536
537 Gets a L<Catalyst::Model> instance by name.
538
539     $c->model('Foo')->do_stuff;
540
541 Any extra arguments are directly passed to ACCEPT_CONTEXT.
542
543 If the name is omitted, it will look for
544  - a model object in $c->stash->{current_model_instance}, then
545  - a model name in $c->stash->{current_model}, then
546  - a config setting 'default_model', or
547  - check if there is only one model, and return it if that's the case.
548
549 If you want to search for models, pass in a regexp as the argument.
550
551     # find all models that start with Foo
552     my @foo_models = $c->model(qr{^Foo});
553
554 =cut
555
556 sub model { shift->_lookup_mvc('model', @_) }
557
558 =head2 $c->view($name)
559
560 Gets a L<Catalyst::View> instance by name.
561
562     $c->view('Foo')->do_stuff;
563
564 Any extra arguments are directly passed to ACCEPT_CONTEXT.
565
566 If the name is omitted, it will look for
567  - a view object in $c->stash->{current_view_instance}, then
568  - a view name in $c->stash->{current_view}, then
569  - a config setting 'default_view', or
570  - check if there is only one view, and return it if that's the case.
571
572 If you want to search for views, pass in a regexp as the argument.
573
574     # find all views that start with Foo
575     my @foo_views = $c->view(qr{^Foo});
576
577 =cut
578
579 sub view { shift->_lookup_mvc('view', @_) }
580
581 sub _lookup_mvc {
582     my ( $c, $type, $name, @args ) = @_;
583
584     if (ref $c && !$name) {
585         my $current_instance = $c->stash->{"current_${type}_instance"};
586         return $current_instance
587             if $current_instance && $type ne 'controller';
588
589         $name = $type eq 'controller'
590               ? Catalyst::Utils::class2classshortsuffix($c->action->class)
591               : $c->stash->{"current_${type}"}
592               ;
593     }
594
595     return $c->container->get_component_from_sub_container($type, $name, $c, @args);
596 }
597
598 =head2 $c->controllers
599
600 Returns the available names which can be passed to $c->controller
601
602 =cut
603
604 sub controllers {
605     my ( $c ) = @_;
606     return $c->container->get_sub_container('controller')->get_service_list;
607 }
608
609 =head2 $c->models
610
611 Returns the available names which can be passed to $c->model
612
613 =cut
614
615 sub models {
616     my ( $c ) = @_;
617     return $c->container->get_sub_container('model')->get_service_list;
618 }
619
620
621 =head2 $c->views
622
623 Returns the available names which can be passed to $c->view
624
625 =cut
626
627 sub views {
628     my ( $c ) = @_;
629     return $c->container->get_sub_container('view')->get_service_list;
630 }
631
632 =head2 $c->comp($name)
633
634 =head2 $c->component($name)
635
636 Gets a component object by name. This method is not recommended,
637 unless you want to get a specific component by full
638 class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
639 should be used instead.
640
641 If C<$name> is a regexp, a list of components matched against the full
642 component name will be returned.
643
644 =cut
645
646 sub component {
647     my ( $c, $component, @args ) = @_;
648
649     unless ($component) {
650         $c->log->warn('Calling $c->component with no args is deprecated and ');
651         $c->log->warn('will be removed in a future release.');
652         $c->log->warn('Use $c->component_list instead.');
653         return $c->component_list;
654     }
655
656     my @result = $c->container->find_component( $component, $c, @args );
657
658     # list context for regexp searches
659     return @result if ref $component;
660
661     # only one component (if it's found) for string searches
662     return shift @result if @result;
663
664     if (ref $c eq $component) {
665         $c->log->warn('You are calling $c->comp("MyApp"). This behaviour is');
666         $c->log->warn('deprecated, and will be removed in a future release.');
667         return $c;
668     }
669
670     $c->log->warn("Looking for '$component', but nothing was found.");
671
672     # I would expect to return an empty list here, but that breaks back-compat
673     $c->log->warn('Component not found, returning the list of existing');
674     $c->log->warn('components. This behavior is deprecated and will be');
675     $c->log->warn('removed in a future release. Use $c->component_list');
676     $c->log->warn('instead.');
677
678     return $c->component_list;
679 }
680
681 =head2 $c->component_list
682
683 Returns the sorted list of the component names of the application.
684
685 =cut
686
687 sub component_list { sort keys %{ shift->components } }
688
689 =head2 CLASS DATA AND HELPER CLASSES
690
691 =head2 $c->config
692
693 Returns or takes a hashref containing the application's configuration.
694
695     __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
696
697 You can also use a C<YAML>, C<XML> or L<Config::General> config file
698 like C<myapp.conf> in your applications home directory. See
699 L<Catalyst::Plugin::ConfigLoader>.
700
701 =head3 Cascading configuration
702
703 The config method is present on all Catalyst components, and configuration
704 will be merged when an application is started. Configuration loaded with
705 L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
706 followed by configuration in your top level C<MyApp> class. These two
707 configurations are merged, and then configuration data whose hash key matches a
708 component name is merged with configuration for that component.
709
710 The configuration for a component is then passed to the C<new> method when a
711 component is constructed.
712
713 For example:
714
715     MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
716     MyApp::Model::Foo->config({ quux => 'frob', overrides => 'this' });
717
718 will mean that C<MyApp::Model::Foo> receives the following data when
719 constructed:
720
721     MyApp::Model::Foo->new({
722         bar => 'baz',
723         quux => 'frob',
724         overrides => 'me',
725     });
726
727 It's common practice to use a Moose attribute
728 on the receiving component to access the config value.
729
730     package MyApp::Model::Foo;
731
732     use Moose;
733
734     # this attr will receive 'baz' at construction time
735     has 'bar' => (
736         is  => 'rw',
737         isa => 'Str',
738     );
739
740 You can then get the value 'baz' by calling $c->model('Foo')->bar
741 (or $self->bar inside code in the model).
742
743 B<NOTE:> you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >>
744 as a way of reading config within your code, as this B<will not> give you the
745 correctly merged config back. You B<MUST> take the config values supplied to
746 the constructor and use those instead.
747
748 =cut
749
750 around config => sub {
751     my $orig = shift;
752     my $c = shift;
753
754     croak('Setting config after setup has been run is not allowed.')
755         if ( @_ and $c->setup_finished );
756
757     $c->$orig(@_);
758 };
759
760 =head2 $c->log
761
762 Returns the logging object instance. Unless it is already set, Catalyst
763 sets this up with a L<Catalyst::Log> object. To use your own log class,
764 set the logger with the C<< __PACKAGE__->log >> method prior to calling
765 C<< __PACKAGE__->setup >>.
766
767  __PACKAGE__->log( MyLogger->new );
768  __PACKAGE__->setup;
769
770 And later:
771
772     $c->log->info( 'Now logging with my own logger!' );
773
774 Your log class should implement the methods described in
775 L<Catalyst::Log>.
776
777
778 =head2 $c->debug
779
780 Returns 1 if debug mode is enabled, 0 otherwise.
781
782 You can enable debug mode in several ways:
783
784 =over
785
786 =item By calling myapp_server.pl with the -d flag
787
788 =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
789
790 =item The -Debug option in your MyApp.pm
791
792 =item By declaring C<sub debug { 1 }> in your MyApp.pm.
793
794 =back
795
796 The first three also set the log level to 'debug'.
797
798 Calling C<< $c->debug(1) >> has no effect.
799
800 =cut
801
802 sub debug { 0 }
803
804 =head2 $c->dispatcher
805
806 Returns the dispatcher instance. See L<Catalyst::Dispatcher>.
807
808 =head2 $c->engine
809
810 Returns the engine instance. See L<Catalyst::Engine>.
811
812
813 =head2 UTILITY METHODS
814
815 =head2 $c->path_to(@path)
816
817 Merges C<@path> with C<< $c->config->{home} >> and returns a
818 L<Path::Class::Dir> object. Note you can usually use this object as
819 a filename, but sometimes you will have to explicitly stringify it
820 yourself by calling the C<< ->stringify >> method.
821
822 For example:
823
824     $c->path_to( 'db', 'sqlite.db' );
825
826 =cut
827
828 sub path_to {
829     my ( $c, @path ) = @_;
830     my $path = Path::Class::Dir->new( $c->config->{home}, @path );
831     if ( -d $path ) { return $path }
832     else { return Path::Class::File->new( $c->config->{home}, @path ) }
833 }
834
835 sub plugin {
836     my ( $class, $name, $plugin, @args ) = @_;
837
838     # See block comment in t/aggregate/unit_core_plugin.t
839     # See block comment in t/unit_core_plugin.t
840     $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in a future release/);
841
842     $class->_register_plugin( $plugin, 1 );
843
844     eval { $plugin->import };
845     $class->mk_classdata($name);
846     my $obj;
847     eval { $obj = $plugin->new(@args) };
848
849     if ($@) {
850         Catalyst::Exception->throw( message =>
851               qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
852     }
853
854     $class->$name($obj);
855     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
856       if $class->debug;
857 }
858
859 =head2 MyApp->setup
860
861 Initializes the dispatcher and engine, loads any plugins, and loads the
862 model, view, and controller components. You may also specify an array
863 of plugins to load here, if you choose to not load them in the C<use
864 Catalyst> line.
865
866     MyApp->setup;
867     MyApp->setup( qw/-Debug/ );
868
869 B<Note:> You B<should not> wrap this method with method modifiers
870 or bad things will happen - wrap the C<setup_finalize> method instead.
871
872 =cut
873
874 sub setup {
875     my ( $class, @arguments ) = @_;
876     croak('Running setup more than once')
877         if ( $class->setup_finished );
878
879     unless ( $class->isa('Catalyst') ) {
880
881         Catalyst::Exception->throw(
882             message => qq/'$class' does not inherit from Catalyst/ );
883     }
884
885     if ( $class->arguments ) {
886         @arguments = ( @arguments, @{ $class->arguments } );
887     }
888
889     # Process options
890     my $flags = {};
891
892     foreach (@arguments) {
893
894         if (/^-Debug$/) {
895             $flags->{log} =
896               ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
897         }
898         elsif (/^-(\w+)=?(.*)$/) {
899             $flags->{ lc $1 } = $2;
900         }
901         else {
902             push @{ $flags->{plugins} }, $_;
903         }
904     }
905
906     $class->setup_config();
907     $class->setup_home( delete $flags->{home} );
908
909     $class->setup_log( delete $flags->{log} );
910     $class->setup_plugins( delete $flags->{plugins} );
911     $class->setup_dispatcher( delete $flags->{dispatcher} );
912     if (my $engine = delete $flags->{engine}) {
913         $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading");
914     }
915     $class->setup_engine();
916     $class->setup_stats( delete $flags->{stats} );
917
918     for my $flag ( sort keys %{$flags} ) {
919
920         if ( my $code = $class->can( 'setup_' . $flag ) ) {
921             &$code( $class, delete $flags->{$flag} );
922         }
923         else {
924             $class->log->warn(qq/Unknown flag "$flag"/);
925         }
926     }
927
928     eval { require Catalyst::Devel; };
929     if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
930         $class->log->warn(<<"EOF");
931 You are running an old script!
932
933   Please update by running (this will overwrite existing files):
934     catalyst.pl -force -scripts $class
935
936   or (this will not overwrite existing files):
937     catalyst.pl -scripts $class
938
939 EOF
940     }
941
942     if ( $class->debug ) {
943         my @plugins = map { "$_  " . ( $_->VERSION || '' ) } $class->registered_plugins;
944
945         if (@plugins) {
946             my $column_width = Catalyst::Utils::term_width() - 6;
947             my $t = Text::SimpleTable->new($column_width);
948             $t->row($_) for @plugins;
949             $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
950         }
951
952         my $dispatcher = $class->dispatcher;
953         my $engine     = $class->engine;
954         my $home       = $class->config->{home};
955
956         $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher)));
957         $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine)));
958
959         $home
960           ? ( -d $home )
961           ? $class->log->debug(qq/Found home "$home"/)
962           : $class->log->debug(qq/Home "$home" doesn't exist/)
963           : $class->log->debug(q/Couldn't find home/);
964     }
965
966     # Call plugins setup, this is stupid and evil.
967     # Also screws C3 badly on 5.10, hack to avoid.
968     {
969         no warnings qw/redefine/;
970         local *setup = sub { };
971         $class->setup unless $Catalyst::__AM_RESTARTING;
972     }
973
974     $class->setup_components;
975
976     if (
977         $class->debug and
978         my $comps = $class->container->get_all_components($class)
979     ) {
980         my $column_width = Catalyst::Utils::term_width() - 8 - 9;
981         my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] );
982         $t->row( $_ => ref($comps->{$_}) ? 'instance' : 'class' ) for keys %$comps;
983
984         $class->log->debug( "Loaded components:\n" . $t->draw . "\n" );
985     }
986
987     $class->setup_actions;
988
989     if ( $class->debug ) {
990         my $name = $class->config->{name} || 'Application';
991         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
992     }
993
994     # Make sure that the application class becomes immutable at this point,
995     B::Hooks::EndOfScope::on_scope_end {
996         return if $@;
997         my $meta = Class::MOP::get_metaclass_by_name($class);
998         if (
999             $meta->is_immutable
1000             && ! { $meta->immutable_options }->{replace_constructor}
1001             && (
1002                    $class->isa('Class::Accessor::Fast')
1003                 || $class->isa('Class::Accessor')
1004             )
1005         ) {
1006             warn "You made your application class ($class) immutable, "
1007                 . "but did not inline the\nconstructor. "
1008                 . "This will break catalyst, as your app \@ISA "
1009                 . "Class::Accessor(::Fast)?\nPlease pass "
1010                 . "(replace_constructor => 1)\nwhen making your class immutable.\n";
1011         }
1012         $meta->make_immutable(
1013             replace_constructor => 1,
1014         ) unless $meta->is_immutable;
1015     };
1016
1017     if ($class->config->{case_sensitive}) {
1018         $class->log->warn($class . "->config->{case_sensitive} is set.");
1019         $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81.");
1020     }
1021
1022     $class->setup_finalize;
1023     # Should be the last thing we do so that user things hooking
1024     # setup_finalize can log..
1025     $class->log->_flush() if $class->log->can('_flush');
1026     return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE.
1027 }
1028
1029 =head2 $app->setup_finalize
1030
1031 A hook to attach modifiers to. This method does not do anything except set the
1032 C<setup_finished> accessor.
1033
1034 Applying method modifiers to the C<setup> method doesn't work, because of quirky things done for plugin setup.
1035
1036 Example:
1037
1038     after setup_finalize => sub {
1039         my $app = shift;
1040
1041         ## do stuff here..
1042     };
1043
1044 =cut
1045
1046 sub setup_finalize {
1047     my ($class) = @_;
1048     $class->setup_finished(1);
1049 }
1050
1051 =head2 $c->uri_for( $path?, @args?, \%query_values? )
1052
1053 =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1054
1055 Constructs an absolute L<URI> object based on the application root, the
1056 provided path, and the additional arguments and query parameters provided.
1057 When used as a string, provides a textual URI.  If you need more flexibility
1058 than this (i.e. the option to provide relative URIs etc.) see
1059 L<Catalyst::Plugin::SmartURI>.
1060
1061 If no arguments are provided, the URI for the current action is returned.
1062 To return the current action and also provide @args, use
1063 C<< $c->uri_for( $c->action, @args ) >>.
1064
1065 If the first argument is a string, it is taken as a public URI path relative
1066 to C<< $c->namespace >> (if it doesn't begin with a forward slash) or
1067 relative to the application root (if it does). It is then merged with
1068 C<< $c->request->base >>; any C<@args> are appended as additional path
1069 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
1070
1071 If the first argument is a L<Catalyst::Action> it represents an action which
1072 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
1073 optional C<\@captures> argument (an arrayref) allows passing the captured
1074 variables that are needed to fill in the paths of Chained and Regex actions;
1075 once the path is resolved, C<uri_for> continues as though a path was
1076 provided, appending any arguments or parameters and creating an absolute
1077 URI.
1078
1079 The captures for the current request can be found in
1080 C<< $c->request->captures >>, and actions can be resolved using
1081 C<< Catalyst::Controller->action_for($name) >>. If you have a private action
1082 path, use C<< $c->uri_for_action >> instead.
1083
1084   # Equivalent to $c->req->uri
1085   $c->uri_for($c->action, $c->req->captures,
1086       @{ $c->req->args }, $c->req->params);
1087
1088   # For the Foo action in the Bar controller
1089   $c->uri_for($c->controller('Bar')->action_for('Foo'));
1090
1091   # Path to a static resource
1092   $c->uri_for('/static/images/logo.png');
1093
1094 =cut
1095
1096 sub uri_for {
1097     my ( $c, $path, @args ) = @_;
1098
1099     if (blessed($path) && $path->isa('Catalyst::Controller')) {
1100         $path = $path->path_prefix;
1101         $path =~ s{/+\z}{};
1102         $path .= '/';
1103     }
1104
1105     undef($path) if (defined $path && $path eq '');
1106
1107     my $params =
1108       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
1109
1110     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
1111     foreach my $arg (@args) {
1112         utf8::encode($arg) if utf8::is_utf8($arg);
1113         $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1114     }
1115
1116     if ( blessed($path) ) { # action object
1117         s|/|%2F|g for @args;
1118         my $captures = [ map { s|/|%2F|g; $_; }
1119                         ( scalar @args && ref $args[0] eq 'ARRAY'
1120                          ? @{ shift(@args) }
1121                          : ()) ];
1122
1123         foreach my $capture (@$captures) {
1124             utf8::encode($capture) if utf8::is_utf8($capture);
1125             $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
1126         }
1127
1128         my $action = $path;
1129         # ->uri_for( $action, \@captures_and_args, \%query_values? )
1130         if( !@args && $action->number_of_args ) {
1131             my $expanded_action = $c->dispatcher->expand_action( $action );
1132
1133             my $num_captures = $expanded_action->number_of_captures;
1134             unshift @args, splice @$captures, $num_captures;
1135         }
1136
1137        $path = $c->dispatcher->uri_for_action($action, $captures);
1138         if (not defined $path) {
1139             $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
1140                 if $c->debug;
1141             return undef;
1142         }
1143         $path = '/' if $path eq '';
1144     }
1145
1146     unshift(@args, $path);
1147
1148     unless (defined $path && $path =~ s!^/!!) { # in-place strip
1149         my $namespace = $c->namespace;
1150         if (defined $path) { # cheesy hack to handle path '../foo'
1151            $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
1152         }
1153         unshift(@args, $namespace || '');
1154     }
1155
1156     # join args with '/', or a blank string
1157     my $args = join('/', grep { defined($_) } @args);
1158     $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
1159     $args =~ s!^/+!!;
1160     my $base = $c->req->base;
1161     my $class = ref($base);
1162     $base =~ s{(?<!/)$}{/};
1163
1164     my $query = '';
1165
1166     if (my @keys = keys %$params) {
1167       # somewhat lifted from URI::_query's query_form
1168       $query = '?'.join('&', map {
1169           my $val = $params->{$_};
1170           s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1171           s/ /+/g;
1172           my $key = $_;
1173           $val = '' unless defined $val;
1174           (map {
1175               my $param = "$_";
1176               utf8::encode( $param ) if utf8::is_utf8($param);
1177               # using the URI::Escape pattern here so utf8 chars survive
1178               $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1179               $param =~ s/ /+/g;
1180               "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1181       } @keys);
1182     }
1183
1184     my $res = bless(\"${base}${args}${query}", $class);
1185     $res;
1186 }
1187
1188 =head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? )
1189
1190 =head2 $c->uri_for_action( $action, \@captures_and_args?, @args?, \%query_values? )
1191
1192 =over
1193
1194 =item $path
1195
1196 A private path to the Catalyst action you want to create a URI for.
1197
1198 This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
1199 >> and passing the resulting C<$action> and the remaining arguments to C<<
1200 $c->uri_for >>.
1201
1202 You can also pass in a Catalyst::Action object, in which case it is passed to
1203 C<< $c->uri_for >>.
1204
1205 Note that although the path looks like a URI that dispatches to the wanted action, it is not a URI, but an internal path to that action.
1206
1207 For example, if the action looks like:
1208
1209  package MyApp::Controller::Users;
1210
1211  sub lst : Path('the-list') {}
1212
1213 You can use:
1214
1215  $c->uri_for_action('/users/lst')
1216
1217 and it will create the URI /users/the-list.
1218
1219 =item \@captures_and_args?
1220
1221 Optional array reference of Captures (i.e. C<<CaptureArgs or $c->req->captures>)
1222 and arguments to the request. Usually used with L<Catalyst::DispatchType::Chained>
1223 to interpolate all the parameters in the URI.
1224
1225 =item @args?
1226
1227 Optional list of extra arguments - can be supplied in the C<< \@captures_and_args? >>
1228 array ref, or here - whichever is easier for your code..
1229
1230 If your action may have a zero, a fixed or a variable number of args (e.g. C<< Args(1) >>
1231 for a fixed number or C<< Args() >> for a variable number)..
1232
1233 =item \%query_values?
1234
1235 Optional array reference of query parameters to append. E.g.
1236
1237   { foo => 'bar' }
1238
1239 will generate
1240
1241   /rest/of/your/uri?foo=bar
1242
1243 =back
1244
1245 =cut
1246
1247 sub uri_for_action {
1248     my ( $c, $path, @args ) = @_;
1249     my $action = blessed($path)
1250       ? $path
1251       : $c->dispatcher->get_action_by_path($path);
1252     unless (defined $action) {
1253       croak "Can't find action for path '$path'";
1254     }
1255     return $c->uri_for( $action, @args );
1256 }
1257
1258 =head2 $c->welcome_message
1259
1260 Returns the Catalyst welcome HTML page.
1261
1262 =cut
1263
1264 sub welcome_message {
1265     my $c      = shift;
1266     my $name   = $c->config->{name};
1267     my $logo   = $c->uri_for('/static/images/catalyst_logo.png');
1268     my $prefix = Catalyst::Utils::appprefix( ref $c );
1269     $c->response->content_type('text/html; charset=utf-8');
1270     return <<"EOF";
1271 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1272     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1273 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
1274     <head>
1275     <meta http-equiv="Content-Language" content="en" />
1276     <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
1277         <title>$name on Catalyst $VERSION</title>
1278         <style type="text/css">
1279             body {
1280                 color: #000;
1281                 background-color: #eee;
1282             }
1283             div#content {
1284                 width: 640px;
1285                 margin-left: auto;
1286                 margin-right: auto;
1287                 margin-top: 10px;
1288                 margin-bottom: 10px;
1289                 text-align: left;
1290                 background-color: #ccc;
1291                 border: 1px solid #aaa;
1292             }
1293             p, h1, h2 {
1294                 margin-left: 20px;
1295                 margin-right: 20px;
1296                 font-family: verdana, tahoma, sans-serif;
1297             }
1298             a {
1299                 font-family: verdana, tahoma, sans-serif;
1300             }
1301             :link, :visited {
1302                     text-decoration: none;
1303                     color: #b00;
1304                     border-bottom: 1px dotted #bbb;
1305             }
1306             :link:hover, :visited:hover {
1307                     color: #555;
1308             }
1309             div#topbar {
1310                 margin: 0px;
1311             }
1312             pre {
1313                 margin: 10px;
1314                 padding: 8px;
1315             }
1316             div#answers {
1317                 padding: 8px;
1318                 margin: 10px;
1319                 background-color: #fff;
1320                 border: 1px solid #aaa;
1321             }
1322             h1 {
1323                 font-size: 0.9em;
1324                 font-weight: normal;
1325                 text-align: center;
1326             }
1327             h2 {
1328                 font-size: 1.0em;
1329             }
1330             p {
1331                 font-size: 0.9em;
1332             }
1333             p img {
1334                 float: right;
1335                 margin-left: 10px;
1336             }
1337             span#appname {
1338                 font-weight: bold;
1339                 font-size: 1.6em;
1340             }
1341         </style>
1342     </head>
1343     <body>
1344         <div id="content">
1345             <div id="topbar">
1346                 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
1347                     $VERSION</h1>
1348              </div>
1349              <div id="answers">
1350                  <p>
1351                  <img src="$logo" alt="Catalyst Logo" />
1352                  </p>
1353                  <p>Welcome to the  world of Catalyst.
1354                     This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1355                     framework will make web development something you had
1356                     never expected it to be: Fun, rewarding, and quick.</p>
1357                  <h2>What to do now?</h2>
1358                  <p>That really depends  on what <b>you</b> want to do.
1359                     We do, however, provide you with a few starting points.</p>
1360                  <p>If you want to jump right into web development with Catalyst
1361                     you might want to start with a tutorial.</p>
1362 <pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
1363 </pre>
1364 <p>Afterwards you can go on to check out a more complete look at our features.</p>
1365 <pre>
1366 <code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1367 <!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1368 </code></pre>
1369                  <h2>What to do next?</h2>
1370                  <p>Next it's time to write an actual application. Use the
1371                     helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
1372                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1373                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
1374                     they can save you a lot of work.</p>
1375                     <pre><code>script/${prefix}_create.pl --help</code></pre>
1376                     <p>Also, be sure to check out the vast and growing
1377                     collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
1378                     you are likely to find what you need there.
1379                     </p>
1380
1381                  <h2>Need help?</h2>
1382                  <p>Catalyst has a very active community. Here are the main places to
1383                     get in touch with us.</p>
1384                  <ul>
1385                      <li>
1386                          <a href="http://dev.catalyst.perl.org">Wiki</a>
1387                      </li>
1388                      <li>
1389                          <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
1390                      </li>
1391                      <li>
1392                          <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
1393                      </li>
1394                  </ul>
1395                  <h2>In conclusion</h2>
1396                  <p>The Catalyst team hopes you will enjoy using Catalyst as much
1397                     as we enjoyed making it. Please contact us if you have ideas
1398                     for improvement or other feedback.</p>
1399              </div>
1400          </div>
1401     </body>
1402 </html>
1403 EOF
1404 }
1405
1406 =head1 INTERNAL METHODS
1407
1408 These methods are not meant to be used by end users.
1409
1410 =head2 $c->components
1411
1412 Returns a hash of components.
1413
1414 =cut
1415
1416 sub components {
1417     my ( $class, $comps ) = @_;
1418
1419     # people create components calling this sub directly, before setup
1420     $class->setup_config unless $class->container;
1421
1422     my $container = $class->container;
1423
1424     if ( $comps ) {
1425         $container->add_component( $_ ) for keys %$comps;
1426     }
1427
1428     return $container->get_all_components($class);
1429 }
1430
1431 =head2 $c->context_class
1432
1433 Returns or sets the context class.
1434
1435 =head2 $c->counter
1436
1437 Returns a hashref containing coderefs and execution counts (needed for
1438 deep recursion detection).
1439
1440 =head2 $c->depth
1441
1442 Returns the number of actions on the current internal execution stack.
1443
1444 =head2 $c->dispatch
1445
1446 Dispatches a request to actions.
1447
1448 =cut
1449
1450 sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1451
1452 =head2 $c->dispatcher_class
1453
1454 Returns or sets the dispatcher class.
1455
1456 =head2 $c->dump_these
1457
1458 Returns a list of 2-element array references (name, structure) pairs
1459 that will be dumped on the error page in debug mode.
1460
1461 =cut
1462
1463 sub dump_these {
1464     my $c = shift;
1465     [ Request => $c->req ],
1466     [ Response => $c->res ],
1467     [ Stash => $c->stash ],
1468     [ Config => $c->config ];
1469 }
1470
1471 =head2 $c->engine_class
1472
1473 Returns or sets the engine class.
1474
1475 =head2 $c->execute( $class, $coderef )
1476
1477 Execute a coderef in given class and catch exceptions. Errors are available
1478 via $c->error.
1479
1480 =cut
1481
1482 sub execute {
1483     my ( $c, $class, $code ) = @_;
1484     $class = $c->component($class) || $class;
1485     $c->state(0);
1486
1487     if ( $c->depth >= $RECURSION ) {
1488         my $action = $code->reverse();
1489         $action = "/$action" unless $action =~ /->/;
1490         my $error = qq/Deep recursion detected calling "${action}"/;
1491         $c->log->error($error);
1492         $c->error($error);
1493         $c->state(0);
1494         return $c->state;
1495     }
1496
1497     my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
1498
1499     push( @{ $c->stack }, $code );
1500
1501     no warnings 'recursion';
1502     # N.B. This used to be combined, but I have seen $c get clobbered if so, and
1503     #      I have no idea how, ergo $ret (which appears to fix the issue)
1504     eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
1505
1506     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
1507
1508     my $last = pop( @{ $c->stack } );
1509
1510     if ( my $error = $@ ) {
1511         if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) {
1512             $error->rethrow if $c->depth > 1;
1513         }
1514         elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) {
1515             $error->rethrow if $c->depth > 0;
1516         }
1517         else {
1518             unless ( ref $error ) {
1519                 no warnings 'uninitialized';
1520                 chomp $error;
1521                 my $class = $last->class;
1522                 my $name  = $last->name;
1523                 $error = qq/Caught exception in $class->$name "$error"/;
1524             }
1525             $c->error($error);
1526         }
1527         $c->state(0);
1528     }
1529     return $c->state;
1530 }
1531
1532 sub _stats_start_execute {
1533     my ( $c, $code ) = @_;
1534     my $appclass = ref($c) || $c;
1535     return if ( ( $code->name =~ /^_.*/ )
1536         && ( !$appclass->config->{show_internal_actions} ) );
1537
1538     my $action_name = $code->reverse();
1539     $c->counter->{$action_name}++;
1540
1541     my $action = $action_name;
1542     $action = "/$action" unless $action =~ /->/;
1543
1544     # determine if the call was the result of a forward
1545     # this is done by walking up the call stack and looking for a calling
1546     # sub of Catalyst::forward before the eval
1547     my $callsub = q{};
1548     for my $index ( 2 .. 11 ) {
1549         last
1550         if ( ( caller($index) )[0] eq 'Catalyst'
1551             && ( caller($index) )[3] eq '(eval)' );
1552
1553         if ( ( caller($index) )[3] =~ /forward$/ ) {
1554             $callsub = ( caller($index) )[3];
1555             $action  = "-> $action";
1556             last;
1557         }
1558     }
1559
1560     my $uid = $action_name . $c->counter->{$action_name};
1561
1562     # is this a root-level call or a forwarded call?
1563     if ( $callsub =~ /forward$/ ) {
1564         my $parent = $c->stack->[-1];
1565
1566         # forward, locate the caller
1567         if ( defined $parent && exists $c->counter->{"$parent"} ) {
1568             $c->stats->profile(
1569                 begin  => $action,
1570                 parent => "$parent" . $c->counter->{"$parent"},
1571                 uid    => $uid,
1572             );
1573         }
1574         else {
1575
1576             # forward with no caller may come from a plugin
1577             $c->stats->profile(
1578                 begin => $action,
1579                 uid   => $uid,
1580             );
1581         }
1582     }
1583     else {
1584
1585         # root-level call
1586         $c->stats->profile(
1587             begin => $action,
1588             uid   => $uid,
1589         );
1590     }
1591     return $action;
1592
1593 }
1594
1595 sub _stats_finish_execute {
1596     my ( $c, $info ) = @_;
1597     $c->stats->profile( end => $info );
1598 }
1599
1600 =head2 $c->finalize
1601
1602 Finalizes the request.
1603
1604 =cut
1605
1606 sub finalize {
1607     my $c = shift;
1608
1609     for my $error ( @{ $c->error } ) {
1610         $c->log->error($error);
1611     }
1612
1613     # Allow engine to handle finalize flow (for POE)
1614     my $engine = $c->engine;
1615     if ( my $code = $engine->can('finalize') ) {
1616         $engine->$code($c);
1617     }
1618     else {
1619
1620         $c->finalize_uploads;
1621
1622         # Error
1623         if ( $#{ $c->error } >= 0 ) {
1624             $c->finalize_error;
1625         }
1626
1627         $c->finalize_headers;
1628
1629         # HEAD request
1630         if ( $c->request->method eq 'HEAD' ) {
1631             $c->response->body('');
1632         }
1633
1634         $c->finalize_body;
1635     }
1636
1637     $c->log_response;
1638
1639     if ($c->use_stats) {
1640         my $elapsed = sprintf '%f', $c->stats->elapsed;
1641         my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
1642         $c->log->info(
1643             "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
1644     }
1645
1646     return $c->response->status;
1647 }
1648
1649 =head2 $c->finalize_body
1650
1651 Finalizes body.
1652
1653 =cut
1654
1655 sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1656
1657 =head2 $c->finalize_cookies
1658
1659 Finalizes cookies.
1660
1661 =cut
1662
1663 sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
1664
1665 =head2 $c->finalize_error
1666
1667 Finalizes error.
1668
1669 =cut
1670
1671 sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1672
1673 =head2 $c->finalize_headers
1674
1675 Finalizes headers.
1676
1677 =cut
1678
1679 sub finalize_headers {
1680     my $c = shift;
1681
1682     my $response = $c->response; #accessor calls can add up?
1683
1684     # Check if we already finalized headers
1685     return if $response->finalized_headers;
1686
1687     # Handle redirects
1688     if ( my $location = $response->redirect ) {
1689         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
1690         $response->header( Location => $location );
1691
1692         if ( !$response->has_body ) {
1693             # Add a default body if none is already present
1694             $response->body(<<"EOF");
1695 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
1696 <html xmlns="http://www.w3.org/1999/xhtml"> 
1697   <head>
1698     <title>Moved</title>
1699   </head>
1700   <body>
1701      <p>This item has moved <a href="$location">here</a>.</p>
1702   </body>
1703 </html>
1704 EOF
1705             $response->content_type('text/html; charset=utf-8');
1706         }
1707     }
1708
1709     # Content-Length
1710     if ( defined $response->body && length $response->body && !$response->content_length ) {
1711
1712         # get the length from a filehandle
1713         if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' )
1714         {
1715             my $size = -s $response->body;
1716             if ( $size ) {
1717                 $response->content_length( $size );
1718             }
1719             else {
1720                 $c->log->warn('Serving filehandle without a content-length');
1721             }
1722         }
1723         else {
1724             # everything should be bytes at this point, but just in case
1725             $response->content_length( length( $response->body ) );
1726         }
1727     }
1728
1729     # Errors
1730     if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1731         $response->headers->remove_header("Content-Length");
1732         $response->body('');
1733     }
1734
1735     $c->finalize_cookies;
1736
1737     $c->engine->finalize_headers( $c, @_ );
1738
1739     # Done
1740     $response->finalized_headers(1);
1741 }
1742
1743 =head2 $c->finalize_output
1744
1745 An alias for finalize_body.
1746
1747 =head2 $c->finalize_read
1748
1749 Finalizes the input after reading is complete.
1750
1751 =cut
1752
1753 sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1754
1755 =head2 $c->finalize_uploads
1756
1757 Finalizes uploads. Cleans up any temporary files.
1758
1759 =cut
1760
1761 sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1762
1763 =head2 $c->get_action( $action, $namespace )
1764
1765 Gets an action in a given namespace.
1766
1767 =cut
1768
1769 sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
1770
1771 =head2 $c->get_actions( $action, $namespace )
1772
1773 Gets all actions of a given name in a namespace and all parent
1774 namespaces.
1775
1776 =cut
1777
1778 sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1779
1780 =head2 $app->handle_request( @arguments )
1781
1782 Called to handle each HTTP request.
1783
1784 =cut
1785
1786 sub handle_request {
1787     my ( $class, @arguments ) = @_;
1788
1789     # Always expect worst case!
1790     my $status = -1;
1791     try {
1792         if ($class->debug) {
1793             my $secs = time - $START || 1;
1794             my $av = sprintf '%.3f', $COUNT / $secs;
1795             my $time = localtime time;
1796             $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
1797         }
1798
1799         my $c = $class->prepare(@arguments);
1800         $c->dispatch;
1801         $status = $c->finalize;
1802     }
1803     catch {
1804         chomp(my $error = $_);
1805         $class->log->error(qq/Caught exception in engine "$error"/);
1806     };
1807
1808     $COUNT++;
1809
1810     if(my $coderef = $class->log->can('_flush')){
1811         $class->log->$coderef();
1812     }
1813     return $status;
1814 }
1815
1816 =head2 $class->prepare( @arguments )
1817
1818 Creates a Catalyst context from an engine-specific request (Apache, CGI,
1819 etc.).
1820
1821 =cut
1822
1823 sub prepare {
1824     my ( $class, @arguments ) = @_;
1825
1826     # XXX
1827     # After the app/ctxt split, this should become an attribute based on something passed
1828     # into the application.
1829     $class->context_class( ref $class || $class ) unless $class->context_class;
1830
1831     my $c = $class->context_class->new({});
1832
1833     # For on-demand data
1834     $c->request->_context($c);
1835     $c->response->_context($c);
1836
1837     #surely this is not the most efficient way to do things...
1838     $c->stats($class->stats_class->new)->enable($c->use_stats);
1839     if ( $c->debug || $c->config->{enable_catalyst_header} ) {
1840         $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
1841     }
1842
1843     try {
1844         # Allow engine to direct the prepare flow (for POE)
1845         if ( my $prepare = $c->engine->can('prepare') ) {
1846             $c->engine->$prepare( $c, @arguments );
1847         }
1848         else {
1849             $c->prepare_request(@arguments);
1850             $c->prepare_connection;
1851             $c->prepare_query_parameters;
1852             $c->prepare_headers;
1853             $c->prepare_cookies;
1854             $c->prepare_path;
1855
1856             # Prepare the body for reading, either by prepare_body
1857             # or the user, if they are using $c->read
1858             $c->prepare_read;
1859
1860             # Parse the body unless the user wants it on-demand
1861             unless ( ref($c)->config->{parse_on_demand} ) {
1862                 $c->prepare_body;
1863             }
1864         }
1865     }
1866     # VERY ugly and probably shouldn't rely on ->finalize actually working
1867     catch {
1868         # failed prepare is always due to an invalid request, right?
1869         $c->response->status(400);
1870         $c->response->content_type('text/plain');
1871         $c->response->body('Bad Request');
1872         $c->finalize;
1873         die $_;
1874     };
1875
1876     my $method  = $c->req->method  || '';
1877     my $path    = $c->req->path;
1878     $path       = '/' unless length $path;
1879     my $address = $c->req->address || '';
1880
1881     $c->log_request;
1882
1883     $c->prepare_action;
1884
1885     return $c;
1886 }
1887
1888 =head2 $c->prepare_action
1889
1890 Prepares action. See L<Catalyst::Dispatcher>.
1891
1892 =cut
1893
1894 sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1895
1896 =head2 $c->prepare_body
1897
1898 Prepares message body.
1899
1900 =cut
1901
1902 sub prepare_body {
1903     my $c = shift;
1904
1905     return if $c->request->_has_body;
1906
1907     # Initialize on-demand data
1908     $c->engine->prepare_body( $c, @_ );
1909     $c->prepare_parameters;
1910     $c->prepare_uploads;
1911 }
1912
1913 =head2 $c->prepare_body_chunk( $chunk )
1914
1915 Prepares a chunk of data before sending it to L<HTTP::Body>.
1916
1917 See L<Catalyst::Engine>.
1918
1919 =cut
1920
1921 sub prepare_body_chunk {
1922     my $c = shift;
1923     $c->engine->prepare_body_chunk( $c, @_ );
1924 }
1925
1926 =head2 $c->prepare_body_parameters
1927
1928 Prepares body parameters.
1929
1930 =cut
1931
1932 sub prepare_body_parameters {
1933     my $c = shift;
1934     $c->engine->prepare_body_parameters( $c, @_ );
1935 }
1936
1937 =head2 $c->prepare_connection
1938
1939 Prepares connection.
1940
1941 =cut
1942
1943 sub prepare_connection {
1944     my $c = shift;
1945     $c->engine->prepare_connection( $c, @_ );
1946 }
1947
1948 =head2 $c->prepare_cookies
1949
1950 Prepares cookies.
1951
1952 =cut
1953
1954 sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1955
1956 =head2 $c->prepare_headers
1957
1958 Prepares headers.
1959
1960 =cut
1961
1962 sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1963
1964 =head2 $c->prepare_parameters
1965
1966 Prepares parameters.
1967
1968 =cut
1969
1970 sub prepare_parameters {
1971     my $c = shift;
1972     $c->prepare_body_parameters;
1973     $c->engine->prepare_parameters( $c, @_ );
1974 }
1975
1976 =head2 $c->prepare_path
1977
1978 Prepares path and base.
1979
1980 =cut
1981
1982 sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1983
1984 =head2 $c->prepare_query_parameters
1985
1986 Prepares query parameters.
1987
1988 =cut
1989
1990 sub prepare_query_parameters {
1991     my $c = shift;
1992
1993     $c->engine->prepare_query_parameters( $c, @_ );
1994 }
1995
1996 =head2 $c->log_request
1997
1998 Writes information about the request to the debug logs.  This includes:
1999
2000 =over 4
2001
2002 =item * Request method, path, and remote IP address
2003
2004 =item * Query keywords (see L<Catalyst::Request/query_keywords>)
2005
2006 =item * Request parameters
2007
2008 =item * File uploads
2009
2010 =back
2011
2012 =cut
2013
2014 sub log_request {
2015     my $c = shift;
2016
2017     return unless $c->debug;
2018
2019     my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these;
2020     my $request = $dump->[1];
2021
2022     my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address );
2023     $method ||= '';
2024     $path = '/' unless length $path;
2025     $address ||= '';
2026     $c->log->debug(qq/"$method" request for "$path" from "$address"/);
2027
2028     $c->log_request_headers($request->headers);
2029
2030     if ( my $keywords = $request->query_keywords ) {
2031         $c->log->debug("Query keywords are: $keywords");
2032     }
2033
2034     $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () );
2035
2036     $c->log_request_uploads($request);
2037 }
2038
2039 =head2 $c->log_response
2040
2041 Writes information about the response to the debug logs by calling
2042 C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>.
2043
2044 =cut
2045
2046 sub log_response {
2047     my $c = shift;
2048
2049     return unless $c->debug;
2050
2051     my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
2052     my $response = $dump->[1];
2053
2054     $c->log_response_status_line($response);
2055     $c->log_response_headers($response->headers);
2056 }
2057
2058 =head2 $c->log_response_status_line($response)
2059
2060 Writes one line of information about the response to the debug logs.  This includes:
2061
2062 =over 4
2063
2064 =item * Response status code
2065
2066 =item * Content-Type header (if present)
2067
2068 =item * Content-Length header (if present)
2069
2070 =back
2071
2072 =cut
2073
2074 sub log_response_status_line {
2075     my ($c, $response) = @_;
2076
2077     $c->log->debug(
2078         sprintf(
2079             'Response Code: %s; Content-Type: %s; Content-Length: %s',
2080             $response->status                            || 'unknown',
2081             $response->headers->header('Content-Type')   || 'unknown',
2082             $response->headers->header('Content-Length') || 'unknown'
2083         )
2084     );
2085 }
2086
2087 =head2 $c->log_response_headers($headers);
2088
2089 Hook method which can be wrapped by plugins to log the response headers.
2090 No-op in the default implementation.
2091
2092 =cut
2093
2094 sub log_response_headers {}
2095
2096 =head2 $c->log_request_parameters( query => {}, body => {} )
2097
2098 Logs request parameters to debug logs
2099
2100 =cut
2101
2102 sub log_request_parameters {
2103     my $c          = shift;
2104     my %all_params = @_;
2105
2106     return unless $c->debug;
2107
2108     my $column_width = Catalyst::Utils::term_width() - 44;
2109     foreach my $type (qw(query body)) {
2110         my $params = $all_params{$type};
2111         next if ! keys %$params;
2112         my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] );
2113         for my $key ( sort keys %$params ) {
2114             my $param = $params->{$key};
2115             my $value = defined($param) ? $param : '';
2116             $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
2117         }
2118         $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw );
2119     }
2120 }
2121
2122 =head2 $c->log_request_uploads
2123
2124 Logs file uploads included in the request to the debug logs.
2125 The parameter name, filename, file type, and file size are all included in
2126 the debug logs.
2127
2128 =cut
2129
2130 sub log_request_uploads {
2131     my $c = shift;
2132     my $request = shift;
2133     return unless $c->debug;
2134     my $uploads = $request->uploads;
2135     if ( keys %$uploads ) {
2136         my $t = Text::SimpleTable->new(
2137             [ 12, 'Parameter' ],
2138             [ 26, 'Filename' ],
2139             [ 18, 'Type' ],
2140             [ 9,  'Size' ]
2141         );
2142         for my $key ( sort keys %$uploads ) {
2143             my $upload = $uploads->{$key};
2144             for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
2145                 $t->row( $key, $u->filename, $u->type, $u->size );
2146             }
2147         }
2148         $c->log->debug( "File Uploads are:\n" . $t->draw );
2149     }
2150 }
2151
2152 =head2 $c->log_request_headers($headers);
2153
2154 Hook method which can be wrapped by plugins to log the request headers.
2155 No-op in the default implementation.
2156
2157 =cut
2158
2159 sub log_request_headers {}
2160
2161 =head2 $c->log_headers($type => $headers)
2162
2163 Logs L<HTTP::Headers> (either request or response) to the debug logs.
2164
2165 =cut
2166
2167 sub log_headers {
2168     my $c       = shift;
2169     my $type    = shift;
2170     my $headers = shift;    # an HTTP::Headers instance
2171
2172     return unless $c->debug;
2173
2174     my $column_width = Catalyst::Utils::term_width() - 28;
2175     my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] );
2176     $headers->scan(
2177         sub {
2178             my ( $name, $value ) = @_;
2179             $t->row( $name, $value );
2180         }
2181     );
2182     $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw );
2183 }
2184
2185
2186 =head2 $c->prepare_read
2187
2188 Prepares the input for reading.
2189
2190 =cut
2191
2192 sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
2193
2194 =head2 $c->prepare_request
2195
2196 Prepares the engine request.
2197
2198 =cut
2199
2200 sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
2201
2202 =head2 $c->prepare_uploads
2203
2204 Prepares uploads.
2205
2206 =cut
2207
2208 sub prepare_uploads {
2209     my $c = shift;
2210
2211     $c->engine->prepare_uploads( $c, @_ );
2212 }
2213
2214 =head2 $c->prepare_write
2215
2216 Prepares the output for writing.
2217
2218 =cut
2219
2220 sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
2221
2222 =head2 $c->request_class
2223
2224 Returns or sets the request class. Defaults to L<Catalyst::Request>.
2225
2226 =head2 $c->response_class
2227
2228 Returns or sets the response class. Defaults to L<Catalyst::Response>.
2229
2230 =head2 $c->read( [$maxlength] )
2231
2232 Reads a chunk of data from the request body. This method is designed to
2233 be used in a while loop, reading C<$maxlength> bytes on every call.
2234 C<$maxlength> defaults to the size of the request if not specified.
2235
2236 You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this
2237 directly.
2238
2239 Warning: If you use read(), Catalyst will not process the body,
2240 so you will not be able to access POST parameters or file uploads via
2241 $c->request.  You must handle all body parsing yourself.
2242
2243 =cut
2244
2245 sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
2246
2247 =head2 $c->run
2248
2249 Starts the engine.
2250
2251 =cut
2252
2253 sub run {
2254   my $app = shift;
2255   $app->engine_loader->needs_psgi_engine_compat_hack ?
2256     $app->engine->run($app, @_) :
2257       $app->engine->run( $app, $app->_finalized_psgi_app, @_ );
2258 }
2259
2260 =head2 $c->set_action( $action, $code, $namespace, $attrs )
2261
2262 Sets an action in a given namespace.
2263
2264 =cut
2265
2266 sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
2267
2268 =head2 $c->setup_actions($component)
2269
2270 Sets up actions for a component.
2271
2272 =cut
2273
2274 sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
2275
2276 =head2 $c->setup_config
2277
2278 =cut
2279
2280 sub setup_config {
2281     my $class = shift;
2282
2283     my %args = %{ $class->config || {} };
2284
2285     my $container_class;
2286
2287     if ( exists $args{container_class} ) {
2288         $container_class = delete $args{container_class};
2289         Class::MOP::load_class($container_class);
2290     }
2291     else {
2292         $container_class = Class::MOP::load_first_existing_class("${class}::Container", 'Catalyst::IOC::Container');
2293     }
2294
2295     my $container = $container_class->new( %args, application_name => "$class", name => "$class" );
2296     $class->container($container);
2297
2298     my $config = $container->resolve( service => 'config' );
2299     $class->config($config);
2300     $class->finalize_config; # back-compat
2301 }
2302
2303 =head2 $c->finalize_config
2304
2305 =cut
2306
2307 sub finalize_config { }
2308
2309 =head2 $c->setup_components
2310
2311 This method is called internally to set up the application's components.
2312
2313 It finds modules by calling the L<locate_components> method, expands them to
2314 package names with the $container->expand_component_module method, and then
2315 installs each component into the application.
2316
2317 The C<setup_components> config option is passed to both of the above methods.
2318
2319 =cut
2320
2321 sub setup_components { shift->container->setup_components }
2322
2323 =head2 locate_components
2324
2325 =cut
2326
2327 sub locate_components {
2328     my $class = shift;
2329
2330     $class->log->warn('The locate_components method has been deprecated.');
2331     $class->log->warn('Please read Catalyst::IOC::Container documentation to');
2332     $class->log->warn('update your application.');
2333
2334     # XXX think about ditching this sort entirely
2335     return sort { length $a <=> length $b }
2336         @{ $class->container->resolve( service => 'locate_components' ) };
2337 }
2338
2339 =head2 $c->setup_dispatcher
2340
2341 Sets up dispatcher.
2342
2343 =cut
2344
2345 sub setup_dispatcher {
2346     my ( $class, $dispatcher ) = @_;
2347
2348     if ($dispatcher) {
2349         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2350     }
2351
2352     if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2353         $dispatcher = 'Catalyst::Dispatcher::' . $env;
2354     }
2355
2356     unless ($dispatcher) {
2357         $dispatcher = $class->dispatcher_class;
2358     }
2359
2360     Class::MOP::load_class($dispatcher);
2361
2362     # dispatcher instance
2363     $class->dispatcher( $dispatcher->new );
2364 }
2365
2366 =head2 $c->setup_engine
2367
2368 Sets up engine.
2369
2370 =cut
2371
2372 sub engine_class {
2373     my ($class, $requested_engine) = @_;
2374
2375     if (!$class->engine_loader || $requested_engine) {
2376         $class->engine_loader(
2377             Catalyst::EngineLoader->new({
2378                 application_name => $class,
2379                 (defined $requested_engine
2380                      ? (catalyst_engine_class => $requested_engine) : ()),
2381             }),
2382         );
2383     }
2384
2385     $class->engine_loader->catalyst_engine_class;
2386 }
2387
2388 sub setup_engine {
2389     my ($class, $requested_engine) = @_;
2390
2391     my $engine = do {
2392         my $loader = $class->engine_loader;
2393
2394         if (!$loader || $requested_engine) {
2395             $loader = Catalyst::EngineLoader->new({
2396                 application_name => $class,
2397                 (defined $requested_engine
2398                      ? (requested_engine => $requested_engine) : ()),
2399             }),
2400
2401             $class->engine_loader($loader);
2402         }
2403
2404         $loader->catalyst_engine_class;
2405     };
2406
2407     # Don't really setup_engine -- see _setup_psgi_app for explanation.
2408     return if $class->loading_psgi_file;
2409
2410     Class::MOP::load_class($engine);
2411
2412     if ($ENV{MOD_PERL}) {
2413         my $apache = $class->engine_loader->auto;
2414
2415         my $meta = find_meta($class);
2416         my $was_immutable = $meta->is_immutable;
2417         my %immutable_options = $meta->immutable_options;
2418         $meta->make_mutable if $was_immutable;
2419
2420         $meta->add_method(handler => sub {
2421             my $r = shift;
2422             my $psgi_app = $class->psgi_app;
2423             $apache->call_app($r, $psgi_app);
2424         });
2425
2426         $meta->make_immutable(%immutable_options) if $was_immutable;
2427     }
2428
2429     $class->engine( $engine->new );
2430
2431     return;
2432 }
2433
2434 sub _finalized_psgi_app {
2435     my ($app) = @_;
2436
2437     unless ($app->_psgi_app) {
2438         my $psgi_app = $app->_setup_psgi_app;
2439         $app->_psgi_app($psgi_app);
2440     }
2441
2442     return $app->_psgi_app;
2443 }
2444
2445 sub _setup_psgi_app {
2446     my ($app) = @_;
2447
2448     for my $home (Path::Class::Dir->new($app->config->{home})) {
2449         my $psgi_file = $home->file(
2450             Catalyst::Utils::appprefix($app) . '.psgi',
2451         );
2452
2453         next unless -e $psgi_file;
2454
2455         # If $psgi_file calls ->setup_engine, it's doing so to load
2456         # Catalyst::Engine::PSGI. But if it does that, we're only going to
2457         # throw away the loaded PSGI-app and load the 5.9 Catalyst::Engine
2458         # anyway. So set a flag (ick) that tells setup_engine not to populate
2459         # $c->engine or do any other things we might regret.
2460
2461         $app->loading_psgi_file(1);
2462         my $psgi_app = Plack::Util::load_psgi($psgi_file);
2463         $app->loading_psgi_file(0);
2464
2465         return $psgi_app
2466             unless $app->engine_loader->needs_psgi_engine_compat_hack;
2467
2468         warn <<"EOW";
2469 Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}.
2470
2471 Its content has been ignored. Please consult the Catalyst::Upgrading
2472 documentation on how to upgrade from Catalyst::Engine::PSGI.
2473 EOW
2474     }
2475
2476     return $app->apply_default_middlewares($app->psgi_app);
2477 }
2478
2479 =head2 $c->apply_default_middlewares
2480
2481 Adds the following L<Plack> middlewares to your application, since they are
2482 useful and commonly needed:
2483
2484 L<Plack::Middleware::ReverseProxy>, (conditionally added based on the status
2485 of your $ENV{REMOTE_ADDR}, and can be forced on with C<using_frontend_proxy>
2486 or forced off with C<ignore_frontend_proxy>), L<Plack::Middleware::LighttpdScriptNameFix>
2487 (if you are using Lighttpd), L<Plack::Middleware::IIS6ScriptNameFix> (always
2488 applied since this middleware is smart enough to conditionally apply itself).
2489
2490 Additionally if we detect we are using Nginx, we add a bit of custom middleware
2491 to solve some problems with the way that server handles $ENV{PATH_INFO} and
2492 $ENV{SCRIPT_NAME}
2493
2494 =cut
2495
2496
2497 sub apply_default_middlewares {
2498     my ($app, $psgi_app) = @_;
2499
2500     $psgi_app = Plack::Middleware::Conditional->wrap(
2501         $psgi_app,
2502         builder   => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) },
2503         condition => sub {
2504             my ($env) = @_;
2505             return if $app->config->{ignore_frontend_proxy};
2506             return $env->{REMOTE_ADDR} eq '127.0.0.1'
2507                 || $app->config->{using_frontend_proxy};
2508         },
2509     );
2510
2511     # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME
2512     # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html
2513     $psgi_app = Plack::Middleware::LighttpdScriptNameFix->wrap($psgi_app);
2514
2515     # we're applying this unconditionally as the middleware itself already makes
2516     # sure it doesn't fuck things up if it's not running under one of the right
2517     # IIS versions
2518     $psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app);
2519
2520     return $psgi_app;
2521 }
2522
2523 =head2 $c->psgi_app
2524
2525 Returns a PSGI application code reference for the catalyst application
2526 C<$c>. This is the bare application without any middlewares
2527 applied. C<${myapp}.psgi> is not taken into account.
2528
2529 This is what you want to be using to retrieve the PSGI application code
2530 reference of your Catalyst application for use in F<.psgi> files.
2531
2532 =cut
2533
2534 sub psgi_app {
2535     my ($app) = @_;
2536     return $app->engine->build_psgi_app($app);
2537 }
2538
2539 =head2 $c->setup_home
2540
2541 Sets up the home directory.
2542
2543 =cut
2544
2545 sub setup_home {
2546     my ( $class, $home ) = @_;
2547
2548     if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2549         $home = $env;
2550     }
2551
2552     $home ||= Catalyst::Utils::home($class);
2553
2554     if ($home) {
2555         #I remember recently being scolded for assigning config values like this
2556         $class->config->{home} ||= $home;
2557         $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
2558     }
2559 }
2560
2561 =head2 $c->setup_log
2562
2563 Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2564 passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2565 log to.
2566
2567 This method also installs a C<debug> method that returns a true value into the
2568 catalyst subclass if the "debug" level is passed in the comma-delimited list,
2569 or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2570
2571 Note that if the log has already been setup, by either a previous call to
2572 C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2573 that this method won't actually set up the log object.
2574
2575 =cut
2576
2577 sub setup_log {
2578     my ( $class, $levels ) = @_;
2579
2580     $levels ||= '';
2581     $levels =~ s/^\s+//;
2582     $levels =~ s/\s+$//;
2583     my %levels = map { $_ => 1 } split /\s*,\s*/, $levels;
2584
2585     my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
2586     if ( defined $env_debug ) {
2587         $levels{debug} = 1 if $env_debug; # Ugly!
2588         delete($levels{debug}) unless $env_debug;
2589     }
2590
2591     unless ( $class->log ) {
2592         $class->log( Catalyst::Log->new(keys %levels) );
2593     }
2594
2595     if ( $levels{debug} ) {
2596         Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 });
2597         $class->log->debug('Debug messages enabled');
2598     }
2599 }
2600
2601 =head2 $c->setup_plugins
2602
2603 Sets up plugins.
2604
2605 =cut
2606
2607 =head2 $c->setup_stats
2608
2609 Sets up timing statistics class.
2610
2611 =cut
2612
2613 sub setup_stats {
2614     my ( $class, $stats ) = @_;
2615
2616     Catalyst::Utils::ensure_class_loaded($class->stats_class);
2617
2618     my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2619     if ( defined($env) ? $env : ($stats || $class->debug ) ) {
2620         Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 });
2621         $class->log->debug('Statistics enabled');
2622     }
2623 }
2624
2625
2626 =head2 $c->registered_plugins
2627
2628 Returns a sorted list of the plugins which have either been stated in the
2629 import list.
2630
2631 If passed a given plugin name, it will report a boolean value indicating
2632 whether or not that plugin is loaded.  A fully qualified name is required if
2633 the plugin name does not begin with C<Catalyst::Plugin::>.
2634
2635  if ($c->registered_plugins('Some::Plugin')) {
2636      ...
2637  }
2638
2639 =cut
2640
2641 {
2642
2643     sub registered_plugins {
2644         my $proto = shift;
2645         return sort keys %{ $proto->_plugins } unless @_;
2646         my $plugin = shift;
2647         return 1 if exists $proto->_plugins->{$plugin};
2648         return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
2649     }
2650
2651     sub _register_plugin {
2652         my ( $proto, $plugin, $instant ) = @_;
2653         my $class = ref $proto || $proto;
2654
2655         Class::MOP::load_class( $plugin );
2656         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
2657             if $plugin->isa( 'Catalyst::Component' );
2658         $proto->_plugins->{$plugin} = 1;
2659         unless ($instant) {
2660             my $meta = Class::MOP::get_metaclass_by_name($class);
2661             $meta->superclasses($plugin, $meta->superclasses);
2662         }
2663         return $class;
2664     }
2665
2666     sub setup_plugins {
2667         my ( $class, $plugins ) = @_;
2668
2669         $class->_plugins( {} ) unless $class->_plugins;
2670         $plugins = Data::OptList::mkopt($plugins || []);
2671
2672         my @plugins = map {
2673             [ Catalyst::Utils::resolve_namespace(
2674                   $class . '::Plugin',
2675                   'Catalyst::Plugin', $_->[0]
2676               ),
2677               $_->[1],
2678             ]
2679          } @{ $plugins };
2680
2681         for my $plugin ( reverse @plugins ) {
2682             Class::MOP::load_class($plugin->[0], $plugin->[1]);
2683             my $meta = find_meta($plugin->[0]);
2684             next if $meta && $meta->isa('Moose::Meta::Role');
2685
2686             $class->_register_plugin($plugin->[0]);
2687         }
2688
2689         my @roles =
2690             map  { $_->[0]->name, $_->[1] }
2691             grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') }
2692             map  { [find_meta($_->[0]), $_->[1]] }
2693             @plugins;
2694
2695         Moose::Util::apply_all_roles(
2696             $class => @roles
2697         ) if @roles;
2698     }
2699 }
2700
2701 =head2 $c->stack
2702
2703 Returns an arrayref of the internal execution stack (actions that are
2704 currently executing).
2705
2706 =head2 $c->stats
2707
2708 Returns the current timing statistics object. By default Catalyst uses
2709 L<Catalyst::Stats|Catalyst::Stats>, but can be set otherwise with
2710 L<< stats_class|/"$c->stats_class" >>.
2711
2712 Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still
2713 available. By enabling it with C< $c->stats->enabled(1) >, it can be used to
2714 profile explicitly, although MyApp.pm still won't profile nor output anything
2715 by itself.
2716
2717 =head2 $c->stats_class
2718
2719 Returns or sets the stats (timing statistics) class. L<Catalyst::Stats|Catalyst::Stats> is used by default.
2720
2721 =head2 $c->use_stats
2722
2723 Returns 1 when L<< stats collection|/"-Stats" >> is enabled.
2724
2725 Note that this is a static method, not an accessor and should be overridden
2726 by declaring C<sub use_stats { 1 }> in your MyApp.pm, not by calling C<< $c->use_stats(1) >>.
2727
2728 =cut
2729
2730 sub use_stats { 0 }
2731
2732
2733 =head2 $c->write( $data )
2734
2735 Writes $data to the output stream. When using this method directly, you
2736 will need to manually set the C<Content-Length> header to the length of
2737 your output data, if known.
2738
2739 =cut
2740
2741 sub write {
2742     my $c = shift;
2743
2744     # Finalize headers if someone manually writes output
2745     $c->finalize_headers;
2746
2747     return $c->engine->write( $c, @_ );
2748 }
2749
2750 =head2 version
2751
2752 Returns the Catalyst version number. Mostly useful for "powered by"
2753 messages in template systems.
2754
2755 =cut
2756
2757 sub version { return $Catalyst::VERSION }
2758
2759 =head1 CONFIGURATION
2760
2761 There are a number of 'base' config variables which can be set:
2762
2763 =over
2764
2765 =item *
2766
2767 C<default_model> - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>.
2768
2769 =item *
2770
2771 C<default_view> - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>.
2772
2773 =item *
2774
2775 C<home> - The application home directory. In an uninstalled application,
2776 this is the top level application directory. In an installed application,
2777 this will be the directory containing C<< MyApp.pm >>.
2778
2779 =item *
2780
2781 C<ignore_frontend_proxy> - See L</PROXY SUPPORT>
2782
2783 =item *
2784
2785 C<name> - The name of the application in debug messages and the debug and
2786 welcome screens
2787
2788 =item *
2789
2790 C<parse_on_demand> - The request body (for example file uploads) will not be parsed
2791 until it is accessed. This allows you to (for example) check authentication (and reject
2792 the upload) before actually receiving all the data. See L</ON-DEMAND PARSER>
2793
2794 =item *
2795
2796 C<root> - The root directory for templates. Usually this is just a
2797 subdirectory of the home directory, but you can set it to change the
2798 templates to a different directory.
2799
2800 =item *
2801
2802 C<show_internal_actions> - If true, causes internal actions such as C<< _DISPATCH >>
2803 to be shown in hit debug tables in the test server.
2804
2805 =item *
2806
2807 C<use_request_uri_for_path> - Controls if the C<REQUEST_URI> or C<PATH_INFO> environment
2808 variable should be used for determining the request path. 
2809
2810 Most web server environments pass the requested path to the application using environment variables,
2811 from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application,
2812 exposed as C<< $c->request->base >>) and the request path below that base.
2813
2814 There are two methods of doing this, both of which have advantages and disadvantages. Which method is used
2815 is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false).
2816
2817 =over
2818
2819 =item use_request_uri_for_path => 0
2820
2821 This is the default (and the) traditional method that Catalyst has used for determining the path information.
2822 The path is generated from a combination of the C<PATH_INFO> and C<SCRIPT_NAME> environment variables.
2823 The allows the application to behave correctly when C<mod_rewrite> is being used to redirect requests
2824 into the application, as these variables are adjusted by mod_rewrite to take account for the redirect.
2825
2826 However this method has the major disadvantage that it is impossible to correctly decode some elements
2827 of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot
2828 contain path-segment parameters. >>" This means PATH_INFO is B<always> decoded, and therefore Catalyst
2829 can't distinguish / vs %2F in paths (in addition to other encoded values).
2830
2831 =item use_request_uri_for_path => 1
2832
2833 This method uses the C<REQUEST_URI> and C<SCRIPT_NAME> environment variables. As C<REQUEST_URI> is never
2834 decoded, this means that applications using this mode can correctly handle URIs including the %2F character
2835 (i.e. with C<AllowEncodedSlashes> set to C<On> in Apache).
2836
2837 Given that this method of path resolution is provably more correct, it is recommended that you use
2838 this unless you have a specific need to deploy your application in a non-standard environment, and you are
2839 aware of the implications of not being able to handle encoded URI paths correctly.
2840
2841 However it also means that in a number of cases when the app isn't installed directly at a path, but instead
2842 is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a
2843 .htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed
2844 at other URIs than that which the app is 'normally' based at with C<mod_rewrite>), the resolution of
2845 C<< $c->request->base >> will be incorrect.
2846
2847 =back
2848
2849 =item *
2850
2851 C<using_frontend_proxy> - See L</PROXY SUPPORT>.
2852
2853 =back
2854
2855 =head1 INTERNAL ACTIONS
2856
2857 Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2858 C<_ACTION>, and C<_END>. These are by default not shown in the private
2859 action table, but you can make them visible with a config parameter.
2860
2861     MyApp->config(show_internal_actions => 1);
2862
2863 =head1 ON-DEMAND PARSER
2864
2865 The request body is usually parsed at the beginning of a request,
2866 but if you want to handle input yourself, you can enable on-demand
2867 parsing with a config parameter.
2868
2869     MyApp->config(parse_on_demand => 1);
2870
2871 =head1 PROXY SUPPORT
2872
2873 Many production servers operate using the common double-server approach,
2874 with a lightweight frontend web server passing requests to a larger
2875 backend server. An application running on the backend server must deal
2876 with two problems: the remote user always appears to be C<127.0.0.1> and
2877 the server's hostname will appear to be C<localhost> regardless of the
2878 virtual host that the user connected through.
2879
2880 Catalyst will automatically detect this situation when you are running
2881 the frontend and backend servers on the same machine. The following
2882 changes are made to the request.
2883
2884     $c->req->address is set to the user's real IP address, as read from
2885     the HTTP X-Forwarded-For header.
2886
2887     The host value for $c->req->base and $c->req->uri is set to the real
2888     host, as read from the HTTP X-Forwarded-Host header.
2889
2890 Additionally, you may be running your backend application on an insecure
2891 connection (port 80) while your frontend proxy is running under SSL.  If there
2892 is a discrepancy in the ports, use the HTTP header C<X-Forwarded-Port> to
2893 tell Catalyst what port the frontend listens on.  This will allow all URIs to
2894 be created properly.
2895
2896 In the case of passing in:
2897
2898     X-Forwarded-Port: 443
2899
2900 All calls to C<uri_for> will result in an https link, as is expected.
2901
2902 Obviously, your web server must support these headers for this to work.
2903
2904 In a more complex server farm environment where you may have your
2905 frontend proxy server(s) on different machines, you will need to set a
2906 configuration option to tell Catalyst to read the proxied data from the
2907 headers.
2908
2909     MyApp->config(using_frontend_proxy => 1);
2910
2911 If you do not wish to use the proxy support at all, you may set:
2912
2913     MyApp->config(ignore_frontend_proxy => 1);
2914
2915 =head1 THREAD SAFETY
2916
2917 Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2918 C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2919 believe the Catalyst core to be thread-safe.
2920
2921 If you plan to operate in a threaded environment, remember that all other
2922 modules you are using must also be thread-safe. Some modules, most notably
2923 L<DBD::SQLite>, are not thread-safe.
2924
2925 =head1 SUPPORT
2926
2927 IRC:
2928
2929     Join #catalyst on irc.perl.org.
2930
2931 Mailing Lists:
2932
2933     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2934     http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
2935
2936 Web:
2937
2938     http://catalyst.perl.org
2939
2940 Wiki:
2941
2942     http://dev.catalyst.perl.org
2943
2944 =head1 SEE ALSO
2945
2946 =head2 L<Task::Catalyst> - All you need to start with Catalyst
2947
2948 =head2 L<Catalyst::Manual> - The Catalyst Manual
2949
2950 =head2 L<Catalyst::Component>, L<Catalyst::Controller> - Base classes for components
2951
2952 =head2 L<Catalyst::Engine> - Core engine
2953
2954 =head2 L<Catalyst::Log> - Log class.
2955
2956 =head2 L<Catalyst::Request> - Request object
2957
2958 =head2 L<Catalyst::Response> - Response object
2959
2960 =head2 L<Catalyst::Test> - The test suite.
2961
2962 =begin stopwords
2963
2964 =head1 PROJECT FOUNDER
2965
2966 sri: Sebastian Riedel <sri@cpan.org>
2967
2968 =head1 CONTRIBUTORS
2969
2970 abw: Andy Wardley
2971
2972 acme: Leon Brocard <leon@astray.com>
2973
2974 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
2975
2976 Andrew Bramble
2977
2978 Andrew Ford E<lt>A.Ford@ford-mason.co.ukE<gt>
2979
2980 Andrew Ruthven
2981
2982 André Walker
2983
2984 andyg: Andy Grundman <andy@hybridized.org>
2985
2986 audreyt: Audrey Tang
2987
2988 bricas: Brian Cassidy <bricas@cpan.org>
2989
2990 Caelum: Rafael Kitover <rkitover@io.com>
2991
2992 chansen: Christian Hansen
2993
2994 chicks: Christopher Hicks
2995
2996 Chisel Wright C<pause@herlpacker.co.uk>
2997
2998 Danijel Milicevic C<me@danijel.de>
2999
3000 David Kamholz E<lt>dkamholz@cpan.orgE<gt>
3001
3002 David Naughton, C<naughton@umn.edu>
3003
3004 David E. Wheeler
3005
3006 dhoss: Devin Austin <dhoss@cpan.org>
3007
3008 dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
3009
3010 Drew Taylor
3011
3012 dwc: Daniel Westermann-Clark <danieltwc@cpan.org>
3013
3014 esskar: Sascha Kiefer
3015
3016 fireartist: Carl Franks <cfranks@cpan.org>
3017
3018 frew: Arthur Axel "fREW" Schmidt <frioux@gmail.com>
3019
3020 gabb: Danijel Milicevic
3021
3022 Gary Ashton Jones
3023
3024 Gavin Henry C<ghenry@perl.me.uk>
3025
3026 Geoff Richards
3027
3028 groditi: Guillermo Roditi <groditi@gmail.com>
3029
3030 hobbs: Andrew Rodland <andrew@cleverdomain.org>
3031
3032 ilmari: Dagfinn Ilmari MannsÃ¥ker <ilmari@ilmari.org>
3033
3034 jcamacho: Juan Camacho
3035
3036 jester: Jesse Sheidlower C<jester@panix.com>
3037
3038 jhannah: Jay Hannah <jay@jays.net>
3039
3040 Jody Belka
3041
3042 Johan Lindstrom
3043
3044 jon: Jon Schutz <jjschutz@cpan.org>
3045
3046 Jonathan Rockway C<< <jrockway@cpan.org> >>
3047
3048 Kieren Diment C<kd@totaldatasolution.com>
3049
3050 konobi: Scott McWhirter <konobi@cpan.org>
3051
3052 marcus: Marcus Ramberg <mramberg@cpan.org>
3053
3054 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
3055
3056 mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
3057
3058 mugwump: Sam Vilain
3059
3060 naughton: David Naughton
3061
3062 ningu: David Kamholz <dkamholz@cpan.org>
3063
3064 nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
3065
3066 numa: Dan Sully <daniel@cpan.org>
3067
3068 obra: Jesse Vincent
3069
3070 Octavian Rasnita
3071
3072 omega: Andreas Marienborg
3073
3074 Oleg Kostyuk <cub.uanic@gmail.com>
3075
3076 phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
3077
3078 rafl: Florian Ragwitz <rafl@debian.org>
3079
3080 random: Roland Lammel <lammel@cpan.org>
3081
3082 Robert Sedlacek C<< <rs@474.at> >>
3083
3084 SpiceMan: Marcel Montes
3085
3086 sky: Arthur Bergman
3087
3088 szbalint: Balint Szilakszi <szbalint@cpan.org>
3089
3090 t0m: Tomas Doran <bobtfish@bobtfish.net>
3091
3092 Ulf Edvinsson
3093
3094 Viljo Marrandi C<vilts@yahoo.com>
3095
3096 Will Hawes C<info@whawes.co.uk>
3097
3098 willert: Sebastian Willert <willert@cpan.org>
3099
3100 wreis: Wallace Reis <wallace@reis.org.br>
3101
3102 Yuval Kogman, C<nothingmuch@woobling.org>
3103
3104 rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
3105
3106 dd070: Dhaval Dhanani <dhaval070@gmail.com>
3107
3108 =end stopwords
3109
3110 =head1 COPYRIGHT
3111
3112 Copyright (c) 2005, the above named PROJECT FOUNDER and CONTRIBUTORS.
3113
3114 =head1 LICENSE
3115
3116 This library is free software. You can redistribute it and/or modify it under
3117 the same terms as Perl itself.
3118
3119 =cut
3120
3121 no Moose;
3122
3123 __PACKAGE__->meta->make_immutable;
3124
3125 1;