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