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