Updated Changes
[catagits/Catalyst-Runtime.git] / 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 Catalyst::Helper;
8 use Text::ASCIITable;
9
10 __PACKAGE__->mk_classdata($_) for qw/dispatcher engine log/;
11
12 our $VERSION = '5.01';
13 our @ISA;
14
15 =head1 NAME
16
17 Catalyst - The Elegant MVC Web Application Framework
18
19 =head1 SYNOPSIS
20
21     # use the helper to start a new application
22     catalyst.pl MyApp
23     cd MyApp
24
25     # add models, views, controllers
26     script/create.pl model Something
27     script/create.pl view Stuff
28     script/create.pl controller Yada
29
30     # built in testserver
31     script/server.pl
32
33     # command line interface
34     script/test.pl /yada
35
36
37     use Catalyst;
38
39     use Catalyst qw/My::Module My::OtherModule/;
40
41     use Catalyst '-Debug';
42
43     use Catalyst qw/-Debug -Engine=CGI/;
44
45     sub default : Private { $_[1]->res->output('Hello') } );
46
47     sub index : Path('/index.html') {
48         my ( $self, $c ) = @_;
49         $c->res->output('Hello');
50         $c->forward('foo');
51     }
52
53     sub product : Regex('^product[_]*(\d*).html$') {
54         my ( $self, $c ) = @_;
55         $c->stash->{template} = 'product.tt';
56         $c->stash->{product} = $c->req->snippets->[0];
57     }
58
59 See also L<Catalyst::Manual::Intro>
60
61 =head1 DESCRIPTION
62
63 Catalyst is based upon L<Maypole>, which you should consider for smaller
64 projects.
65
66 The key concept of Catalyst is DRY (Don't Repeat Yourself).
67
68 See L<Catalyst::Manual> for more documentation.
69
70 Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
71 Omit the C<Catalyst::Plugin::> prefix from the plugin name,
72 so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
73
74     use Catalyst 'My::Module';
75
76 Special flags like -Debug and -Engine can also be specifed as arguments when
77 Catalyst is loaded:
78
79     use Catalyst qw/-Debug My::Module/;
80
81 The position of plugins and flags in the chain is important, because they are
82 loaded in exactly the order that they appear.
83
84 The following flags are supported:
85
86 =over 4
87
88 =item -Debug
89
90 enables debug output, i.e.:
91
92     use Catalyst '-Debug';
93
94 this is equivalent to:
95
96     use Catalyst;
97     sub debug { 1 }
98
99 =item -Engine
100
101 Force Catalyst to use a specific engine.
102 Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
103
104     use Catalyst '-Engine=CGI';
105
106 =back
107
108 =head1 METHODS
109
110 =over 4
111
112 =item debug
113
114 Overload to enable debug messages.
115
116 =cut
117
118 sub debug { 0 }
119
120 =item config
121
122 Returns a hashref containing your applications settings.
123
124 =cut
125
126 sub import {
127     my ( $self, @options ) = @_;
128     my $caller = caller(0);
129
130     # Prepare inheritance
131     unless ( $caller->isa($self) ) {
132         no strict 'refs';
133         push @{"$caller\::ISA"}, $self;
134     }
135
136     if ( $caller->engine ) {
137         return;    # Catalyst is already initialized
138     }
139
140     unless ( $caller->log ) {
141         $caller->log( Catalyst::Log->new );
142     }
143
144     # Debug?
145     if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($caller) . '_DEBUG' } ) {
146         no strict 'refs';
147         *{"$caller\::debug"} = sub { 1 };
148         $caller->log->debug('Debug messages enabled');
149     }
150
151     my $engine     = 'Catalyst::Engine::CGI';
152     my $dispatcher = 'Catalyst::Dispatcher';
153
154     # Detect mod_perl
155     if ( $ENV{MOD_PERL} ) {
156
157         require mod_perl;
158
159         if ( $ENV{MOD_PERL_API_VERSION} == 2 ) {
160             $engine = 'Catalyst::Engine::Apache::MP20';
161         }
162         elsif ( $mod_perl::VERSION >= 1.99 ) {
163             $engine = 'Catalyst::Engine::Apache::MP19';
164         }
165         else {
166             $engine = 'Catalyst::Engine::Apache::MP13';
167         }
168     }
169
170     $caller->log->info( "You are running an old helper script! "
171           . "Please update your scripts by regenerating the "
172           . "application and copying over the new scripts." )
173       if ( $ENV{CATALYST_SCRIPT_GEN}
174         && (
175             $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Helper::CATALYST_SCRIPT_GEN )
176       );
177
178     # Process options
179     my @plugins;
180     foreach (@options) {
181
182         if (/^\-Debug$/) {
183             next if $caller->debug;
184             no strict 'refs';
185             *{"$caller\::debug"} = sub { 1 };
186             $caller->log->debug('Debug messages enabled');
187         }
188
189         elsif (/^-Dispatcher=(.*)$/) {
190             $dispatcher = "Catalyst::Dispatcher::$1";
191         }
192
193         elsif (/^-Engine=(.*)$/) { $engine = "Catalyst::Engine::$1" }
194         elsif (/^-.*$/) { $caller->log->error(qq/Unknown flag "$_"/) }
195
196         else {
197             my $plugin = "Catalyst::Plugin::$_";
198
199             $plugin->require;
200
201             if ($@) { die qq/Couldn't load plugin "$plugin", "$@"/ }
202             else {
203                 push @plugins, $plugin;
204                 no strict 'refs';
205                 push @{"$caller\::ISA"}, $plugin;
206             }
207         }
208
209     }
210
211     # Plugin table
212     my $t = Text::ASCIITable->new( { hide_HeadRow => 1, hide_HeadLine => 1 } );
213     $t->setCols('Class');
214     $t->setColWidth( 'Class', 75, 1 );
215     $t->addRow($_) for @plugins;
216     $caller->log->debug( 'Loaded plugins', $t->draw )
217       if ( @plugins && $caller->debug );
218
219     # Engine
220     $engine = "Catalyst::Engine::$ENV{CATALYST_ENGINE}"
221       if $ENV{CATALYST_ENGINE};
222
223     $engine->require;
224     die qq/Couldn't load engine "$engine", "$@"/ if $@;
225     {
226         no strict 'refs';
227         push @{"$caller\::ISA"}, $engine;
228     }
229     $caller->engine($engine);
230     $caller->log->debug(qq/Loaded engine "$engine"/) if $caller->debug;
231
232     # Dispatcher
233     $dispatcher = "Catalyst::Dispatcher::$ENV{CATALYST_DISPATCHER}"
234       if $ENV{CATALYST_DISPATCHER};
235
236     $dispatcher->require;
237     die qq/Couldn't load dispatcher "$dispatcher", "$@"/ if $@;
238     {
239         no strict 'refs';
240         push @{"$caller\::ISA"}, $dispatcher;
241     }
242     $caller->dispatcher($dispatcher);
243     $caller->log->debug(qq/Loaded dispatcher "$dispatcher"/) if $caller->debug;
244
245 }
246
247 =item $c->engine
248
249 Contains the engine class.
250
251 =item $c->log
252
253 Contains the logging object.  Unless it is already set Catalyst sets this up with a
254 C<Catalyst::Log> object.  To use your own log class:
255
256     $c->log( MyLogger->new );
257     $c->log->info("now logging with my own logger!");
258
259 Your log class should implement the methods described in the C<Catalyst::Log>
260 man page.
261
262
263 =back
264
265 =head1 LIMITATIONS
266
267 FCGI and mod_perl2 support are considered experimental and may contain bugs.
268
269 You may encounter problems accessing the built in test server on public ip
270 addresses on the internet, thats because of a bug in HTTP::Daemon.
271
272 =head1 SUPPORT
273
274 IRC:
275
276     Join #catalyst on irc.perl.org.
277
278 Mailing-Lists:
279
280     http://lists.rawmode.org/mailman/listinfo/catalyst
281     http://lists.rawmode.org/mailman/listinfo/catalyst-dev
282
283 Web:
284
285     http://catalyst.perl.org
286
287 =head1 SEE ALSO
288
289 =over 4
290
291 =item L<Catalyst::Manual> - The Catalyst Manual
292
293 =item L<Catalyst::Engine> - Core Engine
294
295 =item L<Catalyst::Log> - The Log Class.
296
297 =item L<Catalyst::Request> - The Request Object
298
299 =item L<Catalyst::Response> - The Response Object
300
301 =item L<Catalyst::Test> - The test suite.
302
303 =back
304
305 =head1 AUTHOR
306
307 Sebastian Riedel, C<sri@oook.de>
308
309 =head1 THANK YOU
310
311 Andy Grundman, Andrew Ford, Andrew Ruthven, Christian Hansen,
312 Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
313 Gary Ashton Jones, Jesse Sheidlower, Johan Lindstrom, Marcus Ramberg,
314 Tatsuhiko Miyagawa and all the others who've helped.
315
316 =head1 LICENSE
317
318 This library is free software . You can redistribute it and/or modify it under
319 the same terms as perl itself.
320
321 =cut
322
323 1;