lib/Catalyst.pm

   1 package Catalyst;
   2
   3 use strict;
   4 use base qw[ Catalyst::Base Catalyst::Setup ];
   5 use UNIVERSAL::require;
   6 use Catalyst::Exception;
   7 use Catalyst::Log;
   8 use Catalyst::Utils;
   9 use NEXT;
  10 use Text::ASCIITable;
  11 use Path::Class;
  12 our $CATALYST_SCRIPT_GEN = 4;
  13
  14 __PACKAGE__->mk_classdata($_) for qw/arguments dispatcher engine log/;
  15
  16 our $VERSION = '5.24';
  17 our @ISA;
  18
  19 =head1 NAME
  20
  21 Catalyst - The Elegant MVC Web Application Framework
  22
  23 =head1 SYNOPSIS
  24
  25     # use the helper to start a new application
  26     catalyst.pl MyApp
  27     cd MyApp
  28
  29     # add models, views, controllers
  30     script/myapp_create.pl model Something
  31     script/myapp_create.pl view Stuff
  32     script/myapp_create.pl controller Yada
  33
  34     # built in testserver
  35     script/myapp_server.pl
  36
  37     # command line interface
  38     script/myapp_test.pl /yada
  39
  40
  41     use Catalyst;
  42
  43     use Catalyst qw/My::Module My::OtherModule/;
  44
  45     use Catalyst '-Debug';
  46
  47     use Catalyst qw/-Debug -Engine=CGI/;
  48
  49     sub default : Private { $_[1]->res->output('Hello') } );
  50
  51     sub index : Path('/index.html') {
  52         my ( $self, $c ) = @_;
  53         $c->res->output('Hello');
  54         $c->forward('foo');
  55     }
  56
  57     sub product : Regex('^product[_]*(\d*).html$') {
  58         my ( $self, $c ) = @_;
  59         $c->stash->{template} = 'product.tt';
  60         $c->stash->{product} = $c->req->snippets->[0];
  61     }
  62
  63 See also L<Catalyst::Manual::Intro>
  64
  65 =head1 DESCRIPTION
  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 ( $class, @arguments ) = @_;
 129
 130     my $caller = caller(0);
 131
 132     if ( $caller eq 'main' ) {
 133         return;
 134     }
 135
 136     # Prepare inheritance
 137     unless ( $caller->isa($class) ) {
 138         no strict 'refs';
 139         push @{"$caller\::ISA"}, $class;
 140     }
 141
 142     if ( $caller->engine ) {
 143         $caller->log->warn( qq/Attempt to re-initialize "$caller"/ );
 144         return;
 145     }
 146
 147     # Process options
 148     my $flags = { };
 149
 150     foreach (@arguments) {
 151
 152         if ( /^-Debug$/ ) {
 153             $flags->{log} = ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
 154         }
 155         elsif (/^-(\w+)=?(.*)$/) {
 156             $flags->{ lc $1 } = $2;
 157         }
 158         else {
 159             push @{ $flags->{plugins} }, $_;
 160         }
 161     }
 162
 163     $caller->setup_log        ( delete $flags->{log}        );
 164     $caller->setup_plugins    ( delete $flags->{plugins}    );
 165     $caller->setup_dispatcher ( delete $flags->{dispatcher} );
 166     $caller->setup_engine     ( delete $flags->{engine}     );
 167     $caller->setup_home       ( delete $flags->{home}       );
 168
 169     for my $flag ( sort keys %{ $flags } ) {
 170
 171         if ( my $code = $caller->can( 'setup_' . $flag ) ) {
 172             &$code( $caller, delete $flags->{$flag} );
 173         }
 174         else {
 175             $caller->log->warn(qq/Unknown flag "$flag"/);
 176         }
 177     }
 178
 179     $caller->log->warn( "You are running an old helper script! "
 180           . "Please update your scripts by regenerating the "
 181           . "application and copying over the new scripts." )
 182       if ( $ENV{CATALYST_SCRIPT_GEN}
 183         && ( $ENV{CATALYST_SCRIPT_GEN} < $CATALYST_SCRIPT_GEN ) );
 184
 185
 186     if ( $caller->debug ) {
 187
 188         my @plugins = ();
 189
 190         {
 191             no strict 'refs';
 192             @plugins = grep { /^Catalyst::Plugin/ } @{"$caller\::ISA"};
 193         }
 194
 195         if ( @plugins ) {
 196             my $t = Text::ASCIITable->new;
 197             $t->setOptions( 'hide_HeadRow',  1 );
 198             $t->setOptions( 'hide_HeadLine', 1 );
 199             $t->setCols('Class');
 200             $t->setColWidth( 'Class', 75, 1 );
 201             $t->addRow($_) for @plugins;
 202             $caller->log->debug( "Loaded plugins:\n" . $t->draw );
 203         }
 204
 205         my $dispatcher = $caller->dispatcher;
 206         my $engine     = $caller->engine;
 207         my $home       = $caller->config->{home};
 208
 209         $caller->log->debug(qq/Loaded dispatcher "$dispatcher"/);
 210         $caller->log->debug(qq/Loaded engine "$engine"/);
 211
 212         $home
 213           ? ( -d $home )
 214           ? $caller->log->debug(qq/Found home "$home"/)
 215           : $caller->log->debug(qq/Home "$home" doesn't exist/)
 216           : $caller->log->debug(q/Couldn't find home/);
 217     }
 218 }
 219
 220 =item $c->engine
 221
 222 Contains the engine class.
 223
 224 =item $c->log
 225
 226 Contains the logging object.  Unless it is already set Catalyst sets this up with a
 227 C<Catalyst::Log> object.  To use your own log class:
 228
 229     $c->log( MyLogger->new );
 230     $c->log->info("now logging with my own logger!");
 231
 232 Your log class should implement the methods described in the C<Catalyst::Log>
 233 man page.
 234
 235 =item $c->plugin( $name, $class, @args )
 236
 237 Instant plugins for Catalyst.
 238 Classdata accessor/mutator will be created, class loaded and instantiated.
 239
 240     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 241
 242     $c->prototype->define_javascript_functions;
 243
 244 =cut
 245
 246 sub plugin {
 247     my ( $class, $name, $plugin, @args ) = @_;
 248     $plugin->require;
 249
 250     if ( my $error = $UNIVERSAL::require::ERROR ) {
 251         Catalyst::Exception->throw(
 252             message => qq/Couldn't load instant plugin "$plugin", "$error"/
 253         );
 254     }
 255
 256     eval { $plugin->import };
 257     $class->mk_classdata($name);
 258     my $obj;
 259     eval { $obj = $plugin->new(@args) };
 260
 261     if ( $@ ) {
 262         Catalyst::Exception->throw(
 263             message => qq/Couldn't instantiate instant plugin "$plugin", "$@"/
 264         );
 265     }
 266
 267     $class->$name($obj);
 268     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 269       if $class->debug;
 270 }
 271
 272 =item $class->setup
 273
 274 Setup.
 275
 276     MyApp->setup;
 277
 278 =cut
 279
 280 sub setup {
 281     my $class = shift;
 282
 283     # Call plugins setup
 284     $class->NEXT::setup;
 285
 286     # Initialize our data structure
 287     $class->components( {} );
 288
 289     $class->setup_components;
 290
 291     if ( $class->debug ) {
 292         my $t = Text::ASCIITable->new;
 293         $t->setOptions( 'hide_HeadRow',  1 );
 294         $t->setOptions( 'hide_HeadLine', 1 );
 295         $t->setCols('Class');
 296         $t->setColWidth( 'Class', 75, 1 );
 297         $t->addRow($_) for sort keys %{ $class->components };
 298         $class->log->debug( "Loaded components:\n" . $t->draw )
 299           if ( @{ $t->{tbl_rows} } );
 300     }
 301
 302     # Add our self to components, since we are also a component
 303     $class->components->{$class} = $class;
 304
 305     $class->setup_actions;
 306
 307     if ( $class->debug ) {
 308         my $name = $class->config->{name} || 'Application';
 309         $class->log->info("$name powered by Catalyst $Catalyst::VERSION");
 310     }
 311 }
 312
 313 =back
 314
 315 =head1 LIMITATIONS
 316
 317 mod_perl2 support is considered experimental and may contain bugs.
 318
 319 =head1 SUPPORT
 320
 321 IRC:
 322
 323     Join #catalyst on irc.perl.org.
 324
 325 Mailing-Lists:
 326
 327     http://lists.rawmode.org/mailman/listinfo/catalyst
 328     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
 329
 330 Web:
 331
 332     http://catalyst.perl.org
 333
 334 =head1 SEE ALSO
 335
 336 =over 4
 337
 338 =item L<Catalyst::Manual> - The Catalyst Manual
 339
 340 =item L<Catalyst::Engine> - Core Engine
 341
 342 =item L<Catalyst::Log> - The Log Class.
 343
 344 =item L<Catalyst::Request> - The Request Object
 345
 346 =item L<Catalyst::Response> - The Response Object
 347
 348 =item L<Catalyst::Test> - The test suite.
 349
 350 =back
 351
 352 =head1 AUTHOR
 353
 354 Sebastian Riedel, C<sri@oook.de>
 355
 356 =head1 THANK YOU
 357
 358 Andy Grundman, Andrew Ford, Andrew Ruthven, Autrijus Tang, Christian Hansen,
 359 Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
 360 Gary Ashton Jones, Geoff Richards, Jesse Sheidlower, Jody Belka,
 361 Johan Lindstrom, Juan Camacho, Leon Brocard, Marcus Ramberg,
 362 Tatsuhiko Miyagawa and all the others who've helped.
 363
 364 =head1 LICENSE
 365
 366 This library is free software . You can redistribute it and/or modify it under
 367 the same terms as perl itself.
 368
 369 =cut
 370
 371 1;