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