lib/Catalyst.pm

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