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