X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst.pm;h=f51bfb48ba5d8d264980655c8fd865a2827d1835;hb=0a2577a8c5e7fd34a7977ea2fc9267f9f888066d;hp=052c0634eacb98be37873269f6834b08b73ff19d;hpb=e7cbe1bf2a4776f14e0d281a441520d6e6b77fc5;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 052c063..f51bfb4 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -78,10 +78,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.80020'; -our $PRETTY_VERSION = $VERSION; - -$VERSION = eval $VERSION; +our $VERSION = '5.80022'; sub import { my ( $class, @arguments ) = @_; @@ -640,7 +637,13 @@ If you want to search for controllers, pass in a regexp as the argument. sub controller { my ( $c, $name, @args ) = @_; + my $appclass = ref($c) || $c; if( $name ) { + unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps + my $comps = $c->components; + my $check = $appclass."::Controller::".$name; + return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; + } my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ ); return map { $c->_filter_component( $_, @args ) } @result if ref $name; return $c->_filter_component( $result[ 0 ], @args ); @@ -674,6 +677,11 @@ sub model { my ( $c, $name, @args ) = @_; my $appclass = ref($c) || $c; if( $name ) { + unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps + my $comps = $c->components; + my $check = $appclass."::Model::".$name; + return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; + } my @result = $c->_comp_search_prefixes( $name, qw/Model M/ ); return map { $c->_filter_component( $_, @args ) } @result if ref $name; return $c->_filter_component( $result[ 0 ], @args ); @@ -728,6 +736,11 @@ sub view { my $appclass = ref($c) || $c; if( $name ) { + unless ( ref($name) ) { # Direct component hash lookup to avoid costly regexps + my $comps = $c->components; + my $check = $appclass."::View::".$name; + return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; + } my @result = $c->_comp_search_prefixes( $name, qw/View V/ ); return map { $c->_filter_component( $_, @args ) } @result if ref $name; return $c->_filter_component( $result[ 0 ], @args ); @@ -1146,7 +1159,7 @@ EOF if ( $class->debug ) { my $name = $class->config->{name} || 'Application'; - $class->log->info("$name powered by Catalyst $Catalyst::PRETTY_VERSION"); + $class->log->info("$name powered by Catalyst $Catalyst::VERSION"); } # Make sure that the application class becomes immutable at this point, @@ -1500,7 +1513,7 @@ sub welcome_message { models, and views; they can save you a lot of work.

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

Also, be sure to check out the vast and growing collection of plugins for Catalyst on CPAN; you are likely to find what you need there. @@ -1743,7 +1756,7 @@ sub finalize { $c->finalize_body; } - $c->log_response; + $c->log_response; if ($c->use_stats) { my $elapsed = sprintf '%f', $c->stats->elapsed; @@ -1937,7 +1950,7 @@ sub prepare { #surely this is not the most efficient way to do things... $c->stats($class->stats_class->new)->enable($c->use_stats); - if ( $c->debug ) { + if ( $c->debug || $c->config->{enable_catalyst_header} ) { $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); } @@ -2092,8 +2105,6 @@ Writes information about the request to the debug logs. This includes: =item * Request method, path, and remote IP address -=item * Request headers (see L) - =item * Query keywords (see L) =item * Request parameters @@ -2109,8 +2120,8 @@ sub log_request { return unless $c->debug; - my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these; - my $request = $dump->[1]; + my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these; + my $request = $dump->[1]; my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address ); $method ||= ''; @@ -2118,7 +2129,7 @@ sub log_request { $address ||= ''; $c->log->debug(qq/"$method" request for "$path" from "$address"/); - $c->log_headers('request', $request->headers); + $c->log_request_headers($request->headers); if ( my $keywords = $request->query_keywords ) { $c->log->debug("Query keywords are: $keywords"); @@ -2131,29 +2142,60 @@ sub log_request { =head2 $c->log_response -Writes information about the response to the debug logs. This includes: +Writes information about the response to the debug logs by calling +C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>. + +=cut + +sub log_response { + my $c = shift; + + return unless $c->debug; + + my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these; + my $response = $dump->[1]; + + $c->log_response_status_line($response); + $c->log_response_headers($response->headers); +} + +=head2 $c->log_response_status_line($response) + +Writes one line of information about the response to the debug logs. This includes: =over 4 =item * Response status code -=item * Response headers (see L) +=item * Content-Type header (if present) + +=item * Content-Length header (if present) =back =cut -sub log_response { - my $c = shift; +sub log_response_status_line { + my ($c, $response) = @_; - return unless $c->debug; + $c->log->debug( + sprintf( + 'Response Code: %s; Content-Type: %s; Content-Length: %s', + $response->status || 'unknown', + $response->headers->header('Content-Type') || 'unknown', + $response->headers->header('Content-Length') || 'unknown' + ) + ); +} - my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these; - my $response = $dump->[1]; +=head2 $c->log_response_headers($headers); - $c->log->debug('Response Status: ' . $response->status); - $c->log_headers('response', $response->headers); -} +Hook method which can be wrapped by plugins to log the responseheaders. +No-op in the default implementation. + +=cut + +sub log_response_headers {} =head2 $c->log_request_parameters( query => {}, body => {} ) @@ -2165,12 +2207,12 @@ sub log_request_parameters { my $c = shift; my %all_params = @_; - return unless $c->debug; + return unless $c->debug; my $column_width = Catalyst::Utils::term_width() - 44; foreach my $type (qw(query body)) { - my $params = $all_params{$type}; - next if ! keys %$params; + my $params = $all_params{$type}; + next if ! keys %$params; my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] ); for my $key ( sort keys %$params ) { my $param = $params->{$key}; @@ -2191,7 +2233,7 @@ the debug logs. sub log_request_uploads { my $c = shift; - my $request = shift; + my $request = shift; return unless $c->debug; my $uploads = $request->uploads; if ( keys %$uploads ) { @@ -2211,6 +2253,15 @@ sub log_request_uploads { } } +=head2 $c->log_request_headers($headers); + +Hook method which can be wrapped by plugins to log the request headers. +No-op in the default implementation. + +=cut + +sub log_request_headers {} + =head2 $c->log_headers($type => $headers) Logs L (either request or response) to the debug logs. @@ -2224,7 +2275,8 @@ sub log_headers { return unless $c->debug; - my $t = Text::SimpleTable->new( [ 35, 'Header Name' ], [ 40, 'Value' ] ); + my $column_width = Catalyst::Utils::term_width() - 28; + my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] ); $headers->scan( sub { my ( $name, $value ) = @_; @@ -2356,10 +2408,6 @@ sub setup_components { # we know M::P::O found a file on disk so this is safe Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } ); - - # Needs to be done as soon as the component is loaded, as loading a sub-component - # (next time round the loop) can cause us to get the wrong metaclass.. - $class->_controller_init_base_classes($component); } for my $component (@comps) { @@ -2369,7 +2417,6 @@ sub setup_components { : $class->expand_component_module( $component, $config ); for my $component (@expanded_components) { next if $comps{$component}; - $class->_controller_init_base_classes($component); # Also cover inner packages $class->components->{ $component } = $class->setup_component($component); } } @@ -2422,19 +2469,6 @@ sub expand_component_module { =cut -# FIXME - Ugly, ugly hack to ensure the we force initialize non-moose base classes -# nearest to Catalyst::Controller first, no matter what order stuff happens -# to be loaded. There are TODO tests in Moose for this, see -# f2391d17574eff81d911b97be15ea51080500003 -sub _controller_init_base_classes { - my ($app_class, $component) = @_; - return unless $component->isa('Catalyst::Controller'); - foreach my $class ( reverse @{ mro::get_linear_isa($component) } ) { - Moose::Meta::Class->initialize( $class ) - unless find_meta($class); - } -} - sub setup_component { my( $class, $component ) = @_; @@ -2735,13 +2769,8 @@ the plugin name does not begin with C. if $plugin->isa( 'Catalyst::Component' ); $proto->_plugins->{$plugin} = 1; unless ($instant) { - no strict 'refs'; - if ( my $meta = Class::MOP::get_metaclass_by_name($class) ) { - my @superclasses = ($plugin, $meta->superclasses ); - $meta->superclasses(@superclasses); - } else { - unshift @{"$class\::ISA"}, $plugin; - } + my $meta = Class::MOP::get_metaclass_by_name($class); + $meta->superclasses($plugin, $meta->superclasses); } return $class; } @@ -3116,6 +3145,8 @@ Robert Sedlacek C<< >> sky: Arthur Bergman +szbalint: Balint Szilakszi + t0m: Tomas Doran Ulf Edvinsson