X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst.pm;h=b742de064eefb8e427a0dfac49e65623305348f8;hb=f0e9921a9b807f883f868d95ec2ea2975669305c;hp=41663596644526c07219c49d2ce038091f48a8cf;hpb=47c65f37099eb8285df31aed6dee1f27ba2c799a;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 4166359..b742de0 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -78,7 +78,7 @@ __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.80020'; +our $VERSION = '5.80021'; our $PRETTY_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -640,7 +640,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 +680,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 +739,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 ); @@ -1500,7 +1516,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. @@ -2092,8 +2108,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 @@ -2118,7 +2132,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,35 +2145,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( - 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' - ) - ); -} +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 => {} ) @@ -2217,6 +2256,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. @@ -2230,7 +2278,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 ) = @_; @@ -3122,6 +3171,8 @@ Robert Sedlacek C<< >> sky: Arthur Bergman +szbalint: Balint Szilakszi + t0m: Tomas Doran Ulf Edvinsson