X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst.pm;h=2c6ca19cb7543f6e62ed35a5db42ecb7938d85f5;hp=b3abcafcafc0f795c9b4a7126caac722eeef5d22;hb=e63948476024f865b8e84967ffe71681e90f2a4c;hpb=aa6d250314e92cb95095d771defbbf0cada411e7 diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index b3abcaf..2c6ca19 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -1,18 +1,19 @@ package Catalyst; use strict; -use base 'Catalyst::Base'; +use base qw[ Catalyst::Base Catalyst::Setup ]; use UNIVERSAL::require; use Catalyst::Exception; use Catalyst::Log; use Catalyst::Utils; +use NEXT; use Text::ASCIITable; use Path::Class; our $CATALYST_SCRIPT_GEN = 4; -__PACKAGE__->mk_classdata($_) for qw/dispatcher engine log/; +__PACKAGE__->mk_classdata($_) for qw/arguments dispatcher engine log/; -our $VERSION = '5.24'; +our $VERSION = '5.31'; our @ISA; =head1 NAME @@ -125,94 +126,20 @@ Returns a hashref containing your applications settings. sub import { my ( $class, @arguments ) = @_; + + # We have to limit $class to Catalyst to avoid pushing Catalyst upon every + # callers @ISA. + return unless $class eq 'Catalyst'; + my $caller = caller(0); - # Prepare inheritance - unless ( $caller->isa($class) ) { + unless ( $caller->isa('Catalyst') ) { 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/); - } + $caller->arguments( [ @arguments ] ); + $caller->setup_home; } =item $c->engine @@ -267,208 +194,16 @@ sub plugin { 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 ) { +=back - $plugin = "Catalyst::Plugin::$plugin"; +=head1 CASE SENSITIVITY - $plugin->require; +By default Catalyst is not case sensitive, so C becomes +C. - if ( $@ ) { - Catalyst::Exception->throw( - message => qq/Couldn't load plugin "$plugin", "$@"/ - ); - } +But you can activate case sensitivity with a config parameter. - { - no strict 'refs'; - push @{"$class\::ISA"}, $plugin; - } - } -} - -=back + MyApp->config->{case_sensitive} = 1; =head1 LIMITATIONS