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 our $VERSION = '5.24';
  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/myapp_create.pl model Something
  29     script/myapp_create.pl view Stuff
  30     script/myapp_create.pl controller Yada
  31
  32     # built in testserver
  33     script/myapp_server.pl
  34
  35     # command line interface
  36     script/myapp_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 The key concept of Catalyst is DRY (Don't Repeat Yourself).
  66
  67 See L<Catalyst::Manual> for more documentation.
  68
  69 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
  70 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
  71 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
  72
  73     use Catalyst 'My::Module';
  74
  75 Special flags like -Debug and -Engine can also be specifed as arguments when
  76 Catalyst is loaded:
  77
  78     use Catalyst qw/-Debug My::Module/;
  79
  80 The position of plugins and flags in the chain is important, because they are
  81 loaded in exactly the order that they appear.
  82
  83 The following flags are supported:
  84
  85 =over 4
  86
  87 =item -Debug
  88
  89 enables debug output, i.e.:
  90
  91     use Catalyst '-Debug';
  92
  93 this is equivalent to:
  94
  95     use Catalyst;
  96     sub debug { 1 }
  97
  98 =item -Engine
  99
 100 Force Catalyst to use a specific engine.
 101 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
 102
 103     use Catalyst '-Engine=CGI';
 104
 105 =back
 106
 107 =head1 METHODS
 108
 109 =over 4
 110
 111 =item debug
 112
 113 Overload to enable debug messages.
 114
 115 =cut
 116
 117 sub debug { 0 }
 118
 119 =item config
 120
 121 Returns a hashref containing your applications settings.
 122
 123 =cut
 124
 125 sub import {
 126     my ( $class, @arguments ) = @_;
 127
 128     my $caller = caller(0);
 129
 130     if ( $caller eq 'main' ) {
 131         return;
 132     }
 133
 134     # Prepare inheritance
 135     unless ( $caller->isa($class) ) {
 136         no strict 'refs';
 137         push @{"$caller\::ISA"}, $class;
 138     }
 139
 140     if ( $caller->engine ) {
 141         $caller->log->warn( qq/Attempt to re-initialize "$caller"/ );
 142         return;
 143     }
 144
 145     # Process options
 146     my $flags = { };
 147
 148     foreach (@arguments) {
 149
 150         if ( /^-Debug$/ ) {
 151             $flags->{log} = ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug';
 152         }
 153         elsif (/^-(\w+)=?(.*)$/) {
 154             $flags->{ lc $1 } = $2;
 155         }
 156         else {
 157             push @{ $flags->{plugins} }, $_;
 158         }
 159     }
 160
 161     $caller->setup_log        ( delete $flags->{log}        );
 162     $caller->setup_plugins    ( delete $flags->{plugins}    );
 163     $caller->setup_dispatcher ( delete $flags->{dispatcher} );
 164     $caller->setup_engine     ( delete $flags->{engine}     );
 165     $caller->setup_home       ( delete $flags->{home}       );
 166
 167     for my $flag ( sort keys %{ $flags } ) {
 168
 169         if ( my $code = $caller->can( 'setup_' . $flag ) ) {
 170             &$code( $caller, delete $flags->{$flag} );
 171         }
 172         else {
 173             $caller->log->warn(qq/Unknown flag "$flag"/);
 174         }
 175     }
 176
 177     $caller->log->warn( "You are running an old helper script! "
 178           . "Please update your scripts by regenerating the "
 179           . "application and copying over the new scripts." )
 180       if ( $ENV{CATALYST_SCRIPT_GEN}
 181         && ( $ENV{CATALYST_SCRIPT_GEN} < $CATALYST_SCRIPT_GEN ) );
 182
 183
 184     if ( $caller->debug ) {
 185
 186         my @plugins = ();
 187
 188         {
 189             no strict 'refs';
 190             @plugins = grep { /^Catalyst::Plugin/ } @{"$caller\::ISA"};
 191         }
 192
 193         if ( @plugins ) {
 194             my $t = Text::ASCIITable->new;
 195             $t->setOptions( 'hide_HeadRow',  1 );
 196             $t->setOptions( 'hide_HeadLine', 1 );
 197             $t->setCols('Class');
 198             $t->setColWidth( 'Class', 75, 1 );
 199             $t->addRow($_) for @plugins;
 200             $caller->log->debug( "Loaded plugins:\n" . $t->draw );
 201         }
 202
 203         my $dispatcher = $caller->dispatcher;
 204         my $engine     = $caller->engine;
 205         my $home       = $caller->config->{home};
 206
 207         $caller->log->debug(qq/Loaded dispatcher "$dispatcher"/);
 208         $caller->log->debug(qq/Loaded engine "$engine"/);
 209
 210         $home
 211           ? ( -d $home )
 212           ? $caller->log->debug(qq/Found home "$home"/)
 213           : $caller->log->debug(qq/Home "$home" doesn't exist/)
 214           : $caller->log->debug(q/Couldn't find home/);
 215     }
 216 }
 217
 218 =item $c->engine
 219
 220 Contains the engine class.
 221
 222 =item $c->log
 223
 224 Contains the logging object.  Unless it is already set Catalyst sets this up with a
 225 C<Catalyst::Log> object.  To use your own log class:
 226
 227     $c->log( MyLogger->new );
 228     $c->log->info("now logging with my own logger!");
 229
 230 Your log class should implement the methods described in the C<Catalyst::Log>
 231 man page.
 232
 233 =item $c->plugin( $name, $class, @args )
 234
 235 Instant plugins for Catalyst.
 236 Classdata accessor/mutator will be created, class loaded and instantiated.
 237
 238     MyApp->plugin( 'prototype', 'HTML::Prototype' );
 239
 240     $c->prototype->define_javascript_functions;
 241
 242 =cut
 243
 244 sub plugin {
 245     my ( $class, $name, $plugin, @args ) = @_;
 246     $plugin->require;
 247
 248     if ( my $error = $UNIVERSAL::require::ERROR ) {
 249         Catalyst::Exception->throw(
 250             message => qq/Couldn't load instant plugin "$plugin", "$error"/
 251         );
 252     }
 253
 254     eval { $plugin->import };
 255     $class->mk_classdata($name);
 256     my $obj;
 257     eval { $obj = $plugin->new(@args) };
 258
 259     if ( $@ ) {
 260         Catalyst::Exception->throw(
 261             message => qq/Couldn't instantiate instant plugin "$plugin", "$@"/
 262         );
 263     }
 264
 265     $class->$name($obj);
 266     $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
 267       if $class->debug;
 268 }
 269
 270 =back
 271
 272 =head1 LIMITATIONS
 273
 274 mod_perl2 support is considered experimental and may contain bugs.
 275
 276 =head1 SUPPORT
 277
 278 IRC:
 279
 280     Join #catalyst on irc.perl.org.
 281
 282 Mailing-Lists:
 283
 284     http://lists.rawmode.org/mailman/listinfo/catalyst
 285     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
 286
 287 Web:
 288
 289     http://catalyst.perl.org
 290
 291 =head1 SEE ALSO
 292
 293 =over 4
 294
 295 =item L<Catalyst::Manual> - The Catalyst Manual
 296
 297 =item L<Catalyst::Engine> - Core Engine
 298
 299 =item L<Catalyst::Log> - The Log Class.
 300
 301 =item L<Catalyst::Request> - The Request Object
 302
 303 =item L<Catalyst::Response> - The Response Object
 304
 305 =item L<Catalyst::Test> - The test suite.
 306
 307 =back
 308
 309 =head1 AUTHOR
 310
 311 Sebastian Riedel, C<sri@oook.de>
 312
 313 =head1 THANK YOU
 314
 315 Andy Grundman, Andrew Ford, Andrew Ruthven, Autrijus Tang, Christian Hansen,
 316 Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
 317 Gary Ashton Jones, Geoff Richards, Jesse Sheidlower, Jody Belka,
 318 Johan Lindstrom, Juan Camacho, Leon Brocard, Marcus Ramberg,
 319 Tatsuhiko Miyagawa and all the others who've helped.
 320
 321 =head1 LICENSE
 322
 323 This library is free software . You can redistribute it and/or modify it under
 324 the same terms as perl itself.
 325
 326 =cut
 327
 328 1;