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