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 ( $caller->debug ) {
 317         $home
 318           ? ( -d $home )
 319           ? $caller->log->debug(qq/Found home "$home"/)
 320           : $caller->log->debug(qq/Home "$home" doesn't exist/)
 321           : $caller->log->debug(q/Couldn't find home/);
 322     }
 323     $caller->config->{home} = $home || '';
 324     $caller->config->{root} = defined $home ? dir($home)->subdir('root') : '';
 325 }
 326
 327 =item $c->engine
 328
 329 Contains the engine class.
 330
 331 =item $c->log
 332
 333 Contains the logging object.  Unless it is already set Catalyst sets this up with a
 334 C<Catalyst::Log> object.  To use your own log class:
 335
 336     $c->log( MyLogger->new );
 337     $c->log->info("now logging with my own logger!");
 338
 339 Your log class should implement the methods described in the C<Catalyst::Log>
 340 man page.
 341
 342 =item $c->plugin( $name, $class, @args )
 343
 344 Instant plugins for Catalyst.
 345 Classdata accessor/mutator will be created, class loaded and instantiated.
 346
 347     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 348
 349     $c->prototype->define_javascript_functions;
 350
 351 =cut
 352
 353 sub plugin {
 354     my ( $class, $name, $plugin, @args ) = @_;
 355     $plugin->require;
 356     my $error = $UNIVERSAL::require::ERROR;
 357     die qq/Couldn't load instant plugin "$plugin", "$error"/ if $error;
 358     eval { $plugin->import };
 359     $class->mk_classdata($name);
 360     my $obj;
 361     eval { $obj = $plugin->new(@args) };
 362     die qq/Couldn't instantiate instant plugin "$plugin", "$@"/ if $@;
 363     $class->$name($obj);
 364     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 365       if $class->debug;
 366 }
 367
 368 =back
 369
 370 =head1 LIMITATIONS
 371
 372 mod_perl2 support is considered experimental and may contain bugs.
 373
 374 =head1 SUPPORT
 375
 376 IRC:
 377
 378     Join #catalyst on irc.perl.org.
 379
 380 Mailing-Lists:
 381
 382     http://lists.rawmode.org/mailman/listinfo/catalyst
 383     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
 384
 385 Web:
 386
 387     http://catalyst.perl.org
 388
 389 =head1 SEE ALSO
 390
 391 =over 4
 392
 393 =item L<Catalyst::Manual> - The Catalyst Manual
 394
 395 =item L<Catalyst::Engine> - Core Engine
 396
 397 =item L<Catalyst::Log> - The Log Class.
 398
 399 =item L<Catalyst::Request> - The Request Object
 400
 401 =item L<Catalyst::Response> - The Response Object
 402
 403 =item L<Catalyst::Test> - The test suite.
 404
 405 =back
 406
 407 =head1 AUTHOR
 408
 409 Sebastian Riedel, C<sri@oook.de>
 410
 411 =head1 THANK YOU
 412
 413 Andy Grundman, Andrew Ford, Andrew Ruthven, Autrijus Tang, Christian Hansen,
 414 Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
 415 Gary Ashton Jones, Geoff Richards, Jesse Sheidlower, Jody Belka,
 416 Johan Lindstrom, Juan Camacho, Leon Brocard, Marcus Ramberg,
 417 Tatsuhiko Miyagawa and all the others who've helped.
 418
 419 =head1 LICENSE
 420
 421 This library is free software . You can redistribute it and/or modify it under
 422 the same terms as perl itself.
 423
 424 =cut
 425
 426 1;