Updated welcome
[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm
CommitLineData
fc7ec1d9 1package Catalyst;
2
3use strict;
fbcc39ad 4use base 'Catalyst::Base';
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;
5d9a6d47 13use NEXT;
fbcc39ad 14use Text::ASCIITable;
4f6748f1 15use Path::Class;
fbcc39ad 16use Time::HiRes qw/gettimeofday tv_interval/;
17use URI;
18use Scalar::Util qw/weaken/;
fc7ec1d9 19
fbcc39ad 20__PACKAGE__->mk_accessors(qw/counter depth request response state/);
10dd6896 21
fbcc39ad 22# Laziness++
23*comp = \&component;
24*req = \&request;
25*res = \&response;
26
27# For backwards compatibility
28*finalize_output = \&finalize_body;
29
30# For statistics
31our $COUNT = 1;
32our $START = time;
33our $RECURSION = 1000;
34our $DETACH = "catalyst_detach\n";
35
36require Module::Pluggable::Fast;
37
38# Helper script generation
6844bc1c 39our $CATALYST_SCRIPT_GEN = 8;
fbcc39ad 40
41__PACKAGE__->mk_classdata($_)
42 for qw/components arguments dispatcher engine log/;
43
44our $VERSION = '5.49_01';
45
46sub import {
47 my ( $class, @arguments ) = @_;
48
49 # We have to limit $class to Catalyst to avoid pushing Catalyst upon every
50 # callers @ISA.
51 return unless $class eq 'Catalyst';
52
53 my $caller = caller(0);
54
55 unless ( $caller->isa('Catalyst') ) {
56 no strict 'refs';
57 push @{"$caller\::ISA"}, $class;
58 }
59
60 $caller->arguments( [@arguments] );
61 $caller->setup_home;
62}
fc7ec1d9 63
64=head1 NAME
65
66Catalyst - The Elegant MVC Web Application Framework
67
68=head1 SYNOPSIS
69
70 # use the helper to start a new application
91864987 71 catalyst.pl MyApp
fc7ec1d9 72 cd MyApp
73
74 # add models, views, controllers
ae4e40a7 75 script/myapp_create.pl model Something
76 script/myapp_create.pl view Stuff
77 script/myapp_create.pl controller Yada
fc7ec1d9 78
79 # built in testserver
ae4e40a7 80 script/myapp_server.pl
fc7ec1d9 81
82 # command line interface
ae4e40a7 83 script/myapp_test.pl /yada
fc7ec1d9 84
85
fc7ec1d9 86 use Catalyst;
87
88 use Catalyst qw/My::Module My::OtherModule/;
89
90 use Catalyst '-Debug';
91
92 use Catalyst qw/-Debug -Engine=CGI/;
93
5a8ed4fe 94 sub default : Private { $_[1]->res->output('Hello') } );
95
e3dc9d78 96 sub index : Path('/index.html') {
5a8ed4fe 97 my ( $self, $c ) = @_;
98 $c->res->output('Hello');
064834ea 99 $c->forward('foo');
5a8ed4fe 100 }
101
064834ea 102 sub product : Regex('^product[_]*(\d*).html$') {
5a8ed4fe 103 my ( $self, $c ) = @_;
104 $c->stash->{template} = 'product.tt';
105 $c->stash->{product} = $c->req->snippets->[0];
106 }
fc7ec1d9 107
3803e98f 108See also L<Catalyst::Manual::Intro>
109
fc7ec1d9 110=head1 DESCRIPTION
111
fc7ec1d9 112The key concept of Catalyst is DRY (Don't Repeat Yourself).
113
114See L<Catalyst::Manual> for more documentation.
115
23f9d934 116Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
1985c30b 117Omit the C<Catalyst::Plugin::> prefix from the plugin name,
23f9d934 118so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
fc7ec1d9 119
120 use Catalyst 'My::Module';
121
26e73131 122Special flags like -Debug and -Engine can also be specified as arguments when
23f9d934 123Catalyst is loaded:
fc7ec1d9 124
125 use Catalyst qw/-Debug My::Module/;
126
23f9d934 127The position of plugins and flags in the chain is important, because they are
128loaded in exactly the order that they appear.
fc7ec1d9 129
23f9d934 130The following flags are supported:
131
132=over 4
133
134=item -Debug
135
136enables debug output, i.e.:
fc7ec1d9 137
138 use Catalyst '-Debug';
139
23f9d934 140this is equivalent to:
fc7ec1d9 141
142 use Catalyst;
143 sub debug { 1 }
144
fbcc39ad 145=item -Dispatcher
146
147Force Catalyst to use a specific dispatcher.
148
23f9d934 149=item -Engine
fc7ec1d9 150
151Force Catalyst to use a specific engine.
23f9d934 152Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
fc7ec1d9 153
154 use Catalyst '-Engine=CGI';
155
fbcc39ad 156=item -Home
157
158Force Catalyst to use a specific home directory.
159
160=item -Log
161
162Specify log level.
163
23f9d934 164=back
fc7ec1d9 165
23f9d934 166=head1 METHODS
167
168=over 4
169
fbcc39ad 170=item $c->comp($name)
171
172=item $c->component($name)
173
174Get a component object by name.
175
176 $c->comp('MyApp::Model::MyModel')->do_stuff;
177
178=cut
179
180sub component {
181 my $c = shift;
182
183 if (@_) {
184
185 my $name = shift;
186
187 my $appclass = ref $c || $c;
188
189 my @names = (
190 $name, "${appclass}::${name}",
191 map { "${appclass}::${_}::${name}" } qw/M V C/
192 );
193
194 foreach my $try (@names) {
195
196 if ( exists $c->components->{$try} ) {
197
198 return $c->components->{$try};
199 }
200 }
201
202 foreach my $component ( keys %{ $c->components } ) {
203
204 return $c->components->{$component} if $component =~ /$name/i;
205 }
206
207 }
208
209 return sort keys %{ $c->components };
210}
211
212=item config
213
214Returns a hashref containing your applications settings.
215
23f9d934 216=item debug
fc7ec1d9 217
218Overload to enable debug messages.
219
220=cut
221
222sub debug { 0 }
223
fbcc39ad 224=item $c->detach( $command [, \@arguments ] )
fc7ec1d9 225
fbcc39ad 226Like C<forward> but doesn't return.
fc7ec1d9 227
228=cut
229
fbcc39ad 230sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
231
232=item $c->dispatcher
233
234Contains the dispatcher instance.
235Stringifies to class.
236
237=item $c->forward( $command [, \@arguments ] )
238
239Forward processing to a private action or a method from a class.
240If you define a class without method it will default to process().
241also takes an optional arrayref containing arguments to be passed
242to the new function. $c->req->args will be reset upon returning
243from the function.
244
245 $c->forward('/foo');
246 $c->forward('index');
247 $c->forward(qw/MyApp::Model::CDBI::Foo do_stuff/);
248 $c->forward('MyApp::View::TT');
249
250=cut
251
252sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
253
254=item $c->setup
255
256Setup.
257
258 $c->setup;
259
260=cut
261
262sub setup {
0319a12c 263 my ( $class, @arguments ) = @_;
599b5295 264
fbcc39ad 265 unless ( $class->isa('Catalyst') ) {
953b0e15 266
fbcc39ad 267 Catalyst::Exception->throw(
268 message => qq/'$class' does not inherit from Catalyst/ );
1c99e125 269 }
0319a12c 270
fbcc39ad 271 if ( $class->arguments ) {
272 @arguments = ( @arguments, @{ $class->arguments } );
273 }
274
275 # Process options
276 my $flags = {};
277
278 foreach (@arguments) {
279
280 if (/^-Debug$/) {
281 $flags->{log} =
282 ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
283 }
284 elsif (/^-(\w+)=?(.*)$/) {
285 $flags->{ lc $1 } = $2;
286 }
287 else {
288 push @{ $flags->{plugins} }, $_;
289 }
290 }
291
292 $class->setup_log( delete $flags->{log} );
293 $class->setup_plugins( delete $flags->{plugins} );
294 $class->setup_dispatcher( delete $flags->{dispatcher} );
295 $class->setup_engine( delete $flags->{engine} );
296 $class->setup_home( delete $flags->{home} );
297
298 for my $flag ( sort keys %{$flags} ) {
299
300 if ( my $code = $class->can( 'setup_' . $flag ) ) {
301 &$code( $class, delete $flags->{$flag} );
302 }
303 else {
304 $class->log->warn(qq/Unknown flag "$flag"/);
305 }
306 }
307
308 $class->log->warn( "You are running an old helper script! "
309 . "Please update your scripts by regenerating the "
310 . "application and copying over the new scripts." )
311 if ( $ENV{CATALYST_SCRIPT_GEN}
312 && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::CATALYST_SCRIPT_GEN ) );
313
314 if ( $class->debug ) {
315
316 my @plugins = ();
317
318 {
319 no strict 'refs';
320 @plugins = grep { /^Catalyst::Plugin/ } @{"$class\::ISA"};
321 }
322
323 if (@plugins) {
324 my $t = Text::ASCIITable->new;
325 $t->setOptions( 'hide_HeadRow', 1 );
326 $t->setOptions( 'hide_HeadLine', 1 );
327 $t->setCols('Class');
328 $t->setColWidth( 'Class', 75, 1 );
329 $t->addRow($_) for @plugins;
330 $class->log->debug( "Loaded plugins:\n" . $t->draw );
331 }
332
333 my $dispatcher = $class->dispatcher;
334 my $engine = $class->engine;
335 my $home = $class->config->{home};
336
337 $class->log->debug(qq/Loaded dispatcher "$dispatcher"/);
338 $class->log->debug(qq/Loaded engine "$engine"/);
339
340 $home
341 ? ( -d $home )
342 ? $class->log->debug(qq/Found home "$home"/)
343 : $class->log->debug(qq/Home "$home" doesn't exist/)
344 : $class->log->debug(q/Couldn't find home/);
345 }
346
347 # Call plugins setup
348 {
349 no warnings qw/redefine/;
350 local *setup = sub { };
351 $class->setup;
352 }
353
354 # Initialize our data structure
355 $class->components( {} );
356
357 $class->setup_components;
358
359 if ( $class->debug ) {
360 my $t = Text::ASCIITable->new;
361 $t->setOptions( 'hide_HeadRow', 1 );
362 $t->setOptions( 'hide_HeadLine', 1 );
363 $t->setCols('Class');
364 $t->setColWidth( 'Class', 75, 1 );
365 $t->addRow($_) for sort keys %{ $class->components };
366 $class->log->debug( "Loaded components:\n" . $t->draw )
367 if ( @{ $t->{tbl_rows} } );
368 }
369
370 # Add our self to components, since we are also a component
371 $class->components->{$class} = $class;
372
373 $class->setup_actions;
374
375 if ( $class->debug ) {
376 my $name = $class->config->{name} || 'Application';
377 $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
378 }
379 $class->log->_flush() if $class->log->can('_flush');
380}
381
382=item $c->uri_for($path)
383
384Merges path with $c->request->base for absolute uri's and with
385$c->request->match for relative uri's, then returns a normalized
386L<URI> object.
387
388=cut
389
390sub uri_for {
391 my ( $c, $path ) = @_;
392 my $base = $c->request->base->clone;
393 my $basepath = $base->path;
394 $basepath =~ s/\/$//;
fdba7a9d 395 $basepath .= '/';
fbcc39ad 396 my $match = $c->request->match;
397 $match =~ s/^\///;
398 $match .= '/' if $match;
399 $match = '' if $path =~ /^\//;
400 $path =~ s/^\///;
401 return URI->new_abs( URI->new_abs( $path, "$basepath$match" ), $base )
402 ->canonical;
403}
404
405=item $c->error
406
407=item $c->error($error, ...)
408
409=item $c->error($arrayref)
410
411Returns an arrayref containing error messages.
412
413 my @error = @{ $c->error };
414
415Add a new error.
416
417 $c->error('Something bad happened');
418
419=cut
420
421sub error {
422 my $c = shift;
423 my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
424 push @{ $c->{error} }, @$error;
425 return $c->{error};
0319a12c 426}
427
428=item $c->engine
429
fbcc39ad 430Contains the engine instance.
431Stringifies to the class.
fc7ec1d9 432
0319a12c 433=item $c->log
434
435Contains the logging object. Unless it is already set Catalyst sets this up with a
436C<Catalyst::Log> object. To use your own log class:
437
438 $c->log( MyLogger->new );
439 $c->log->info("now logging with my own logger!");
440
441Your log class should implement the methods described in the C<Catalyst::Log>
442man page.
443
444=item $c->plugin( $name, $class, @args )
445
446Instant plugins for Catalyst.
447Classdata accessor/mutator will be created, class loaded and instantiated.
448
449 MyApp->plugin( 'prototype', 'HTML::Prototype' );
450
451 $c->prototype->define_javascript_functions;
452
453=cut
454
455sub plugin {
456 my ( $class, $name, $plugin, @args ) = @_;
457 $plugin->require;
458
459 if ( my $error = $UNIVERSAL::require::ERROR ) {
460 Catalyst::Exception->throw(
fbcc39ad 461 message => qq/Couldn't load instant plugin "$plugin", "$error"/ );
0319a12c 462 }
463
464 eval { $plugin->import };
465 $class->mk_classdata($name);
466 my $obj;
467 eval { $obj = $plugin->new(@args) };
468
fbcc39ad 469 if ($@) {
470 Catalyst::Exception->throw( message =>
471 qq/Couldn't instantiate instant plugin "$plugin", "$@"/ );
0319a12c 472 }
473
474 $class->$name($obj);
475 $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
476 if $class->debug;
477}
478
fbcc39ad 479=item $c->request
480
481=item $c->req
482
483Returns a C<Catalyst::Request> object.
484
485 my $req = $c->req;
486
487=item $c->response
488
489=item $c->res
490
491Returns a C<Catalyst::Response> object.
492
493 my $res = $c->res;
494
495=item $c->state
496
497Contains the return value of the last executed action.
498
499=item $c->stash
500
501Returns a hashref containing all your data.
502
fbcc39ad 503 print $c->stash->{foo};
504
23eb3f51 505Keys may be set in the stash by assigning to the hash reference, or by passing
506either a single hash reference or a list of key/value pairs as arguments.
507
508For example:
509
510 $c->stash->{foo} ||= 'yada';
511 $c->stash( { moose => 'majestic', qux => 0 } );
512 $c->stash( bar => 1, gorch => 2 );
513
fbcc39ad 514=cut
515
516sub stash {
517 my $c = shift;
518 if (@_) {
519 my $stash = @_ > 1 ? {@_} : $_[0];
520 while ( my ( $key, $val ) = each %$stash ) {
521 $c->{stash}->{$key} = $val;
522 }
523 }
524 return $c->{stash};
525}
526
2c63fc07 527=item $c->welcome_message
ab2374d3 528
529Returns the Catalyst welcome HTML page.
530
531=cut
532
533sub welcome_message {
bf1f2c60 534 my $c = shift;
535 my $name = $c->config->{name};
536 my $logo = $c->uri_for('/static/images/catalyst_logo.png');
537 my $prefix = Catalyst::Utils::appprefix( ref $c );
ab2374d3 538 return <<"EOF";
539<html>
540 <head>
541 <title>$name on Catalyst $VERSION</title>
542 <style type="text/css">
543 body {
544 text-align: center;
545 padding-left: 50%;
546 color: #000;
547 background-color: #eee;
548 }
549 div#content {
550 width: 640px;
551 margin-left: -320px;
552 margin-top: 10px;
553 margin-bottom: 10px;
554 text-align: left;
555 background-color: #ccc;
556 border: 1px solid #aaa;
557 -moz-border-radius: 10px;
558 }
d84c4dab 559 p, h1, h2 {
ab2374d3 560 margin-left: 20px;
561 margin-right: 20px;
16215972 562 font-family: verdana, tahoma, sans-serif;
ab2374d3 563 }
d84c4dab 564 a {
565 font-family: verdana, tahoma, sans-serif;
566 }
d114e033 567 :link, :visited {
568 text-decoration: none;
569 color: #b00;
570 border-bottom: 1px dotted #bbb;
571 }
572 :link:hover, :visited:hover {
d114e033 573 color: #555;
574 }
ab2374d3 575 div#topbar {
576 margin: 0px;
577 }
3e82a295 578 pre {
3e82a295 579 margin: 10px;
580 padding: 8px;
581 }
ab2374d3 582 div#answers {
583 padding: 8px;
584 margin: 10px;
d114e033 585 background-color: #fff;
ab2374d3 586 border: 1px solid #aaa;
587 -moz-border-radius: 10px;
588 }
589 h1 {
33108eaf 590 font-size: 0.9em;
591 font-weight: normal;
ab2374d3 592 text-align: center;
593 }
594 h2 {
595 font-size: 1.0em;
596 }
597 p {
598 font-size: 0.9em;
599 }
ae7c5252 600 p img {
601 float: right;
602 margin-left: 10px;
603 }
33108eaf 604 b#appname {
605 font-size: 1.6em;
ab2374d3 606 }
607 </style>
608 </head>
609 <body>
610 <div id="content">
611 <div id="topbar">
33108eaf 612 <h1><b id="appname">$name</b> on <a href="http://catalyst.perl.org">Catalyst</a>
d84c4dab 613 $VERSION</h1>
ab2374d3 614 </div>
615 <div id="answers">
ae7c5252 616 <p>
f68d720e 617 <img src="$logo"/>
ae7c5252 618 </p>
4b8cb778 619 <p>Welcome to the wonderful world of Catalyst.
620 This MVC framework will make web development
ab2374d3 621 something you had never expected it to be:
622 Fun, rewarding and quick.</p>
623 <h2>What to do now?</h2>
4b8cb778 624 <p>That really depends on what <b>you</b> want to do.
ab2374d3 625 We do, however, provide you with a few starting points.</p>
626 <p>If you want to jump right into web development with Catalyst
5db7f9a1 627 you might want to check out the documentation.</p>
bf1f2c60 628 <pre><code>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual/Intro.pod">Catalyst::Manual::Intro</a>
629perldoc <a href="http://cpansearch.perl.org/dist/Catalyst/lib/Catalyst/Manual.pod">Catalyst::Manual</a></code></pre>
ab2374d3 630 <h2>What to do next?</h2>
f5681c92 631 <p>Next it's time to write an actual application. Use the
bf1f2c60 632 helper scripts to generate <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AController%3A%3A&mode=all">controllers</a>,
633 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&mode=all">models</a> and
634 <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&mode=all">views</a>,
635 they can save you a lot of work.</p>
636 <pre><code>script/${prefix}_create.pl -help</code></pre>
637 <p>Also, be sure to check out the vast and growing
638 collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>,
639 you are likely to find what you need there.
f5681c92 640 </p>
641
82245cc4 642 <h2>Need help?</h2>
f5681c92 643 <p>Catalyst has a very active community. Here are the main places to
644 get in touch with us.</p>
16215972 645 <ul>
646 <li>
2b9a7d76 647 <a href="http://dev.catalyst.perl.org">Wiki</a>
16215972 648 </li>
649 <li>
650 <a href="http://lists.rawmode.org/mailman/listinfo/catalyst">Mailing-List</a>
651 </li>
652 <li>
ea7cd80d 653 <a href="irc://irc.perl.org/catalyst">IRC channel #catalyst on irc.perl.org</a>
16215972 654 </li>
655 </ul>
ab2374d3 656 <h2>In conclusion</h2>
ea7cd80d 657 <p>The Catalyst team hope you will enjoy using Catalyst as much
f5681c92 658 as we enjoyed making it. Please contact us if you have ideas
659 for improvement or other feedback.</p>
ab2374d3 660 </div>
661 </div>
662 </body>
663</html>
664EOF
665}
666
fbcc39ad 667=back
668
669=head1 INTERNAL METHODS
670
671=over 4
672
673=item $c->benchmark($coderef)
674
675Takes a coderef with arguments and returns elapsed time as float.
676
677 my ( $elapsed, $status ) = $c->benchmark( sub { return 1 } );
678 $c->log->info( sprintf "Processing took %f seconds", $elapsed );
679
680=cut
681
682sub benchmark {
683 my $c = shift;
684 my $code = shift;
685 my $time = [gettimeofday];
686 my @return = &$code(@_);
687 my $elapsed = tv_interval $time;
688 return wantarray ? ( $elapsed, @return ) : $elapsed;
689}
690
691=item $c->components
692
693Contains the components.
694
695=item $c->counter
696
697Returns a hashref containing coderefs and execution counts.
698(Needed for deep recursion detection)
699
700=item $c->depth
701
702Returns the actual forward depth.
703
704=item $c->dispatch
705
706Dispatch request to actions.
707
708=cut
709
710sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) }
711
712=item $c->execute($class, $coderef)
713
714Execute a coderef in given class and catch exceptions.
715Errors are available via $c->error.
716
717=cut
718
719sub execute {
720 my ( $c, $class, $code ) = @_;
721 $class = $c->components->{$class} || $class;
722 $c->state(0);
723 my $callsub = ( caller(1) )[3];
724
725 my $action = '';
726 if ( $c->debug ) {
727 $action = "$code";
728 $action = "/$action" unless $action =~ /\-\>/;
729 $c->counter->{"$code"}++;
730
731 if ( $c->counter->{"$code"} > $RECURSION ) {
732 my $error = qq/Deep recursion detected in "$action"/;
733 $c->log->error($error);
734 $c->error($error);
735 $c->state(0);
736 return $c->state;
737 }
738
739 $action = "-> $action" if $callsub =~ /forward$/;
740 }
741 $c->{depth}++;
742 eval {
743 if ( $c->debug )
744 {
745 my ( $elapsed, @state ) =
746 $c->benchmark( $code, $class, $c, @{ $c->req->args } );
747 push @{ $c->{stats} }, [ $action, sprintf( '%fs', $elapsed ) ];
748 $c->state(@state);
749 }
750 else { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) }
751 };
752 $c->{depth}--;
753
754 if ( my $error = $@ ) {
755
756 if ( $error eq $DETACH ) { die $DETACH if $c->{depth} > 1 }
757 else {
758 unless ( ref $error ) {
759 chomp $error;
760 $error = qq/Caught exception "$error"/;
761 }
762
763 $c->log->error($error);
764 $c->error($error);
765 $c->state(0);
766 }
767 }
768 return $c->state;
769}
770
771=item $c->finalize
772
773Finalize request.
774
775=cut
776
777sub finalize {
778 my $c = shift;
779
780 $c->finalize_uploads;
781
782 # Error
783 if ( $#{ $c->error } >= 0 ) {
784 $c->finalize_error;
785 }
786
787 $c->finalize_headers;
788
789 # HEAD request
790 if ( $c->request->method eq 'HEAD' ) {
791 $c->response->body('');
792 }
793
794 $c->finalize_body;
795
796 return $c->response->status;
797}
798
799=item $c->finalize_body
800
801Finalize body.
802
803=cut
804
805sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) }
806
807=item $c->finalize_cookies
808
809Finalize cookies.
810
811=cut
812
813sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) }
814
815=item $c->finalize_error
816
817Finalize error.
818
819=cut
820
821sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) }
822
823=item $c->finalize_headers
824
825Finalize headers.
826
827=cut
828
829sub finalize_headers {
830 my $c = shift;
831
832 # Check if we already finalized headers
833 return if $c->response->{_finalized_headers};
834
835 # Handle redirects
836 if ( my $location = $c->response->redirect ) {
837 $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
838 $c->response->header( Location => $location );
839 }
840
841 # Content-Length
842 if ( $c->response->body && !$c->response->content_length ) {
843 $c->response->content_length( bytes::length( $c->response->body ) );
844 }
845
846 # Errors
847 if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
848 $c->response->headers->remove_header("Content-Length");
849 $c->response->body('');
850 }
851
852 $c->finalize_cookies;
853
854 $c->engine->finalize_headers( $c, @_ );
855
856 # Done
857 $c->response->{_finalized_headers} = 1;
858}
859
860=item $c->finalize_output
861
862An alias for finalize_body.
863
864=item $c->finalize_read
865
866Finalize the input after reading is complete.
867
868=cut
869
870sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) }
871
872=item $c->finalize_uploads
873
874Finalize uploads. Cleans up any temporary files.
875
876=cut
877
878sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) }
879
880=item $c->get_action( $action, $namespace, $inherit )
881
882Get an action in a given namespace.
883
884=cut
885
886sub get_action { my $c = shift; $c->dispatcher->get_action( $c, @_ ) }
887
888=item handle_request( $class, @arguments )
889
890Handles the request.
891
892=cut
893
894sub handle_request {
895 my ( $class, @arguments ) = @_;
896
897 # Always expect worst case!
898 my $status = -1;
899 eval {
900 my @stats = ();
901
902 my $handler = sub {
903 my $c = $class->prepare(@arguments);
904 $c->{stats} = \@stats;
905 $c->dispatch;
906 return $c->finalize;
907 };
908
909 if ( $class->debug ) {
910 my $elapsed;
911 ( $elapsed, $status ) = $class->benchmark($handler);
912 $elapsed = sprintf '%f', $elapsed;
913 my $av = sprintf '%.3f',
914 ( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
915 my $t = Text::ASCIITable->new;
916 $t->setCols( 'Action', 'Time' );
917 $t->setColWidth( 'Action', 64, 1 );
918 $t->setColWidth( 'Time', 9, 1 );
919
920 for my $stat (@stats) { $t->addRow( $stat->[0], $stat->[1] ) }
921 $class->log->info(
922 "Request took ${elapsed}s ($av/s)\n" . $t->draw );
923 }
924 else { $status = &$handler }
925
926 };
927
928 if ( my $error = $@ ) {
929 chomp $error;
930 $class->log->error(qq/Caught exception in engine "$error"/);
931 }
932
933 $COUNT++;
934 $class->log->_flush() if $class->log->can('_flush');
935 return $status;
936}
937
938=item $c->prepare(@arguments)
939
940Turns the engine-specific request( Apache, CGI ... )
941into a Catalyst context .
942
943=cut
944
945sub prepare {
946 my ( $class, @arguments ) = @_;
947
948 my $c = bless {
949 counter => {},
950 depth => 0,
951 request => Catalyst::Request->new(
952 {
953 arguments => [],
954 body_parameters => {},
955 cookies => {},
fbcc39ad 956 headers => HTTP::Headers->new,
957 parameters => {},
958 query_parameters => {},
959 secure => 0,
960 snippets => [],
961 uploads => {}
962 }
963 ),
964 response => Catalyst::Response->new(
965 {
966 body => '',
967 cookies => {},
fbcc39ad 968 headers => HTTP::Headers->new(),
969 status => 200
970 }
971 ),
972 stash => {},
973 state => 0
974 }, $class;
975
976 # For on-demand data
977 $c->request->{_context} = $c;
978 $c->response->{_context} = $c;
979 weaken( $c->request->{_context} );
980 weaken( $c->response->{_context} );
981
982 if ( $c->debug ) {
983 my $secs = time - $START || 1;
984 my $av = sprintf '%.3f', $COUNT / $secs;
985 $c->log->debug('**********************************');
986 $c->log->debug("* Request $COUNT ($av/s) [$$]");
987 $c->log->debug('**********************************');
988 $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
989 }
990
991 $c->prepare_request(@arguments);
992 $c->prepare_connection;
993 $c->prepare_query_parameters;
994 $c->prepare_headers;
995 $c->prepare_cookies;
996 $c->prepare_path;
997
998 # On-demand parsing
999 $c->prepare_body unless $c->config->{parse_on_demand};
1000
1001 $c->prepare_action;
1002 my $method = $c->req->method || '';
1003 my $path = $c->req->path || '';
1004 my $address = $c->req->address || '';
1005
1006 $c->log->debug(qq/"$method" request for "$path" from $address/)
1007 if $c->debug;
1008
1009 return $c;
1010}
1011
1012=item $c->prepare_action
1013
1014Prepare action.
1015
1016=cut
1017
1018sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) }
1019
1020=item $c->prepare_body
1021
1022Prepare message body.
1023
1024=cut
1025
1026sub prepare_body {
1027 my $c = shift;
1028
1029 # Do we run for the first time?
1030 return if defined $c->request->{_body};
1031
1032 # Initialize on-demand data
1033 $c->engine->prepare_body( $c, @_ );
1034 $c->prepare_parameters;
1035 $c->prepare_uploads;
1036
1037 if ( $c->debug && keys %{ $c->req->body_parameters } ) {
1038 my $t = Text::ASCIITable->new;
1039 $t->setCols( 'Key', 'Value' );
1040 $t->setColWidth( 'Key', 37, 1 );
1041 $t->setColWidth( 'Value', 36, 1 );
1042 $t->alignCol( 'Value', 'right' );
1043 for my $key ( sort keys %{ $c->req->body_parameters } ) {
1044 my $param = $c->req->body_parameters->{$key};
1045 my $value = defined($param) ? $param : '';
1046 $t->addRow( $key,
1047 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1048 }
1049 $c->log->debug( "Body Parameters are:\n" . $t->draw );
1050 }
1051}
1052
4bd82c41 1053=item $c->prepare_body_chunk( $chunk )
1054
1055Prepare a chunk of data before sending it to HTTP::Body.
1056
1057=cut
1058
4f5ebacd 1059sub prepare_body_chunk {
1060 my $c = shift;
4bd82c41 1061 $c->engine->prepare_body_chunk( $c, @_ );
1062}
1063
fbcc39ad 1064=item $c->prepare_body_parameters
1065
1066Prepare body parameters.
1067
1068=cut
1069
1070sub prepare_body_parameters {
1071 my $c = shift;
1072 $c->engine->prepare_body_parameters( $c, @_ );
1073}
1074
1075=item $c->prepare_connection
1076
1077Prepare connection.
1078
1079=cut
1080
1081sub prepare_connection {
1082 my $c = shift;
1083 $c->engine->prepare_connection( $c, @_ );
1084}
1085
1086=item $c->prepare_cookies
1087
1088Prepare cookies.
1089
1090=cut
1091
1092sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
1093
1094=item $c->prepare_headers
1095
1096Prepare headers.
1097
1098=cut
1099
1100sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
1101
1102=item $c->prepare_parameters
1103
1104Prepare parameters.
1105
1106=cut
1107
1108sub prepare_parameters {
1109 my $c = shift;
1110 $c->prepare_body_parameters;
1111 $c->engine->prepare_parameters( $c, @_ );
1112}
1113
1114=item $c->prepare_path
1115
1116Prepare path and base.
1117
1118=cut
1119
1120sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) }
1121
1122=item $c->prepare_query_parameters
1123
1124Prepare query parameters.
1125
1126=cut
1127
1128sub prepare_query_parameters {
1129 my $c = shift;
1130
1131 $c->engine->prepare_query_parameters( $c, @_ );
1132
1133 if ( $c->debug && keys %{ $c->request->query_parameters } ) {
1134 my $t = Text::ASCIITable->new;
1135 $t->setCols( 'Key', 'Value' );
1136 $t->setColWidth( 'Key', 37, 1 );
1137 $t->setColWidth( 'Value', 36, 1 );
1138 $t->alignCol( 'Value', 'right' );
1139 for my $key ( sort keys %{ $c->req->query_parameters } ) {
1140 my $param = $c->req->query_parameters->{$key};
1141 my $value = defined($param) ? $param : '';
1142 $t->addRow( $key,
1143 ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value );
1144 }
1145 $c->log->debug( "Query Parameters are:\n" . $t->draw );
1146 }
1147}
1148
1149=item $c->prepare_read
1150
1151Prepare the input for reading.
1152
1153=cut
1154
1155sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) }
1156
1157=item $c->prepare_request
1158
1159Prepare the engine request.
1160
1161=cut
1162
1163sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) }
1164
1165=item $c->prepare_uploads
1166
1167Prepare uploads.
1168
1169=cut
1170
1171sub prepare_uploads {
1172 my $c = shift;
1173
1174 $c->engine->prepare_uploads( $c, @_ );
1175
1176 if ( $c->debug && keys %{ $c->request->uploads } ) {
1177 my $t = Text::ASCIITable->new;
bc2beef5 1178 $t->setCols( 'Key', 'Filename', 'Type', 'Size' );
1179 $t->setColWidth( 'Key', 12, 1 );
1180 $t->setColWidth( 'Filename', 28, 1 );
1181 $t->setColWidth( 'Type', 18, 1 );
fbcc39ad 1182 $t->setColWidth( 'Size', 9, 1 );
1183 $t->alignCol( 'Size', 'left' );
1184 for my $key ( sort keys %{ $c->request->uploads } ) {
1185 my $upload = $c->request->uploads->{$key};
1186 for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) {
bc2beef5 1187 $t->addRow( $key, $u->filename, $u->type, $u->size );
fbcc39ad 1188 }
1189 }
1190 $c->log->debug( "File Uploads are:\n" . $t->draw );
1191 }
1192}
1193
1194=item $c->prepare_write
1195
1196Prepare the output for writing.
1197
1198=cut
1199
1200sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) }
1201
1202=item $c->read( [$maxlength] )
1203
1204Read a chunk of data from the request body. This method is designed to be
1205used in a while loop, reading $maxlength bytes on every call. $maxlength
1206defaults to the size of the request if not specified.
1207
1208You have to set MyApp->config->{parse_on_demand} to use this directly.
1209
1210=cut
1211
1212sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
1213
1214=item $c->run
1215
1216Starts the engine.
1217
1218=cut
1219
1220sub run { my $c = shift; return $c->engine->run( $c, @_ ) }
1221
1222=item $c->set_action( $action, $code, $namespace, $attrs )
1223
1224Set an action in a given namespace.
1225
1226=cut
1227
1228sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) }
1229
1230=item $c->setup_actions($component)
1231
1232Setup actions for a component.
1233
1234=cut
1235
1236sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) }
1237
1238=item $c->setup_components
1239
1240Setup components.
1241
1242=cut
1243
1244sub setup_components {
1245 my $class = shift;
1246
1247 my $callback = sub {
1248 my ( $component, $context ) = @_;
1249
1250 unless ( $component->isa('Catalyst::Base') ) {
1251 return $component;
1252 }
1253
1254 my $suffix = Catalyst::Utils::class2classsuffix($component);
1255 my $config = $class->config->{$suffix} || {};
1256
1257 my $instance;
1258
1259 eval { $instance = $component->new( $context, $config ); };
1260
1261 if ( my $error = $@ ) {
1262
1263 chomp $error;
1264
1265 Catalyst::Exception->throw( message =>
1266 qq/Couldn't instantiate component "$component", "$error"/ );
1267 }
1268
1269 Catalyst::Exception->throw( message =>
1270qq/Couldn't instantiate component "$component", "new() didn't return a object"/
1271 )
1272 unless ref $instance;
1273 return $instance;
1274 };
1275
1276 eval {
1277 Module::Pluggable::Fast->import(
1278 name => '_catalyst_components',
1279 search => [
1280 "$class\::Controller", "$class\::C",
1281 "$class\::Model", "$class\::M",
1282 "$class\::View", "$class\::V"
1283 ],
1284 callback => $callback
1285 );
1286 };
1287
1288 if ( my $error = $@ ) {
1289
1290 chomp $error;
1291
1292 Catalyst::Exception->throw(
1293 message => qq/Couldn't load components "$error"/ );
1294 }
1295
1296 for my $component ( $class->_catalyst_components($class) ) {
1297 $class->components->{ ref $component || $component } = $component;
1298 }
1299}
1300
1301=item $c->setup_dispatcher
1302
1303=cut
1304
1305sub setup_dispatcher {
1306 my ( $class, $dispatcher ) = @_;
1307
1308 if ($dispatcher) {
1309 $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
1310 }
1311
1312 if ( $ENV{CATALYST_DISPATCHER} ) {
1313 $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
1314 }
1315
1316 if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
1317 $dispatcher =
1318 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
1319 }
1320
1321 unless ($dispatcher) {
1322 $dispatcher = 'Catalyst::Dispatcher';
1323 }
1324
1325 $dispatcher->require;
1326
1327 if ($@) {
1328 Catalyst::Exception->throw(
1329 message => qq/Couldn't load dispatcher "$dispatcher", "$@"/ );
1330 }
1331
1332 # dispatcher instance
1333 $class->dispatcher( $dispatcher->new );
1334}
1335
1336=item $c->setup_engine
1337
1338=cut
1339
1340sub setup_engine {
1341 my ( $class, $engine ) = @_;
1342
1343 if ($engine) {
1344 $engine = 'Catalyst::Engine::' . $engine;
1345 }
1346
1347 if ( $ENV{CATALYST_ENGINE} ) {
1348 $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
1349 }
1350
1351 if ( $ENV{ uc($class) . '_ENGINE' } ) {
1352 $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
1353 }
1354
1355 if ( !$engine && $ENV{MOD_PERL} ) {
1356
1357 # create the apache method
1358 {
1359 no strict 'refs';
1360 *{"$class\::apache"} = sub { shift->engine->apache };
1361 }
1362
1363 my ( $software, $version ) =
1364 $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
1365
1366 $version =~ s/_//g;
1367 $version =~ s/(\.[^.]+)\./$1/g;
1368
1369 if ( $software eq 'mod_perl' ) {
1370
1371 if ( $version >= 1.99922 ) {
1372 $engine = 'Catalyst::Engine::Apache2::MP20';
1373 }
1374
1375 elsif ( $version >= 1.9901 ) {
1376 $engine = 'Catalyst::Engine::Apache2::MP19';
1377 }
1378
1379 elsif ( $version >= 1.24 ) {
1380 $engine = 'Catalyst::Engine::Apache::MP13';
1381 }
1382
1383 else {
1384 Catalyst::Exception->throw( message =>
1385 qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ );
1386 }
1387
1388 # install the correct mod_perl handler
1389 if ( $version >= 1.9901 ) {
1390 *handler = sub : method {
1391 shift->handle_request(@_);
1392 };
1393 }
1394 else {
1395 *handler = sub ($$) { shift->handle_request(@_) };
1396 }
1397
1398 }
1399
1400 elsif ( $software eq 'Zeus-Perl' ) {
1401 $engine = 'Catalyst::Engine::Zeus';
1402 }
1403
1404 else {
1405 Catalyst::Exception->throw(
1406 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/ );
1407 }
1408 }
1409
1410 unless ($engine) {
1411 $engine = 'Catalyst::Engine::CGI';
1412 }
1413
1414 $engine->require;
1415
1416 if ($@) {
1417 Catalyst::Exception->throw( message =>
1418qq/Couldn't load engine "$engine" (maybe you forgot to install it?), "$@"/
1419 );
1420 }
1421
1422 # engine instance
1423 $class->engine( $engine->new );
1424}
1425
1426=item $c->setup_home
1427
1428=cut
1429
1430sub setup_home {
1431 my ( $class, $home ) = @_;
1432
1433 if ( $ENV{CATALYST_HOME} ) {
1434 $home = $ENV{CATALYST_HOME};
1435 }
1436
1437 if ( $ENV{ uc($class) . '_HOME' } ) {
1438 $home = $ENV{ uc($class) . '_HOME' };
1439 }
1440
1441 unless ($home) {
1442 $home = Catalyst::Utils::home($class);
1443 }
1444
1445 if ($home) {
1446 $class->config->{home} ||= $home;
1447 $class->config->{root} ||= dir($home)->subdir('root');
1448 }
1449}
1450
1451=item $c->setup_log
1452
1453=cut
1454
1455sub setup_log {
1456 my ( $class, $debug ) = @_;
1457
1458 unless ( $class->log ) {
1459 $class->log( Catalyst::Log->new );
1460 }
1461
1462 if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
1463 no strict 'refs';
1464 *{"$class\::debug"} = sub { 1 };
1465 $class->log->debug('Debug messages enabled');
1466 }
1467}
1468
1469=item $c->setup_plugins
1470
1471=cut
1472
1473sub setup_plugins {
1474 my ( $class, $plugins ) = @_;
1475
1476 $plugins ||= [];
1477 for my $plugin ( reverse @$plugins ) {
1478
1479 $plugin = "Catalyst::Plugin::$plugin";
1480
1481 $plugin->require;
1482
1483 if ($@) {
1484 Catalyst::Exception->throw(
1485 message => qq/Couldn't load plugin "$plugin", "$@"/ );
1486 }
1487
1488 {
1489 no strict 'refs';
1490 unshift @{"$class\::ISA"}, $plugin;
1491 }
1492 }
1493}
1494
1495=item $c->write( $data )
1496
1497Writes $data to the output stream. When using this method directly, you will
1498need to manually set the Content-Length header to the length of your output
1499data, if known.
1500
1501=cut
1502
4f5ebacd 1503sub write {
1504 my $c = shift;
1505
1506 # Finalize headers if someone manually writes output
1507 $c->finalize_headers;
1508
1509 return $c->engine->write( $c, @_ );
1510}
fbcc39ad 1511
23f9d934 1512=back
1513
d2ee9760 1514=head1 CASE SENSITIVITY
1515
1516By default Catalyst is not case sensitive, so C<MyApp::C::FOO::Bar> becomes
1517C</foo/bar>.
1518
1519But you can activate case sensitivity with a config parameter.
1520
1521 MyApp->config->{case_sensitive} = 1;
1522
fbcc39ad 1523So C<MyApp::C::Foo::Bar> becomes C</Foo/Bar>.
1524
1525=head1 ON-DEMAND PARSER
1526
1527The request body is usually parsed at the beginning of a request,
1528but if you want to handle input yourself or speed things up a bit
1529you can enable on-demand parsing with a config parameter.
1530
1531 MyApp->config->{parse_on_demand} = 1;
1532
1533=head1 PROXY SUPPORT
1534
1535Many production servers operate using the common double-server approach, with
1536a lightweight frontend web server passing requests to a larger backend
1537server. An application running on the backend server must deal with two
1538problems: the remote user always appears to be '127.0.0.1' and the server's
1539hostname will appear to be 'localhost' regardless of the virtual host the
1540user connected through.
1541
1542Catalyst will automatically detect this situation when you are running both
1543the frontend and backend servers on the same machine. The following changes
1544are made to the request.
1545
1546 $c->req->address is set to the user's real IP address, as read from the
1547 HTTP_X_FORWARDED_FOR header.
1548
1549 The host value for $c->req->base and $c->req->uri is set to the real host,
1550 as read from the HTTP_X_FORWARDED_HOST header.
1551
1552Obviously, your web server must support these 2 headers for this to work.
1553
1554In a more complex server farm environment where you may have your frontend
1555proxy server(s) on different machines, you will need to set a configuration
1556option to tell Catalyst to read the proxied data from the headers.
1557
1558 MyApp->config->{using_frontend_proxy} = 1;
1559
1560If you do not wish to use the proxy support at all, you may set:
d1a31ac6 1561
fbcc39ad 1562 MyApp->config->{ignore_frontend_proxy} = 1;
1563
1564=head1 THREAD SAFETY
1565
1566Catalyst has been tested under Apache 2's threading mpm_worker, mpm_winnt,
1567and the standalone forking HTTP server on Windows. We believe the Catalyst
1568core to be thread-safe.
1569
1570If you plan to operate in a threaded environment, remember that all other
1571modules you are using must also be thread-safe. Some modules, most notably
1572DBD::SQLite, are not thread-safe.
d1a31ac6 1573
3cb1db8c 1574=head1 SUPPORT
1575
1576IRC:
1577
1578 Join #catalyst on irc.perl.org.
1579
1580Mailing-Lists:
1581
1582 http://lists.rawmode.org/mailman/listinfo/catalyst
1583 http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1985c30b 1584
432d507d 1585Web:
1586
1587 http://catalyst.perl.org
1588
fc7ec1d9 1589=head1 SEE ALSO
1590
61b1e958 1591=over 4
1592
1593=item L<Catalyst::Manual> - The Catalyst Manual
1594
1595=item L<Catalyst::Engine> - Core Engine
1596
1597=item L<Catalyst::Log> - The Log Class.
1598
1599=item L<Catalyst::Request> - The Request Object
1600
1601=item L<Catalyst::Response> - The Response Object
1602
1603=item L<Catalyst::Test> - The test suite.
1604
1605=back
fc7ec1d9 1606
15f0b5b7 1607=head1 CREDITS
fc7ec1d9 1608
15f0b5b7 1609Andy Grundman
1610
fbcc39ad 1611Andy Wardley
1612
33108eaf 1613Andreas Marienborg
1614
f4a57de4 1615Andrew Bramble
1616
15f0b5b7 1617Andrew Ford
1618
1619Andrew Ruthven
1620
fbcc39ad 1621Arthur Bergman
1622
15f0b5b7 1623Autrijus Tang
1624
1625Christian Hansen
1626
1627Christopher Hicks
1628
1629Dan Sully
1630
1631Danijel Milicevic
1632
1633David Naughton
1634
1635Gary Ashton Jones
1636
1637Geoff Richards
1638
1639Jesse Sheidlower
1640
fbcc39ad 1641Jesse Vincent
1642
15f0b5b7 1643Jody Belka
1644
1645Johan Lindstrom
1646
1647Juan Camacho
1648
1649Leon Brocard
1650
1651Marcus Ramberg
1652
1653Matt S Trout
1654
71c3bcc3 1655Robert Sedlacek
1656
15f0b5b7 1657Tatsuhiko Miyagawa
fc7ec1d9 1658
51f0308d 1659Ulf Edvinsson
1660
bdcb95ef 1661Yuval Kogman
1662
51f0308d 1663=head1 AUTHOR
1664
1665Sebastian Riedel, C<sri@oook.de>
1666
fc7ec1d9 1667=head1 LICENSE
1668
1669This library is free software . You can redistribute it and/or modify it under
41ca9ba7 1670the same terms as Perl itself.
fc7ec1d9 1671
1672=cut
1673
16741;