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