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         mod_perl->require;
 159
 160         if ( $mod_perl::VERSION >= 1.99_90_22 ) {
 161             $engine = 'Catalyst::Engine::Apache::MP20';
 162         }
 163
 164         elsif ( $mod_perl::VERSION >= 1.99_01 ) {
 165             $engine = 'Catalyst::Engine::Apache::MP19';
 166         }
 167
 168         elsif ( $mod_perl::VERSION >= 1.27 ) {
 169             $engine = 'Catalyst::Engine::Apache::MP13';
 170         }
 171
 172         else {
 173             die( qq/Unsupported mod_perl version: "$mod_perl::VERSION"/ );
 174         }
 175     }
 176
 177     $caller->log->info( "You are running an old helper script! "
 178           . "Please update your scripts by regenerating the "
 179           . "application and copying over the new scripts." )
 180       if ( $ENV{CATALYST_SCRIPT_GEN}
 181         && ( $ENV{CATALYST_SCRIPT_GEN} < $CATALYST_SCRIPT_GEN ) );
 182
 183     # Process options
 184     my @plugins;
 185     foreach (@options) {
 186
 187         if (/^\-Debug$/) {
 188             next if $caller->debug;
 189             no strict 'refs';
 190             *{"$caller\::debug"} = sub { 1 };
 191             $caller->log->debug('Debug messages enabled');
 192         }
 193
 194         elsif (/^-Dispatcher=(.*)$/) {
 195             $dispatcher = "Catalyst::Dispatcher::$1";
 196         }
 197
 198         elsif (/^-Engine=(.*)$/) { $engine = "Catalyst::Engine::$1" }
 199         elsif (/^-.*$/) { $caller->log->error(qq/Unknown flag "$_"/) }
 200
 201         else {
 202             my $plugin = "Catalyst::Plugin::$_";
 203
 204             $plugin->require;
 205
 206             if ($@) { die qq/Couldn't load plugin "$plugin", "$@"/ }
 207             else {
 208                 push @plugins, $plugin;
 209                 no strict 'refs';
 210                 push @{"$caller\::ISA"}, $plugin;
 211             }
 212         }
 213
 214     }
 215
 216     # Plugin table
 217     my $t = Text::ASCIITable->new( { hide_HeadRow => 1, hide_HeadLine => 1 } );
 218     $t->setCols('Class');
 219     $t->setColWidth( 'Class', 75, 1 );
 220     $t->addRow($_) for @plugins;
 221     $caller->log->debug( 'Loaded plugins', $t->draw )
 222       if ( @plugins && $caller->debug );
 223
 224     # Dispatcher
 225     $dispatcher = "Catalyst::Dispatcher::$ENV{CATALYST_DISPATCHER}"
 226       if $ENV{CATALYST_DISPATCHER};
 227     my $appdis = $ENV{ uc($caller) . '_DISPATCHER' };
 228     $dispatcher = "Catalyst::Dispatcher::$appdis" if $appdis;
 229
 230     $dispatcher->require;
 231     die qq/Couldn't load dispatcher "$dispatcher", "$@"/ if $@;
 232     {
 233         no strict 'refs';
 234         push @{"$caller\::ISA"}, $dispatcher;
 235     }
 236     $caller->dispatcher($dispatcher);
 237     $caller->log->debug(qq/Loaded dispatcher "$dispatcher"/) if $caller->debug;
 238
 239     # Engine
 240     $engine = "Catalyst::Engine::$ENV{CATALYST_ENGINE}"
 241       if $ENV{CATALYST_ENGINE};
 242     my $appeng = $ENV{ uc($caller) . '_ENGINE' };
 243     $engine = "Catalyst::Engine::$appeng" if $appeng;
 244
 245     $engine->require;
 246     die qq/Couldn't load engine "$engine", "$@"/ if $@;
 247
 248     {
 249         no strict 'refs';
 250         push @{"$caller\::ISA"}, $engine;
 251     }
 252
 253     $caller->engine($engine);
 254     $caller->log->debug(qq/Loaded engine "$engine"/) if $caller->debug;
 255
 256     # Find home
 257     my $home = Catalyst::Utils::home($caller);
 258     if ( $caller->debug ) {
 259         $home
 260           ? ( -d $home )
 261           ? $caller->log->debug(qq/Found home "$home"/)
 262           : $caller->log->debug(qq/Home "$home" doesn't exist/)
 263           : $caller->log->debug(q/Couldn't find home/);
 264     }
 265     $caller->config->{home} = $home || '';
 266     $caller->config->{root} = defined $home ? dir($home)->subdir('root') : '';
 267 }
 268
 269 =item $c->engine
 270
 271 Contains the engine class.
 272
 273 =item $c->log
 274
 275 Contains the logging object.  Unless it is already set Catalyst sets this up with a
 276 C<Catalyst::Log> object.  To use your own log class:
 277
 278     $c->log( MyLogger->new );
 279     $c->log->info("now logging with my own logger!");
 280
 281 Your log class should implement the methods described in the C<Catalyst::Log>
 282 man page.
 283
 284 =item $c->plugin( $name, $class, @args )
 285
 286 Instant plugins for Catalyst.
 287 Classdata accessor/mutator will be created, class loaded and instantiated.
 288
 289     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 290
 291     $c->prototype->define_javascript_functions;
 292
 293 =cut
 294
 295 sub plugin {
 296     my ( $class, $name, $plugin, @args ) = @_;
 297     $plugin->require;
 298     my $error = $UNIVERSAL::require::ERROR;
 299     die qq/Couldn't load instant plugin "$plugin", "$error"/ if $error;
 300     eval { $plugin->import };
 301     $class->mk_classdata($name);
 302     my $obj;
 303     eval { $obj = $plugin->new(@args) };
 304     die qq/Couldn't instantiate instant plugin "$plugin", "$@"/ if $@;
 305     $class->$name($obj);
 306     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 307       if $class->debug;
 308 }
 309
 310 =back
 311
 312 =head1 LIMITATIONS
 313
 314 mod_perl2 support is considered experimental and may contain bugs.
 315
 316 =head1 SUPPORT
 317
 318 IRC:
 319
 320     Join #catalyst on irc.perl.org.
 321
 322 Mailing-Lists:
 323
 324     http://lists.rawmode.org/mailman/listinfo/catalyst
 325     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
 326
 327 Web:
 328
 329     http://catalyst.perl.org
 330
 331 =head1 SEE ALSO
 332
 333 =over 4
 334
 335 =item L<Catalyst::Manual> - The Catalyst Manual
 336
 337 =item L<Catalyst::Engine> - Core Engine
 338
 339 =item L<Catalyst::Log> - The Log Class.
 340
 341 =item L<Catalyst::Request> - The Request Object
 342
 343 =item L<Catalyst::Response> - The Response Object
 344
 345 =item L<Catalyst::Test> - The test suite.
 346
 347 =back
 348
 349 =head1 AUTHOR
 350
 351 Sebastian Riedel, C<sri@oook.de>
 352
 353 =head1 THANK YOU
 354
 355 Andy Grundman, Andrew Ford, Andrew Ruthven, Autrijus Tang, Christian Hansen,
 356 Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
 357 Gary Ashton Jones, Geoff Richards, Jesse Sheidlower, Jody Belka,
 358 Johan Lindstrom, Leon Brocard, Marcus Ramberg, Tatsuhiko Miyagawa
 359 and all the others who've helped.
 360
 361 =head1 LICENSE
 362
 363 This library is free software . You can redistribute it and/or modify it under
 364 the same terms as perl itself.
 365
 366 =cut
 367
 368 1;