X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst.pm;h=f9ebe5177cde0caef8856d73eb9715dc593c3578;hb=d87eba4d709c2db0756466df8d8a5137a67ef8f1;hp=61e280339eff1f5f096695573b435a199a64fed4;hpb=41c0e09a56ab8ea4cc2dc249e7989101169189d0;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 61e2803..f9ebe51 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -4,7 +4,7 @@ use Moose; use Moose::Meta::Class (); extends 'Catalyst::Component'; use Moose::Util qw/find_meta/; -use B::Hooks::EndOfScope (); +use namespace::clean -except => 'meta'; use Catalyst::Exception; use Catalyst::Exception::Detach; use Catalyst::Exception::Go; @@ -32,12 +32,14 @@ use Catalyst::EngineLoader; use utf8; use Carp qw/croak carp shortmess/; use Try::Tiny; +use Safe::Isa; use Plack::Middleware::Conditional; use Plack::Middleware::ReverseProxy; use Plack::Middleware::IIS6ScriptNameFix; +use Plack::Middleware::IIS7KeepAliveFix; use Plack::Middleware::LighttpdScriptNameFix; -BEGIN { require 5.008004; } +BEGIN { require 5.008003; } has stack => (is => 'ro', default => sub { [] }); has stash => (is => 'rw', default => sub { {} }); @@ -45,8 +47,34 @@ has state => (is => 'rw', default => 0); has stats => (is => 'rw'); has action => (is => 'rw'); has counter => (is => 'rw', default => sub { {} }); -has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1); -has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1); +has request => ( + is => 'rw', + default => sub { + my $self = shift; + $self->request_class->new($self->_build_request_constructor_args); + }, + lazy => 1, +); +sub _build_request_constructor_args { + my $self = shift; + my %p = ( _log => $self->log ); + $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp; + \%p; +} + +has response => ( + is => 'rw', + default => sub { + my $self = shift; + $self->response_class->new($self->_build_response_constructor_args); + }, + lazy => 1, +); +sub _build_response_constructor_args { + my $self = shift; + { _log => $self->log }; +} + has namespace => (is => 'rw'); sub depth { scalar @{ shift->stack || [] }; } @@ -74,7 +102,7 @@ our $GO = Catalyst::Exception::Go->new; __PACKAGE__->mk_classdata($_) for qw/container arguments dispatcher engine log dispatcher_class engine_loader context_class request_class response_class stats_class - setup_finished _psgi_app loading_psgi_file/; + setup_finished _psgi_app loading_psgi_file run_options/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); __PACKAGE__->request_class('Catalyst::Request'); @@ -83,7 +111,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.90005'; +our $VERSION = '5.90017'; sub import { my ( $class, @arguments ) = @_; @@ -115,6 +143,13 @@ sub import { } $caller->arguments( [@arguments] ); + + # FIXME + # what is this for? + # we call setup_home on import AND on ->setup + # is there a reason for it? + # anyway there is no point for setup_home without setup_config() so... + $caller->setup_config; $caller->setup_home; } @@ -129,6 +164,8 @@ sub MODIFY_CODE_ATTRIBUTES { sub _application { $_[0] } +=encoding UTF-8 + =head1 NAME Catalyst - The Elegant MVC Web Application Framework @@ -366,8 +403,12 @@ When called with no arguments it escapes the processing chain entirely. sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) } +=head2 $c->visit( $action [, \@arguments ] ) + =head2 $c->visit( $action [, \@captures, \@arguments ] ) +=head2 $c->visit( $class, $method, [, \@arguments ] ) + =head2 $c->visit( $class, $method, [, \@captures, \@arguments ] ) Almost the same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, @@ -396,8 +437,12 @@ transfer control to another action as if it had been reached directly from a URL sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) } +=head2 $c->go( $action [, \@arguments ] ) + =head2 $c->go( $action [, \@captures, \@arguments ] ) +=head2 $c->go( $class, $method, [, \@arguments ] ) + =head2 $c->go( $class, $method, [, \@captures, \@arguments ] ) The relationship between C and @@ -975,11 +1020,20 @@ EOF if ( $class->debug and - my $comps = $class->container->get_all_components($class) + my $comps = $class->container->get_all_component_services($class) ) { my $column_width = Catalyst::Utils::term_width() - 8 - 9; - my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] ); - $t->row( $_ => ref($comps->{$_}) ? 'instance' : 'class' ) for keys %$comps; + my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Lifecycle' ] ); + + # FIXME + # I don't really know what we're going to show here + while (my ($class, $info) = each %$comps) { + my $lifecycle = $info->{backcompat_service} + ? $info->{backcompat_service}->lifecycle + : $info->{service}->lifecycle + ; + $t->row( $class, $lifecycle ); + } $class->log->debug( "Loaded components:\n" . $t->draw . "\n" ); } @@ -991,29 +1045,6 @@ EOF $class->log->info("$name powered by Catalyst $Catalyst::VERSION"); } - # Make sure that the application class becomes immutable at this point, - B::Hooks::EndOfScope::on_scope_end { - return if $@; - my $meta = Class::MOP::get_metaclass_by_name($class); - if ( - $meta->is_immutable - && ! { $meta->immutable_options }->{replace_constructor} - && ( - $class->isa('Class::Accessor::Fast') - || $class->isa('Class::Accessor') - ) - ) { - warn "You made your application class ($class) immutable, " - . "but did not inline the\nconstructor. " - . "This will break catalyst, as your app \@ISA " - . "Class::Accessor(::Fast)?\nPlease pass " - . "(replace_constructor => 1)\nwhen making your class immutable.\n"; - } - $meta->make_immutable( - replace_constructor => 1, - ) unless $meta->is_immutable; - }; - if ($class->config->{case_sensitive}) { $class->log->warn($class . "->config->{case_sensitive} is set."); $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81."); @@ -1096,7 +1127,7 @@ path, use C<< $c->uri_for_action >> instead. sub uri_for { my ( $c, $path, @args ) = @_; - if (blessed($path) && $path->isa('Catalyst::Controller')) { + if ( $path->$_isa('Catalyst::Controller') ) { $path = $path->path_prefix; $path =~ s{/+\z}{}; $path .= '/'; @@ -1113,7 +1144,7 @@ sub uri_for { $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; } - if ( blessed($path) ) { # action object + if ( $path->$_isa('Catalyst::Action') ) { # action object s|/|%2F|g for @args; my $captures = [ map { s|/|%2F|g; $_; } ( scalar @args && ref $args[0] eq 'ARRAY' @@ -1224,11 +1255,12 @@ to interpolate all the parameters in the URI. =item @args? -Optional list of extra arguments - can be supplied in the C<< \@captures_and_args? >> -array ref, or here - whichever is easier for your code.. +Optional list of extra arguments - can be supplied in the +C<< \@captures_and_args? >> array ref, or here - whichever is easier for your +code. -If your action may have a zero, a fixed or a variable number of args (e.g. C<< Args(1) >> -for a fixed number or C<< Args() >> for a variable number).. +Your action can have zero, a fixed or a variable number of args (e.g. +C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number).. =item \%query_values? @@ -1359,18 +1391,18 @@ sub welcome_message { We do, however, provide you with a few starting points.

If you want to jump right into web development with Catalyst you might want to start with a tutorial.

-
perldoc Catalyst::Manual::Tutorial
+
perldoc Catalyst::Manual::Tutorial
 

 
Afterwards you can go on to check out a more complete look at our features.

 
-perldoc Catalyst::Manual::Intro
+perldoc Catalyst::Manual::Intro
 
 

                  
What to do next?

                  
Next it's time to write an actual application. Use the
-                    helper scripts to generate controllers,
-                    models, and
-                    views;
+                    helper scripts to generate controllers,
+                    models, and
+                    views;
                     they can save you a lot of work.

                     
script/${prefix}_create.pl --help

                     
Also, be sure to check out the vast and growing
@@ -1403,6 +1435,16 @@ sub welcome_message {
 EOF
 }
 
+=head2 run_options
+
+Contains a hash of options passed from the application script, including
+the original ARGV the script received, the processed values from that
+ARGV and any extra arguments to the script which were not processed.
+
+This can be used to add custom options to your application's scripts
+and setup your application differently depending on the values of these
+options.
+
 =head1 INTERNAL METHODS
 
 These methods are not meant to be used by end users.
@@ -1624,7 +1666,7 @@ sub finalize {
             $c->finalize_error;
         }
 
-        $c->finalize_headers;
+        $c->finalize_headers unless $c->response->finalized_headers;
 
         # HEAD request
         if ( $c->request->method eq 'HEAD' ) {
@@ -1734,7 +1776,7 @@ EOF
 
     $c->finalize_cookies;
 
-    $c->engine->finalize_headers( $c, @_ );
+    $c->response->finalize_headers();
 
     # Done
     $response->finalized_headers(1);
@@ -1820,6 +1862,11 @@ etc.).
 
 =cut
 
+has _uploadtmp => (
+    is => 'ro',
+    predicate => '_has_uploadtmp',
+);
+
 sub prepare {
     my ( $class, @arguments ) = @_;
 
@@ -1828,10 +1875,9 @@ sub prepare {
     # into the application.
     $class->context_class( ref $class || $class ) unless $class->context_class;
 
-    my $c = $class->context_class->new({});
+    my $uploadtmp = $class->config->{uploadtmp};
+    my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()});
 
-    # For on-demand data
-    $c->request->_context($c);
     $c->response->_context($c);
 
     #surely this is not the most efficient way to do things...
@@ -1849,8 +1895,8 @@ sub prepare {
             $c->prepare_request(@arguments);
             $c->prepare_connection;
             $c->prepare_query_parameters;
-            $c->prepare_headers;
-            $c->prepare_cookies;
+            $c->prepare_headers; # Just hooks, no longer needed - they just
+            $c->prepare_cookies; # cause the lazy attribute on req to build
             $c->prepare_path;
 
             # Prepare the body for reading, either by prepare_body
@@ -1862,6 +1908,7 @@ sub prepare {
                 $c->prepare_body;
             }
         }
+        $c->prepare_action;
     }
     # VERY ugly and probably shouldn't rely on ->finalize actually working
     catch {
@@ -1869,19 +1916,19 @@ sub prepare {
         $c->response->status(400);
         $c->response->content_type('text/plain');
         $c->response->body('Bad Request');
+        # Note we call finalize and then die here, which escapes
+        # finalize being called in the enclosing block..
+        # It in fact couldn't be called, as we don't return $c..
+        # This is a mess - but I'm unsure you can fix this without
+        # breaking compat for people doing crazy things (we should set
+        # the 400 and just return the ctx here IMO, letting finalize get called
+        # above...
         $c->finalize;
         die $_;
     };
 
-    my $method  = $c->req->method  || '';
-    my $path    = $c->req->path;
-    $path       = '/' unless length $path;
-    my $address = $c->req->address || '';
-
     $c->log_request;
 
-    $c->prepare_action;
-
     return $c;
 }
 
@@ -1942,24 +1989,28 @@ Prepares connection.
 
 sub prepare_connection {
     my $c = shift;
-    $c->engine->prepare_connection( $c, @_ );
+    # XXX - This is called on the engine (not the request) to maintain
+    #       Engine::PSGI back compat.
+    $c->engine->prepare_connection($c);
 }
 
 =head2 $c->prepare_cookies
 
-Prepares cookies.
+Prepares cookies by ensuring that the attribute on the request
+object has been built.
 
 =cut
 
-sub prepare_cookies { my $c = shift; $c->engine->prepare_cookies( $c, @_ ) }
+sub prepare_cookies { my $c = shift; $c->request->cookies }
 
 =head2 $c->prepare_headers
 
-Prepares headers.
+Prepares request headers by ensuring that the attribute on the request
+object has been built.
 
 =cut
 
-sub prepare_headers { my $c = shift; $c->engine->prepare_headers( $c, @_ ) }
+sub prepare_headers { my $c = shift; $c->request->headers }
 
 =head2 $c->prepare_parameters
 
@@ -2242,7 +2293,7 @@ $c->request.  You must handle all body parsing yourself.
 
 =cut
 
-sub read { my $c = shift; return $c->engine->read( $c, @_ ) }
+sub read { my $c = shift; return $c->request->read( @_ ) }
 
 =head2 $c->run
 
@@ -2252,11 +2303,35 @@ Starts the engine.
 
 sub run {
   my $app = shift;
+  $app->_make_immutable_if_needed;
   $app->engine_loader->needs_psgi_engine_compat_hack ?
     $app->engine->run($app, @_) :
       $app->engine->run( $app, $app->_finalized_psgi_app, @_ );
 }
 
+sub _make_immutable_if_needed {
+    my $class = shift;
+    my $meta = Class::MOP::get_metaclass_by_name($class);
+    my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor');
+    if (
+        $meta->is_immutable
+        && ! { $meta->immutable_options }->{replace_constructor}
+        && $isa_ca
+    ) {
+        warn("You made your application class ($class) immutable, "
+            . "but did not inline the\nconstructor. "
+            . "This will break catalyst, as your app \@ISA "
+            . "Class::Accessor(::Fast)?\nPlease pass "
+            . "(replace_constructor => 1)\nwhen making your class immutable.\n");
+    }
+    unless ($meta->is_immutable) {
+        # XXX - FIXME warning here as you should make your app immutable yourself.
+        $meta->make_immutable(
+            replace_constructor => 1,
+        );
+    }
+}
+
 =head2 $c->set_action( $action, $code, $namespace, $attrs )
 
 Sets an action in a given namespace.
@@ -2292,7 +2367,7 @@ sub setup_config {
         $container_class = Class::MOP::load_first_existing_class("${class}::Container", 'Catalyst::IOC::Container');
     }
 
-    my $container = $container_class->new( %args, application_name => "$class", name => "$class" );
+    my $container = $container_class->new( %args, name => $class );
     $class->container($container);
 
     my $config = $container->resolve( service => 'config' );
@@ -2419,7 +2494,7 @@ sub setup_engine {
 
         $meta->add_method(handler => sub {
             my $r = shift;
-            my $psgi_app = $class->psgi_app;
+            my $psgi_app = $class->_finalized_psgi_app;
             $apache->call_app($r, $psgi_app);
         });
 
@@ -2510,13 +2585,32 @@ sub apply_default_middlewares {
 
     # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME
     # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html
-    $psgi_app = Plack::Middleware::LighttpdScriptNameFix->wrap($psgi_app);
+    $psgi_app = Plack::Middleware::Conditional->wrap(
+        $psgi_app,
+        builder   => sub { Plack::Middleware::LighttpdScriptNameFix->wrap($_[0]) },
+        condition => sub {
+            my ($env) = @_;
+            return unless $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!lighttpd[-/]1\.(\d+\.\d+)!;
+            return unless $1 < 4.23;
+            1;
+        },
+    );
 
     # we're applying this unconditionally as the middleware itself already makes
     # sure it doesn't fuck things up if it's not running under one of the right
     # IIS versions
     $psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app);
 
+    # And another IIS issue, this time with IIS7.
+    $psgi_app = Plack::Middleware::Conditional->wrap(
+        $psgi_app,
+        builder => sub { Plack::Middleware::IIS7KeepAliveFix->wrap($_[0]) },
+        condition => sub {
+            my ($env) = @_;
+            return $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!IIS/7\.[0-9]!;
+        },
+    );
+
     return $psgi_app;
 }
 
@@ -2543,18 +2637,19 @@ Sets up the home directory.
 =cut
 
 sub setup_home {
-    my ( $class, $home ) = @_;
-
-    if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) {
-        $home = $env;
-    }
+    my ( $class, $home_flag ) = @_;
 
-    $home ||= Catalyst::Utils::home($class);
+    my $home = $class->container->resolve(
+        service    => 'home',
+        parameters => {
+            home_flag => $home_flag
+        },
+    );
 
     if ($home) {
         #I remember recently being scolded for assigning config values like this
         $class->config->{home} ||= $home;
-        $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root');
+        $class->config->{root} ||= $class->container->resolve(service => 'root_dir');
     }
 }
 
@@ -2655,11 +2750,16 @@ the plugin name does not begin with C.
         Class::MOP::load_class( $plugin );
         $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" )
             if $plugin->isa( 'Catalyst::Component' );
-        $proto->_plugins->{$plugin} = 1;
-        unless ($instant) {
+        my $plugin_meta = Moose::Meta::Class->create($plugin);
+        if (!$plugin_meta->has_method('new')
+            && ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) {
+            $plugin_meta->add_method('new', Moose::Object->meta->get_method('new'))
+        }
+        if (!$instant && !$proto->_plugins->{$plugin}) {
             my $meta = Class::MOP::get_metaclass_by_name($class);
             $meta->superclasses($plugin, $meta->superclasses);
         }
+        $proto->_plugins->{$plugin} = 1;
         return $class;
     }
 
@@ -2741,10 +2841,10 @@ your output data, if known.
 sub write {
     my $c = shift;
 
-    # Finalize headers if someone manually writes output
+    # Finalize headers if someone manually writes output (for compat)
     $c->finalize_headers;
 
-    return $c->engine->write( $c, @_ );
+    return $c->response->write( @_ );
 }
 
 =head2 version
@@ -2910,7 +3010,26 @@ headers.
 
 If you do not wish to use the proxy support at all, you may set:
 
-    MyApp->config(ignore_frontend_proxy => 1);
+    MyApp->config(ignore_frontend_proxy => 0);
+
+=head2 Note about psgi files
+
+Note that if you supply your own .psgi file, calling
+C<< MyApp->psgi_app(@_); >>, then B.
+
+You either need to apply L yourself
+in your psgi, for example:
+
+    builder {
+        enable "Plack::Middleware::ReverseProxy";
+        MyApp->psgi_app
+    };
+
+This will unconditionally add the ReverseProxy support, or you need to call
+C<< $app = MyApp->apply_default_middlewares($app) >> (to conditionally
+apply the support depending upon your config).
+
+See L for more information.
 
 =head1 THREAD SAFETY
 
@@ -2959,8 +3078,6 @@ Wiki:
 
 =head2 L - The test suite.
 
-=begin stopwords
-
 =head1 PROJECT FOUNDER
 
 sri: Sebastian Riedel 
@@ -3105,8 +3222,6 @@ rainboxx: Matthias Dietrich, C
 
 dd070: Dhaval Dhanani 
 
-=end stopwords
-
 =head1 COPYRIGHT
 
 Copyright (c) 2005, the above named PROJECT FOUNDER and CONTRIBUTORS.