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