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