clean up logging and debug output, minor doc fixes

diff --git a/Changes b/Changes
index 544b913..2ef55bd 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 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

diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm
index 247a79d..c894fed 100644 (file)
--- a/lib/Catalyst.pm
+++ b/lib/Catalyst.pm
@@ -795,7 +795,7 @@ EOF
         }
 
         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 );
         }
@@ -827,7 +827,7 @@ EOF
     $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 );
@@ -870,7 +870,7 @@ sub uri_for {
     my $namespace = $c->namespace || '';
 
     # massage namespace, empty if absolute path
-    $namespace =~ s/^\///;
+    $namespace =~ s/^\/// if $namespace;
     $namespace .= '/' if $namespace;
     $path ||= '';
     $namespace = '' if $path =~ /^\//;
@@ -931,7 +931,6 @@ sub welcome_message {
                 text-align: left;
                 background-color: #ccc;
                 border: 1px solid #aaa;
-                -moz-border-radius: 10px;
             }
             p, h1, h2 {
                 margin-left: 20px;
@@ -961,7 +960,6 @@ sub welcome_message {
                 margin: 10px;
                 background-color: #fff;
                 border: 1px solid #aaa;
-                -moz-border-radius: 10px;
             }
             h1 {
                 font-size: 0.9em;
@@ -1280,7 +1278,7 @@ sub finalize {
 
     # Allow engine to handle finalize flow (for POE)
     if ( $c->engine->can('finalize') ) {
-        $c->engine->finalize( $c );
+        $c->engine->finalize($c);
     }
     else {
 
@@ -1443,7 +1441,7 @@ sub handle_request {
             $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 {
@@ -1521,9 +1519,8 @@ sub prepare {
     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 );
     }
 
@@ -1544,7 +1541,7 @@ sub prepare {
     }
 
     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"/)
@@ -1581,7 +1578,7 @@ sub prepare_body {
     $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 : '';
@@ -1675,7 +1672,7 @@ sub prepare_query_parameters {
     $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 : '';
@@ -1715,8 +1712,8 @@ sub prepare_uploads {
 
     if ( $c->debug && keys %{ $c->request->uploads } ) {
         my $t = Text::SimpleTable->new(
-            [ 12, 'Key' ],
-            [ 28, 'Filename' ],
+            [ 12, 'Parameter' ],
+            [ 26, 'Filename' ],
             [ 18, 'Type' ],
             [ 9,  'Size' ]
         );

diff --git a/lib/Catalyst/DispatchType/Path.pm b/lib/Catalyst/DispatchType/Path.pm
index d887a13..7f32b61 100644 (file)
--- a/lib/Catalyst/DispatchType/Path.pm
+++ b/lib/Catalyst/DispatchType/Path.pm
@@ -25,7 +25,7 @@ Debug output for Path dispatch points
 
 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 '/';

diff --git a/lib/Catalyst/DispatchType/Regex.pm b/lib/Catalyst/DispatchType/Regex.pm
index 4a27801..a32dfa5 100644 (file)
--- a/lib/Catalyst/DispatchType/Regex.pm
+++ b/lib/Catalyst/DispatchType/Regex.pm
@@ -24,7 +24,7 @@ Output a table of all regex actions, and their private equivalent.
 
 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" );
@@ -73,7 +73,7 @@ Returns 1 on if any regexps were registered.
 
 sub register {
     my ( $self, $c, $action ) = @_;
-    my $attrs = $action->attributes;
+    my $attrs    = $action->attributes;
     my @register = @{ $attrs->{'Regex'} || [] };
 
     foreach my $r (@register) {

diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm
index c4e4dd0..96dc2ad 100644 (file)
--- a/lib/Catalyst/Dispatcher.pm
+++ b/lib/Catalyst/Dispatcher.pm
@@ -292,11 +292,11 @@ sub get_action {
     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 ) = @_;
@@ -442,7 +442,7 @@ sub setup_actions {
 
     my $privates = Text::SimpleTable->new(
         [ 20, 'Private' ],
-        [ 38, 'Class' ],
+        [ 36, 'Class' ],
         [ 12, 'Method' ]
     );
 

diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm
index 2082f59..80ff49f 100644 (file)
--- a/lib/Catalyst/Engine.pm
+++ b/lib/Catalyst/Engine.pm
@@ -40,7 +40,7 @@ Finalize body.  Prints the response output.
 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 );
@@ -93,7 +93,7 @@ sub finalize_error {
     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 ) {
@@ -120,9 +120,9 @@ sub finalize_error {
         # 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;
@@ -180,13 +180,13 @@ EOF
         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;
@@ -194,30 +194,26 @@ EOF
             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;
@@ -317,7 +313,8 @@ sub prepare_body {
 
     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 ) {
@@ -327,9 +324,10 @@ sub prepare_body {
 
         # 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 );
         }
     }
 }
@@ -578,6 +576,13 @@ sub write {
     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

diff --git a/lib/Catalyst/Log.pm b/lib/Catalyst/Log.pm
index de7a447..24b7931 100644 (file)
--- a/lib/Catalyst/Log.pm
+++ b/lib/Catalyst/Log.pm
@@ -63,16 +63,14 @@ sub disable {
 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 {

diff --git a/lib/Catalyst/Manual/About.pod b/lib/Catalyst/Manual/About.pod
index 40eec28..4625eaf 100644 (file)
--- a/lib/Catalyst/Manual/About.pod
+++ b/lib/Catalyst/Manual/About.pod
@@ -1,6 +1,6 @@
 =head1 NAME
 
-Catalyst::Manual::About - Basic explanation of Catalyst
+Catalyst::Manual::About - The philosophy of Catalyst
 
 =head1 DESCRIPTION
 

diff --git a/lib/Catalyst/Manual/Tutorial.pod b/lib/Catalyst/Manual/Tutorial.pod
index 0e44645..ef0db08 100644 (file)
--- a/lib/Catalyst/Manual/Tutorial.pod
+++ b/lib/Catalyst/Manual/Tutorial.pod
@@ -43,15 +43,15 @@ Catalyst provides:
     $ 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                                 |
     +--------------------------------------+---------------------------------------+
@@ -91,12 +91,10 @@ http://localhost:3000/ with your browser.
 
 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      |
     +------------------------------------------------------------------+-----------+

diff --git a/script/catalyst.pl b/script/catalyst.pl
index 85d30c9..34a6f94 100755 (executable)
--- a/script/catalyst.pl
+++ b/script/catalyst.pl
@@ -3,7 +3,8 @@
 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;
@@ -21,12 +22,14 @@ GetOptions(
 
 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;

diff --git a/t/unit_core_log.t b/t/unit_core_log.t
index ff7e8a4..bc167b1 100644 (file)
--- a/t/unit_core_log.t
+++ b/t/unit_core_log.t
@@ -4,7 +4,6 @@ use warnings;
 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 {
@@ -37,13 +36,14 @@ can_ok $log, "_flush";
 $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;
@@ -69,6 +69,6 @@ $log->_flush;
 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';