Fix the CDI issue, Plugin::Auth's tests now blow up a different way..
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
CommitLineData
fc7ec1d9 1package Catalyst;
2
e9e51b8f 3# we don't need really need this, but if we load it before MRO::Compat gets
4# loaded (via Moose and Class::MOP), we can avoid some nasty warnings
5use Class::C3;
6
a7caa492 7use Moose;
74c89dea 8use Class::MOP::Object ();
a7caa492 9extends 'Catalyst::Component';
fbcc39ad 10use bytes;
a2f2cde9 11use Catalyst::Exception;
fc7ec1d9 12use Catalyst::Log;
fbcc39ad 13use Catalyst::Request;
14use Catalyst::Request::Upload;
15use Catalyst::Response;
812a28c9 16use Catalyst::Utils;
31375184 17use Catalyst::Controller;
364d7324 18use Devel::InnerPackage ();
8f62c91a 19use File::stat;
c50f595c 20use Module::Pluggable::Object ();
c50f595c 21use Text::SimpleTable ();
22use Path::Class::Dir ();
23use Path::Class::File ();
fbcc39ad 24use Time::HiRes qw/gettimeofday tv_interval/;
c50f595c 25use URI ();
933ba403 26use URI::http;
27use URI::https;
6a4a7002 28use Scalar::Util qw/weaken blessed/;
5513038d 29use Tree::Simple qw/use_weak_refs/;
30use Tree::Simple::Visitor::FindByUID;
261c571e 31use attributes;
5789a3d8 32use utf8;
c45c5d37 33use Carp qw/croak carp/;
fc7ec1d9 34
f63c03e4 35BEGIN { require 5.008001; }
36
8a440eba 37# FIXME lazy => 1 here makes C::P::Auth tests pass?!?
38has stack => (is => 'ro', default => sub { [] });
6680c772 39has stash => (is => 'rw', default => sub { {} });
40has state => (is => 'rw', default => 0);
b6d4ee6e 41has stats => (is => 'rw');
42has action => (is => 'rw');
6680c772 43has counter => (is => 'rw', default => sub { {} });
44has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
45has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
e63bdf38 46has namespace => (is => 'rw');
47
8767c5a3 48sub depth { scalar @{ shift->stack || [] }; }
0fc2d522 49sub comp { shift->component(@_) }
6680c772 50
51sub req {
52 # carp "the use of req() is deprecated in favour of request()";
53 my $self = shift; return $self->request(@_);
54}
55sub res {
56 # carp "the use of res() is deprecated in favour of response()";
57 my $self = shift; return $self->response(@_);
58}
fbcc39ad 59
60# For backwards compatibility
0fc2d522 61sub finalize_output { shift->finalize_body(@_) };
fbcc39ad 62
63# For statistics
64our $COUNT = 1;
65our $START = time;
66our $RECURSION = 1000;
67our $DETACH = "catalyst_detach\n";
55424863 68our $GO = "catalyst_go\n";
fbcc39ad 69
b6d4ee6e 70#I imagine that very few of these really need to be class variables. if any.
71#maybe we should just make them attributes with a default?
fbcc39ad 72__PACKAGE__->mk_classdata($_)
3cec521a 73 for qw/components arguments dispatcher engine log dispatcher_class
ac5c933b 74 engine_class context_class request_class response_class stats_class
dc5f035e 75 setup_finished/;
cb0354c6 76
3cec521a 77__PACKAGE__->dispatcher_class('Catalyst::Dispatcher');
78__PACKAGE__->engine_class('Catalyst::Engine::CGI');
79__PACKAGE__->request_class('Catalyst::Request');
80__PACKAGE__->response_class('Catalyst::Response');
dc5f035e 81__PACKAGE__->stats_class('Catalyst::Stats');
fbcc39ad 82
6415bb4d 83# Remember to update this in Catalyst::Runtime as well!
84
76b3b586 85our $VERSION = '5.8000_04';
189e2a51 86
fbcc39ad 87sub import {
88 my ( $class, @arguments ) = @_;
89
90 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
91 # callers @ISA.
92 return unless $class eq 'Catalyst';
93
84ff88cf 94 my $caller = caller();
95 return if $caller eq 'main';
96 my $meta = Moose::Meta::Class->initialize($caller);
97 #Moose->import({ into => $caller }); #do we want to do this?
fbcc39ad 98
99 unless ( $caller->isa('Catalyst') ) {
84ff88cf 100 my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
101 $meta->superclasses(@superclasses);
102 }
103 unless( $meta->has_method('meta') ){
104 $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
fbcc39ad 105 }
106
107 $caller->arguments( [@arguments] );
108 $caller->setup_home;
109}
fc7ec1d9 110
111=head1 NAME
112
113Catalyst - The Elegant MVC Web Application Framework
114
115=head1 SYNOPSIS
116
e7ad3b81 117See the L<Catalyst::Manual> distribution for comprehensive
118documentation and tutorials.
119
86418559 120 # Install Catalyst::Devel for helpers and other development tools
b4b01a8a 121 # use the helper to create a new application
91864987 122 catalyst.pl MyApp
fc7ec1d9 123
124 # add models, views, controllers
2f381252 125 script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db
cc95842f 126 script/myapp_create.pl view MyTemplate TT
0ef52a96 127 script/myapp_create.pl controller Search
fc7ec1d9 128
e7f1cf73 129 # built in testserver -- use -r to restart automatically on changes
cc95842f 130 # --help to see all available options
ae4e40a7 131 script/myapp_server.pl
fc7ec1d9 132
0ef52a96 133 # command line testing interface
ae4e40a7 134 script/myapp_test.pl /yada
fc7ec1d9 135
b4b01a8a 136 ### in lib/MyApp.pm
0ef52a96 137 use Catalyst qw/-Debug/; # include plugins here as well
ac5c933b 138
85d9fce6 139 ### In lib/MyApp/Controller/Root.pm (autocreated)
0ef52a96 140 sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc.
ae1e6b59 141 my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2
142 $c->stash->{template} = 'foo.tt'; # set the template
0ef52a96 143 # lookup something from db -- stash vars are passed to TT
ac5c933b 144 $c->stash->{data} =
b4b01a8a 145 $c->model('Database::Foo')->search( { country => $args[0] } );
0ef52a96 146 if ( $c->req->params->{bar} ) { # access GET or POST parameters
147 $c->forward( 'bar' ); # process another action
ac5c933b 148 # do something else after forward returns
0ef52a96 149 }
150 }
ac5c933b 151
ae1e6b59 152 # The foo.tt TT template can use the stash data from the database
0ef52a96 153 [% WHILE (item = data.next) %]
154 [% item.foo %]
155 [% END %]
ac5c933b 156
0ef52a96 157 # called for /bar/of/soap, /bar/of/soap/10, etc.
158 sub bar : Path('/bar/of/soap') { ... }
fc7ec1d9 159
ae1e6b59 160 # called for all actions, from the top-most controller downwards
ac5c933b 161 sub auto : Private {
0ef52a96 162 my ( $self, $c ) = @_;
b4b01a8a 163 if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication
0ef52a96 164 $c->res->redirect( '/login' ); # require login
165 return 0; # abort request and go immediately to end()
166 }
ae1e6b59 167 return 1; # success; carry on to next action
0ef52a96 168 }
ac5c933b 169
ae1e6b59 170 # called after all actions are finished
ac5c933b 171 sub end : Private {
5a8ed4fe 172 my ( $self, $c ) = @_;
0ef52a96 173 if ( scalar @{ $c->error } ) { ... } # handle errors
174 return if $c->res->body; # already have a response
175 $c->forward( 'MyApp::View::TT' ); # render template
5a8ed4fe 176 }
177
0ef52a96 178 ### in MyApp/Controller/Foo.pm
179 # called for /foo/bar
180 sub bar : Local { ... }
ac5c933b 181
5400c668 182 # called for /blargle
183 sub blargle : Global { ... }
ac5c933b 184
5400c668 185 # an index action matches /foo, but not /foo/1, etc.
186 sub index : Private { ... }
ac5c933b 187
0ef52a96 188 ### in MyApp/Controller/Foo/Bar.pm
189 # called for /foo/bar/baz
190 sub baz : Local { ... }
ac5c933b 191
b4b01a8a 192 # first Root auto is called, then Foo auto, then this
0ef52a96 193 sub auto : Private { ... }
ac5c933b 194
0ef52a96 195 # powerful regular expression paths are also possible
196 sub details : Regex('^product/(\w+)/details$') {
5a8ed4fe 197 my ( $self, $c ) = @_;
0ef52a96 198 # extract the (\w+) from the URI
2982e768 199 my $product = $c->req->captures->[0];
5a8ed4fe 200 }
fc7ec1d9 201
0ef52a96 202See L<Catalyst::Manual::Intro> for additional information.
3803e98f 203
fc7ec1d9 204=head1 DESCRIPTION
205
86418559 206Catalyst is a modern framework for making web applications without the
207pain usually associated with this process. This document is a reference
208to the main Catalyst application. If you are a new user, we suggest you
209start with L<Catalyst::Manual::Tutorial> or L<Catalyst::Manual::Intro>.
fc7ec1d9 210
211See L<Catalyst::Manual> for more documentation.
212
ae1e6b59 213Catalyst plugins can be loaded by naming them as arguments to the "use
214Catalyst" statement. Omit the C<Catalyst::Plugin::> prefix from the
215plugin name, i.e., C<Catalyst::Plugin::My::Module> becomes
216C<My::Module>.
fc7ec1d9 217
0ef52a96 218 use Catalyst qw/My::Module/;
fc7ec1d9 219
836e1134 220If your plugin starts with a name other than C<Catalyst::Plugin::>, you can
221fully qualify the name by using a unary plus:
222
223 use Catalyst qw/
224 My::Module
225 +Fully::Qualified::Plugin::Name
226 /;
227
ae1e6b59 228Special flags like C<-Debug> and C<-Engine> can also be specified as
229arguments when Catalyst is loaded:
fc7ec1d9 230
231 use Catalyst qw/-Debug My::Module/;
232
ae1e6b59 233The position of plugins and flags in the chain is important, because
86418559 234they are loaded in the order in which they appear.
fc7ec1d9 235
23f9d934 236The following flags are supported:
237
b5ecfcf0 238=head2 -Debug
23f9d934 239
f8ad6ea5 240Enables debug output. You can also force this setting from the system
86418559 241environment with CATALYST_DEBUG or <MYAPP>_DEBUG. The environment
242settings override the application, with <MYAPP>_DEBUG having the highest
243priority.
fc7ec1d9 244
b5ecfcf0 245=head2 -Engine
fc7ec1d9 246
ae1e6b59 247Forces Catalyst to use a specific engine. Omit the
248C<Catalyst::Engine::> prefix of the engine name, i.e.:
fc7ec1d9 249
0ef52a96 250 use Catalyst qw/-Engine=CGI/;
fc7ec1d9 251
b5ecfcf0 252=head2 -Home
fbcc39ad 253
ae1e6b59 254Forces Catalyst to use a specific home directory, e.g.:
255
86418559 256 use Catalyst qw[-Home=/usr/mst];
fbcc39ad 257
cc95842f 258This can also be done in the shell environment by setting either the
259C<CATALYST_HOME> environment variable or C<MYAPP_HOME>; where C<MYAPP>
260is replaced with the uppercased name of your application, any "::" in
261the name will be replaced with underscores, e.g. MyApp::Web should use
262MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used.
263
b5ecfcf0 264=head2 -Log
fbcc39ad 265
0fa676a7 266 use Catalyst '-Log=warn,fatal,error';
267
268Specifies a comma-delimited list of log levels.
fbcc39ad 269
dc5f035e 270=head2 -Stats
271
272Enables statistics collection and reporting. You can also force this setting
273from the system environment with CATALYST_STATS or <MYAPP>_STATS. The
274environment settings override the application, with <MYAPP>_STATS having the
275highest priority.
276
ac5c933b 277e.g.
dc5f035e 278
279 use Catalyst qw/-Stats=1/
280
23f9d934 281=head1 METHODS
282
f7b672ef 283=head2 INFORMATION ABOUT THE CURRENT REQUEST
0ef52a96 284
b5ecfcf0 285=head2 $c->action
66e28e3f 286
ae1e6b59 287Returns a L<Catalyst::Action> object for the current action, which
288stringifies to the action name. See L<Catalyst::Action>.
0ef52a96 289
b5ecfcf0 290=head2 $c->namespace
0ef52a96 291
86418559 292Returns the namespace of the current action, i.e., the URI prefix
ae1e6b59 293corresponding to the controller of the current action. For example:
294
295 # in Controller::Foo::Bar
296 $c->namespace; # returns 'foo/bar';
0ef52a96 297
b5ecfcf0 298=head2 $c->request
0ef52a96 299
b5ecfcf0 300=head2 $c->req
0ef52a96 301
86418559 302Returns the current L<Catalyst::Request> object, giving access to
303information about the current client request (including parameters,
304cookies, HTTP headers, etc.). See L<Catalyst::Request>.
0ef52a96 305
b4b01a8a 306=head2 REQUEST FLOW HANDLING
0ef52a96 307
b5ecfcf0 308=head2 $c->forward( $action [, \@arguments ] )
0ef52a96 309
b5ecfcf0 310=head2 $c->forward( $class, $method, [, \@arguments ] )
0ef52a96 311
86418559 312Forwards processing to another action, by its private name. If you give a
b4b01a8a 313class name but no method, C<process()> is called. You may also optionally
314pass arguments in an arrayref. The action will receive the arguments in
cc95842f 315C<@_> and C<< $c->req->args >>. Upon returning from the function,
316C<< $c->req->args >> will be restored to the previous values.
0ef52a96 317
3b984c64 318Any data C<return>ed from the action forwarded to, will be returned by the
d759db1e 319call to forward.
3b984c64 320
321 my $foodata = $c->forward('/foo');
0ef52a96 322 $c->forward('index');
e112461a 323 $c->forward(qw/MyApp::Model::DBIC::Foo do_stuff/);
0ef52a96 324 $c->forward('MyApp::View::TT');
325
86418559 326Note that forward implies an C<<eval { }>> around the call (actually
327C<execute> does), thus de-fatalizing all 'dies' within the called
328action. If you want C<die> to propagate you need to do something like:
f3e6a8c0 329
330 $c->forward('foo');
331 die $c->error if $c->error;
332
86418559 333Or make sure to always return true values from your actions and write
334your code like this:
f3e6a8c0 335
336 $c->forward('foo') || return;
337
0ef52a96 338=cut
339
6680c772 340sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
0ef52a96 341
b5ecfcf0 342=head2 $c->detach( $action [, \@arguments ] )
0ef52a96 343
b5ecfcf0 344=head2 $c->detach( $class, $method, [, \@arguments ] )
0ef52a96 345
264bac8c 346=head2 $c->detach()
347
ac5c933b 348The same as C<forward>, but doesn't return to the previous action when
349processing is finished.
0ef52a96 350
264bac8c 351When called with no arguments it escapes the processing chain entirely.
352
0ef52a96 353=cut
354
355sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
356
ae0e35ee 357=head2 $c->visit( $action [, \@arguments ] )
358
359=head2 $c->visit( $class, $method, [, \@arguments ] )
360
361Almost the same as C<forward>, but does a full dispatch, instead of just
362calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
363C<auto> and the method you go to are called, just like a new request.
364
365C<$c-E<gt>stash> is kept unchanged.
366
367In effect, C<visit> allows you to "wrap" another action, just as it
368would have been called by dispatching from a URL, while the analogous
369C<go> allows you to transfer control to another action as if it had
370been reached directly from a URL.
371
372=cut
373
374sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
375
2f381252 376=head2 $c->go( $action [, \@arguments ] )
377
378=head2 $c->go( $class, $method, [, \@arguments ] )
379
ae0e35ee 380Almost the same as C<detach>, but does a full dispatch like C<visit>,
381instead of just calling the new C<$action> /
382C<$class-E<gt>$method>. This means that C<begin>, C<auto> and the
383method you visit are called, just like a new request.
2f381252 384
385C<$c-E<gt>stash> is kept unchanged.
386
387=cut
388
389sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
390
b4b01a8a 391=head2 $c->response
392
393=head2 $c->res
394
cc95842f 395Returns the current L<Catalyst::Response> object, see there for details.
b4b01a8a 396
397=head2 $c->stash
398
399Returns a hashref to the stash, which may be used to store data and pass
400it between components during a request. You can also set hash keys by
401passing arguments. The stash is automatically sent to the view. The
402stash is cleared at the end of a request; it cannot be used for
86418559 403persistent storage (for this you must use a session; see
404L<Catalyst::Plugin::Session> for a complete system integrated with
405Catalyst).
b4b01a8a 406
407 $c->stash->{foo} = $bar;
408 $c->stash( { moose => 'majestic', qux => 0 } );
409 $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref
ac5c933b 410
b4b01a8a 411 # stash is automatically passed to the view for use in a template
cc95842f 412 $c->forward( 'MyApp::View::TT' );
b4b01a8a 413
414=cut
415
4090e3bb 416around stash => sub {
417 my $orig = shift;
b4b01a8a 418 my $c = shift;
4090e3bb 419 my $stash = $orig->($c);
b4b01a8a 420 if (@_) {
4090e3bb 421 my $new_stash = @_ > 1 ? {@_} : $_[0];
422 croak('stash takes a hash or hashref') unless ref $new_stash;
423 foreach my $key ( keys %$new_stash ) {
424 $stash->{$key} = $new_stash->{$key};
b4b01a8a 425 }
426 }
0fc2d522 427
4090e3bb 428 return $stash;
429};
0fc2d522 430
b4b01a8a 431
b5ecfcf0 432=head2 $c->error
0ef52a96 433
b5ecfcf0 434=head2 $c->error($error, ...)
0ef52a96 435
b5ecfcf0 436=head2 $c->error($arrayref)
0ef52a96 437
83a8fcac 438Returns an arrayref containing error messages. If Catalyst encounters an
439error while processing a request, it stores the error in $c->error. This
e7ad3b81 440method should only be used to store fatal error messages.
0ef52a96 441
442 my @error = @{ $c->error };
443
444Add a new error.
445
446 $c->error('Something bad happened');
447
0ef52a96 448=cut
449
450sub error {
451 my $c = shift;
452 if ( $_[0] ) {
453 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
9ce44430 454 croak @$error unless ref $c;
0ef52a96 455 push @{ $c->{error} }, @$error;
456 }
457 elsif ( defined $_[0] ) { $c->{error} = undef }
458 return $c->{error} || [];
459}
460
b4b01a8a 461
462=head2 $c->state
463
464Contains the return value of the last executed action.
465
ca81eb67 466=head2 $c->clear_errors
467
468Clear errors. You probably don't want to clear the errors unless you are
469implementing a custom error screen.
470
471This is equivalent to running
472
473 $c->error(0);
474
475=cut
476
477sub clear_errors {
478 my $c = shift;
479 $c->error(0);
480}
481
2f381252 482# search components given a name and some prefixes
483sub _comp_search_prefixes {
484 my ( $c, $name, @prefixes ) = @_;
485 my $appclass = ref $c || $c;
486 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
0ef52a96 487
2f381252 488 # map the original component name to the sub part that we will search against
489 my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
490 grep { /$filter/ } keys %{ $c->components };
0756fe3b 491
2f381252 492 # undef for a name will return all
493 return keys %eligible if !defined $name;
0756fe3b 494
2f381252 495 my $query = ref $name ? $name : qr/^$name$/i;
496 my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
0756fe3b 497
2f381252 498 return map { $c->components->{ $_ } } @result if @result;
0756fe3b 499
2f381252 500 # if we were given a regexp to search against, we're done.
501 return if ref $name;
0756fe3b 502
2f381252 503 # regexp fallback
504 $query = qr/$name/i;
505 @result = map { $c->components->{ $_ } } grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
0756fe3b 506
2f381252 507 # no results? try against full names
508 if( !@result ) {
509 @result = map { $c->components->{ $_ } } grep { m{$query} } keys %eligible;
510 }
0756fe3b 511
2f381252 512 # don't warn if we didn't find any results, it just might not exist
513 if( @result ) {
514 $c->log->warn( qq(Found results for "${name}" using regexp fallback.) );
515 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution is unreliable and unsafe.' );
516 $c->log->warn( 'If you really want to search, pass in a regexp as the argument.' );
517 }
0756fe3b 518
2f381252 519 return @result;
0756fe3b 520}
521
ac5c933b 522# Find possible names for a prefix
3b88a455 523sub _comp_names {
524 my ( $c, @prefixes ) = @_;
3b88a455 525 my $appclass = ref $c || $c;
526
2f381252 527 my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
3b88a455 528
2f381252 529 my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes );
3b88a455 530 return @names;
531}
532
197bd788 533# Filter a component before returning by calling ACCEPT_CONTEXT if available
534sub _filter_component {
535 my ( $c, $comp, @args ) = @_;
2f381252 536
8abaac85 537 if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
197bd788 538 return $comp->ACCEPT_CONTEXT( $c, @args );
539 }
2f381252 540
541 return $comp;
197bd788 542}
543
f7b672ef 544=head2 COMPONENT ACCESSORS
0ef52a96 545
b5ecfcf0 546=head2 $c->controller($name)
af3ff00e 547
0ef52a96 548Gets a L<Catalyst::Controller> instance by name.
af3ff00e 549
550 $c->controller('Foo')->do_stuff;
551
86418559 552If the name is omitted, will return the controller for the dispatched
553action.
649fd1fa 554
2f381252 555If you want to search for controllers, pass in a regexp as the argument.
556
557 # find all controllers that start with Foo
558 my @foo_controllers = $c->controller(qr{^Foo});
559
560
af3ff00e 561=cut
562
563sub controller {
197bd788 564 my ( $c, $name, @args ) = @_;
2f381252 565
566 if( $name ) {
567 my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
568 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
569 return $c->_filter_component( $result[ 0 ], @args );
570 }
571
197bd788 572 return $c->component( $c->action->class );
af3ff00e 573}
574
b5ecfcf0 575=head2 $c->model($name)
fc7ec1d9 576
0ef52a96 577Gets a L<Catalyst::Model> instance by name.
578
579 $c->model('Foo')->do_stuff;
fc7ec1d9 580
72f87c4b 581Any extra arguments are directly passed to ACCEPT_CONTEXT.
582
ac5c933b 583If the name is omitted, it will look for
2f381252 584 - a model object in $c->stash->{current_model_instance}, then
a3b71f0f 585 - a model name in $c->stash->{current_model}, then
586 - a config setting 'default_model', or
587 - check if there is only one model, and return it if that's the case.
649fd1fa 588
2f381252 589If you want to search for models, pass in a regexp as the argument.
590
591 # find all models that start with Foo
592 my @foo_models = $c->model(qr{^Foo});
593
fc7ec1d9 594=cut
595
0ef52a96 596sub model {
197bd788 597 my ( $c, $name, @args ) = @_;
2f381252 598
599 if( $name ) {
600 my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
601 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
602 return $c->_filter_component( $result[ 0 ], @args );
603 }
604
a3b71f0f 605 if (ref $c) {
ac5c933b 606 return $c->stash->{current_model_instance}
a3b71f0f 607 if $c->stash->{current_model_instance};
608 return $c->model( $c->stash->{current_model} )
609 if $c->stash->{current_model};
a3b71f0f 610 }
72f87c4b 611 return $c->model( $c->config->{default_model} )
612 if $c->config->{default_model};
3b88a455 613
2f381252 614 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
3b88a455 615
2f381252 616 if( $rest ) {
617 $c->log->warn( 'Calling $c->model() will return a random model unless you specify one of:' );
618 $c->log->warn( '* $c->config->{default_model} # the name of the default model to use' );
619 $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
620 $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
621 $c->log->warn( 'NB: in version 5.80, the "random" behavior will not work at all.' );
622 }
3b88a455 623
2f381252 624 return $c->_filter_component( $comp );
3b88a455 625}
626
b4b01a8a 627
b5ecfcf0 628=head2 $c->view($name)
0ef52a96 629
630Gets a L<Catalyst::View> instance by name.
fc7ec1d9 631
0ef52a96 632 $c->view('Foo')->do_stuff;
fc7ec1d9 633
72f87c4b 634Any extra arguments are directly passed to ACCEPT_CONTEXT.
635
ac5c933b 636If the name is omitted, it will look for
2f381252 637 - a view object in $c->stash->{current_view_instance}, then
a3b71f0f 638 - a view name in $c->stash->{current_view}, then
639 - a config setting 'default_view', or
640 - check if there is only one view, and return it if that's the case.
649fd1fa 641
2f381252 642If you want to search for views, pass in a regexp as the argument.
643
644 # find all views that start with Foo
645 my @foo_views = $c->view(qr{^Foo});
646
fc7ec1d9 647=cut
648
0ef52a96 649sub view {
197bd788 650 my ( $c, $name, @args ) = @_;
2f381252 651
652 if( $name ) {
653 my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
654 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
655 return $c->_filter_component( $result[ 0 ], @args );
656 }
657
a3b71f0f 658 if (ref $c) {
ac5c933b 659 return $c->stash->{current_view_instance}
a3b71f0f 660 if $c->stash->{current_view_instance};
661 return $c->view( $c->stash->{current_view} )
662 if $c->stash->{current_view};
a3b71f0f 663 }
72f87c4b 664 return $c->view( $c->config->{default_view} )
665 if $c->config->{default_view};
2f381252 666
667 my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
668
669 if( $rest ) {
670 $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
671 $c->log->warn( '* $c->config->{default_view} # the name of the default view to use' );
672 $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
673 $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
674 $c->log->warn( 'NB: in version 5.80, the "random" behavior will not work at all.' );
675 }
676
677 return $c->_filter_component( $comp );
678}
679
680=head2 $c->controllers
681
682Returns the available names which can be passed to $c->controller
683
684=cut
685
686sub controllers {
687 my ( $c ) = @_;
688 return $c->_comp_names(qw/Controller C/);
0ef52a96 689}
fbcc39ad 690
b4b01a8a 691=head2 $c->models
692
693Returns the available names which can be passed to $c->model
694
695=cut
696
697sub models {
698 my ( $c ) = @_;
699 return $c->_comp_names(qw/Model M/);
700}
701
702
3b88a455 703=head2 $c->views
704
705Returns the available names which can be passed to $c->view
706
707=cut
708
709sub views {
710 my ( $c ) = @_;
711 return $c->_comp_names(qw/View V/);
712}
713
b4b01a8a 714=head2 $c->comp($name)
715
716=head2 $c->component($name)
717
cc95842f 718Gets a component object by name. This method is not recommended,
b4b01a8a 719unless you want to get a specific component by full
cc95842f 720class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
b4b01a8a 721should be used instead.
722
2f381252 723If C<$name> is a regexp, a list of components matched against the full
724component name will be returned.
725
b4b01a8a 726=cut
727
728sub component {
2f381252 729 my ( $c, $name, @args ) = @_;
b4b01a8a 730
2f381252 731 if( $name ) {
732 my $comps = $c->components;
b4b01a8a 733
2f381252 734 if( !ref $name ) {
735 # is it the exact name?
736 return $c->_filter_component( $comps->{ $name }, @args )
737 if exists $comps->{ $name };
b4b01a8a 738
2f381252 739 # perhaps we just omitted "MyApp"?
740 my $composed = ( ref $c || $c ) . "::${name}";
741 return $c->_filter_component( $comps->{ $composed }, @args )
742 if exists $comps->{ $composed };
b4b01a8a 743
2f381252 744 # search all of the models, views and controllers
745 my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
746 return $c->_filter_component( $comp, @args ) if $comp;
747 }
748
749 # This is here so $c->comp( '::M::' ) works
750 my $query = ref $name ? $name : qr{$name}i;
b4b01a8a 751
2f381252 752 my @result = grep { m{$query} } keys %{ $c->components };
753 return map { $c->_filter_component( $_, @args ) } @result if ref $name;
b4b01a8a 754
2f381252 755 if( $result[ 0 ] ) {
756 $c->log->warn( qq(Found results for "${name}" using regexp fallback.) );
757 $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
758 $c->log->warn( 'is unreliable and unsafe. You have been warned' );
759 return $c->_filter_component( $result[ 0 ], @args );
760 }
761
762 # I would expect to return an empty list here, but that breaks back-compat
b4b01a8a 763 }
764
2f381252 765 # fallback
b4b01a8a 766 return sort keys %{ $c->components };
767}
768
b4b01a8a 769=head2 CLASS DATA AND HELPER CLASSES
fbcc39ad 770
b5ecfcf0 771=head2 $c->config
fbcc39ad 772
0ef52a96 773Returns or takes a hashref containing the application's configuration.
774
61b1d329 775 __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
81557adf 776
cc95842f 777You can also use a C<YAML>, C<XML> or C<Config::General> config file
778like myapp.yml in your applications home directory. See
779L<Catalyst::Plugin::ConfigLoader>.
a6ad13b6 780
781 ---
782 db: dsn:SQLite:foo.db
783
b4b01a8a 784
3643e890 785=cut
786
4090e3bb 787around config => sub {
788 my $orig = shift;
3643e890 789 my $c = shift;
790
791 $c->log->warn("Setting config after setup has been run is not a good idea.")
792 if ( @_ and $c->setup_finished );
793
4090e3bb 794 $c->$orig(@_);
795};
3643e890 796
b5ecfcf0 797=head2 $c->log
0ef52a96 798
86418559 799Returns the logging object instance. Unless it is already set, Catalyst
800sets this up with a L<Catalyst::Log> object. To use your own log class,
801set the logger with the C<< __PACKAGE__->log >> method prior to calling
9e7673af 802C<< __PACKAGE__->setup >>.
803
804 __PACKAGE__->log( MyLogger->new );
805 __PACKAGE__->setup;
806
807And later:
0ef52a96 808
ae1e6b59 809 $c->log->info( 'Now logging with my own logger!' );
0ef52a96 810
86418559 811Your log class should implement the methods described in
812L<Catalyst::Log>.
af3ff00e 813
b4b01a8a 814
815=head2 $c->debug
816
817Overload to enable debug messages (same as -Debug option).
818
e80e8542 819Note that this is a static method, not an accessor and should be overloaded
820by declaring "sub debug { 1 }" in your MyApp.pm, not by calling $c->debug(1).
821
af3ff00e 822=cut
823
b4b01a8a 824sub debug { 0 }
825
826=head2 $c->dispatcher
827
828Returns the dispatcher instance. Stringifies to class name. See
829L<Catalyst::Dispatcher>.
830
831=head2 $c->engine
832
833Returns the engine instance. Stringifies to the class name. See
834L<Catalyst::Engine>.
835
836
f7b672ef 837=head2 UTILITY METHODS
66e28e3f 838
b5ecfcf0 839=head2 $c->path_to(@path)
01033d73 840
cc95842f 841Merges C<@path> with C<< $c->config->{home} >> and returns a
afbb9aa3 842L<Path::Class::Dir> object.
01033d73 843
844For example:
845
846 $c->path_to( 'db', 'sqlite.db' );
847
848=cut
849
850sub path_to {
851 my ( $c, @path ) = @_;
a738ab68 852 my $path = Path::Class::Dir->new( $c->config->{home}, @path );
01033d73 853 if ( -d $path ) { return $path }
a738ab68 854 else { return Path::Class::File->new( $c->config->{home}, @path ) }
01033d73 855}
856
b5ecfcf0 857=head2 $c->plugin( $name, $class, @args )
0ef52a96 858
ae1e6b59 859Helper method for plugins. It creates a classdata accessor/mutator and
860loads and instantiates the given class.
0ef52a96 861
862 MyApp->plugin( 'prototype', 'HTML::Prototype' );
863
864 $c->prototype->define_javascript_functions;
865
866=cut
867
868sub plugin {
869 my ( $class, $name, $plugin, @args ) = @_;
97b58e17 870 $class->_register_plugin( $plugin, 1 );
0ef52a96 871
872 eval { $plugin->import };
873 $class->mk_classdata($name);
874 my $obj;
875 eval { $obj = $plugin->new(@args) };
876
877 if ($@) {
878 Catalyst::Exception->throw( message =>
879 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
880 }
881
882 $class->$name($obj);
883 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
884 if $class->debug;
885}
886
b5ecfcf0 887=head2 MyApp->setup
fbcc39ad 888
e7f1cf73 889Initializes the dispatcher and engine, loads any plugins, and loads the
ae1e6b59 890model, view, and controller components. You may also specify an array
891of plugins to load here, if you choose to not load them in the C<use
892Catalyst> line.
fbcc39ad 893
0ef52a96 894 MyApp->setup;
895 MyApp->setup( qw/-Debug/ );
fbcc39ad 896
897=cut
898
899sub setup {
0319a12c 900 my ( $class, @arguments ) = @_;
5168a5fc 901 $class->log->warn("Running setup twice is not a good idea.")
902 if ( $class->setup_finished );
903
fbcc39ad 904 unless ( $class->isa('Catalyst') ) {
953b0e15 905
fbcc39ad 906 Catalyst::Exception->throw(
907 message => qq/'$class' does not inherit from Catalyst/ );
1c99e125 908 }
0319a12c 909
fbcc39ad 910 if ( $class->arguments ) {
911 @arguments = ( @arguments, @{ $class->arguments } );
912 }
913
914 # Process options
915 my $flags = {};
916
917 foreach (@arguments) {
918
919 if (/^-Debug$/) {
920 $flags->{log} =
921 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
922 }
923 elsif (/^-(\w+)=?(.*)$/) {
924 $flags->{ lc $1 } = $2;
925 }
926 else {
927 push @{ $flags->{plugins} }, $_;
928 }
929 }
930
99f187d6 931 $class->setup_home( delete $flags->{home} );
932
fbcc39ad 933 $class->setup_log( delete $flags->{log} );
934 $class->setup_plugins( delete $flags->{plugins} );
935 $class->setup_dispatcher( delete $flags->{dispatcher} );
936 $class->setup_engine( delete $flags->{engine} );
dc5f035e 937 $class->setup_stats( delete $flags->{stats} );
fbcc39ad 938
939 for my $flag ( sort keys %{$flags} ) {
940
941 if ( my $code = $class->can( 'setup_' . $flag ) ) {
942 &$code( $class, delete $flags->{$flag} );
943 }
944 else {
945 $class->log->warn(qq/Unknown flag "$flag"/);
946 }
947 }
948
0eb4af72 949 eval { require Catalyst::Devel; };
950 if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) {
951 $class->log->warn(<<"EOF");
4ff0d824 952You are running an old script!
953
34a83d89 954 Please update by running (this will overwrite existing files):
955 catalyst.pl -force -scripts $class
956
957 or (this will not overwrite existing files):
958 catalyst.pl -scripts $class
1cf0345b 959
4ff0d824 960EOF
0eb4af72 961 }
ac5c933b 962
fbcc39ad 963 if ( $class->debug ) {
6601f2ad 964 my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins;
fbcc39ad 965
966 if (@plugins) {
34d28dfd 967 my $t = Text::SimpleTable->new(74);
8c113188 968 $t->row($_) for @plugins;
1cf0345b 969 $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" );
fbcc39ad 970 }
971
972 my $dispatcher = $class->dispatcher;
973 my $engine = $class->engine;
974 my $home = $class->config->{home};
975
976 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
977 $class->log->debug(qq/Loaded engine "$engine"/);
978
979 $home
980 ? ( -d $home )
981 ? $class->log->debug(qq/Found home "$home"/)
982 : $class->log->debug(qq/Home "$home" doesn't exist/)
983 : $class->log->debug(q/Couldn't find home/);
984 }
985
986 # Call plugins setup
987 {
988 no warnings qw/redefine/;
989 local *setup = sub { };
990 $class->setup;
991 }
992
993 # Initialize our data structure
994 $class->components( {} );
995
996 $class->setup_components;
997
998 if ( $class->debug ) {
34d28dfd 999 my $t = Text::SimpleTable->new( [ 63, 'Class' ], [ 8, 'Type' ] );
684d10ed 1000 for my $comp ( sort keys %{ $class->components } ) {
1001 my $type = ref $class->components->{$comp} ? 'instance' : 'class';
1002 $t->row( $comp, $type );
1003 }
1cf0345b 1004 $class->log->debug( "Loaded components:\n" . $t->draw . "\n" )
8c113188 1005 if ( keys %{ $class->components } );
fbcc39ad 1006 }
1007
1008 # Add our self to components, since we are also a component
96d8d513 1009 if( $class->isa('Catalyst::Controller') ){
1010 $class->components->{$class} = $class;
1011 }
fbcc39ad 1012
1013 $class->setup_actions;
1014
1015 if ( $class->debug ) {
1016 my $name = $class->config->{name} || 'Application';
1017 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
1018 }
1019 $class->log->_flush() if $class->log->can('_flush');
3643e890 1020
1021 $class->setup_finished(1);
fbcc39ad 1022}
1023
8a27f860 1024=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
1025
73664287 1026=head2 $c->uri_for( $path, @args?, \%query_values? )
fbcc39ad 1027
8a27f860 1028=over
fbcc39ad 1029
8a27f860 1030=item $action
8dc69021 1031
8a27f860 1032A Catalyst::Action object representing the Catalyst action you want to
1033create a URI for. To get one for an action in the current controller,
1034use C<< $c->action('someactionname') >>. To get one from different
1035controller, fetch the controller using C<< $c->controller() >>, then
1036call C<action_for> on it.
ea0e58d9 1037
9df7c5d9 1038You can maintain the arguments captured by an action (e.g.: Regex, Chained)
1039using C<< $c->req->captures >>.
1040
1041 # For the current action
1042 $c->uri_for($c->action, $c->req->captures);
1043
1044 # For the Foo action in the Bar controller
1045 $c->uri_for($c->controller->('Bar')->action_for('Foo'), $c->req->captures);
1046
d5e3d528 1047=back
1048
4cf1dd00 1049=cut
1050
fbcc39ad 1051sub uri_for {
00e6a2b7 1052 my ( $c, $path, @args ) = @_;
00e6a2b7 1053
ea0e58d9 1054 if ( Scalar::Util::blessed($path) ) { # action object
1055 my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
1056 ? shift(@args)
1057 : [] );
1058 $path = $c->dispatcher->uri_for_action($path, $captures);
1059 return undef unless defined($path);
81e75875 1060 $path = '/' if $path eq '';
ea0e58d9 1061 }
1062
51674a63 1063 undef($path) if (defined $path && $path eq '');
00e6a2b7 1064
97b58e17 1065 my $params =
1066 ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
8327e2e2 1067
cbb93105 1068 carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
51674a63 1069 s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
1070
1071 unshift(@args, $path);
1072
1073 unless (defined $path && $path =~ s!^/!!) { # in-place strip
1074 my $namespace = $c->namespace;
1075 if (defined $path) { # cheesy hack to handle path '../foo'
1076 $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{};
6601f2ad 1077 }
51674a63 1078 unshift(@args, $namespace || '');
1079 }
ac5c933b 1080
189e2a51 1081 # join args with '/', or a blank string
51674a63 1082 my $args = join('/', grep { defined($_) } @args);
1083 $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
7a2295bc 1084 $args =~ s!^/+!!;
51674a63 1085 my $base = $c->req->base;
1086 my $class = ref($base);
1087 $base =~ s{(?<!/)$}{/};
1088
1089 my $query = '';
1090
1091 if (my @keys = keys %$params) {
1092 # somewhat lifted from URI::_query's query_form
1093 $query = '?'.join('&', map {
2f381252 1094 my $val = $params->{$_};
51674a63 1095 s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
1096 s/ /+/g;
1097 my $key = $_;
51674a63 1098 $val = '' unless defined $val;
1099 (map {
1100 $_ = "$_";
0ce485e9 1101 utf8::encode( $_ ) if utf8::is_utf8($_);
51674a63 1102 # using the URI::Escape pattern here so utf8 chars survive
1103 s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
1104 s/ /+/g;
1105 "${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
1106 } @keys);
1107 }
1108
1109 my $res = bless(\"${base}${args}${query}", $class);
d3e7a648 1110 $res;
fbcc39ad 1111}
1112
b5ecfcf0 1113=head2 $c->welcome_message
ab2374d3 1114
1115Returns the Catalyst welcome HTML page.
1116
1117=cut
1118
1119sub welcome_message {
bf1f2c60 1120 my $c = shift;
1121 my $name = $c->config->{name};
1122 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
1123 my $prefix = Catalyst::Utils::appprefix( ref $c );
80cdbbff 1124 $c->response->content_type('text/html; charset=utf-8');
ab2374d3 1125 return <<"EOF";
80cdbbff 1126<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
1127 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
1128<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
ab2374d3 1129 <head>
85d9fce6 1130 <meta http-equiv="Content-Language" content="en" />
1131 <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
ab2374d3 1132 <title>$name on Catalyst $VERSION</title>
1133 <style type="text/css">
1134 body {
ab2374d3 1135 color: #000;
1136 background-color: #eee;
1137 }
1138 div#content {
1139 width: 640px;
80cdbbff 1140 margin-left: auto;
1141 margin-right: auto;
ab2374d3 1142 margin-top: 10px;
1143 margin-bottom: 10px;
1144 text-align: left;
1145 background-color: #ccc;
1146 border: 1px solid #aaa;
ab2374d3 1147 }
d84c4dab 1148 p, h1, h2 {
ab2374d3 1149 margin-left: 20px;
1150 margin-right: 20px;
16215972 1151 font-family: verdana, tahoma, sans-serif;
ab2374d3 1152 }
d84c4dab 1153 a {
1154 font-family: verdana, tahoma, sans-serif;
1155 }
d114e033 1156 :link, :visited {
1157 text-decoration: none;
1158 color: #b00;
1159 border-bottom: 1px dotted #bbb;
1160 }
1161 :link:hover, :visited:hover {
d114e033 1162 color: #555;
1163 }
ab2374d3 1164 div#topbar {
1165 margin: 0px;
1166 }
3e82a295 1167 pre {
3e82a295 1168 margin: 10px;
1169 padding: 8px;
1170 }
ab2374d3 1171 div#answers {
1172 padding: 8px;
1173 margin: 10px;
d114e033 1174 background-color: #fff;
ab2374d3 1175 border: 1px solid #aaa;
ab2374d3 1176 }
1177 h1 {
33108eaf 1178 font-size: 0.9em;
1179 font-weight: normal;
ab2374d3 1180 text-align: center;
1181 }
1182 h2 {
1183 font-size: 1.0em;
1184 }
1185 p {
1186 font-size: 0.9em;
1187 }
ae7c5252 1188 p img {
1189 float: right;
1190 margin-left: 10px;
1191 }
9619f23c 1192 span#appname {
1193 font-weight: bold;
33108eaf 1194 font-size: 1.6em;
ab2374d3 1195 }
1196 </style>
1197 </head>
1198 <body>
1199 <div id="content">
1200 <div id="topbar">
9619f23c 1201 <h1><span id="appname">$name</span> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 1202 $VERSION</h1>
ab2374d3 1203 </div>
1204 <div id="answers">
ae7c5252 1205 <p>
80cdbbff 1206 <img src="$logo" alt="Catalyst Logo" />
ae7c5252 1207 </p>
596aaffe 1208 <p>Welcome to the world of Catalyst.
f92fd545 1209 This <a href="http://en.wikipedia.org/wiki/MVC">MVC</a>
1210 framework will make web development something you had
60dd6e1d 1211 never expected it to be: Fun, rewarding, and quick.</p>
ab2374d3 1212 <h2>What to do now?</h2>
4b8cb778 1213 <p>That really depends on what <b>you</b> want to do.
ab2374d3 1214 We do, however, provide you with a few starting points.</p>
1215 <p>If you want to jump right into web development with Catalyst
2f381252 1216 you might want to start with a tutorial.</p>
b607f8a0 1217<pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
596aaffe 1218</pre>
1219<p>Afterwards you can go on to check out a more complete look at our features.</p>
1220<pre>
b607f8a0 1221<code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
1222<!-- Something else should go here, but the Catalyst::Manual link seems unhelpful -->
1223</code></pre>
ab2374d3 1224 <h2>What to do next?</h2>
f5681c92 1225 <p>Next it's time to write an actual application. Use the
80cdbbff 1226 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&amp;mode=all">controllers</a>,
60dd6e1d 1227 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
1228 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
bf1f2c60 1229 they can save you a lot of work.</p>
1230 <pre><code>script/${prefix}_create.pl -help</code></pre>
1231 <p>Also, be sure to check out the vast and growing
60dd6e1d 1232 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&amp;mode=all">plugins for Catalyst on CPAN</a>;
bf1f2c60 1233 you are likely to find what you need there.
f5681c92 1234 </p>
1235
82245cc4 1236 <h2>Need help?</h2>
f5681c92 1237 <p>Catalyst has a very active community. Here are the main places to
1238 get in touch with us.</p>
16215972 1239 <ul>
1240 <li>
2b9a7d76 1241 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 1242 </li>
1243 <li>
6d4c3368 1244 <a href="http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst">Mailing-List</a>
16215972 1245 </li>
1246 <li>
4eaf7c88 1247 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 1248 </li>
1249 </ul>
ab2374d3 1250 <h2>In conclusion</h2>
ac5c933b 1251 <p>The Catalyst team hopes you will enjoy using Catalyst as much
f5681c92 1252 as we enjoyed making it. Please contact us if you have ideas
1253 for improvement or other feedback.</p>
ab2374d3 1254 </div>
1255 </div>
1256 </body>
1257</html>
1258EOF
1259}
1260
fbcc39ad 1261=head1 INTERNAL METHODS
1262
ae1e6b59 1263These methods are not meant to be used by end users.
1264
b5ecfcf0 1265=head2 $c->components
fbcc39ad 1266
e7f1cf73 1267Returns a hash of components.
fbcc39ad 1268
b5ecfcf0 1269=head2 $c->context_class
1f9cb7c1 1270
e7f1cf73 1271Returns or sets the context class.
1f9cb7c1 1272
b5ecfcf0 1273=head2 $c->counter
fbcc39ad 1274
ae1e6b59 1275Returns a hashref containing coderefs and execution counts (needed for
1276deep recursion detection).
fbcc39ad 1277
b5ecfcf0 1278=head2 $c->depth
fbcc39ad 1279
e7f1cf73 1280Returns the number of actions on the current internal execution stack.
fbcc39ad 1281
b5ecfcf0 1282=head2 $c->dispatch
fbcc39ad 1283
e7f1cf73 1284Dispatches a request to actions.
fbcc39ad 1285
1286=cut
1287
1288sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
1289
b5ecfcf0 1290=head2 $c->dispatcher_class
1f9cb7c1 1291
e7f1cf73 1292Returns or sets the dispatcher class.
1f9cb7c1 1293
b5ecfcf0 1294=head2 $c->dump_these
7f92deef 1295
ae1e6b59 1296Returns a list of 2-element array references (name, structure) pairs
1297that will be dumped on the error page in debug mode.
7f92deef 1298
1299=cut
1300
1301sub dump_these {
1302 my $c = shift;
ac5c933b 1303 [ Request => $c->req ],
1304 [ Response => $c->res ],
052a2d89 1305 [ Stash => $c->stash ],
1306 [ Config => $c->config ];
7f92deef 1307}
1308
b5ecfcf0 1309=head2 $c->engine_class
1f9cb7c1 1310
e7f1cf73 1311Returns or sets the engine class.
1f9cb7c1 1312
b5ecfcf0 1313=head2 $c->execute( $class, $coderef )
fbcc39ad 1314
0ef52a96 1315Execute a coderef in given class and catch exceptions. Errors are available
1316via $c->error.
fbcc39ad 1317
1318=cut
1319
1320sub execute {
1321 my ( $c, $class, $code ) = @_;
858828dd 1322 $class = $c->component($class) || $class;
fbcc39ad 1323 $c->state(0);
a0eca838 1324
197bd788 1325 if ( $c->depth >= $RECURSION ) {
f3414019 1326 my $action = $code->reverse();
91d08727 1327 $action = "/$action" unless $action =~ /->/;
f3414019 1328 my $error = qq/Deep recursion detected calling "${action}"/;
1627551a 1329 $c->log->error($error);
1330 $c->error($error);
1331 $c->state(0);
1332 return $c->state;
1333 }
1334
dc5f035e 1335 my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats;
22247e54 1336
8767c5a3 1337 push( @{ $c->stack }, $code );
ac5c933b 1338
f3414019 1339 eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
22247e54 1340
dc5f035e 1341 $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
ac5c933b 1342
a6724a82 1343 my $last = pop( @{ $c->stack } );
fbcc39ad 1344
1345 if ( my $error = $@ ) {
2f381252 1346 if ( !ref($error) and $error eq $DETACH ) {
1347 die $DETACH if($c->depth > 1);
1348 }
55424863 1349 elsif ( !ref($error) and $error eq $GO ) {
1350 die $GO if($c->depth > 0);
1351 }
fbcc39ad 1352 else {
1353 unless ( ref $error ) {
91d08727 1354 no warnings 'uninitialized';
fbcc39ad 1355 chomp $error;
f59def82 1356 my $class = $last->class;
1357 my $name = $last->name;
1358 $error = qq/Caught exception in $class->$name "$error"/;
fbcc39ad 1359 }
fbcc39ad 1360 $c->error($error);
1361 $c->state(0);
1362 }
1363 }
1364 return $c->state;
1365}
1366
7a7d7af5 1367sub _stats_start_execute {
1368 my ( $c, $code ) = @_;
1369
a6724a82 1370 return if ( ( $code->name =~ /^_.*/ )
1371 && ( !$c->config->{show_internal_actions} ) );
7a7d7af5 1372
f3414019 1373 my $action_name = $code->reverse();
1374 $c->counter->{$action_name}++;
7a7d7af5 1375
f3414019 1376 my $action = $action_name;
a6724a82 1377 $action = "/$action" unless $action =~ /->/;
1378
7a7d7af5 1379 # determine if the call was the result of a forward
1380 # this is done by walking up the call stack and looking for a calling
1381 # sub of Catalyst::forward before the eval
1382 my $callsub = q{};
1383 for my $index ( 2 .. 11 ) {
1384 last
1385 if ( ( caller($index) )[0] eq 'Catalyst'
1386 && ( caller($index) )[3] eq '(eval)' );
1387
1388 if ( ( caller($index) )[3] =~ /forward$/ ) {
1389 $callsub = ( caller($index) )[3];
1390 $action = "-> $action";
1391 last;
1392 }
1393 }
1394
f3414019 1395 my $uid = $action_name . $c->counter->{$action_name};
74efc144 1396
a6724a82 1397 # is this a root-level call or a forwarded call?
1398 if ( $callsub =~ /forward$/ ) {
1399
1400 # forward, locate the caller
1401 if ( my $parent = $c->stack->[-1] ) {
69d8f33c 1402 $c->stats->profile(
ac5c933b 1403 begin => $action,
69d8f33c 1404 parent => "$parent" . $c->counter->{"$parent"},
1405 uid => $uid,
1406 );
7a7d7af5 1407 }
1408 else {
1409
a6724a82 1410 # forward with no caller may come from a plugin
69d8f33c 1411 $c->stats->profile(
1412 begin => $action,
1413 uid => $uid,
1414 );
7a7d7af5 1415 }
1416 }
a6724a82 1417 else {
ac5c933b 1418
a6724a82 1419 # root-level call
69d8f33c 1420 $c->stats->profile(
1421 begin => $action,
1422 uid => $uid,
1423 );
a6724a82 1424 }
dc5f035e 1425 return $action;
7a7d7af5 1426
7a7d7af5 1427}
1428
1429sub _stats_finish_execute {
1430 my ( $c, $info ) = @_;
69d8f33c 1431 $c->stats->profile( end => $info );
7a7d7af5 1432}
1433
3d0d6d21 1434=head2 $c->_localize_fields( sub { }, \%keys );
1435
1436=cut
1437
e63bdf38 1438#Why does this exist? This is no longer safe and WILL NOT WORK.
1439# it doesnt seem to be used anywhere. can we remove it?
3d0d6d21 1440sub _localize_fields {
1441 my ( $c, $localized, $code ) = ( @_ );
1442
1443 my $request = delete $localized->{request} || {};
1444 my $response = delete $localized->{response} || {};
ac5c933b 1445
3d0d6d21 1446 local @{ $c }{ keys %$localized } = values %$localized;
1447 local @{ $c->request }{ keys %$request } = values %$request;
1448 local @{ $c->response }{ keys %$response } = values %$response;
1449
1450 $code->();
1451}
1452
b5ecfcf0 1453=head2 $c->finalize
fbcc39ad 1454
e7f1cf73 1455Finalizes the request.
fbcc39ad 1456
1457=cut
1458
1459sub finalize {
1460 my $c = shift;
1461
369c09bc 1462 for my $error ( @{ $c->error } ) {
1463 $c->log->error($error);
1464 }
1465
5050d7a7 1466 # Allow engine to handle finalize flow (for POE)
e63bdf38 1467 my $engine = $c->engine;
1468 if ( my $code = $engine->can('finalize') ) {
1469 $engine->$code($c);
fbcc39ad 1470 }
5050d7a7 1471 else {
fbcc39ad 1472
5050d7a7 1473 $c->finalize_uploads;
fbcc39ad 1474
5050d7a7 1475 # Error
1476 if ( $#{ $c->error } >= 0 ) {
1477 $c->finalize_error;
1478 }
1479
1480 $c->finalize_headers;
fbcc39ad 1481
5050d7a7 1482 # HEAD request
1483 if ( $c->request->method eq 'HEAD' ) {
1484 $c->response->body('');
1485 }
1486
1487 $c->finalize_body;
1488 }
ac5c933b 1489
1490 if ($c->use_stats) {
596677b6 1491 my $elapsed = sprintf '%f', $c->stats->elapsed;
12bf12c0 1492 my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed;
908e3d9e 1493 $c->log->info(
ac5c933b 1494 "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" );
908e3d9e 1495 }
fbcc39ad 1496
1497 return $c->response->status;
1498}
1499
b5ecfcf0 1500=head2 $c->finalize_body
fbcc39ad 1501
e7f1cf73 1502Finalizes body.
fbcc39ad 1503
1504=cut
1505
1506sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
1507
b5ecfcf0 1508=head2 $c->finalize_cookies
fbcc39ad 1509
e7f1cf73 1510Finalizes cookies.
fbcc39ad 1511
1512=cut
1513
147821ea 1514sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
fbcc39ad 1515
b5ecfcf0 1516=head2 $c->finalize_error
fbcc39ad 1517
e7f1cf73 1518Finalizes error.
fbcc39ad 1519
1520=cut
1521
1522sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
1523
b5ecfcf0 1524=head2 $c->finalize_headers
fbcc39ad 1525
e7f1cf73 1526Finalizes headers.
fbcc39ad 1527
1528=cut
1529
1530sub finalize_headers {
1531 my $c = shift;
1532
e63bdf38 1533 my $response = $c->response; #accessor calls can add up?
1534
fbcc39ad 1535 # Check if we already finalized headers
6680c772 1536 return if $response->finalized_headers;
fbcc39ad 1537
1538 # Handle redirects
e63bdf38 1539 if ( my $location = $response->redirect ) {
fbcc39ad 1540 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
e63bdf38 1541 $response->header( Location => $location );
a7caa492 1542
02570318 1543 if ( !$response->has_body ) {
39655cdc 1544 # Add a default body if none is already present
e63bdf38 1545 $response->body(
e422816e 1546 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
39655cdc 1547 );
1548 }
fbcc39ad 1549 }
1550
1551 # Content-Length
e63bdf38 1552 if ( $response->body && !$response->content_length ) {
775878ac 1553
8f62c91a 1554 # get the length from a filehandle
e63bdf38 1555 if ( blessed( $response->body ) && $response->body->can('read') )
197bd788 1556 {
e63bdf38 1557 my $stat = stat $response->body;
3b6a1db1 1558 if ( $stat && $stat->size > 0 ) {
e63bdf38 1559 $response->content_length( $stat->size );
8f62c91a 1560 }
1561 else {
775878ac 1562 $c->log->warn('Serving filehandle without a content-length');
8f62c91a 1563 }
1564 }
1565 else {
b5d7a61f 1566 # everything should be bytes at this point, but just in case
e63bdf38 1567 $response->content_length( bytes::length( $response->body ) );
8f62c91a 1568 }
fbcc39ad 1569 }
1570
1571 # Errors
e63bdf38 1572 if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
1573 $response->headers->remove_header("Content-Length");
1574 $response->body('');
fbcc39ad 1575 }
1576
1577 $c->finalize_cookies;
1578
1579 $c->engine->finalize_headers( $c, @_ );
1580
1581 # Done
6680c772 1582 $response->finalized_headers(1);
fbcc39ad 1583}
1584
b5ecfcf0 1585=head2 $c->finalize_output
fbcc39ad 1586
1587An alias for finalize_body.
1588
b5ecfcf0 1589=head2 $c->finalize_read
fbcc39ad 1590
e7f1cf73 1591Finalizes the input after reading is complete.
fbcc39ad 1592
1593=cut
1594
1595sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
1596
b5ecfcf0 1597=head2 $c->finalize_uploads
fbcc39ad 1598
ae1e6b59 1599Finalizes uploads. Cleans up any temporary files.
fbcc39ad 1600
1601=cut
1602
1603sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
1604
b5ecfcf0 1605=head2 $c->get_action( $action, $namespace )
fbcc39ad 1606
e7f1cf73 1607Gets an action in a given namespace.
fbcc39ad 1608
1609=cut
1610
684d10ed 1611sub get_action { my $c = shift; $c->dispatcher->get_action(@_) }
fbcc39ad 1612
b5ecfcf0 1613=head2 $c->get_actions( $action, $namespace )
a9dc674c 1614
ae1e6b59 1615Gets all actions of a given name in a namespace and all parent
1616namespaces.
a9dc674c 1617
1618=cut
1619
1620sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) }
1621
f7b672ef 1622=head2 $c->handle_request( $class, @arguments )
fbcc39ad 1623
e7f1cf73 1624Called to handle each HTTP request.
fbcc39ad 1625
1626=cut
1627
1628sub handle_request {
1629 my ( $class, @arguments ) = @_;
1630
1631 # Always expect worst case!
1632 my $status = -1;
1633 eval {
dea1884f 1634 if ($class->debug) {
908e3d9e 1635 my $secs = time - $START || 1;
1636 my $av = sprintf '%.3f', $COUNT / $secs;
1637 my $time = localtime time;
1638 $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
dea1884f 1639 }
908e3d9e 1640
1641 my $c = $class->prepare(@arguments);
1642 $c->dispatch;
ac5c933b 1643 $status = $c->finalize;
fbcc39ad 1644 };
1645
1646 if ( my $error = $@ ) {
1647 chomp $error;
1648 $class->log->error(qq/Caught exception in engine "$error"/);
1649 }
1650
1651 $COUNT++;
6680c772 1652
1653 if(my $coderef = $class->log->can('_flush')){
1654 $class->log->$coderef();
1655 }
fbcc39ad 1656 return $status;
1657}
1658
b5ecfcf0 1659=head2 $c->prepare( @arguments )
fbcc39ad 1660
ae1e6b59 1661Creates a Catalyst context from an engine-specific request (Apache, CGI,
1662etc.).
fbcc39ad 1663
1664=cut
1665
1666sub prepare {
1667 my ( $class, @arguments ) = @_;
1668
6680c772 1669 # XXX
1670 # After the app/ctxt split, this should become an attribute based on something passed
1671 # into the application.
3cec521a 1672 $class->context_class( ref $class || $class ) unless $class->context_class;
6680c772 1673
1674 my $c = $class->context_class->new({});
1675
1676 # For on-demand data
1677 $c->request->_context($c);
1678 $c->response->_context($c);
fbcc39ad 1679
b6d4ee6e 1680 #surely this is not the most efficient way to do things...
dc5f035e 1681 $c->stats($class->stats_class->new)->enable($c->use_stats);
908e3d9e 1682 if ( $c->debug ) {
ac5c933b 1683 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
908e3d9e 1684 }
1685
e63bdf38 1686 #XXX reuse coderef from can
5050d7a7 1687 # Allow engine to direct the prepare flow (for POE)
1688 if ( $c->engine->can('prepare') ) {
1689 $c->engine->prepare( $c, @arguments );
1690 }
1691 else {
1692 $c->prepare_request(@arguments);
1693 $c->prepare_connection;
1694 $c->prepare_query_parameters;
1695 $c->prepare_headers;
1696 $c->prepare_cookies;
1697 $c->prepare_path;
1698
878b821c 1699 # Prepare the body for reading, either by prepare_body
1700 # or the user, if they are using $c->read
1701 $c->prepare_read;
ac5c933b 1702
878b821c 1703 # Parse the body unless the user wants it on-demand
1704 unless ( $c->config->{parse_on_demand} ) {
1705 $c->prepare_body;
1706 }
5050d7a7 1707 }
fbcc39ad 1708
fbcc39ad 1709 my $method = $c->req->method || '';
2f381252 1710 my $path = $c->req->path;
1711 $path = '/' unless length $path;
fbcc39ad 1712 my $address = $c->req->address || '';
1713
e3a13771 1714 $c->log->debug(qq/"$method" request for "$path" from "$address"/)
fbcc39ad 1715 if $c->debug;
1716
e3a13771 1717 $c->prepare_action;
1718
fbcc39ad 1719 return $c;
1720}
1721
b5ecfcf0 1722=head2 $c->prepare_action
fbcc39ad 1723
b4b01a8a 1724Prepares action. See L<Catalyst::Dispatcher>.
fbcc39ad 1725
1726=cut
1727
1728sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1729
b5ecfcf0 1730=head2 $c->prepare_body
fbcc39ad 1731
e7f1cf73 1732Prepares message body.
fbcc39ad 1733
1734=cut
1735
1736sub prepare_body {
1737 my $c = shift;
1738
e63bdf38 1739 #Moose TODO: what is _body ??
fbcc39ad 1740 # Do we run for the first time?
1741 return if defined $c->request->{_body};
1742
1743 # Initialize on-demand data
1744 $c->engine->prepare_body( $c, @_ );
1745 $c->prepare_parameters;
1746 $c->prepare_uploads;
1747
1748 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
34d28dfd 1749 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
fbcc39ad 1750 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1751 my $param = $c->req->body_parameters->{$key};
1752 my $value = defined($param) ? $param : '';
8c113188 1753 $t->row( $key,
fbcc39ad 1754 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1755 }
1756 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1757 }
1758}
1759
b5ecfcf0 1760=head2 $c->prepare_body_chunk( $chunk )
4bd82c41 1761
e7f1cf73 1762Prepares a chunk of data before sending it to L<HTTP::Body>.
4bd82c41 1763
b4b01a8a 1764See L<Catalyst::Engine>.
1765
4bd82c41 1766=cut
1767
4f5ebacd 1768sub prepare_body_chunk {
1769 my $c = shift;
4bd82c41 1770 $c->engine->prepare_body_chunk( $c, @_ );
1771}
1772
b5ecfcf0 1773=head2 $c->prepare_body_parameters
fbcc39ad 1774
e7f1cf73 1775Prepares body parameters.
fbcc39ad 1776
1777=cut
1778
1779sub prepare_body_parameters {
1780 my $c = shift;
1781 $c->engine->prepare_body_parameters( $c, @_ );
1782}
1783
b5ecfcf0 1784=head2 $c->prepare_connection
fbcc39ad 1785
e7f1cf73 1786Prepares connection.
fbcc39ad 1787
1788=cut
1789
1790sub prepare_connection {
1791 my $c = shift;
1792 $c->engine->prepare_connection( $c, @_ );
1793}
1794
b5ecfcf0 1795=head2 $c->prepare_cookies
fbcc39ad 1796
e7f1cf73 1797Prepares cookies.
fbcc39ad 1798
1799=cut
1800
1801sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1802
b5ecfcf0 1803=head2 $c->prepare_headers
fbcc39ad 1804
e7f1cf73 1805Prepares headers.
fbcc39ad 1806
1807=cut
1808
1809sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1810
b5ecfcf0 1811=head2 $c->prepare_parameters
fbcc39ad 1812
e7f1cf73 1813Prepares parameters.
fbcc39ad 1814
1815=cut
1816
1817sub prepare_parameters {
1818 my $c = shift;
1819 $c->prepare_body_parameters;
1820 $c->engine->prepare_parameters( $c, @_ );
1821}
1822
b5ecfcf0 1823=head2 $c->prepare_path
fbcc39ad 1824
e7f1cf73 1825Prepares path and base.
fbcc39ad 1826
1827=cut
1828
1829sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1830
b5ecfcf0 1831=head2 $c->prepare_query_parameters
fbcc39ad 1832
e7f1cf73 1833Prepares query parameters.
fbcc39ad 1834
1835=cut
1836
1837sub prepare_query_parameters {
1838 my $c = shift;
1839
1840 $c->engine->prepare_query_parameters( $c, @_ );
1841
1842 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
34d28dfd 1843 my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
fbcc39ad 1844 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1845 my $param = $c->req->query_parameters->{$key};
1846 my $value = defined($param) ? $param : '';
8c113188 1847 $t->row( $key,
fbcc39ad 1848 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1849 }
1850 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1851 }
1852}
1853
b5ecfcf0 1854=head2 $c->prepare_read
fbcc39ad 1855
e7f1cf73 1856Prepares the input for reading.
fbcc39ad 1857
1858=cut
1859
1860sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1861
b5ecfcf0 1862=head2 $c->prepare_request
fbcc39ad 1863
e7f1cf73 1864Prepares the engine request.
fbcc39ad 1865
1866=cut
1867
1868sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1869
b5ecfcf0 1870=head2 $c->prepare_uploads
fbcc39ad 1871
e7f1cf73 1872Prepares uploads.
fbcc39ad 1873
1874=cut
1875
1876sub prepare_uploads {
1877 my $c = shift;
1878
1879 $c->engine->prepare_uploads( $c, @_ );
1880
1881 if ( $c->debug && keys %{ $c->request->uploads } ) {
8c113188 1882 my $t = Text::SimpleTable->new(
34d28dfd 1883 [ 12, 'Parameter' ],
1884 [ 26, 'Filename' ],
8c113188 1885 [ 18, 'Type' ],
1886 [ 9, 'Size' ]
1887 );
fbcc39ad 1888 for my $key ( sort keys %{ $c->request->uploads } ) {
1889 my $upload = $c->request->uploads->{$key};
1890 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
8c113188 1891 $t->row( $key, $u->filename, $u->type, $u->size );
fbcc39ad 1892 }
1893 }
1894 $c->log->debug( "File Uploads are:\n" . $t->draw );
1895 }
1896}
1897
b5ecfcf0 1898=head2 $c->prepare_write
fbcc39ad 1899
e7f1cf73 1900Prepares the output for writing.
fbcc39ad 1901
1902=cut
1903
1904sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1905
b5ecfcf0 1906=head2 $c->request_class
1f9cb7c1 1907
e7f1cf73 1908Returns or sets the request class.
1f9cb7c1 1909
b5ecfcf0 1910=head2 $c->response_class
1f9cb7c1 1911
e7f1cf73 1912Returns or sets the response class.
1f9cb7c1 1913
b5ecfcf0 1914=head2 $c->read( [$maxlength] )
fbcc39ad 1915
ae1e6b59 1916Reads a chunk of data from the request body. This method is designed to
1917be used in a while loop, reading C<$maxlength> bytes on every call.
1918C<$maxlength> defaults to the size of the request if not specified.
fbcc39ad 1919
cc95842f 1920You have to set C<< MyApp->config->{parse_on_demand} >> to use this
ae1e6b59 1921directly.
fbcc39ad 1922
878b821c 1923Warning: If you use read(), Catalyst will not process the body,
1924so you will not be able to access POST parameters or file uploads via
1925$c->request. You must handle all body parsing yourself.
1926
fbcc39ad 1927=cut
1928
1929sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1930
b5ecfcf0 1931=head2 $c->run
fbcc39ad 1932
1933Starts the engine.
1934
1935=cut
1936
1937sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1938
b5ecfcf0 1939=head2 $c->set_action( $action, $code, $namespace, $attrs )
fbcc39ad 1940
e7f1cf73 1941Sets an action in a given namespace.
fbcc39ad 1942
1943=cut
1944
1945sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1946
b5ecfcf0 1947=head2 $c->setup_actions($component)
fbcc39ad 1948
e7f1cf73 1949Sets up actions for a component.
fbcc39ad 1950
1951=cut
1952
1953sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1954
b5ecfcf0 1955=head2 $c->setup_components
fbcc39ad 1956
86418559 1957Sets up components. Specify a C<setup_components> config option to pass
1958additional options directly to L<Module::Pluggable>. To add additional
1959search paths, specify a key named C<search_extra> as an array
1960reference. Items in the array beginning with C<::> will have the
18de900e 1961application class name prepended to them.
fbcc39ad 1962
2f381252 1963All components found will also have any
1964L<Devel::InnerPackage|inner packages> loaded and set up as components.
1965Note, that modules which are B<not> an I<inner package> of the main
1966file namespace loaded will not be instantiated as components.
1967
fbcc39ad 1968=cut
1969
1970sub setup_components {
1971 my $class = shift;
1972
18de900e 1973 my @paths = qw( ::Controller ::C ::Model ::M ::View ::V );
1974 my $config = $class->config->{ setup_components };
1975 my $extra = delete $config->{ search_extra } || [];
ac5c933b 1976
18de900e 1977 push @paths, @$extra;
ac5c933b 1978
364d7324 1979 my $locator = Module::Pluggable::Object->new(
18de900e 1980 search_path => [ map { s/^(?=::)/$class/; $_; } @paths ],
1981 %$config
364d7324 1982 );
b94b200c 1983
1984 my @comps = sort { length $a <=> length $b } $locator->plugins;
1985 my %comps = map { $_ => 1 } @comps;
ac5c933b 1986
b94b200c 1987 for my $component ( @comps ) {
dd91afb5 1988
1989 # We pass ignore_loaded here so that overlay files for (e.g.)
1990 # Model::DBI::Schema sub-classes are loaded - if it's in @comps
1991 # we know M::P::O found a file on disk so this is safe
1992
f5a4863c 1993 Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
1994 #Class::MOP::load_class($component);
364d7324 1995
1996 my $module = $class->setup_component( $component );
1997 my %modules = (
1998 $component => $module,
1999 map {
2000 $_ => $class->setup_component( $_ )
ac5c933b 2001 } grep {
b94b200c 2002 not exists $comps{$_}
364d7324 2003 } Devel::InnerPackage::list_packages( $component )
2004 );
ac5c933b 2005
364d7324 2006 for my $key ( keys %modules ) {
2007 $class->components->{ $key } = $modules{ $key };
fbcc39ad 2008 }
364d7324 2009 }
2010}
fbcc39ad 2011
364d7324 2012=head2 $c->setup_component
fbcc39ad 2013
364d7324 2014=cut
fbcc39ad 2015
364d7324 2016sub setup_component {
2017 my( $class, $component ) = @_;
fbcc39ad 2018
364d7324 2019 unless ( $component->can( 'COMPONENT' ) ) {
2020 return $component;
2021 }
fbcc39ad 2022
364d7324 2023 my $suffix = Catalyst::Utils::class2classsuffix( $component );
2024 my $config = $class->config->{ $suffix } || {};
fbcc39ad 2025
364d7324 2026 my $instance = eval { $component->COMPONENT( $class, $config ); };
fbcc39ad 2027
2028 if ( my $error = $@ ) {
fbcc39ad 2029 chomp $error;
fbcc39ad 2030 Catalyst::Exception->throw(
364d7324 2031 message => qq/Couldn't instantiate component "$component", "$error"/
2032 );
fbcc39ad 2033 }
2034
364d7324 2035 Catalyst::Exception->throw(
2036 message =>
2037 qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
84ff88cf 2038 ) unless blessed($instance);
364d7324 2039
2040 return $instance;
fbcc39ad 2041}
2042
b5ecfcf0 2043=head2 $c->setup_dispatcher
fbcc39ad 2044
ae1e6b59 2045Sets up dispatcher.
2046
fbcc39ad 2047=cut
2048
2049sub setup_dispatcher {
2050 my ( $class, $dispatcher ) = @_;
2051
2052 if ($dispatcher) {
2053 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
2054 }
2055
cb69249e 2056 if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) {
2057 $dispatcher = 'Catalyst::Dispatcher::' . $env;
fbcc39ad 2058 }
2059
2060 unless ($dispatcher) {
cb0354c6 2061 $dispatcher = $class->dispatcher_class;
fbcc39ad 2062 }
2063
e63bdf38 2064 Class::MOP::load_class($dispatcher);
fbcc39ad 2065
2066 # dispatcher instance
2067 $class->dispatcher( $dispatcher->new );
2068}
2069
b5ecfcf0 2070=head2 $c->setup_engine
fbcc39ad 2071
ae1e6b59 2072Sets up engine.
2073
fbcc39ad 2074=cut
2075
2076sub setup_engine {
2077 my ( $class, $engine ) = @_;
2078
2079 if ($engine) {
2080 $engine = 'Catalyst::Engine::' . $engine;
2081 }
2082
cb69249e 2083 if ( my $env = Catalyst::Utils::env_value( $class, 'ENGINE' ) ) {
2084 $engine = 'Catalyst::Engine::' . $env;
fbcc39ad 2085 }
2086
9b0a3e0f 2087 if ( $ENV{MOD_PERL} ) {
74c89dea 2088 my $meta = $class->Class::MOP::Object::meta();
2089
fbcc39ad 2090 # create the apache method
74c89dea 2091 $meta->add_method('apache' => sub { shift->engine->apache });
fbcc39ad 2092
2093 my ( $software, $version ) =
2094 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
2095
2096 $version =~ s/_//g;
2097 $version =~ s/(\.[^.]+)\./$1/g;
2098
2099 if ( $software eq 'mod_perl' ) {
2100
9b0a3e0f 2101 if ( !$engine ) {
22247e54 2102
9b0a3e0f 2103 if ( $version >= 1.99922 ) {
2104 $engine = 'Catalyst::Engine::Apache2::MP20';
2105 }
22247e54 2106
9b0a3e0f 2107 elsif ( $version >= 1.9901 ) {
2108 $engine = 'Catalyst::Engine::Apache2::MP19';
2109 }
22247e54 2110
9b0a3e0f 2111 elsif ( $version >= 1.24 ) {
2112 $engine = 'Catalyst::Engine::Apache::MP13';
2113 }
22247e54 2114
9b0a3e0f 2115 else {
2116 Catalyst::Exception->throw( message =>
2117 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
2118 }
fbcc39ad 2119
fbcc39ad 2120 }
2121
2122 # install the correct mod_perl handler
2123 if ( $version >= 1.9901 ) {
2124 *handler = sub : method {
2125 shift->handle_request(@_);
2126 };
2127 }
2128 else {
2129 *handler = sub ($$) { shift->handle_request(@_) };
2130 }
2131
2132 }
2133
2134 elsif ( $software eq 'Zeus-Perl' ) {
2135 $engine = 'Catalyst::Engine::Zeus';
2136 }
2137
2138 else {
2139 Catalyst::Exception->throw(
2140 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
2141 }
2142 }
2143
2144 unless ($engine) {
cb0354c6 2145 $engine = $class->engine_class;
fbcc39ad 2146 }
2147
e63bdf38 2148 Class::MOP::load_class($engine);
0e7f5826 2149
d54484bf 2150 # check for old engines that are no longer compatible
2151 my $old_engine;
0e7f5826 2152 if ( $engine->isa('Catalyst::Engine::Apache')
2153 && !Catalyst::Engine::Apache->VERSION )
d54484bf 2154 {
2155 $old_engine = 1;
2156 }
0e7f5826 2157
d54484bf 2158 elsif ( $engine->isa('Catalyst::Engine::Server::Base')
0e7f5826 2159 && Catalyst::Engine::Server->VERSION le '0.02' )
d54484bf 2160 {
2161 $old_engine = 1;
2162 }
0e7f5826 2163
2164 elsif ($engine->isa('Catalyst::Engine::HTTP::POE')
2165 && $engine->VERSION eq '0.01' )
d54484bf 2166 {
2167 $old_engine = 1;
2168 }
0e7f5826 2169
2170 elsif ($engine->isa('Catalyst::Engine::Zeus')
2171 && $engine->VERSION eq '0.01' )
d54484bf 2172 {
2173 $old_engine = 1;
2174 }
fbcc39ad 2175
d54484bf 2176 if ($old_engine) {
2177 Catalyst::Exception->throw( message =>
0e7f5826 2178 qq/Engine "$engine" is not supported by this version of Catalyst/
d54484bf 2179 );
2180 }
0e7f5826 2181
fbcc39ad 2182 # engine instance
2183 $class->engine( $engine->new );
2184}
2185
b5ecfcf0 2186=head2 $c->setup_home
fbcc39ad 2187
ae1e6b59 2188Sets up the home directory.
2189
fbcc39ad 2190=cut
2191
2192sub setup_home {
2193 my ( $class, $home ) = @_;
2194
cb69249e 2195 if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
2196 $home = $env;
fbcc39ad 2197 }
2198
b6d4ee6e 2199 $home ||= Catalyst::Utils::home($class);
fbcc39ad 2200
2201 if ($home) {
e63bdf38 2202 #I remember recently being scolded for assigning config values like this
fbcc39ad 2203 $class->config->{home} ||= $home;
a738ab68 2204 $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
fbcc39ad 2205 }
2206}
2207
b5ecfcf0 2208=head2 $c->setup_log
fbcc39ad 2209
0fa676a7 2210Sets up log by instantiating a L<Catalyst::Log|Catalyst::Log> object and
2211passing it to C<log()>. Pass in a comma-delimited list of levels to set the
2212log to.
2213
2214This method also installs a C<debug> method that returns a true value into the
2215catalyst subclass if the "debug" level is passed in the comma-delimited list,
2216or if the C<$CATALYST_DEBUG> environment variable is set to a true value.
2217
2218Note that if the log has already been setup, by either a previous call to
2219C<setup_log> or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>,
2220that this method won't actually set up the log.
ae1e6b59 2221
fbcc39ad 2222=cut
2223
2224sub setup_log {
0fa676a7 2225 my ( $class, $levels ) = @_;
fbcc39ad 2226
0fa676a7 2227 my %levels;
fbcc39ad 2228 unless ( $class->log ) {
0fa676a7 2229 $levels ||= '';
2230 $levels =~ s/^\s+//;
2231 $levels =~ s/\s+$//;
2232 %levels = map { $_ => 1 } split /\s*,\s*/, $levels || '';
2233 $class->log( Catalyst::Log->new(keys %levels) );
fbcc39ad 2234 }
af3ff00e 2235
cb69249e 2236 my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
0fa676a7 2237 if ( defined($env_debug) or $levels{debug} ) {
74c89dea 2238 $class->Class::MOP::Object::meta()->add_method('debug' => sub { 1 });
fbcc39ad 2239 $class->log->debug('Debug messages enabled');
2240 }
2241}
2242
b5ecfcf0 2243=head2 $c->setup_plugins
fbcc39ad 2244
ae1e6b59 2245Sets up plugins.
2246
fbcc39ad 2247=cut
2248
dc5f035e 2249=head2 $c->setup_stats
2250
2251Sets up timing statistics class.
2252
2253=cut
2254
2255sub setup_stats {
2256 my ( $class, $stats ) = @_;
2257
2258 Catalyst::Utils::ensure_class_loaded($class->stats_class);
2259
2260 my $env = Catalyst::Utils::env_value( $class, 'STATS' );
2261 if ( defined($env) ? $env : ($stats || $class->debug ) ) {
74c89dea 2262 $class->Class::MOP::Object::meta()->add_method('use_stats' => sub { 1 });
b01f0c69 2263 $class->log->debug('Statistics enabled');
dc5f035e 2264 }
2265}
2266
2267
ac5c933b 2268=head2 $c->registered_plugins
836e1134 2269
2270Returns a sorted list of the plugins which have either been stated in the
2271import list or which have been added via C<< MyApp->plugin(@args); >>.
2272
2273If passed a given plugin name, it will report a boolean value indicating
2274whether or not that plugin is loaded. A fully qualified name is required if
2275the plugin name does not begin with C<Catalyst::Plugin::>.
2276
2277 if ($c->registered_plugins('Some::Plugin')) {
2278 ...
2279 }
2280
2281=cut
fbcc39ad 2282
836e1134 2283{
97b58e17 2284
2285 sub registered_plugins {
836e1134 2286 my $proto = shift;
197bd788 2287 return sort keys %{ $proto->_plugins } unless @_;
836e1134 2288 my $plugin = shift;
d0d4d785 2289 return 1 if exists $proto->_plugins->{$plugin};
2290 return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"};
836e1134 2291 }
fbcc39ad 2292
836e1134 2293 sub _register_plugin {
2294 my ( $proto, $plugin, $instant ) = @_;
2295 my $class = ref $proto || $proto;
fbcc39ad 2296
dd91afb5 2297 # no ignore_loaded here, the plugin may already have been
2298 # defined in memory and we don't want to error on "no file" if so
2299
b6d4ee6e 2300 Class::MOP::load_class( $plugin );
fbcc39ad 2301
197bd788 2302 $proto->_plugins->{$plugin} = 1;
836e1134 2303 unless ($instant) {
fbcc39ad 2304 no strict 'refs';
74c89dea 2305 if ( my $meta = $class->Class::MOP::Object::meta() ) {
2306 my @superclasses = ($plugin, $meta->superclasses );
2307 $meta->superclasses(@superclasses);
5fb67d52 2308 } else {
2309 unshift @{"$class\::ISA"}, $plugin;
2310 }
fbcc39ad 2311 }
836e1134 2312 return $class;
2313 }
2314
2315 sub setup_plugins {
2316 my ( $class, $plugins ) = @_;
2317
d0d4d785 2318 $class->_plugins( {} ) unless $class->_plugins;
836e1134 2319 $plugins ||= [];
2320 for my $plugin ( reverse @$plugins ) {
2321
2322 unless ( $plugin =~ s/\A\+// ) {
2323 $plugin = "Catalyst::Plugin::$plugin";
2324 }
2325
2326 $class->_register_plugin($plugin);
2327 }
fbcc39ad 2328 }
2329}
2330
b5ecfcf0 2331=head2 $c->stack
8767c5a3 2332
86418559 2333Returns an arrayref of the internal execution stack (actions that are
2334currently executing).
8767c5a3 2335
dc5f035e 2336=head2 $c->stats_class
2337
2338Returns or sets the stats (timing statistics) class.
2339
2340=head2 $c->use_stats
2341
2342Returns 1 when stats collection is enabled. Stats collection is enabled
2343when the -Stats options is set, debug is on or when the <MYAPP>_STATS
2344environment variable is set.
2345
2346Note that this is a static method, not an accessor and should be overloaded
2347by declaring "sub use_stats { 1 }" in your MyApp.pm, not by calling $c->use_stats(1).
2348
2349=cut
2350
2351sub use_stats { 0 }
2352
2353
b5ecfcf0 2354=head2 $c->write( $data )
fbcc39ad 2355
ae1e6b59 2356Writes $data to the output stream. When using this method directly, you
2357will need to manually set the C<Content-Length> header to the length of
2358your output data, if known.
fbcc39ad 2359
2360=cut
2361
4f5ebacd 2362sub write {
2363 my $c = shift;
2364
2365 # Finalize headers if someone manually writes output
2366 $c->finalize_headers;
2367
2368 return $c->engine->write( $c, @_ );
2369}
fbcc39ad 2370
b5ecfcf0 2371=head2 version
bf88a181 2372
ae1e6b59 2373Returns the Catalyst version number. Mostly useful for "powered by"
2374messages in template systems.
bf88a181 2375
2376=cut
2377
2378sub version { return $Catalyst::VERSION }
2379
b0bb11ec 2380=head1 INTERNAL ACTIONS
2381
ae1e6b59 2382Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>,
2383C<_ACTION>, and C<_END>. These are by default not shown in the private
3e705254 2384action table, but you can make them visible with a config parameter.
b0bb11ec 2385
2386 MyApp->config->{show_internal_actions} = 1;
2387
d2ee9760 2388=head1 CASE SENSITIVITY
2389
3e705254 2390By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> is
ae1e6b59 2391mapped to C</foo/bar>. You can activate case sensitivity with a config
3e705254 2392parameter.
d2ee9760 2393
2394 MyApp->config->{case_sensitive} = 1;
2395
3e705254 2396This causes C<MyApp::C::Foo::Bar> to map to C</Foo/Bar>.
fbcc39ad 2397
2398=head1 ON-DEMAND PARSER
2399
2400The request body is usually parsed at the beginning of a request,
878b821c 2401but if you want to handle input yourself, you can enable on-demand
2402parsing with a config parameter.
fbcc39ad 2403
2404 MyApp->config->{parse_on_demand} = 1;
ac5c933b 2405
fbcc39ad 2406=head1 PROXY SUPPORT
2407
ae1e6b59 2408Many production servers operate using the common double-server approach,
2409with a lightweight frontend web server passing requests to a larger
2410backend server. An application running on the backend server must deal
2411with two problems: the remote user always appears to be C<127.0.0.1> and
2412the server's hostname will appear to be C<localhost> regardless of the
2413virtual host that the user connected through.
fbcc39ad 2414
ae1e6b59 2415Catalyst will automatically detect this situation when you are running
2416the frontend and backend servers on the same machine. The following
2417changes are made to the request.
fbcc39ad 2418
ac5c933b 2419 $c->req->address is set to the user's real IP address, as read from
ae1e6b59 2420 the HTTP X-Forwarded-For header.
ac5c933b 2421
ae1e6b59 2422 The host value for $c->req->base and $c->req->uri is set to the real
2423 host, as read from the HTTP X-Forwarded-Host header.
fbcc39ad 2424
3e705254 2425Obviously, your web server must support these headers for this to work.
fbcc39ad 2426
ae1e6b59 2427In a more complex server farm environment where you may have your
2428frontend proxy server(s) on different machines, you will need to set a
2429configuration option to tell Catalyst to read the proxied data from the
2430headers.
fbcc39ad 2431
2432 MyApp->config->{using_frontend_proxy} = 1;
ac5c933b 2433
fbcc39ad 2434If you do not wish to use the proxy support at all, you may set:
d1a31ac6 2435
fbcc39ad 2436 MyApp->config->{ignore_frontend_proxy} = 1;
2437
2438=head1 THREAD SAFETY
2439
86418559 2440Catalyst has been tested under Apache 2's threading C<mpm_worker>,
2441C<mpm_winnt>, and the standalone forking HTTP server on Windows. We
2442believe the Catalyst core to be thread-safe.
fbcc39ad 2443
2444If you plan to operate in a threaded environment, remember that all other
3e705254 2445modules you are using must also be thread-safe. Some modules, most notably
2446L<DBD::SQLite>, are not thread-safe.
d1a31ac6 2447
3cb1db8c 2448=head1 SUPPORT
2449
2450IRC:
2451
4eaf7c88 2452 Join #catalyst on irc.perl.org.
3cb1db8c 2453
3e705254 2454Mailing Lists:
3cb1db8c 2455
6d4c3368 2456 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst
2457 http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev
1985c30b 2458
432d507d 2459Web:
2460
2461 http://catalyst.perl.org
2462
0ef52a96 2463Wiki:
2464
2465 http://dev.catalyst.perl.org
2466
fc7ec1d9 2467=head1 SEE ALSO
2468
829a28ca 2469=head2 L<Task::Catalyst> - All you need to start with Catalyst
2470
b5ecfcf0 2471=head2 L<Catalyst::Manual> - The Catalyst Manual
e7f1cf73 2472
b5ecfcf0 2473=head2 L<Catalyst::Component>, L<Catalyst::Base> - Base classes for components
61b1e958 2474
b5ecfcf0 2475=head2 L<Catalyst::Engine> - Core engine
61b1e958 2476
b5ecfcf0 2477=head2 L<Catalyst::Log> - Log class.
61b1e958 2478
b5ecfcf0 2479=head2 L<Catalyst::Request> - Request object
61b1e958 2480
b5ecfcf0 2481=head2 L<Catalyst::Response> - Response object
61b1e958 2482
b5ecfcf0 2483=head2 L<Catalyst::Test> - The test suite.
fc7ec1d9 2484
2f381252 2485=head1 PROJECT FOUNDER
2486
2487sri: Sebastian Riedel <sri@cpan.org>
fc7ec1d9 2488
2f381252 2489=head1 CONTRIBUTORS
15f0b5b7 2490
2f381252 2491abw: Andy Wardley
fbcc39ad 2492
2f381252 2493acme: Leon Brocard <leon@astray.com>
33108eaf 2494
f4a57de4 2495Andrew Bramble
2496
15f0b5b7 2497Andrew Ford
2498
2499Andrew Ruthven
2500
2f381252 2501andyg: Andy Grundman <andy@hybridized.org>
fbcc39ad 2502
2f381252 2503audreyt: Audrey Tang
15f0b5b7 2504
2f381252 2505bricas: Brian Cassidy <bricas@cpan.org>
0cf56dbc 2506
e31b525c 2507Caelum: Rafael Kitover <rkitover@io.com>
2508
2f381252 2509chansen: Christian Hansen
6aaa1c60 2510
2f381252 2511chicks: Christopher Hicks
15f0b5b7 2512
0fa676a7 2513David E. Wheeler
2514
2f381252 2515dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
15f0b5b7 2516
2f381252 2517Drew Taylor
15f0b5b7 2518
2f381252 2519esskar: Sascha Kiefer
0ef52a96 2520
2f381252 2521fireartist: Carl Franks <cfranks@cpan.org>
15f0b5b7 2522
2f381252 2523gabb: Danijel Milicevic
61bef238 2524
15f0b5b7 2525Gary Ashton Jones
2526
2527Geoff Richards
2528
e4cc83b2 2529ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
2530
2f381252 2531jcamacho: Juan Camacho
fbcc39ad 2532
15f0b5b7 2533Jody Belka
2534
2535Johan Lindstrom
2536
2f381252 2537jon: Jon Schutz <jjschutz@cpan.org>
15f0b5b7 2538
2f381252 2539marcus: Marcus Ramberg <mramberg@cpan.org>
15f0b5b7 2540
2f381252 2541miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
15f0b5b7 2542
2f381252 2543mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
15f0b5b7 2544
2f381252 2545mugwump: Sam Vilain
71c3bcc3 2546
2f381252 2547naughton: David Naughton
a727119f 2548
2f381252 2549ningu: David Kamholz <dkamholz@cpan.org>
1cf1c56a 2550
2f381252 2551nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
9c71d51d 2552
2f381252 2553numa: Dan Sully <daniel@cpan.org>
fc7ec1d9 2554
2f381252 2555obra: Jesse Vincent
2556
2557omega: Andreas Marienborg
51f0308d 2558
2f381252 2559phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
bdcb95ef 2560
6dae3eef 2561rafl: Florian Ragwitz <rafl@debian.org>
2562
2f381252 2563sky: Arthur Bergman
2564
2565the_jester: Jesse Sheidlower
2566
2567Ulf Edvinsson
51f0308d 2568
2f381252 2569willert: Sebastian Willert <willert@cpan.org>
51f0308d 2570
fc7ec1d9 2571=head1 LICENSE
2572
9ce5ab63 2573This library is free software, you can redistribute it and/or modify it under
41ca9ba7 2574the same terms as Perl itself.
fc7ec1d9 2575
2576=cut
2577
4090e3bb 2578no Moose;
2579
46d0346d 2580__PACKAGE__->meta->make_immutable;
2581
fc7ec1d9 25821;