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 Text::ASCIITable;
   8 use Path::Class;
   9 our $CATALYST_SCRIPT_GEN = 4;
  10
  11 __PACKAGE__->mk_classdata($_) for qw/dispatcher engine log/;
  12
  13 our $VERSION = '5.20';
  14 our @ISA;
  15
  16 =head1 NAME
  17
  18 Catalyst - The Elegant MVC Web Application Framework
  19
  20 =head1 SYNOPSIS
  21
  22     # use the helper to start a new application
  23     catalyst.pl MyApp
  24     cd MyApp
  25
  26     # add models, views, controllers
  27     script/create.pl model Something
  28     script/create.pl view Stuff
  29     script/create.pl controller Yada
  30
  31     # built in testserver
  32     script/server.pl
  33
  34     # command line interface
  35     script/test.pl /yada
  36
  37
  38     use Catalyst;
  39
  40     use Catalyst qw/My::Module My::OtherModule/;
  41
  42     use Catalyst '-Debug';
  43
  44     use Catalyst qw/-Debug -Engine=CGI/;
  45
  46     sub default : Private { $_[1]->res->output('Hello') } );
  47
  48     sub index : Path('/index.html') {
  49         my ( $self, $c ) = @_;
  50         $c->res->output('Hello');
  51         $c->forward('foo');
  52     }
  53
  54     sub product : Regex('^product[_]*(\d*).html$') {
  55         my ( $self, $c ) = @_;
  56         $c->stash->{template} = 'product.tt';
  57         $c->stash->{product} = $c->req->snippets->[0];
  58     }
  59
  60 See also L<Catalyst::Manual::Intro>
  61
  62 =head1 DESCRIPTION
  63
  64 Catalyst is based upon L<Maypole>, which you should consider for smaller
  65 projects.
  66
  67 The key concept of Catalyst is DRY (Don't Repeat Yourself).
  68
  69 See L<Catalyst::Manual> for more documentation.
  70
  71 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
  72 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
  73 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
  74
  75     use Catalyst 'My::Module';
  76
  77 Special flags like -Debug and -Engine can also be specifed as arguments when
  78 Catalyst is loaded:
  79
  80     use Catalyst qw/-Debug My::Module/;
  81
  82 The position of plugins and flags in the chain is important, because they are
  83 loaded in exactly the order that they appear.
  84
  85 The following flags are supported:
  86
  87 =over 4
  88
  89 =item -Debug
  90
  91 enables debug output, i.e.:
  92
  93     use Catalyst '-Debug';
  94
  95 this is equivalent to:
  96
  97     use Catalyst;
  98     sub debug { 1 }
  99
 100 =item -Engine
 101
 102 Force Catalyst to use a specific engine.
 103 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
 104
 105     use Catalyst '-Engine=CGI';
 106
 107 =back
 108
 109 =head1 METHODS
 110
 111 =over 4
 112
 113 =item debug
 114
 115 Overload to enable debug messages.
 116
 117 =cut
 118
 119 sub debug { 0 }
 120
 121 =item config
 122
 123 Returns a hashref containing your applications settings.
 124
 125 =cut
 126
 127 sub import {
 128     my ( $self, @options ) = @_;
 129     my $caller = caller(0);
 130
 131     # Prepare inheritance
 132     unless ( $caller->isa($self) ) {
 133         no strict 'refs';
 134         push @{"$caller\::ISA"}, $self;
 135     }
 136
 137     if ( $caller->engine ) {
 138         return;    # Catalyst is already initialized
 139     }
 140
 141     unless ( $caller->log ) {
 142         $caller->log( Catalyst::Log->new );
 143     }
 144
 145     # Debug?
 146     if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($caller) . '_DEBUG' } ) {
 147         no strict 'refs';
 148         *{"$caller\::debug"} = sub { 1 };
 149         $caller->log->debug('Debug messages enabled');
 150     }
 151
 152     my $engine     = 'Catalyst::Engine::CGI';
 153     my $dispatcher = 'Catalyst::Dispatcher';
 154
 155     # Detect mod_perl
 156     if ( $ENV{MOD_PERL} ) {
 157
 158         require mod_perl;
 159
 160         if ( $ENV{MOD_PERL_API_VERSION} == 2 ) {
 161             $engine = 'Catalyst::Engine::Apache::MP20';
 162         }
 163         elsif ( $mod_perl::VERSION >= 1.99 ) {
 164             $engine = 'Catalyst::Engine::Apache::MP19';
 165         }
 166         else {
 167             $engine = 'Catalyst::Engine::Apache::MP13';
 168         }
 169     }
 170
 171     $caller->log->info( "You are running an old helper script! "
 172           . "Please update your scripts by regenerating the "
 173           . "application and copying over the new scripts." )
 174       if ( $ENV{CATALYST_SCRIPT_GEN}
 175         && ( $ENV{CATALYST_SCRIPT_GEN} < $CATALYST_SCRIPT_GEN ) );
 176
 177     # Process options
 178     my @plugins;
 179     foreach (@options) {
 180
 181         if (/^\-Debug$/) {
 182             next if $caller->debug;
 183             no strict 'refs';
 184             *{"$caller\::debug"} = sub { 1 };
 185             $caller->log->debug('Debug messages enabled');
 186         }
 187
 188         elsif (/^-Dispatcher=(.*)$/) {
 189             $dispatcher = "Catalyst::Dispatcher::$1";
 190         }
 191
 192         elsif (/^-Engine=(.*)$/) { $engine = "Catalyst::Engine::$1" }
 193         elsif (/^-.*$/) { $caller->log->error(qq/Unknown flag "$_"/) }
 194
 195         else {
 196             my $plugin = "Catalyst::Plugin::$_";
 197
 198             $plugin->require;
 199
 200             if ($@) { die qq/Couldn't load plugin "$plugin", "$@"/ }
 201             else {
 202                 push @plugins, $plugin;
 203                 no strict 'refs';
 204                 push @{"$caller\::ISA"}, $plugin;
 205             }
 206         }
 207
 208     }
 209
 210     # Plugin table
 211     my $t = Text::ASCIITable->new( { hide_HeadRow => 1, hide_HeadLine => 1 } );
 212     $t->setCols('Class');
 213     $t->setColWidth( 'Class', 75, 1 );
 214     $t->addRow($_) for @plugins;
 215     $caller->log->debug( 'Loaded plugins', $t->draw )
 216       if ( @plugins && $caller->debug );
 217
 218     # Dispatcher
 219     $dispatcher = "Catalyst::Dispatcher::$ENV{CATALYST_DISPATCHER}"
 220       if $ENV{CATALYST_DISPATCHER};
 221     my $appdis = $ENV{ uc($caller) . '_DISPATCHER' };
 222     $dispatcher = "Catalyst::Dispatcher::$appdis" if $appdis;
 223
 224     $dispatcher->require;
 225     die qq/Couldn't load dispatcher "$dispatcher", "$@"/ if $@;
 226     {
 227         no strict 'refs';
 228         push @{"$caller\::ISA"}, $dispatcher;
 229     }
 230     $caller->dispatcher($dispatcher);
 231     $caller->log->debug(qq/Loaded dispatcher "$dispatcher"/) if $caller->debug;
 232
 233     # Engine
 234     $engine = "Catalyst::Engine::$ENV{CATALYST_ENGINE}"
 235       if $ENV{CATALYST_ENGINE};
 236     my $appeng = $ENV{ uc($caller) . '_ENGINE' };
 237     $engine = "Catalyst::Engine::$appeng" if $appeng;
 238
 239     $engine->require;
 240     die qq/Couldn't load engine "$engine", "$@"/ if $@;
 241     {
 242         no strict 'refs';
 243         push @{"$caller\::ISA"}, $engine;
 244     }
 245     $caller->engine($engine);
 246     $caller->log->debug(qq/Loaded engine "$engine"/) if $caller->debug;
 247
 248     # Find home
 249     my $name = $caller;
 250     $name =~ s/\:\:/\//g;
 251     my $home;
 252     if ( my $path = $INC{"$name.pm"} ) {
 253         $home = file($path)->absolute->dir;
 254         $name =~ /(\w+)$/;
 255         my $append = $1;
 256         my $subdir = dir($home)->subdir($append);
 257         for ( split '/', $name ) { $home = dir($home)->parent }
 258         if ( $home =~ /blib$/ ) { $home = dir($home)->parent }
 259         elsif ( !-f file( $home, 'Makefile.PL' ) ) { $home = $subdir }
 260     }
 261
 262     if ( $caller->debug ) {
 263         $home
 264           ? ( -d $home )
 265           ? $caller->log->debug(qq/Found home "$home"/)
 266           : $caller->log->debug(qq/Home "$home" doesn't exist/)
 267           : $caller->log->debug(q/Couldn't find home/);
 268     }
 269     $caller->config->{home} = $home || '';
 270     $caller->config->{root} = defined $home ? dir($home)->subdir('root') : '';
 271 }
 272
 273 =item $c->engine
 274
 275 Contains the engine class.
 276
 277 =item $c->log
 278
 279 Contains the logging object.  Unless it is already set Catalyst sets this up with a
 280 C<Catalyst::Log> object.  To use your own log class:
 281
 282     $c->log( MyLogger->new );
 283     $c->log->info("now logging with my own logger!");
 284
 285 Your log class should implement the methods described in the C<Catalyst::Log>
 286 man page.
 287
 288 =item $c->plugin( $name, $class, @args )
 289
 290 Instant plugins for Catalyst.
 291 Classdata accessor/mutator will be created, class loaded and instantiated.
 292
 293     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 294
 295     $c->prototype->define_javascript_functions;
 296
 297 =cut
 298
 299 sub plugin {
 300     my ( $class, $name, $plugin, @args ) = @_;
 301     $plugin->require;
 302     my $error = $UNIVERSAL::require::ERROR;
 303     die qq/Couldn't load instant plugin "$plugin", "$error"/ if $error;
 304     eval { $plugin->import };
 305     $class->mk_classdata($name);
 306     my $obj;
 307     eval { $obj = $plugin->new(@args) };
 308     die qq/Couldn't instantiate instant plugin "$plugin", "$@"/ if $@;
 309     $class->$name($obj);
 310     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 311       if $class->debug;
 312 }
 313
 314 =back
 315
 316 =head1 LIMITATIONS
 317
 318 mod_perl2 support is considered experimental and may contain bugs.
 319
 320 =head1 SUPPORT
 321
 322 IRC:
 323
 324     Join #catalyst on irc.perl.org.
 325
 326 Mailing-Lists:
 327
 328     http://lists.rawmode.org/mailman/listinfo/catalyst
 329     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
 330
 331 Web:
 332
 333     http://catalyst.perl.org
 334
 335 =head1 SEE ALSO
 336
 337 =over 4
 338
 339 =item L<Catalyst::Manual> - The Catalyst Manual
 340
 341 =item L<Catalyst::Engine> - Core Engine
 342
 343 =item L<Catalyst::Log> - The Log Class.
 344
 345 =item L<Catalyst::Request> - The Request Object
 346
 347 =item L<Catalyst::Response> - The Response Object
 348
 349 =item L<Catalyst::Test> - The test suite.
 350
 351 =back
 352
 353 =head1 AUTHOR
 354
 355 Sebastian Riedel, C<sri@oook.de>
 356
 357 =head1 THANK YOU
 358
 359 Andy Grundman, Andrew Ford, Andrew Ruthven, Autrijus Tang, Christian Hansen,
 360 Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
 361 Gary Ashton Jones, Geoff Richards, Jesse Sheidlower, Jody Belka,
 362 Johan Lindstrom, Leon Brocard, Marcus Ramberg, Tatsuhiko Miyagawa
 363 and all the others who've helped.
 364
 365 =head1 LICENSE
 366
 367 This library is free software . You can redistribute it and/or modify it under
 368 the same terms as perl itself.
 369
 370 =cut
 371
 372 1;