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