lib/Catalyst.pm

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