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