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