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 ( $self, @options ) = @_;
 128     my $caller = caller(0);
 129
 130     # Prepare inheritance
 131     unless ( $caller->isa($self) ) {
 132         no strict 'refs';
 133         push @{"$caller\::ISA"}, $self;
 134     }
 135
 136     if ( $caller->engine ) {
 137         return;    # Catalyst is already initialized
 138     }
 139
 140     unless ( $caller->log ) {
 141         $caller->log( Catalyst::Log->new );
 142     }
 143
 144     # Debug?
 145     if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($caller) . '_DEBUG' } ) {
 146         no strict 'refs';
 147         *{"$caller\::debug"} = sub { 1 };
 148         $caller->log->debug('Debug messages enabled');
 149     }
 150
 151     my $engine     = 'Catalyst::Engine::CGI';
 152     my $dispatcher = 'Catalyst::Dispatcher';
 153
 154     if ( $ENV{MOD_PERL} ) {
 155
 156         my ( $software, $version ) = $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
 157
 158         $version =~ s/_//g;
 159         $version =~ s/(\.[^.]+)\./$1/g;
 160
 161         if ( $software eq 'mod_perl') {
 162
 163             if ( $version >= 1.99922 ) {
 164
 165                 $engine = 'Catalyst::Engine::Apache::MP20';
 166
 167                 if ( Apache2::Request->require ) {
 168                     $engine = 'Catalyst::Engine::Apache::MP20::Apreq';
 169                 }
 170             }
 171
 172             elsif ( $version >= 1.9901 ) {
 173
 174                 $engine = 'Catalyst::Engine::Apache::MP19';
 175
 176                 if ( Apache::Request->require ) {
 177                     $engine = 'Catalyst::Engine::Apache::MP19::Apreq';
 178                 }
 179             }
 180
 181             elsif ( $version >= 1.24 ) {
 182
 183                 $engine = 'Catalyst::Engine::Apache::MP13';
 184
 185                 if ( Apache::Request->require ) {
 186                     $engine = 'Catalyst::Engine::Apache::MP13::Apreq';
 187                 }
 188             }
 189
 190             else {
 191                 Catalyst::Exception->throw(
 192                     message => qq/Unsupported mod_perl version: $ENV{MOD_PERL}/
 193                 );
 194             }
 195         }
 196
 197         elsif ( $software eq 'Zeus-Perl' ) {
 198             $engine = 'Catalyst::Engine::Zeus';
 199         }
 200
 201         else {
 202             Catalyst::Exception->throw(
 203                 message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/
 204             );
 205         }
 206     }
 207
 208     $caller->log->info( "You are running an old helper script! "
 209           . "Please update your scripts by regenerating the "
 210           . "application and copying over the new scripts." )
 211       if ( $ENV{CATALYST_SCRIPT_GEN}
 212         && ( $ENV{CATALYST_SCRIPT_GEN} < $CATALYST_SCRIPT_GEN ) );
 213
 214     # Process options
 215     my @plugins;
 216     foreach (@options) {
 217
 218         if (/^\-Debug$/) {
 219             next if $caller->debug;
 220             no strict 'refs';
 221             *{"$caller\::debug"} = sub { 1 };
 222             $caller->log->debug('Debug messages enabled');
 223         }
 224
 225         elsif (/^-Dispatcher=(.*)$/) {
 226             $dispatcher = "Catalyst::Dispatcher::$1";
 227         }
 228
 229         elsif (/^-Engine=(.*)$/) { $engine = "Catalyst::Engine::$1" }
 230         elsif (/^-.*$/) { $caller->log->error(qq/Unknown flag "$_"/) }
 231
 232         else {
 233             my $plugin = "Catalyst::Plugin::$_";
 234
 235             $plugin->require;
 236
 237             if ( $@ ) {
 238                 Catalyst::Exception->throw(
 239                     message => qq/Couldn't load plugin "$plugin", "$@"/
 240                 );
 241             }
 242             else {
 243                 push @plugins, $plugin;
 244                 no strict 'refs';
 245                 push @{"$caller\::ISA"}, $plugin;
 246             }
 247         }
 248
 249     }
 250
 251     # Plugin table
 252     my $t = Text::ASCIITable->new( { hide_HeadRow => 1, hide_HeadLine => 1 } );
 253     $t->setCols('Class');
 254     $t->setColWidth( 'Class', 75, 1 );
 255     $t->addRow($_) for @plugins;
 256     $caller->log->debug( 'Loaded plugins', $t->draw )
 257       if ( @plugins && $caller->debug );
 258
 259     # Dispatcher
 260     $dispatcher = "Catalyst::Dispatcher::$ENV{CATALYST_DISPATCHER}"
 261       if $ENV{CATALYST_DISPATCHER};
 262     my $appdis = $ENV{ uc($caller) . '_DISPATCHER' };
 263     $dispatcher = "Catalyst::Dispatcher::$appdis" if $appdis;
 264
 265     $dispatcher->require;
 266
 267     if ( $@ ) {
 268         Catalyst::Exception->throw(
 269             message => qq/Couldn't load dispatcher "$dispatcher", "$@"/
 270         );
 271     }
 272
 273     {
 274         no strict 'refs';
 275         push @{"$caller\::ISA"}, $dispatcher;
 276     }
 277     $caller->dispatcher($dispatcher);
 278     $caller->log->debug(qq/Loaded dispatcher "$dispatcher"/) if $caller->debug;
 279
 280     # Engine
 281     $engine = "Catalyst::Engine::$ENV{CATALYST_ENGINE}"
 282       if $ENV{CATALYST_ENGINE};
 283     my $appeng = $ENV{ uc($caller) . '_ENGINE' };
 284     $engine = "Catalyst::Engine::$appeng" if $appeng;
 285
 286     $engine->require;
 287
 288     if ( $@ ) {
 289         Catalyst::Exception->throw(
 290             message => qq/Couldn't load engine "$engine", "$@"/
 291         );
 292     }
 293
 294     {
 295         no strict 'refs';
 296         push @{"$caller\::ISA"}, $engine;
 297     }
 298
 299     $caller->engine($engine);
 300     $caller->log->debug(qq/Loaded engine "$engine"/) if $caller->debug;
 301
 302     # Find home
 303     my $home = Catalyst::Utils::home($caller);
 304
 305     if ( my $h = $ENV{CATALYST_HOME} ) {
 306
 307         $home = $h if -d $h;
 308
 309         unless ( -e _ ) {
 310             $caller->log->warn(qq/CATALYST_HOME does not exist "$h"/);
 311         }
 312
 313         unless ( -e _ && -d _ ) {
 314             $caller->log->warn(qq/CATALYST_HOME is not a directory "$h"/);
 315         }
 316     }
 317
 318     if ( my $h = $ENV{ uc($caller) . '_HOME' } ) {
 319
 320         $home = $h if -d $h;
 321
 322         unless ( -e _ ) {
 323             my $e = uc($caller) . '_HOME';
 324             $caller->log->warn(qq/$e does not exist "$h"/)
 325         }
 326
 327         unless ( -e _ && -d _ ) {
 328             my $e = uc($caller) . '_HOME';
 329             $caller->log->warn(qq/$e is not a directory "$h"/);
 330         }
 331     }
 332
 333     if ( $caller->debug ) {
 334         $home
 335           ? ( -d $home )
 336           ? $caller->log->debug(qq/Found home "$home"/)
 337           : $caller->log->debug(qq/Home "$home" doesn't exist/)
 338           : $caller->log->debug(q/Couldn't find home/);
 339     }
 340     $caller->config->{home} = $home || '';
 341     $caller->config->{root} = defined $home ? dir($home)->subdir('root') : '';
 342 }
 343
 344 =item $c->engine
 345
 346 Contains the engine class.
 347
 348 =item $c->log
 349
 350 Contains the logging object.  Unless it is already set Catalyst sets this up with a
 351 C<Catalyst::Log> object.  To use your own log class:
 352
 353     $c->log( MyLogger->new );
 354     $c->log->info("now logging with my own logger!");
 355
 356 Your log class should implement the methods described in the C<Catalyst::Log>
 357 man page.
 358
 359 =item $c->plugin( $name, $class, @args )
 360
 361 Instant plugins for Catalyst.
 362 Classdata accessor/mutator will be created, class loaded and instantiated.
 363
 364     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 365
 366     $c->prototype->define_javascript_functions;
 367
 368 =cut
 369
 370 sub plugin {
 371     my ( $class, $name, $plugin, @args ) = @_;
 372     $plugin->require;
 373
 374     if ( my $error = $UNIVERSAL::require::ERROR ) {
 375         Catalyst::Exception->throw(
 376             message => qq/Couldn't load instant plugin "$plugin", "$error"/
 377         );
 378     }
 379
 380     eval { $plugin->import };
 381     $class->mk_classdata($name);
 382     my $obj;
 383     eval { $obj = $plugin->new(@args) };
 384
 385     if ( $@ ) {
 386         Catalyst::Exception->throw(
 387             message => qq/Couldn't instantiate instant plugin "$plugin", "$@"/
 388         );
 389     }
 390
 391     $class->$name($obj);
 392     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 393       if $class->debug;
 394 }
 395
 396 =back
 397
 398 =head1 LIMITATIONS
 399
 400 mod_perl2 support is considered experimental and may contain bugs.
 401
 402 =head1 SUPPORT
 403
 404 IRC:
 405
 406     Join #catalyst on irc.perl.org.
 407
 408 Mailing-Lists:
 409
 410     http://lists.rawmode.org/mailman/listinfo/catalyst
 411     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
 412
 413 Web:
 414
 415     http://catalyst.perl.org
 416
 417 =head1 SEE ALSO
 418
 419 =over 4
 420
 421 =item L<Catalyst::Manual> - The Catalyst Manual
 422
 423 =item L<Catalyst::Engine> - Core Engine
 424
 425 =item L<Catalyst::Log> - The Log Class.
 426
 427 =item L<Catalyst::Request> - The Request Object
 428
 429 =item L<Catalyst::Response> - The Response Object
 430
 431 =item L<Catalyst::Test> - The test suite.
 432
 433 =back
 434
 435 =head1 AUTHOR
 436
 437 Sebastian Riedel, C<sri@oook.de>
 438
 439 =head1 THANK YOU
 440
 441 Andy Grundman, Andrew Ford, Andrew Ruthven, Autrijus Tang, Christian Hansen,
 442 Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
 443 Gary Ashton Jones, Geoff Richards, Jesse Sheidlower, Jody Belka,
 444 Johan Lindstrom, Juan Camacho, Leon Brocard, Marcus Ramberg,
 445 Tatsuhiko Miyagawa and all the others who've helped.
 446
 447 =head1 LICENSE
 448
 449 This library is free software . You can redistribute it and/or modify it under
 450 the same terms as perl itself.
 451
 452 =cut
 453
 454 1;