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