lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use strict;
   4 use base 'Catalyst::Base';
   5 use UNIVERSAL::require;
   6 use Catalyst::Exception;
   7 use Catalyst::Log;
   8 use Catalyst::Utils;
   9 use Text::ASCIITable;
  10 use Path::Class;
  11 our $CATALYST_SCRIPT_GEN = 4;
  12
  13 __PACKAGE__->mk_classdata($_) for qw/dispatcher engine log/;
  14
  15 our $VERSION = '5.24';
  16 our @ISA;
  17
  18 =head1 NAME
  19
  20 Catalyst - The Elegant MVC Web Application Framework
  21
  22 =head1 SYNOPSIS
  23
  24     # use the helper to start a new application
  25     catalyst.pl MyApp
  26     cd MyApp
  27
  28     # add models, views, controllers
  29     script/myapp_create.pl model Something
  30     script/myapp_create.pl view Stuff
  31     script/myapp_create.pl controller Yada
  32
  33     # built in testserver
  34     script/myapp_server.pl
  35
  36     # command line interface
  37     script/myapp_test.pl /yada
  38
  39
  40     use Catalyst;
  41
  42     use Catalyst qw/My::Module My::OtherModule/;
  43
  44     use Catalyst '-Debug';
  45
  46     use Catalyst qw/-Debug -Engine=CGI/;
  47
  48     sub default : Private { $_[1]->res->output('Hello') } );
  49
  50     sub index : Path('/index.html') {
  51         my ( $self, $c ) = @_;
  52         $c->res->output('Hello');
  53         $c->forward('foo');
  54     }
  55
  56     sub product : Regex('^product[_]*(\d*).html$') {
  57         my ( $self, $c ) = @_;
  58         $c->stash->{template} = 'product.tt';
  59         $c->stash->{product} = $c->req->snippets->[0];
  60     }
  61
  62 See also L<Catalyst::Manual::Intro>
  63
  64 =head1 DESCRIPTION
  65
  66 The key concept of Catalyst is DRY (Don't Repeat Yourself).
  67
  68 See L<Catalyst::Manual> for more documentation.
  69
  70 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
  71 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
  72 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
  73
  74     use Catalyst 'My::Module';
  75
  76 Special flags like -Debug and -Engine can also be specifed as arguments when
  77 Catalyst is loaded:
  78
  79     use Catalyst qw/-Debug My::Module/;
  80
  81 The position of plugins and flags in the chain is important, because they are
  82 loaded in exactly the order that they appear.
  83
  84 The following flags are supported:
  85
  86 =over 4
  87
  88 =item -Debug
  89
  90 enables debug output, i.e.:
  91
  92     use Catalyst '-Debug';
  93
  94 this is equivalent to:
  95
  96     use Catalyst;
  97     sub debug { 1 }
  98
  99 =item -Engine
 100
 101 Force Catalyst to use a specific engine.
 102 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
 103
 104     use Catalyst '-Engine=CGI';
 105
 106 =back
 107
 108 =head1 METHODS
 109
 110 =over 4
 111
 112 =item debug
 113
 114 Overload to enable debug messages.
 115
 116 =cut
 117
 118 sub debug { 0 }
 119
 120 =item config
 121
 122 Returns a hashref containing your applications settings.
 123
 124 =cut
 125
 126 sub import {
 127     my ( $class, @arguments ) = @_;
 128     my $caller = caller(0);
 129
 130     # Prepare inheritance
 131     unless ( $caller->isa($class) ) {
 132         no strict 'refs';
 133         push @{"$caller\::ISA"}, $class;
 134     }
 135
 136     if ( $caller->engine ) {
 137
 138         unless ( $caller eq 'main' ) {
 139             $caller->log->warn( qq/Attempt to re-initialize "$caller"/ );
 140         }
 141
 142         return;
 143     }
 144
 145     # Process options
 146     my $flags = { };
 147
 148     foreach (@arguments) {
 149
 150         if ( /^-Debug$/ ) {
 151             $flags->{log} = 1
 152         }
 153         elsif (/^-(\w+)=?(.*)$/) {
 154             $flags->{ lc $1 } = $2;
 155         }
 156         else {
 157             push @{ $flags->{plugins} }, $_;
 158         }
 159     }
 160
 161     $caller->setup_log        ( delete $flags->{log}        );
 162     $caller->setup_plugins    ( delete $flags->{plugins}    );
 163     $caller->setup_dispatcher ( delete $flags->{dispatcher} );
 164     $caller->setup_engine     ( delete $flags->{engine}     );
 165     $caller->setup_home       ( delete $flags->{home}       );
 166
 167     for my $flag ( sort keys %{ $flags } ) {
 168
 169         if ( my $code = $caller->can( 'setup_' . $flag ) ) {
 170             &$code( $caller, delete $flags->{$flag} );
 171         }
 172         else {
 173             $caller->log->warn(qq/Unknown flag "$flag"/);
 174         }
 175     }
 176
 177     $caller->log->warn( "You are running an old helper script! "
 178           . "Please update your scripts by regenerating the "
 179           . "application and copying over the new scripts." )
 180       if ( $ENV{CATALYST_SCRIPT_GEN}
 181         && ( $ENV{CATALYST_SCRIPT_GEN} < $CATALYST_SCRIPT_GEN ) );
 182
 183
 184     if ( $caller->debug ) {
 185
 186         my @plugins = ();
 187
 188         {
 189             no strict 'refs';
 190             @plugins = grep { /^Catalyst::Plugin/ } @{"$caller\::ISA"};
 191         }
 192
 193         if ( @plugins ) {
 194             my $t = Text::ASCIITable->new;
 195             $t->setOptions( 'hide_HeadRow',  1 );
 196             $t->setOptions( 'hide_HeadLine', 1 );
 197             $t->setCols('Class');
 198             $t->setColWidth( 'Class', 75, 1 );
 199             $t->addRow($_) for @plugins;
 200             $caller->log->debug( 'Loaded plugins', $t->draw );
 201         }
 202
 203         my $dispatcher = $caller->dispatcher;
 204         my $engine     = $caller->engine;
 205         my $home       = $caller->config->{home};
 206
 207         $caller->log->debug(qq/Loaded dispatcher "$dispatcher"/);
 208         $caller->log->debug(qq/Loaded engine "$engine"/);
 209
 210         $home
 211           ? ( -d $home )
 212           ? $caller->log->debug(qq/Found home "$home"/)
 213           : $caller->log->debug(qq/Home "$home" doesn't exist/)
 214           : $caller->log->debug(q/Couldn't find home/);
 215     }
 216 }
 217
 218 =item $c->engine
 219
 220 Contains the engine class.
 221
 222 =item $c->log
 223
 224 Contains the logging object.  Unless it is already set Catalyst sets this up with a
 225 C<Catalyst::Log> object.  To use your own log class:
 226
 227     $c->log( MyLogger->new );
 228     $c->log->info("now logging with my own logger!");
 229
 230 Your log class should implement the methods described in the C<Catalyst::Log>
 231 man page.
 232
 233 =item $c->plugin( $name, $class, @args )
 234
 235 Instant plugins for Catalyst.
 236 Classdata accessor/mutator will be created, class loaded and instantiated.
 237
 238     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 239
 240     $c->prototype->define_javascript_functions;
 241
 242 =cut
 243
 244 sub plugin {
 245     my ( $class, $name, $plugin, @args ) = @_;
 246     $plugin->require;
 247
 248     if ( my $error = $UNIVERSAL::require::ERROR ) {
 249         Catalyst::Exception->throw(
 250             message => qq/Couldn't load instant plugin "$plugin", "$error"/
 251         );
 252     }
 253
 254     eval { $plugin->import };
 255     $class->mk_classdata($name);
 256     my $obj;
 257     eval { $obj = $plugin->new(@args) };
 258
 259     if ( $@ ) {
 260         Catalyst::Exception->throw(
 261             message => qq/Couldn't instantiate instant plugin "$plugin", "$@"/
 262         );
 263     }
 264
 265     $class->$name($obj);
 266     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 267       if $class->debug;
 268 }
 269
 270 =item $c->setup_dispatcher
 271
 272 =cut
 273
 274 sub setup_dispatcher {
 275     my ( $class, $dispatcher ) = @_;
 276
 277     if ( $dispatcher ) {
 278         $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
 279     }
 280
 281     if ( $ENV{CATALYST_DISPATCHER} ) {
 282         $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
 283     }
 284
 285     if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
 286         $dispatcher = 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
 287     }
 288
 289     unless ( $dispatcher ) {
 290         $dispatcher = 'Catalyst::Dispatcher';
 291     }
 292
 293     $dispatcher->require;
 294
 295     if ( $@ ) {
 296         Catalyst::Exception->throw(
 297             message => qq/Couldn't load dispatcher "$dispatcher", "$@"/
 298         );
 299     }
 300
 301     {
 302         no strict 'refs';
 303         push @{"$class\::ISA"}, $dispatcher;
 304     }
 305
 306     $class->dispatcher($dispatcher);
 307 }
 308
 309 =item $c->setup_engine
 310
 311 =cut
 312
 313 sub setup_engine {
 314     my ( $class, $engine ) = @_;
 315
 316     if ( $engine ) {
 317         $engine = 'Catalyst::Engine::' . $engine;
 318     }
 319
 320     if ( $ENV{CATALYST_ENGINE} ) {
 321         $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
 322     }
 323
 324     if ( $ENV{ uc($class) . '_ENGINE' } ) {
 325         $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
 326     }
 327
 328     if ( ! $engine && $ENV{MOD_PERL} ) {
 329
 330         my ( $software, $version ) = $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
 331
 332         $version =~ s/_//g;
 333         $version =~ s/(\.[^.]+)\./$1/g;
 334
 335         if ( $software eq 'mod_perl') {
 336
 337             if ( $version >= 1.99922 ) {
 338
 339                 $engine = 'Catalyst::Engine::Apache::MP20';
 340
 341                 if ( Apache2::Request->require ) {
 342                     $engine = 'Catalyst::Engine::Apache::MP20::Apreq';
 343                 }
 344             }
 345
 346             elsif ( $version >= 1.9901 ) {
 347
 348                 $engine = 'Catalyst::Engine::Apache::MP19';
 349
 350                 if ( Apache::Request->require ) {
 351                     $engine = 'Catalyst::Engine::Apache::MP19::Apreq';
 352                 }
 353             }
 354
 355             elsif ( $version >= 1.24 ) {
 356
 357                 $engine = 'Catalyst::Engine::Apache::MP13';
 358
 359                 if ( Apache::Request->require ) {
 360                     $engine = 'Catalyst::Engine::Apache::MP13::Apreq';
 361                 }
 362             }
 363
 364             else {
 365                 Catalyst::Exception->throw(
 366                     message => qq/Unsupported mod_perl version: $ENV{MOD_PERL}/
 367                 );
 368             }
 369         }
 370
 371         elsif ( $software eq 'Zeus-Perl' ) {
 372             $engine = 'Catalyst::Engine::Zeus';
 373         }
 374
 375         else {
 376             Catalyst::Exception->throw(
 377                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/
 378             );
 379         }
 380     }
 381
 382     unless ( $engine ) {
 383         $engine = 'Catalyst::Engine::CGI';
 384     }
 385
 386     $engine->require;
 387
 388     if ( $@ ) {
 389         Catalyst::Exception->throw(
 390             message => qq/Couldn't load engine "$engine", "$@"/
 391         );
 392     }
 393
 394     {
 395         no strict 'refs';
 396         push @{"$class\::ISA"}, $engine;
 397     }
 398
 399     $class->engine($engine);
 400 }
 401
 402 =item $c->setup_home
 403
 404 =cut
 405
 406 sub setup_home {
 407     my ( $class, $home ) = @_;
 408
 409     if ( $ENV{CATALYST_HOME} ) {
 410         $home = $ENV{CATALYST_HOME};
 411     }
 412
 413     if ( $ENV{ uc($class) . '_HOME' } ) {
 414         $home = $ENV{ uc($class) . '_HOME' };
 415     }
 416
 417     unless ( $home ) {
 418         $home = Catalyst::Utils::home($class);
 419     }
 420
 421     if ( $home ) {
 422         $class->config->{home} = $home;
 423         $class->config->{root} = dir($home)->subdir('root');
 424     }
 425 }
 426
 427 =item $c->setup_log
 428
 429 =cut
 430
 431 sub setup_log {
 432     my ( $class, $debug ) = @_;
 433
 434     unless ( $class->log ) {
 435         $class->log( Catalyst::Log->new );
 436     }
 437
 438     if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
 439         no strict 'refs';
 440         *{"$class\::debug"} = sub { 1 };
 441         $class->log->debug('Debug messages enabled');
 442     }
 443 }
 444
 445 =item $c->setup_plugins
 446
 447 =cut
 448
 449 sub setup_plugins {
 450     my ( $class, $plugins ) = @_;
 451
 452     for my $plugin ( @$plugins ) {
 453
 454         $plugin = "Catalyst::Plugin::$plugin";
 455
 456         $plugin->require;
 457
 458         if ( $@ ) {
 459             Catalyst::Exception->throw(
 460                 message => qq/Couldn't load plugin "$plugin", "$@"/
 461             );
 462         }
 463
 464         {
 465             no strict 'refs';
 466             push @{"$class\::ISA"}, $plugin;
 467         }
 468     }
 469 }
 470
 471 =back
 472
 473 =head1 LIMITATIONS
 474
 475 mod_perl2 support is considered experimental and may contain bugs.
 476
 477 =head1 SUPPORT
 478
 479 IRC:
 480
 481     Join #catalyst on irc.perl.org.
 482
 483 Mailing-Lists:
 484
 485     http://lists.rawmode.org/mailman/listinfo/catalyst
 486     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
 487
 488 Web:
 489
 490     http://catalyst.perl.org
 491
 492 =head1 SEE ALSO
 493
 494 =over 4
 495
 496 =item L<Catalyst::Manual> - The Catalyst Manual
 497
 498 =item L<Catalyst::Engine> - Core Engine
 499
 500 =item L<Catalyst::Log> - The Log Class.
 501
 502 =item L<Catalyst::Request> - The Request Object
 503
 504 =item L<Catalyst::Response> - The Response Object
 505
 506 =item L<Catalyst::Test> - The test suite.
 507
 508 =back
 509
 510 =head1 AUTHOR
 511
 512 Sebastian Riedel, C<sri@oook.de>
 513
 514 =head1 THANK YOU
 515
 516 Andy Grundman, Andrew Ford, Andrew Ruthven, Autrijus Tang, Christian Hansen,
 517 Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
 518 Gary Ashton Jones, Geoff Richards, Jesse Sheidlower, Jody Belka,
 519 Johan Lindstrom, Juan Camacho, Leon Brocard, Marcus Ramberg,
 520 Tatsuhiko Miyagawa and all the others who've helped.
 521
 522 =head1 LICENSE
 523
 524 This library is free software . You can redistribute it and/or modify it under
 525 the same terms as perl itself.
 526
 527 =cut
 528
 529 1;