X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst.pm;h=13c813aca0e6dc96150c1b1ff93865840ffaae80;hb=3f7d86f8303cd1d3f1d4ffa04bba510fc3a93d98;hp=052c0634eacb98be37873269f6834b08b73ff19d;hpb=e7cbe1bf2a4776f14e0d281a441520d6e6b77fc5;p=catagits%2FCatalyst-Runtime.git
diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 052c063..13c813a 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;
@@ -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 ) = @_;
@@ -2735,13 +2787,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 +3163,8 @@ Robert Sedlacek C<< >>
sky: Arthur Bergman
+szbalint: Balint Szilakszi
+
t0m: Tomas Doran
Ulf Edvinsson