[catagits/Catalyst-Runtime.git] / lib / Catalyst.pm

package Catalyst;

use strict;
use base 'Catalyst::Base';
use UNIVERSAL::require;
use Catalyst::Exception;
use Catalyst::Log;
use Catalyst::Utils;
use Text::ASCIITable;
use Path::Class;
our $CATALYST_SCRIPT_GEN = 4;

__PACKAGE__->mk_classdata($_) for qw/dispatcher engine log/;

our $VERSION = '5.24';
our @ISA;

=head1 NAME

Catalyst - The Elegant MVC Web Application Framework

=head1 SYNOPSIS

    # use the helper to start a new application
    catalyst.pl MyApp
    cd MyApp

    # add models, views, controllers
    script/myapp_create.pl model Something
    script/myapp_create.pl view Stuff
    script/myapp_create.pl controller Yada

    # built in testserver
    script/myapp_server.pl

    # command line interface
    script/myapp_test.pl /yada


    use Catalyst;

    use Catalyst qw/My::Module My::OtherModule/;

    use Catalyst '-Debug';

    use Catalyst qw/-Debug -Engine=CGI/;

    sub default : Private { $_[1]->res->output('Hello') } );

    sub index : Path('/index.html') {
        my ( $self, $c ) = @_;
        $c->res->output('Hello');
        $c->forward('foo');
    }

    sub product : Regex('^product[_]*(\d*).html$') {
        my ( $self, $c ) = @_;
        $c->stash->{template} = 'product.tt';
        $c->stash->{product} = $c->req->snippets->[0];
    }

See also L<Catalyst::Manual::Intro>

=head1 DESCRIPTION

The key concept of Catalyst is DRY (Don't Repeat Yourself).

See L<Catalyst::Manual> for more documentation.

Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
Omit the C<Catalyst::Plugin::> prefix from the plugin name,
so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.

    use Catalyst 'My::Module';

Special flags like -Debug and -Engine can also be specifed as arguments when
Catalyst is loaded:

    use Catalyst qw/-Debug My::Module/;

The position of plugins and flags in the chain is important, because they are
loaded in exactly the order that they appear.

The following flags are supported:

=over 4

=item -Debug

enables debug output, i.e.:

    use Catalyst '-Debug';

this is equivalent to:

    use Catalyst;
    sub debug { 1 }

=item -Engine

Force Catalyst to use a specific engine.
Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:

    use Catalyst '-Engine=CGI';

=back

=head1 METHODS

=over 4

=item debug

Overload to enable debug messages.

=cut

sub debug { 0 }

=item config

Returns a hashref containing your applications settings.

=cut

sub import {
    my ( $class, @arguments ) = @_;
    my $caller = caller(0);

    # Prepare inheritance
    unless ( $caller->isa($class) ) {
        no strict 'refs';
        push @{"$caller\::ISA"}, $class;
    }

    if ( $caller->engine ) {

        unless ( $caller eq 'main' ) {
            $caller->log->warn( qq/Attempt to re-initialize "$caller"/ );
        }

        return;
    }

    # Process options
    my $flags = { };

    foreach (@arguments) {

        if ( /^-Debug$/ ) {
            $flags->{log} = 1
        }
        elsif (/^-(\w+)=?(.*)$/) {
            $flags->{ lc $1 } = $2;
        }
        else {
            push @{ $flags->{plugins} }, $_;
        }
    }

    $caller->setup_log        ( delete $flags->{log}        );
    $caller->setup_plugins    ( delete $flags->{plugins}    );
    $caller->setup_dispatcher ( delete $flags->{dispatcher} );
    $caller->setup_engine     ( delete $flags->{engine}     );
    $caller->setup_home       ( delete $flags->{home}       );

    for my $flag ( sort keys %{ $flags } ) {

        if ( my $code = $caller->can( 'setup_' . $flag ) ) {
            &$code( $caller, delete $flags->{$flag} );
        }
        else {
            $caller->log->warn(qq/Unknown flag "$flag"/);
        }
    }

    $caller->log->warn( "You are running an old helper script! "
          . "Please update your scripts by regenerating the "
          . "application and copying over the new scripts." )
      if ( $ENV{CATALYST_SCRIPT_GEN}
        && ( $ENV{CATALYST_SCRIPT_GEN} < $CATALYST_SCRIPT_GEN ) );


    if ( $caller->debug ) {

        my @plugins = ();

        {
            no strict 'refs';
            @plugins = grep { /^Catalyst::Plugin/ } @{"$caller\::ISA"};
        }

        if ( @plugins ) {
            my $t = Text::ASCIITable->new;
            $t->setOptions( 'hide_HeadRow',  1 );
            $t->setOptions( 'hide_HeadLine', 1 );
            $t->setCols('Class');
            $t->setColWidth( 'Class', 75, 1 );
            $t->addRow($_) for @plugins;
            $caller->log->debug( 'Loaded plugins', $t->draw );
        }

        my $dispatcher = $caller->dispatcher;
        my $engine     = $caller->engine;
        my $home       = $caller->config->{home};

        $caller->log->debug(qq/Loaded dispatcher "$dispatcher"/);
        $caller->log->debug(qq/Loaded engine "$engine"/);

        $home
          ? ( -d $home )
          ? $caller->log->debug(qq/Found home "$home"/)
          : $caller->log->debug(qq/Home "$home" doesn't exist/)
          : $caller->log->debug(q/Couldn't find home/);
    }
}

=item $c->engine

Contains the engine class.

=item $c->log

Contains the logging object.  Unless it is already set Catalyst sets this up with a
C<Catalyst::Log> object.  To use your own log class:

    $c->log( MyLogger->new );
    $c->log->info("now logging with my own logger!");

Your log class should implement the methods described in the C<Catalyst::Log>
man page.

=item $c->plugin( $name, $class, @args )

Instant plugins for Catalyst.
Classdata accessor/mutator will be created, class loaded and instantiated.

    MyApp->plugin( 'prototype', 'HTML::Prototype' );

    $c->prototype->define_javascript_functions;

=cut

sub plugin {
    my ( $class, $name, $plugin, @args ) = @_;
    $plugin->require;

    if ( my $error = $UNIVERSAL::require::ERROR ) {
        Catalyst::Exception->throw(
            message => qq/Couldn't load instant plugin "$plugin", "$error"/
        );
    }

    eval { $plugin->import };
    $class->mk_classdata($name);
    my $obj;
    eval { $obj = $plugin->new(@args) };

    if ( $@ ) {
        Catalyst::Exception->throw(
            message => qq/Couldn't instantiate instant plugin "$plugin", "$@"/
        );
    }

    $class->$name($obj);
    $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/)
      if $class->debug;
}

=item $c->setup_dispatcher

=cut

sub setup_dispatcher {
    my ( $class, $dispatcher ) = @_;

    if ( $dispatcher ) {
        $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
    }

    if ( $ENV{CATALYST_DISPATCHER} ) {
        $dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
    }

    if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
        $dispatcher = 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
    }

    unless ( $dispatcher ) {
        $dispatcher = 'Catalyst::Dispatcher';
    }

    $dispatcher->require;

    if ( $@ ) {
        Catalyst::Exception->throw(
            message => qq/Couldn't load dispatcher "$dispatcher", "$@"/
        );
    }

    {
        no strict 'refs';
        push @{"$class\::ISA"}, $dispatcher;
    }

    $class->dispatcher($dispatcher);
}

=item $c->setup_engine

=cut

sub setup_engine {
    my ( $class, $engine ) = @_;

    if ( $engine ) {
        $engine = 'Catalyst::Engine::' . $engine;
    }

    if ( $ENV{CATALYST_ENGINE} ) {
        $engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
    }

    if ( $ENV{ uc($class) . '_ENGINE' } ) {
        $engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
    }

    if ( ! $engine && $ENV{MOD_PERL} ) {

        my ( $software, $version ) = $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;

        $version =~ s/_//g;
        $version =~ s/(\.[^.]+)\./$1/g;

        if ( $software eq 'mod_perl') {

            if ( $version >= 1.99922 ) {

                $engine = 'Catalyst::Engine::Apache::MP20';

                if ( Apache2::Request->require ) {
                    $engine = 'Catalyst::Engine::Apache::MP20::Apreq';
                }
            }

            elsif ( $version >= 1.9901 ) {

                $engine = 'Catalyst::Engine::Apache::MP19';

                if ( Apache::Request->require ) {
                    $engine = 'Catalyst::Engine::Apache::MP19::Apreq';
                }
            }

            elsif ( $version >= 1.24 ) {

                $engine = 'Catalyst::Engine::Apache::MP13';

                if ( Apache::Request->require ) {
                    $engine = 'Catalyst::Engine::Apache::MP13::Apreq';
                }
            }

            else {
                Catalyst::Exception->throw(
                    message => qq/Unsupported mod_perl version: $ENV{MOD_PERL}/
                );
            }
        }

        elsif ( $software eq 'Zeus-Perl' ) {
            $engine = 'Catalyst::Engine::Zeus';
        }

        else {
            Catalyst::Exception->throw(
                message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/
            );
        }
    }

    unless ( $engine ) {
        $engine = 'Catalyst::Engine::CGI';
    }

    $engine->require;

    if ( $@ ) {
        Catalyst::Exception->throw(
            message => qq/Couldn't load engine "$engine", "$@"/
        );
    }

    {
        no strict 'refs';
        push @{"$class\::ISA"}, $engine;
    }

    $class->engine($engine);
}

=item $c->setup_home

=cut

sub setup_home {
    my ( $class, $home ) = @_;

    if ( $ENV{CATALYST_HOME} ) {
        $home = $ENV{CATALYST_HOME};
    }

    if ( $ENV{ uc($class) . '_HOME' } ) {
        $home = $ENV{ uc($class) . '_HOME' };
    }

    unless ( $home ) {
        $home = Catalyst::Utils::home($class);
    }

    if ( $home ) {
        $class->config->{home} = $home;
        $class->config->{root} = dir($home)->subdir('root');
    }
}

=item $c->setup_log

=cut

sub setup_log {
    my ( $class, $debug ) = @_;

    unless ( $class->log ) {
        $class->log( Catalyst::Log->new );
    }

    if ( $ENV{CATALYST_DEBUG} || $ENV{ uc($class) . '_DEBUG' } || $debug ) {
        no strict 'refs';
        *{"$class\::debug"} = sub { 1 };
        $class->log->debug('Debug messages enabled');
    }
}

=item $c->setup_plugins

=cut

sub setup_plugins {
    my ( $class, $plugins ) = @_;

    for my $plugin ( @$plugins ) {

        $plugin = "Catalyst::Plugin::$plugin";

        $plugin->require;

        if ( $@ ) {
            Catalyst::Exception->throw(
                message => qq/Couldn't load plugin "$plugin", "$@"/
            );
        }

        {
            no strict 'refs';
            push @{"$class\::ISA"}, $plugin;
        }
    }
}

=back

=head1 LIMITATIONS

mod_perl2 support is considered experimental and may contain bugs.

=head1 SUPPORT

IRC:

    Join #catalyst on irc.perl.org.

Mailing-Lists:

    http://lists.rawmode.org/mailman/listinfo/catalyst
    http://lists.rawmode.org/mailman/listinfo/catalyst-dev

Web:

    http://catalyst.perl.org

=head1 SEE ALSO

=over 4

=item L<Catalyst::Manual> - The Catalyst Manual

=item L<Catalyst::Engine> - Core Engine

=item L<Catalyst::Log> - The Log Class.

=item L<Catalyst::Request> - The Request Object

=item L<Catalyst::Response> - The Response Object

=item L<Catalyst::Test> - The test suite.

=back

=head1 AUTHOR

Sebastian Riedel, C<sri@oook.de>

=head1 THANK YOU

Andy Grundman, Andrew Ford, Andrew Ruthven, Autrijus Tang, Christian Hansen,
Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
Gary Ashton Jones, Geoff Richards, Jesse Sheidlower, Jody Belka,
Johan Lindstrom, Juan Camacho, Leon Brocard, Marcus Ramberg,
Tatsuhiko Miyagawa and all the others who've helped.

=head1 LICENSE

This library is free software . You can redistribute it and/or modify it under
the same terms as perl itself.

=cut

1;
Commit	Line	Data
fc7ec1d9	1	package Catalyst;
	2
	3	use strict;
ac733264	4	use base 'Catalyst::Base';
fc7ec1d9	5	use UNIVERSAL::require;
a2f2cde9	6	use Catalyst::Exception;
fc7ec1d9	7	use Catalyst::Log;
812a28c9	8	use Catalyst::Utils;
0f7ecc53	9	use Text::ASCIITable;
4f6748f1	10	use Path::Class;
367d15f8	11	our $CATALYST_SCRIPT_GEN = 4;
fc7ec1d9	12
424b2705	13	__PACKAGE__->mk_classdata($_) for qw/dispatcher engine log/;
fc7ec1d9	14
abddf0b5	15	our $VERSION = '5.24';
fc7ec1d9	16	our @ISA;
	17
	18	=head1 NAME
	19
	20	Catalyst - The Elegant MVC Web Application Framework
	21
	22	=head1 SYNOPSIS
	23
	24	# use the helper to start a new application
91864987	25	catalyst.pl MyApp
fc7ec1d9	26	cd MyApp
	27
	28	# add models, views, controllers
ae4e40a7	29	script/myapp_create.pl model Something
	30	script/myapp_create.pl view Stuff
	31	script/myapp_create.pl controller Yada
fc7ec1d9	32
fc7ec1d9	33	# built in testserver
ae4e40a7	34	script/myapp_server.pl
fc7ec1d9	35
fc7ec1d9	36	# command line interface
ae4e40a7	37	script/myapp_test.pl /yada
fc7ec1d9	38
fc7ec1d9	39
fc7ec1d9	40	use Catalyst;
	41
	42	use Catalyst qw/My::Module My::OtherModule/;
	43
	44	use Catalyst '-Debug';
	45
	46	use Catalyst qw/-Debug -Engine=CGI/;
	47
5a8ed4fe	48	sub default : Private { $_[1]->res->output('Hello') } );
5a8ed4fe	49
e3dc9d78	50	sub index : Path('/index.html') {
5a8ed4fe	51	my ( $self, $c ) = @_;
5a8ed4fe	52	$c->res->output('Hello');
064834ea	53	$c->forward('foo');
5a8ed4fe	54	}
5a8ed4fe	55
064834ea	56	sub product : Regex('^product[_](\d).html$') {
5a8ed4fe	57	my ( $self, $c ) = @_;
	58	$c->stash->{template} = 'product.tt';
	59	$c->stash->{product} = $c->req->snippets->[0];
	60	}
fc7ec1d9	61
3803e98f	62	See also L<Catalyst::Manual::Intro>
3803e98f	63
fc7ec1d9	64	=head1 DESCRIPTION
fc7ec1d9	65
fc7ec1d9	66	The key concept of Catalyst is DRY (Don't Repeat Yourself).
	67
	68	See L<Catalyst::Manual> for more documentation.
	69
23f9d934	70	Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement.
1985c30b	71	Omit the C<Catalyst::Plugin::> prefix from the plugin name,
23f9d934	72	so C<Catalyst::Plugin::My::Module> becomes C<My::Module>.
fc7ec1d9	73
	74	use Catalyst 'My::Module';
	75
23f9d934	76	Special flags like -Debug and -Engine can also be specifed as arguments when
23f9d934	77	Catalyst is loaded:
fc7ec1d9	78
	79	use Catalyst qw/-Debug My::Module/;
	80
23f9d934	81	The position of plugins and flags in the chain is important, because they are
23f9d934	82	loaded in exactly the order that they appear.
fc7ec1d9	83
23f9d934	84	The following flags are supported:
	85
	86	=over 4
	87
	88	=item -Debug
	89
	90	enables debug output, i.e.:
fc7ec1d9	91
	92	use Catalyst '-Debug';
	93
23f9d934	94	this is equivalent to:
fc7ec1d9	95
	96	use Catalyst;
	97	sub debug { 1 }
	98
23f9d934	99	=item -Engine
fc7ec1d9	100
fc7ec1d9	101	Force Catalyst to use a specific engine.
23f9d934	102	Omit the C<Catalyst::Engine::> prefix of the engine name, i.e.:
fc7ec1d9	103
	104	use Catalyst '-Engine=CGI';
	105
23f9d934	106	=back
fc7ec1d9	107
23f9d934	108	=head1 METHODS
	109
	110	=over 4
	111
	112	=item debug
fc7ec1d9	113
	114	Overload to enable debug messages.
	115
	116	=cut
	117
	118	sub debug { 0 }
	119
23f9d934	120	=item config
fc7ec1d9	121
	122	Returns a hashref containing your applications settings.
	123
	124	=cut
	125
fc7ec1d9	126	sub import {
0319a12c	127	my ( $class, @arguments ) = @_;
fc7ec1d9	128	my $caller = caller(0);
fc7ec1d9	129
99fe1710	130	# Prepare inheritance
0319a12c	131	unless ( $caller->isa($class) ) {
fc7ec1d9	132	no strict 'refs';
0319a12c	133	push @{"$caller\::ISA"}, $class;
1c99e125	134	}
1c99e125	135
d96e14c2	136	if ( $caller->engine ) {
aa6d2503	137
	138	unless ( $caller eq 'main' ) {
	139	$caller->log->warn( qq/Attempt to re-initialize "$caller"/ );
	140	}
	141
0319a12c	142	return;
d96e14c2	143	}
d96e14c2	144
0319a12c	145	# Process options
	146	my $flags = { };
	147
	148	foreach (@arguments) {
	149
	150	if ( /^-Debug$/ ) {
	151	$flags->{log} = 1
	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', $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/);
fc7ec1d9	215	}
0319a12c	216	}
	217
	218	=item $c->engine
	219
	220	Contains the engine class.
fc7ec1d9	221
0319a12c	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	=item $c->setup_dispatcher
	271
	272	=cut
	273
	274	sub setup_dispatcher {
	275	my ( $class, $dispatcher ) = @_;
	276
	277	if ( $dispatcher ) {
	278	$dispatcher = 'Catalyst::Dispatcher::' . $dispatcher;
	279	}
	280
	281	if ( $ENV{CATALYST_DISPATCHER} ) {
	282	$dispatcher = 'Catalyst::Dispatcher::' . $ENV{CATALYST_DISPATCHER};
	283	}
	284
	285	if ( $ENV{ uc($class) . '_DISPATCHER' } ) {
286	$dispatcher = 'Catalyst::Dispatcher::' . $ENV{ uc($class) . '_DISPATCHER' };
287	}
288
289	unless ( $dispatcher ) {
290	$dispatcher = 'Catalyst::Dispatcher';
291	}
292
293	$dispatcher->require;
294
295	if ( $@ ) {
296	Catalyst::Exception->throw(
297	message => qq/Couldn't load dispatcher "$dispatcher", "$@"/
298	);
299	}
300
301	{
1985c30b	302	no strict 'refs';
0319a12c	303	push @{"$class\::ISA"}, $dispatcher;
1985c30b	304	}
1985c30b	305
0319a12c	306	$class->dispatcher($dispatcher);
	307	}
	308
	309	=item $c->setup_engine
	310
	311	=cut
	312
	313	sub setup_engine {
	314	my ( $class, $engine ) = @_;
	315
	316	if ( $engine ) {
	317	$engine = 'Catalyst::Engine::' . $engine;
	318	}
6dc87a0f	319
0319a12c	320	if ( $ENV{CATALYST_ENGINE} ) {
	321	$engine = 'Catalyst::Engine::' . $ENV{CATALYST_ENGINE};
	322	}
	323
	324	if ( $ENV{ uc($class) . '_ENGINE' } ) {
	325	$engine = 'Catalyst::Engine::' . $ENV{ uc($class) . '_ENGINE' };
	326	}
	327
	328	if ( ! $engine && $ENV{MOD_PERL} ) {
6dc87a0f	329
316bf0f0	330	my ( $software, $version ) = $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
	331
	332	$version =~ s/_//g;
	333	$version =~ s/(\.[^.]+)\./$1/g;
	334
	335	if ( $software eq 'mod_perl') {
	336
	337	if ( $version >= 1.99922 ) {
	338
	339	$engine = 'Catalyst::Engine::Apache::MP20';
	340
	341	if ( Apache2::Request->require ) {
566ee5d7	342	$engine = 'Catalyst::Engine::Apache::MP20::Apreq';
316bf0f0	343	}
	344	}
	345
	346	elsif ( $version >= 1.9901 ) {
	347
	348	$engine = 'Catalyst::Engine::Apache::MP19';
	349
	350	if ( Apache::Request->require ) {
566ee5d7	351	$engine = 'Catalyst::Engine::Apache::MP19::Apreq';
316bf0f0	352	}
	353	}
	354
	355	elsif ( $version >= 1.24 ) {
	356
	357	$engine = 'Catalyst::Engine::Apache::MP13';
	358
	359	if ( Apache::Request->require ) {
566ee5d7	360	$engine = 'Catalyst::Engine::Apache::MP13::Apreq';
316bf0f0	361	}
316bf0f0	362	}
d837e1a7	363
316bf0f0	364	else {
a2f2cde9	365	Catalyst::Exception->throw(
	366	message => qq/Unsupported mod_perl version: $ENV{MOD_PERL}/
	367	);
316bf0f0	368	}
6dc87a0f	369	}
d837e1a7	370
316bf0f0	371	elsif ( $software eq 'Zeus-Perl' ) {
316bf0f0	372	$engine = 'Catalyst::Engine::Zeus';
6dc87a0f	373	}
d837e1a7	374
d837e1a7	375	else {
a2f2cde9	376	Catalyst::Exception->throw(
	377	message => qq/Unsupported mod_perl: $ENV{MOD_PERL}/
	378	);
d837e1a7	379	}
6dc87a0f	380	}
1985c30b	381
0319a12c	382	unless ( $engine ) {
0319a12c	383	$engine = 'Catalyst::Engine::CGI';
424b2705	384	}
e8bf1b2d	385
e8bf1b2d	386	$engine->require;
0319a12c	387
a2f2cde9	388	if ( $@ ) {
	389	Catalyst::Exception->throw(
	390	message => qq/Couldn't load engine "$engine", "$@"/
	391	);
	392	}
d837e1a7	393
e8bf1b2d	394	{
e8bf1b2d	395	no strict 'refs';
0319a12c	396	push @{"$class\::ISA"}, $engine;
e8bf1b2d	397	}
d837e1a7	398
0319a12c	399	$class->engine($engine);
0319a12c	400	}
895b2303	401
0319a12c	402	=item $c->setup_home
895b2303	403
0319a12c	404	=cut
895b2303	405
0319a12c	406	sub setup_home {
0319a12c	407	my ( $class, $home ) = @_;
895b2303	408
0319a12c	409	if ( $ENV{CATALYST_HOME} ) {
0319a12c	410	$home = $ENV{CATALYST_HOME};
895b2303	411	}
895b2303	412
0319a12c	413	if ( $ENV{ uc($class) . '_HOME' } ) {
	414	$home = $ENV{ uc($class) . '_HOME' };
	415	}
895b2303	416
0319a12c	417	unless ( $home ) {
0319a12c	418	$home = Catalyst::Utils::home($class);
895b2303	419	}
0319a12c	420
	421	if ( $home ) {
	422	$class->config->{home} = $home;
	423	$class->config->{root} = dir($home)->subdir('root');
4f6748f1	424	}
fc7ec1d9	425	}
fc7ec1d9	426
0319a12c	427	=item $c->setup_log
70cb38f0	428
0319a12c	429	=cut
70cb38f0	430
0319a12c	431	sub setup_log {
0319a12c	432	my ( $class, $debug ) = @_;
145074c2	433
0319a12c	434	unless ( $class->log ) {
	435	$class->log( Catalyst::Log->new );
	436	}
145074c2	437
0319a12c	438	if ( $ENV{CATALYST_DEBUG} \|\| $ENV{ uc($class) . '_DEBUG' } \|\| $debug ) {
	439	no strict 'refs';
	440	*{"$class\::debug"} = sub { 1 };
	441	$class->log->debug('Debug messages enabled');
	442	}
	443	}
145074c2	444
0319a12c	445	=item $c->setup_plugins
145074c2	446
0319a12c	447	=cut
87232381	448
0319a12c	449	sub setup_plugins {
0319a12c	450	my ( $class, $plugins ) = @_;
87232381	451
0319a12c	452	for my $plugin ( @$plugins ) {
87232381	453
0319a12c	454	$plugin = "Catalyst::Plugin::$plugin";
87232381	455
0319a12c	456	$plugin->require;
87232381	457
0319a12c	458	if ( $@ ) {
	459	Catalyst::Exception->throw(
	460	message => qq/Couldn't load plugin "$plugin", "$@"/
	461	);
	462	}
a2f2cde9	463
0319a12c	464	{
	465	no strict 'refs';
	466	push @{"$class\::ISA"}, $plugin;
	467	}
a2f2cde9	468	}
87232381	469	}
145074c2	470
23f9d934	471	=back
23f9d934	472
d1a31ac6	473	=head1 LIMITATIONS
d1a31ac6	474
b2b7d352	475	mod_perl2 support is considered experimental and may contain bugs.
d1a31ac6	476
3cb1db8c	477	=head1 SUPPORT
	478
	479	IRC:
	480
	481	Join #catalyst on irc.perl.org.
	482
	483	Mailing-Lists:
	484
	485	http://lists.rawmode.org/mailman/listinfo/catalyst
	486	http://lists.rawmode.org/mailman/listinfo/catalyst-dev
1985c30b	487
432d507d	488	Web:
	489
	490	http://catalyst.perl.org
	491
fc7ec1d9	492	=head1 SEE ALSO
fc7ec1d9	493
61b1e958	494	=over 4
	495
	496	=item L<Catalyst::Manual> - The Catalyst Manual
	497
	498	=item L<Catalyst::Engine> - Core Engine
	499
	500	=item L<Catalyst::Log> - The Log Class.
	501
	502	=item L<Catalyst::Request> - The Request Object
	503
	504	=item L<Catalyst::Response> - The Response Object
	505
	506	=item L<Catalyst::Test> - The test suite.
	507
	508	=back
fc7ec1d9	509
	510	=head1 AUTHOR
	511
	512	Sebastian Riedel, C<sri@oook.de>
	513
	514	=head1 THANK YOU
	515
84cf74e7	516	Andy Grundman, Andrew Ford, Andrew Ruthven, Autrijus Tang, Christian Hansen,
ce2b098c	517	Christopher Hicks, Dan Sully, Danijel Milicevic, David Naughton,
75aeff23	518	Gary Ashton Jones, Geoff Richards, Jesse Sheidlower, Jody Belka,
9cee9588	519	Johan Lindstrom, Juan Camacho, Leon Brocard, Marcus Ramberg,
9cee9588	520	Tatsuhiko Miyagawa and all the others who've helped.
fc7ec1d9	521
	522	=head1 LICENSE
	523
	524	This library is free software . You can redistribute it and/or modify it under
	525	the same terms as perl itself.
	526
	527	=cut
	528
	529	1;