This file documents the revision history for Perl extension Catalyst.
+ - cleaned up logging and debug output
+ - minor doc fixes
- Added warning for setup being called twice
- Fix pod to use DBIC::Schema instead of DBIC model
- Fix ->config failing to copy _config for subclassing
}
if (@plugins) {
- my $t = Text::SimpleTable->new(76);
+ my $t = Text::SimpleTable->new(74);
$t->row($_) for @plugins;
$class->log->debug( "Loaded plugins:\n" . $t->draw );
}
$class->setup_components;
if ( $class->debug ) {
- my $t = Text::SimpleTable->new( [ 65, 'Class' ], [ 8, 'Type' ] );
+ my $t = Text::SimpleTable->new( [ 63, 'Class' ], [ 8, 'Type' ] );
for my $comp ( sort keys %{ $class->components } ) {
my $type = ref $class->components->{$comp} ? 'instance' : 'class';
$t->row( $comp, $type );
my $namespace = $c->namespace || '';
# massage namespace, empty if absolute path
- $namespace =~ s/^\///;
+ $namespace =~ s/^\/// if $namespace;
$namespace .= '/' if $namespace;
$path ||= '';
$namespace = '' if $path =~ /^\//;
text-align: left;
background-color: #ccc;
border: 1px solid #aaa;
- -moz-border-radius: 10px;
}
p, h1, h2 {
margin-left: 20px;
margin: 10px;
background-color: #fff;
border: 1px solid #aaa;
- -moz-border-radius: 10px;
}
h1 {
font-size: 0.9em;
# Allow engine to handle finalize flow (for POE)
if ( $c->engine->can('finalize') ) {
- $c->engine->finalize( $c );
+ $c->engine->finalize($c);
}
else {
$elapsed = sprintf '%f', $elapsed;
my $av = sprintf '%.3f',
( $elapsed == 0 ? '??' : ( 1 / $elapsed ) );
- my $t = Text::SimpleTable->new( [ 64, 'Action' ], [ 9, 'Time' ] );
+ my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
$stats->traverse(
sub {
if ( $c->debug ) {
my $secs = time - $START || 1;
my $av = sprintf '%.3f', $COUNT / $secs;
- $c->log->debug('**********************************');
- $c->log->debug("* Request $COUNT ($av/s) [$$]");
- $c->log->debug('**********************************');
+ my $time = localtime time;
+ $c->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***");
$c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
}
}
my $method = $c->req->method || '';
- my $path = $c->req->path || '';
+ my $path = $c->req->path || '/';
my $address = $c->req->address || '';
$c->log->debug(qq/"$method" request for "$path" from "$address"/)
$c->prepare_uploads;
if ( $c->debug && keys %{ $c->req->body_parameters } ) {
- my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
+ my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
for my $key ( sort keys %{ $c->req->body_parameters } ) {
my $param = $c->req->body_parameters->{$key};
my $value = defined($param) ? $param : '';
$c->engine->prepare_query_parameters( $c, @_ );
if ( $c->debug && keys %{ $c->request->query_parameters } ) {
- my $t = Text::SimpleTable->new( [ 37, 'Key' ], [ 36, 'Value' ] );
+ my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ 36, 'Value' ] );
for my $key ( sort keys %{ $c->req->query_parameters } ) {
my $param = $c->req->query_parameters->{$key};
my $value = defined($param) ? $param : '';
if ( $c->debug && keys %{ $c->request->uploads } ) {
my $t = Text::SimpleTable->new(
- [ 12, 'Key' ],
- [ 28, 'Filename' ],
+ [ 12, 'Parameter' ],
+ [ 26, 'Filename' ],
[ 18, 'Type' ],
[ 9, 'Size' ]
);
sub list {
my ( $self, $c ) = @_;
- my $paths = Text::SimpleTable->new( [ 36, 'Path' ], [ 37, 'Private' ] );
+ my $paths = Text::SimpleTable->new( [ 35, 'Path' ], [ 36, 'Private' ] );
for my $path ( sort keys %{ $self->{paths} } ) {
my $action = $self->{paths}->{$path};
$path = "/$path" unless $path eq '/';
sub list {
my ( $self, $c ) = @_;
- my $re = Text::SimpleTable->new( [ 36, 'Regex' ], [ 37, 'Private' ] );
+ my $re = Text::SimpleTable->new( [ 35, 'Regex' ], [ 36, 'Private' ] );
for my $regex ( @{ $self->{compiled} } ) {
my $action = $regex->{action};
$re->row( $regex->{path}, "/$action" );
sub register {
my ( $self, $c, $action ) = @_;
- my $attrs = $action->attributes;
+ my $attrs = $action->attributes;
my @register = @{ $attrs->{'Regex'} || [] };
foreach my $r (@register) {
return $self->action_hash->{"$namespace/$name"};
}
-=head2 $self->get_action_by_path( $path );
+=head2 $self->get_action_by_path( $path );
+
+Returns the named action by its full path.
-returns the named action by it's full path.
-
-=cut
+=cut
sub get_action_by_path {
my ( $self, $path ) = @_;
my $privates = Text::SimpleTable->new(
[ 20, 'Private' ],
- [ 38, 'Class' ],
+ [ 36, 'Class' ],
[ 12, 'Method' ]
);
sub finalize_body {
my ( $self, $c ) = @_;
my $body = $c->response->body;
- if ( ref $body && ($body->can('read') || ref($body) eq 'GLOB') ) {
+ if ( ref $body && ( $body->can('read') || ref($body) eq 'GLOB' ) ) {
while ( !eof $body ) {
read $body, my ($buffer), $CHUNKSIZE;
last unless $self->write( $c, $buffer );
my ( $self, $c ) = @_;
$c->res->content_type('text/html; charset=utf-8');
- my $name = $c->config->{name} || 'Catalyst Application';
+ my $name = $c->config->{name} || join(' ', split('::', ref $c));
my ( $title, $error, $infos );
if ( $c->debug ) {
# Don't show response header state in dump
delete $c->res->{_finalized_headers};
- my $req = encode_entities Dumper $c->req;
- my $res = encode_entities Dumper $c->res;
- my $stash = encode_entities Dumper $c->stash;
+ my $req = _fixup_debug_info($c->req);
+ my $res = _fixup_debug_info($c->res);
+ my $stash = _fixup_debug_info($c->stash);
my @infos;
my $i = 0;
body {
font-family: "Bitstream Vera Sans", "Trebuchet MS", Verdana,
Tahoma, Arial, helvetica, sans-serif;
- color: #ddd;
+ color: #333;
background-color: #eee;
margin: 0px;
padding: 0px;
}
:link, :link:hover, :visited, :visited:hover {
- color: #ddd;
+ color: #000;
}
div.box {
position: relative;
border: 1px solid #aaa;
padding: 4px;
margin: 10px;
- -moz-border-radius: 10px;
}
div.error {
- background-color: #977;
+ background-color: #cce;
border: 1px solid #755;
padding: 8px;
margin: 4px;
margin-bottom: 10px;
- -moz-border-radius: 10px;
}
div.infos {
- background-color: #797;
+ background-color: #eee;
border: 1px solid #575;
padding: 8px;
margin: 4px;
margin-bottom: 10px;
- -moz-border-radius: 10px;
}
div.name {
- background-color: #779;
+ background-color: #cce;
border: 1px solid #557;
padding: 8px;
margin: 4px;
- -moz-border-radius: 10px;
}
code.error {
display: block;
unless ( $c->request->{_body} ) {
$c->request->{_body} = HTTP::Body->new( $type, $self->read_length );
- $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp} if exists $c->config->{uploadtmp};
+ $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp}
+ if exists $c->config->{uploadtmp};
}
if ( $self->read_length > 0 ) {
# paranoia against wrong Content-Length header
my $remaining = $self->read_length - $self->read_position;
- if ($remaining > 0) {
+ if ( $remaining > 0 ) {
$self->finalize_read($c);
- Catalyst::Exception->throw("Wrong Content-Length value: ". $self->read_length);
+ Catalyst::Exception->throw(
+ "Wrong Content-Length value: " . $self->read_length );
}
}
}
print STDOUT $buffer;
}
+sub _fixup_debug_info {
+ my $info = encode_entities Dumper shift;
+ my @info = split "\n", $info;
+ pop @info; shift @info;
+ return join "\n",@info;
+}
+
=head2 $self->finalize_output
<obsolete>, see finalize_body
sub _dump {
my $self = shift;
local $Data::Dumper::Terse = 1;
- $self->info( Dumper( @_ ) );
+ $self->info( Dumper(@_) );
}
sub _log {
my $self = shift;
my $level = shift;
- my $time = localtime(time);
my $message = join( "\n", @_ );
- $self->{body} .=
- sprintf( "[%s] [catalyst] [%s] %s\n", $time, $level, $message );
+ $self->{body} .= sprintf( "[%s] %s\n", $level, $message );
}
sub _flush {
=head1 NAME
-Catalyst::Manual::About - Basic explanation of Catalyst
+Catalyst::Manual::About - The philosophy of Catalyst
=head1 DESCRIPTION
$ cd tutorial
$ script/tutorial_server.pl
- [...] [catalyst] [debug] Debug messages enabled
- [...] [catalyst] [debug] Loaded plugins:
+ [debug] Debug messages enabled
+ [debug] Loaded plugins:
.------------------------------------------------------------------------------.
| Catalyst::Plugin::Static::Simple |
'------------------------------------------------------------------------------'
- [...] [catalyst] [debug] Loaded dispatcher "Catalyst::Dispatcher"
- [...] [catalyst] [debug] Loaded engine "Catalyst::Engine::HTTP"
- [...] [catalyst] [debug] Found home "/home/users/me/tutorial"
- [...] [catalyst] [debug] Loaded Private actions:
+ [debug] Loaded dispatcher "Catalyst::Dispatcher"
+ [debug] Loaded engine "Catalyst::Engine::HTTP"
+ [debug] Found home "/home/users/me/tutorial"
+ [debug] Loaded Private actions:
.--------------------------------------+---------------------------------------.
| Private | Class |
+--------------------------------------+---------------------------------------+
More trace messages will appear in the original terminal window:
- [...] [catalyst] [debug] **********************************
- [...] [catalyst] [debug] * Request 1 (0.063/s) [2148]
- [...] [catalyst] [debug] **********************************
- [...] [catalyst] [debug] Arguments are ""
- [...] [catalyst] [debug] "GET" request for "" from localhost
- [...] [catalyst] [info] Request took 0.046883s (21.330/s)
+ [debug] *** Request 1 (0.063/s) [2148]
+ [debug] Arguments are ""
+ [debug] "GET" request for "/" from localhost
+ [info] Request took 0.046883s (21.330/s)
.------------------------------------------------------------------+-----------.
| Action | Time |
+------------------------------------------------------------------+-----------+
use strict;
use Getopt::Long;
use Pod::Usage;
-use Catalyst::Helper;
+eval 'use Catalyst::Helper "1.0";';
+die "Please install Catalyst::Helper!\n" if $@;
my $force = 0;
my $help = 0;
pod2usage(1) if ( $help || !$ARGV[0] );
-my $helper = Catalyst::Helper->new( {
- '.newfiles' => !$force,
- 'makefile' => $makefile,
- 'scripts' => $scripts,
- 'short' => $short,
-} );
+my $helper = Catalyst::Helper->new(
+ {
+ '.newfiles' => !$force,
+ 'makefile' => $makefile,
+ 'scripts' => $scripts,
+ 'short' => $short,
+ }
+);
pod2usage(1) unless $helper->mk_app( $ARGV[0] );
1;
use Test::More tests => 24;
use Test::NoWarnings; # Adds an extra test.
-my $timestamp = '\[\w{3}\s\w{3}\s[ 123]\d\s\d{2}:\d{2}:\d{2}\s\d{4}\]';
my $LOG;
BEGIN {
$log->_flush;
ok @MESSAGES, '... and flushing the log should succeed';
is scalar @MESSAGES, 1, '... with one log message';
-like $MESSAGES[0], qr/^$timestamp \[catalyst\] \[info\] hello there!$/,
+like $MESSAGES[0], qr/^\[info\] hello there!$/,
'... which should match the format we expect';
{
package Catalyst::Log::Subclass;
- our @ISA = 'Catalyst::Log';
+ use Moose;
+ extends 'Catalyst::Log';
sub _send_to_log {
my $self = shift;
ok @MESSAGES, '... and flushing the log should succeed';
is scalar @MESSAGES, 2, '... with two log messages';
is $MESSAGES[0], '---', '... with the first one being our new data';
-like $MESSAGES[1], qr/^$timestamp \[catalyst\] \[info\] hi there!$/,
+like $MESSAGES[1], qr/^\[info\] hi there!$/,
'... which should match the format we expect';