lib/Catalyst.pm

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