lib/Catalyst.pm

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