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         {
 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 Andreas Marienborg
1624
1625 Andrew Bramble
1626
1627 Andrew Ford
1628
1629 Andrew Ruthven
1630
1631 Arthur Bergman
1632
1633 Autrijus Tang
1634
1635 Christian Hansen
1636
1637 Christopher Hicks
1638
1639 Dan Sully
1640
1641 Danijel Milicevic
1642
1643 David Naughton
1644
1645 Gary Ashton Jones
1646
1647 Geoff Richards
1648
1649 Jesse Sheidlower
1650
1651 Jesse Vincent
1652
1653 Jody Belka
1654
1655 Johan Lindstrom
1656
1657 Juan Camacho
1658
1659 Leon Brocard
1660
1661 Marcus Ramberg
1662
1663 Matt S Trout
1664
1665 Robert Sedlacek
1666
1667 Tatsuhiko Miyagawa
1668
1669 Ulf Edvinsson
1670
1671 Yuval Kogman
1672
1673 =head1 AUTHOR
1674
1675 Sebastian Riedel, C<sri@oook.de>
1676
1677 =head1 LICENSE
1678
1679 This library is free software . You can redistribute it and/or modify it under
1680 the same terms as Perl itself.
1681
1682 =cut
1683
1684 1;