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