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