Back out behaviour change in debug logging we don't want, keeping only the addition...

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

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 052c063..58c0505 100644 (file)
--- 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 {
                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AModel%3A%3A&amp;mode=all">models</a>, and
                     <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3AView%3A%3A&amp;mode=all">views</a>;
                     they can save you a lot of work.</p>
-                    <pre><code>script/${prefix}_create.pl -help</code></pre>
+                    <pre><code>script/${prefix}_create.pl --help</code></pre>
                     <p>Also, be sure to check out the vast and growing
                     collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
                     you are likely to find what you need there.
@@ -1743,7 +1759,7 @@ sub finalize {
         $c->finalize_body;
     }
 
-       $c->log_response;
+    $c->log_response;
 
     if ($c->use_stats) {
         my $elapsed = sprintf '%f', $c->stats->elapsed;
@@ -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</log_headers>)
-
 =item * Query keywords (see L<Catalyst::Request/query_keywords>)
 
 =item * Request parameters
@@ -2109,8 +2123,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 +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");
@@ -2137,7 +2151,9 @@ Writes information about the response to the debug logs.  This includes:
 
 =item * Response status code
 
-=item * Response headers (see L</log_headers>)
+=item * Content-Type header (if present)
+
+=item * Content-Length header (if present)
 
 =back
 
@@ -2148,11 +2164,17 @@ sub log_response {
 
     return unless $c->debug;
 
-       my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
-       my $response = $dump->[1];
+    my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these;
+    my $response = $dump->[1];
 
-    $c->log->debug('Response Status: ' . $response->status);
-    $c->log_headers('response', $response->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'
+        )
+    );
 }
 
 =head2 $c->log_request_parameters( query => {}, body => {} )
@@ -2165,12 +2187,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 +2213,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 +2233,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<HTTP::Headers> (either request or response) to the debug logs.
@@ -3116,6 +3147,8 @@ Robert Sedlacek C<< <rs@474.at> >>
 
 sky: Arthur Bergman
 
+szbalint: Balint Szilakszi <szbalint@cpan.org>
+
 t0m: Tomas Doran <bobtfish@bobtfish.net>
 
 Ulf Edvinsson