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

andyg at dev.catalyst.perl.org andyg at dev.catalyst.perl.org
Tue Oct 16 20:08:51 GMT 2007 

Author: andyg
Date: 2007-10-16 20:08:51 +0100 (Tue, 16 Oct 2007)
New Revision: 7021

Modified:
   Catalyst-Runtime/5.80/trunk/
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/HTTP.pm
   Catalyst-Runtime/5.80/trunk/lib/Catalyst/Utils.pm
   Catalyst-Runtime/5.80/trunk/t/unit_utils_load_class.t
Log:
 r22786 at macbookpro-eth (orig r6989):  castaway | 2007-10-14 13:13:09 -0400
 Add tests to not load files that are not valid/sane class names (from theorbtwo)
 
 r22835 at macbookpro-eth (orig r7020):  andyg | 2007-10-16 15:06:52 -0400
 Change Engine::write() to use IO::Select instead of worrying about EWOULDBLOCK



Property changes on: Catalyst-Runtime/5.80/trunk
___________________________________________________________________
Name: svk:merge
   - 1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst/trunk/Catalyst-Runtime:9763
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/trunk:6979
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-ChildOf:4443
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-Runtime-jrockway:5857
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-component-setup:4320
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-docs:4325
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/current/Catalyst-Runtime:5142
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst:4483
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst-Runtime:6165
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime:8339
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime-jrockway:8342
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime:6511
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime-current:10442
   + 1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst/trunk/Catalyst-Runtime:9763
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/trunk:7020
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-ChildOf:4443
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-Runtime-jrockway:5857
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-component-setup:4320
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-docs:4325
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/current/Catalyst-Runtime:5142
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst:4483
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst-Runtime:6165
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime:8339
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime-jrockway:8342
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime:6511
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime-current:10442

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/HTTP.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/HTTP.pm	2007-10-16 19:06:52 UTC (rev 7020)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine/HTTP.pm	2007-10-16 19:08:51 UTC (rev 7021)
@@ -161,6 +161,7 @@
     
     if ( !defined $ret ) {
         $self->{_write_error} = $!;
+        DEBUG && warn "write: Failed to write response ($!)\n";
     }
     else {
         DEBUG && warn "write: Wrote response ($ret bytes)\n";
@@ -284,7 +285,6 @@
                 $self->_handler( $class, $port, $method, $uri, $protocol );
             
                 if ( my $error = delete $self->{_write_error} ) {
-                    DEBUG && warn "Write error: $error\n";
                     close Remote;
                     
                     if ( !defined $pid ) {

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine.pm	2007-10-16 19:06:52 UTC (rev 7020)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Engine.pm	2007-10-16 19:08:51 UTC (rev 7021)
@@ -4,10 +4,10 @@
 use base 'Class::Accessor::Fast';
 use CGI::Simple::Cookie;
 use Data::Dump qw/dump/;
-use Errno 'EWOULDBLOCK';
 use HTML::Entities;
 use HTTP::Body;
 use HTTP::Headers;
+use IO::Select ();
 use URI::QueryParam;
 use Scalar::Util ();
 
@@ -622,30 +622,29 @@
         $self->{_prepared_write} = 1;
     }
     
-    my $len   = length($buffer);
-    my $wrote = syswrite STDOUT, $buffer;
+    my $wrote;
+    my $len = length($buffer);
     
-    if ( !defined $wrote && $! == EWOULDBLOCK ) {
-        # Unable to write on the first try, will retry in the loop below
-        $wrote = 0;
-    }
+    my $sel = IO::Select->new();
+    $sel->add( \*STDOUT );
     
-    if ( defined $wrote && $wrote < $len ) {
-        # We didn't write the whole buffer
-        while (1) {
-            my $ret = syswrite STDOUT, $buffer, $CHUNKSIZE, $wrote;
-            if ( defined $ret ) {
-                $wrote += $ret;
-            }
-            else {
-                next if $! == EWOULDBLOCK;
-                return;
-            }
-            
-            last if $wrote >= $len;
+    while ( $sel->can_write() ) {
+        $wrote ||= 0;
+        
+        my $ret = syswrite STDOUT, $buffer, $CHUNKSIZE, $wrote;
+        if ( defined $ret ) {
+            $wrote += $ret;
         }
+        else {
+            # Write error
+            return;
+        }
+    
+        last if $wrote >= $len;
     }
     
+    $sel->remove( \*STDOUT );
+    
     return $wrote;
 }
 

Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Utils.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Utils.pm	2007-10-16 19:06:52 UTC (rev 7020)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Utils.pm	2007-10-16 19:08:51 UTC (rev 7021)
@@ -251,6 +251,12 @@
     croak "Malformed class Name $class"
         if $class =~ m/(?:\b\:\b|\:{3,})/;
 
+    croak "Malformed class Name $class"
+        if $class =~ m/[^\w:]/;
+
+    croak "ensure_class_loaded should be given a classname, not a filename ($class)"
+        if $class =~ m/\.pm$/;
+
     return if !$opts->{ ignore_loaded }
         && Class::Inspector->loaded( $class ); # if a symbol entry exists we don't load again
 
@@ -258,7 +264,7 @@
     my $error;
     {
         local $@;
-        eval "require $class";
+        eval "require $class;";
         $error = $@;
     }
 

Modified: Catalyst-Runtime/5.80/trunk/t/unit_utils_load_class.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/unit_utils_load_class.t	2007-10-16 19:06:52 UTC (rev 7020)
+++ Catalyst-Runtime/5.80/trunk/t/unit_utils_load_class.t	2007-10-16 19:08:51 UTC (rev 7021)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 12;
+use Test::More tests => 14;
 
 use lib "t/lib";
 
@@ -49,3 +49,11 @@
 eval { Catalyst::Utils::ensure_class_loaded("This::Module::Is::Not::In::Inc::But::Does::Exist") };
 ok( !$@, "no error when loading non existent .pm that *does* have a symbol table entry" ); 
 
+undef $@;
+eval { Catalyst::Utils::ensure_class_loaded('Silly::File::.#Name') };
+like($@, qr/Malformed class Name/, 'errored when attempting to load a file beginning with a .');
+
+undef $@;
+eval { Catalyst::Utils::ensure_class_loaded('Silly::File::Name.pm') };
+like($@, qr/Malformed class Name/, 'errored sanely when given a classname ending in .pm');
+

More information about the Catalyst-commits mailing list