[Catalyst-commits] r8787 - in Catalyst-Runtime/5.80/trunk: . lib lib/Catalyst lib/Catalyst/Engine lib/Catalyst/Request t

t0m at dev.catalyst.perl.org t0m at dev.catalyst.perl.org
Mon Dec 8 01:11:24 GMT 2008


Author: t0m
Date: 2008-12-08 01:11:23 +0000 (Mon, 08 Dec 2008)
New Revision: 8787

Modified:
   Catalyst-Runtime/5.80/trunk/Changes
   Catalyst-Runtime/5.80/trunk/TODO
   Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/CGI.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/FastCGI.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/HTTP.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/ROADMAP.pod
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request/Upload.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Response.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Stats.pm
   Catalyst-Runtime/5.80/trunk/t/meta_method_unneeded.t
Log:
Do a load of small refatoring to remove direct hash accesses, update todo, bump dates in roadmap - however that needs a proper update

Modified: Catalyst-Runtime/5.80/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.80/trunk/Changes	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/Changes	2008-12-08 01:11:23 UTC (rev 8787)
@@ -1,5 +1,18 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+        - Add a clearer method on request and response _context 
+          attributes, and use if from ::Engine rather than deleting
+          the key from the instance hash (t0m)
+        - Use handles on tree attribute of Catalyst::Stats to replace
+          trivial delegation methods (t0m)
+        - Change the following direct hash accesses into attributes:
+          Catalyst::Engine: _prepared_write
+          Catalyst::Engine::CGI: _header_buf
+          Catalyst::Engine::HTTP: options, _keepalive, _write_error
+          Catalyst::Request: _path
+          Catalyst::Request::Upload: basename
+          Catalyst::Stats: tree
+          (t0m)
         - Fix issues in Catalyst::Controller::WrapCGI 
           and any other components which import (or define) their 
           own meta method by always explicitly calling

Modified: Catalyst-Runtime/5.80/trunk/TODO
===================================================================
--- Catalyst-Runtime/5.80/trunk/TODO	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/TODO	2008-12-08 01:11:23 UTC (rev 8787)
@@ -1,7 +1,7 @@
   - Fix t/caf_backcompat_plugin_accessor_override.t
   
   - meta-method.diff test for MX::Emulate::CAF needed by 
-    ::Plugin::Cache::Curried
+    Catalyst::Plugin::Cache::Curried
 
   - Common engine test failures, look into and get tests into core.
 
@@ -20,14 +20,20 @@
     - After that set up attr handlers that will output helpful error messages 
       when you do it as well as how to fix it. (done already?)
   
-  - Comments marked /Moose TODO/i in the code
+  - Comments marked /Moose TODO/i in Catalyst::Request re {_body}
   
-  - Eliminate all instances of $instance->{$key}
+  - Eliminate all instances of $instance->{$key}, I think the only thing
+    left is lib/Catalyst/Engine/HTTP.pm: $self->{inputbuf}, which I haven't
+    touched as it is used as an lvalue in a lot of places.
 
-  - Catalyst-Log-Log4perl - deep recursion in the test suite, investigate
+  - Catalyst-Log-Log4perl - deep recursion in the test suite, investigate. 
 
   - Profiling vs 5.70 and optimisation as needed.
 
   - http://lists.scsys.co.uk/pipermail/catalyst-dev/2008-November/001546.html
     - patch to list, andyg to look at?
 
+  - Fix the Roadmap to be less full of lies.
+  
+  - Run another round of repository smokes against latest 5.80 trunk, manually
+    go through all the things which are broken.

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/CGI.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/CGI.pm	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/CGI.pm	2008-12-08 01:11:23 UTC (rev 8787)
@@ -4,6 +4,7 @@
 extends 'Catalyst::Engine';
 
 has env => (is => 'rw');
+has _header_buf => (is => 'rw', clearer => '_clear_header_buf', predicate => '_has_header_buf');
 
 =head1 NAME
 
@@ -41,8 +42,7 @@
 
     $c->response->header( Status => $c->response->status );
 
-    $self->{_header_buf} 
-        = $c->response->headers->as_string("\015\012") . "\015\012";
+    $self->_header_buf($c->response->headers->as_string("\015\012") . "\015\012");
 }
 
 =head2 $self->prepare_connection($c)
@@ -216,8 +216,8 @@
     my ( $self, $c, $buffer ) = @_;
 
     # Prepend the headers if they have not yet been sent
-    if ( my $headers = delete $self->{_header_buf} ) {
-        $buffer = $headers . $buffer;
+    if ( $self->_has_header_buf ) {
+        $buffer = $self->_clear_header_buf . $buffer;
     }
 
     return $self->$orig( $c, $buffer );

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/FastCGI.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/FastCGI.pm	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/FastCGI.pm	2008-12-08 01:11:23 UTC (rev 8787)
@@ -159,9 +159,9 @@
 sub write {
     my ( $self, $c, $buffer ) = @_;
 
-    unless ( $self->{_prepared_write} ) {
+    unless ( $self->_prepared_write ) {
         $self->prepare_write($c);
-        $self->{_prepared_write} = 1;
+        $self->_prepared_write(1);
     }
     
     # XXX: We can't use Engine's write() method because syswrite
@@ -169,8 +169,8 @@
     # written: http://www.fastcgi.com/om_archive/mail-archive/0128.html
     
     # Prepend the headers if they have not yet been sent
-    if ( my $headers = delete $self->{_header_buf} ) {
-        $buffer = $headers . $buffer;
+    if ( $self->_has_header_buf ) {
+        $buffer = $self->_clear_header_buf . $buffer;
     }
 
     # FastCGI does not stream data properly if using 'print $handle',

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/HTTP.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/HTTP.pm	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/HTTP.pm	2008-12-08 01:11:23 UTC (rev 8787)
@@ -19,6 +19,10 @@
 use constant CHUNKSIZE => 64 * 1024;
 use constant DEBUG     => $ENV{CATALYST_HTTP_DEBUG} || 0;
 
+has options => ( is => 'rw' );
+has _keepalive => ( is => 'rw', predicate => '_is_keepalive', clearer => '_clear_keepalive' );
+has _write_error => ( is => 'rw', predicate => '_has_write_error' );
+
 use namespace::clean -except => [qw/meta/];
 
 =head1 NAME
@@ -64,12 +68,12 @@
 
     # Should we keep the connection open?
     my $connection = $c->request->header('Connection');
-    if (   $self->{options}->{keepalive} 
+    if (   $self->options->{keepalive} 
         && $connection 
         && $connection =~ /^keep-alive$/i
     ) {
         $res_headers->header( Connection => 'keep-alive' );
-        $self->{_keepalive} = 1;
+        $self->_keepalive(1);
     }
     else {
         $res_headers->header( Connection => 'close' );
@@ -79,7 +83,7 @@
 
     # Buffer the headers so they are sent with the first write() call
     # This reduces the number of TCP packets we are sending
-    $self->{_header_buf} = join("\x0D\x0A", @headers, '');
+    $self->_header_buf( join("\x0D\x0A", @headers, '') );
 }
 
 =head2 $self->finalize_read($c)
@@ -149,14 +153,14 @@
     return unless *STDOUT->opened();
 
     # Prepend the headers if they have not yet been sent
-    if ( my $headers = delete $self->{_header_buf} ) {
-        $buffer = $headers . $buffer;
+    if ( $self->_has_header_buf ) {
+        $buffer = $self->_clear_header_buf . $buffer;
     }
 
     my $ret = $self->$orig($c, $buffer);
 
     if ( !defined $ret ) {
-        $self->{_write_error} = $!;
+        $self->_write_error($!);
         DEBUG && warn "write: Failed to write response ($!)\n";
     }
     else {
@@ -176,7 +180,7 @@
 
     $options ||= {};
     
-    $self->{options} = $options;
+    $self->options($options);
 
     if ($options->{background}) {
         my $child = fork;
@@ -280,7 +284,7 @@
 
                 $self->_handler( $class, $port, $method, $uri, $protocol );
             
-                if ( my $error = delete $self->{_write_error} ) {
+                if ( $self->_has_write_error ) {
                     close Remote;
                     
                     if ( !defined $pid ) {
@@ -378,7 +382,8 @@
     
         # Allow keepalive requests, this is a hack but we'll support it until
         # the next major release.
-        if ( delete $self->{_keepalive} ) {
+        if ( $self->_is_keepalive ) {
+            $self->_clear_keepalive;
             
             DEBUG && warn "Reusing previous connection for keep-alive request\n";
             
@@ -523,6 +528,11 @@
 
 no Moose;
 
+=head2 options
+
+Options hash passed to the http engine to control things like if keepalive
+is supported.
+
 =head1 SEE ALSO
 
 L<Catalyst>, L<Catalyst::Engine>

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine.pm	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine.pm	2008-12-08 01:11:23 UTC (rev 8787)
@@ -16,6 +16,8 @@
 has read_length => (is => 'rw');
 has read_position => (is => 'rw');
 
+has _prepared_write => (is => 'rw');
+
 no Moose;
 
 # Amount of data to read from input on each pass
@@ -123,8 +125,8 @@
         $name  = "<h1>$name</h1>";
 
         # Don't show context in the dump
-        delete $c->req->{_context};
-        delete $c->res->{_context};
+        $c->req->_clear_context;
+        $c->res->_clear_context;
 
         # Don't show body parser in the dump
         delete $c->req->{_body};
@@ -618,9 +620,9 @@
 sub write {
     my ( $self, $c, $buffer ) = @_;
 
-    unless ( $self->{_prepared_write} ) {
+    unless ( $self->_prepared_write ) {
         $self->prepare_write($c);
-        $self->{_prepared_write} = 1;
+        $self->_prepared_write(1);
     }
     
     return 0 if !defined $buffer;

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/ROADMAP.pod
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/ROADMAP.pod	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/ROADMAP.pod	2008-12-08 01:11:23 UTC (rev 8787)
@@ -46,7 +46,7 @@
 
 =back
 
-=head2 5.80000 4. Quarter 2006
+=head2 5.80000 1st Quarter 2009
 
 Next major planned release.
 
@@ -79,7 +79,7 @@
 
 =back
  
-=head2 5.90000 2007
+=head2 5.90000 2009
 
 Blue Sky. Will start planning this once we land 5.8 :)
 

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request/Upload.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request/Upload.pm	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request/Upload.pm	2008-12-08 01:11:23 UTC (rev 8787)
@@ -13,7 +13,7 @@
 has size => (is => 'rw');
 has tempname => (is => 'rw');
 has type => (is => 'rw');
-has basename => (is => 'rw');
+has basename => (is => 'ro', lazy_build => 1);
 
 has fh => (
   is => 'rw',
@@ -33,6 +33,15 @@
   },
 );
 
+sub _build_basename {
+    my $self = shift;
+    my $basename = $self->filename;
+    $basename =~ s|\\|/|g;
+    $basename = ( File::Spec::Unix->splitpath($basename) )[2];
+    $basename =~ s|[^\w\.-]+|_|g;
+    return $basename;
+}
+
 no Moose;
 
 =head1 NAME
@@ -138,19 +147,6 @@
     return $content;
 }
 
-sub basename {
-    my $self = shift;
-    unless ( $self->{basename} ) {
-        my $basename = $self->filename;
-        $basename =~ s|\\|/|g;
-        $basename = ( File::Spec::Unix->splitpath($basename) )[2];
-        $basename =~ s|[^\w\.-]+|_|g;
-        $self->{basename} = $basename;
-    }
-
-    return $self->{basename};
-}
-
 =head2 $upload->basename
 
 Returns basename for C<filename>.

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request.pm	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Request.pm	2008-12-08 01:11:23 UTC (rev 8787)
@@ -34,16 +34,19 @@
   lazy => 1,
 );
 
-#Moose ToDo:
-#can we lose the before modifiers which just call prepare_body ?
-#they are wasteful, slow us down and feel cluttery.
+# Moose TODO:
+# - Can we lose the before modifiers which just call prepare_body ?
+#   they are wasteful, slow us down and feel cluttery.
 # Can we call prepare_body at BUILD time?
-# Can we make _body an attribute and have the rest of these lazy build from there?
+# Can we make _body an attribute, have the rest of 
+# these lazy build from there and kill all the direct hash access
+# in Catalyst.pm and Engine.pm?
 
 has _context => (
   is => 'rw',
   weak_ref => 1,
   handles => ['read'],
+  clearer => '_clear_context',
 );
 
 has body_parameters => (
@@ -119,6 +122,8 @@
   },
 );
 
+has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
+
 no Moose;
 
 sub args            { shift->arguments(@_) }
@@ -408,17 +413,17 @@
 
     if (@params) {
         $self->uri->path(@params);
-        undef $self->{path};
+        $self->_clear_path;
     }
-    elsif ( defined( my $path = $self->{path} ) ) {
-        return $path;
+    elsif ( $self->_has_path ) {
+        return $self->_path;
     }
     else {
         my $path     = $self->uri->path;
         my $location = $self->base->path;
         $path =~ s/^(\Q$location\E)?//;
         $path =~ s/^\///;
-        $self->{path} = $path;
+        $self->_path($path);
 
         return $path;
     }

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Response.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Response.pm	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Response.pm	2008-12-08 01:11:23 UTC (rev 8787)
@@ -6,7 +6,7 @@
 with 'MooseX::Emulate::Class::Accessor::Fast';
 
 has cookies   => (is => 'rw', default => sub { {} });
-has body      => (is => 'rw', default => '');
+has body      => (is => 'rw', default => '', lazy => 1, predicate => 'has_body');
 has location  => (is => 'rw');
 has status    => (is => 'rw', default => 200);
 has finalized_headers => (is => 'rw', default => 0);
@@ -21,6 +21,7 @@
   is => 'rw',
   weak_ref => 1,
   handles => ['write'],
+  clearer => '_clear_context',
 );
 
 sub output { shift->body(@_) }
@@ -63,6 +64,10 @@
 in the same fashion), or a filehandle GLOB. Catalyst
 will write it piece by piece into the response.
 
+=head2 $res->has_body
+
+Predicate which returns true when a body has been set.
+
 =head2 $res->content_encoding
 
 Shortcut for $res->headers->content_encoding.

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Stats.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Stats.pm	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Stats.pm	2008-12-08 01:11:23 UTC (rev 8787)
@@ -10,7 +10,8 @@
 has tree => (
              is => 'ro',
              required => 1,
-             default => sub{ Tree::Simple->new({t => [gettimeofday]}) }
+             default => sub{ Tree::Simple->new({t => [gettimeofday]}) },
+             handles => [qw/ accept traverse /],
             );
 has stack => (
               is => 'ro',
@@ -89,7 +90,7 @@
 
     my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
     my @results;
-    $self->tree->traverse(
+    $self->traverse(
                 sub {
                 my $action = shift;
                 my $stat   = $action->getNodeValue;
@@ -114,15 +115,10 @@
 
     my $visitor = Tree::Simple::Visitor::FindByUID->new;
     $visitor->searchForUID($uid);
-    $self->tree->accept($visitor);
+    $self->accept($visitor);
     return $visitor->getResult;
 } 
 
-sub accept {
-    my $self = shift;
-    $self->{tree}->accept( @_ );
-}
-
 sub addChild {
     my $self = shift;
     my $node = $_[ 0 ];
@@ -135,7 +131,7 @@
         $stat->{ elapsed } =~ s{s$}{};
     }
 
-    $self->{tree}->addChild( @_ );
+    $self->tree->addChild( @_ );
 }
 
 sub setNodeValue {
@@ -148,19 +144,14 @@
         $stat->{ elapsed } =~ s{s$}{};
     }
 
-    $self->{tree}->setNodeValue( @_ );
+    $self->tree->setNodeValue( @_ );
 }
 
 sub getNodeValue {
     my $self = shift;
-    $self->{tree}->getNodeValue( @_ )->{ t };
+    $self->tree->getNodeValue( @_ )->{ t };
 }
 
-sub traverse {
-    my $self = shift;
-    $self->{tree}->traverse( @_ );
-}
-
 no Moose;
 __PACKAGE__->meta->make_immutable();
 

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst.pm	2008-12-08 01:11:23 UTC (rev 8787)
@@ -1537,8 +1537,7 @@
         $c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
         $response->header( Location => $location );
 
-        #Moose TODO: we should probably be using a predicate method here ?
-        if ( !$response->body ) {
+        if ( !$response->has_body ) {
             # Add a default body if none is already present
             $response->body(
                 qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}

Modified: Catalyst-Runtime/5.80/trunk/t/meta_method_unneeded.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/meta_method_unneeded.t	2008-12-07 23:50:01 UTC (rev 8786)
+++ Catalyst-Runtime/5.80/trunk/t/meta_method_unneeded.t	2008-12-08 01:11:23 UTC (rev 8787)
@@ -16,6 +16,7 @@
 {    
     package TestAppWithMeta;
     use Catalyst;
+    no warnings 'redefine';
     sub meta {}
 }
 




More information about the Catalyst-commits mailing list