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