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 $path = $INC{"$name.pm"};
 252     my $home = file($path)->absolute->dir;
 253     $name =~ /(\w+)$/;
 254     my $append = $1;
 255     my $subdir = dir($home)->subdir($append);
 256     for ( split '/', $name ) { $home = dir($home)->parent }
 257     if ( $home =~ /blib$/ ) { $home = dir($home)->parent }
 258     elsif ( !-f file( $home, 'Makefile.PL' ) ) { $home = $subdir }
 259
 260     if ( $caller->debug ) {
 261         $home
 262           ? ( -d $home )
 263           ? $caller->log->debug(qq/Found home "$home"/)
 264           : $caller->log->debug(qq/Home "$home" doesn't exist/)
 265           : $caller->log->debug(q/Couldn't find home/);
 266     }
 267     $caller->config->{home} = $home;
 268     $caller->config->{root} = dir($home)->subdir('root');
 269 }
 270
 271 =item $c->engine
 272
 273 Contains the engine class.
 274
 275 =item $c->log
 276
 277 Contains the logging object.  Unless it is already set Catalyst sets this up with a
 278 C<Catalyst::Log> object.  To use your own log class:
 279
 280     $c->log( MyLogger->new );
 281     $c->log->info("now logging with my own logger!");
 282
 283 Your log class should implement the methods described in the C<Catalyst::Log>
 284 man page.
 285
 286 =item $c->plugin( $name, $class, @args )
 287
 288 Instant plugins for Catalyst.
 289 Classdata accessor/mutator will be created, class loaded and instantiated.
 290
 291     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 292
 293     $c->prototype->define_javascript_functions;
 294
 295 =cut
 296
 297 sub plugin {
 298     my ( $class, $name, $plugin, @args ) = @_;
 299     $plugin->require;
 300     my $error = $UNIVERSAL::require::ERROR;
 301     die qq/Couldn't load instant plugin "$plugin", "$error"/ if $error;
 302     eval { $plugin->import };
 303     $class->mk_classdata($name);
 304     my $obj;
 305     eval { $obj = $plugin->new(@args) };
 306     die qq/Couldn't instantiate instant plugin "$plugin", "$@"/ if $@;
 307     $class->$name($obj);
 308     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 309       if $class->debug;
 310 }
 311
 312 =back
 313
 314 =head1 LIMITATIONS
 315
 316 mod_perl2 support is considered experimental and may contain bugs.
 317
 318 =head1 SUPPORT
 319
 320 IRC:
 321
 322     Join #catalyst on irc.perl.org.
 323
 324 Mailing-Lists:
 325
 326     http://lists.rawmode.org/mailman/listinfo/catalyst
 327     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
 328
 329 Web:
 330
 331     http://catalyst.perl.org
 332
 333 =head1 SEE ALSO
 334
 335 =over 4
 336
 337 =item L<Catalyst::Manual> - The Catalyst Manual
 338
 339 =item L<Catalyst::Engine> - Core Engine
 340
 341 =item L<Catalyst::Log> - The Log Class.
 342
 343 =item L<Catalyst::Request> - The Request Object
 344
 345 =item L<Catalyst::Response> - The Response Object
 346
 347 =item L<Catalyst::Test> - The test suite.
 348
 349 =back
 350
 351 =head1 AUTHOR
 352
 353 Sebastian Riedel, C<sri@oook.de>
 354
 355 =head1 THANK YOU
 356
 357 Andy Grundman, Andrew Ford, Andrew Ruthven, Autrijus Tang, Christian Hansen,
 358 Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
 359 Gary Ashton Jones, Jesse Sheidlower, Jody Belka, Johan Lindstrom, Leon Brocard,
 360 Marcus Ramberg, Tatsuhiko Miyagawa and all the others who've helped.
 361
 362 =head1 LICENSE
 363
 364 This library is free software . You can redistribute it and/or modify it under
 365 the same terms as perl itself.
 366
 367 =cut
 368
 369 1;