commit perl-PerlIO-via-Timeout for openSUSE:Factory

1 Aug 2015

Hello community,

here is the log from the commit of package perl-PerlIO-via-Timeout for openSUSE:Factory checked in at 2015-08-01 11:38:04
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-PerlIO-via-Timeout (Old)
 and      /work/SRC/openSUSE:Factory/.perl-PerlIO-via-Timeout.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Package is "perl-PerlIO-via-Timeout"

Changes:
--------

--- /work/SRC/openSUSE:Factory/perl-PerlIO-via-Timeout/perl-PerlIO-via-Timeout.changes	2015-05-15 07:44:58.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.perl-PerlIO-via-Timeout.new/perl-PerlIO-via-Timeout.changes	2015-08-01 11:38:05.000000000 +0200
@@ -1,0 +2,10 @@
+Wed Jul 29 09:01:07 UTC 2015 - coolo@suse.com
+
+- updated to 0.31
+   see /usr/share/doc/packages/perl-PerlIO-via-Timeout/Changes
+
+  0.31      2015-07-29 07:59:46CEST+0200 Europe/Paris
+          . fixed a potential race condition case where read or write would be
+            blocking even with a timeout (thanks to Luciano Rocha)
+
+-------------------------------------------------------------------

Old:
----
  PerlIO-via-Timeout-0.30.tar.gz

New:
----
  PerlIO-via-Timeout-0.31.tar.gz

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Other differences:
------------------
++++++ perl-PerlIO-via-Timeout.spec ++++++
--- /var/tmp/diff_new_pack.jt8vbZ/_old	2015-08-01 11:38:05.000000000 +0200
+++ /var/tmp/diff_new_pack.jt8vbZ/_new	2015-08-01 11:38:05.000000000 +0200
@@ -17,7 +17,7 @@
 
 
 Name:           perl-PerlIO-via-Timeout
-Version:        0.30
+Version:        0.31
 Release:        0
 %define cpan_name PerlIO-via-Timeout
 Summary:        PerlIO layer that adds read & write timeout to a handle

++++++ PerlIO-via-Timeout-0.30.tar.gz -> PerlIO-via-Timeout-0.31.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/PerlIO-via-Timeout-0.30/Changes new/PerlIO-via-Timeout-0.31/Changes
--- old/PerlIO-via-Timeout-0.30/Changes	2015-05-13 20:33:15.000000000 +0200
+++ new/PerlIO-via-Timeout-0.31/Changes	2015-07-29 07:59:52.000000000 +0200
@@ -1,3 +1,7 @@
+0.31      2015-07-29 07:59:46CEST+0200 Europe/Paris
+        . fixed a potential race condition case where read or write would be
+          blocking even with a timeout (thanks to Luciano Rocha)
+
 0.30      2015-05-13 20:33:08CEST+0200 Europe/Amsterdam
 
 0.29      2013-12-28 22:31:38 Europe/Paris
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/PerlIO-via-Timeout-0.30/META.yml new/PerlIO-via-Timeout-0.31/META.yml
--- old/PerlIO-via-Timeout-0.30/META.yml	2015-05-13 20:33:15.000000000 +0200
+++ new/PerlIO-via-Timeout-0.31/META.yml	2015-07-29 07:59:52.000000000 +0200
@@ -21,7 +21,7 @@
 provides:
   PerlIO::via::Timeout:
     file: lib/PerlIO/via/Timeout.pm
-    version: 0.30
+    version: 0.31
 requires:
   Exporter: 5.57
   PerlIO::via: 0
@@ -29,4 +29,4 @@
 resources:
   bugtracker: https://github.com/dams/perlio-via-timeout/issues
   repository: git://github.com/dams/perlio-via-timeout.git
-version: 0.30
+version: 0.31
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/PerlIO-via-Timeout-0.30/Makefile.PL new/PerlIO-via-Timeout-0.31/Makefile.PL
--- old/PerlIO-via-Timeout-0.30/Makefile.PL	2015-05-13 20:33:15.000000000 +0200
+++ new/PerlIO-via-Timeout-0.31/Makefile.PL	2015-07-29 07:59:52.000000000 +0200
@@ -92,7 +92,7 @@
     "Test::More" => 0,
     "Test::TCP" => 0
   },
-  "VERSION" => "0.30",
+  "VERSION" => "0.31",
   "test" => {
     "TESTS" => "t/*.t"
   }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/PerlIO-via-Timeout-0.30/README new/PerlIO-via-Timeout-0.31/README
--- old/PerlIO-via-Timeout-0.30/README	2015-05-13 20:33:15.000000000 +0200
+++ new/PerlIO-via-Timeout-0.31/README	2015-07-29 07:59:52.000000000 +0200
@@ -1,7 +1,7 @@
 
 
 This archive contains the distribution PerlIO-via-Timeout,
-version 0.30:
+version 0.31:
 
   a PerlIO layer that adds read & write timeout to a handle
 
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/PerlIO-via-Timeout-0.30/lib/PerlIO/via/Timeout.pm new/PerlIO-via-Timeout-0.31/lib/PerlIO/via/Timeout.pm
--- old/PerlIO-via-Timeout-0.30/lib/PerlIO/via/Timeout.pm	2015-05-13 20:33:15.000000000 +0200
+++ new/PerlIO-via-Timeout-0.31/lib/PerlIO/via/Timeout.pm	2015-07-29 07:59:52.000000000 +0200
@@ -7,7 +7,7 @@
 # the same terms as the Perl 5 programming language system itself.
 #
 package PerlIO::via::Timeout;
-$PerlIO::via::Timeout::VERSION = '0.30';
+$PerlIO::via::Timeout::VERSION = '0.31';
 # ABSTRACT: a PerlIO layer that adds read & write timeout to a handle
 
 require 5.008;
@@ -15,7 +15,9 @@
 use strict;
 use warnings;
 use Carp;
-use Errno qw(EBADF EINTR ETIMEDOUT);
+use Errno qw(EBADF EINTR ETIMEDOUT EAGAIN EWOULDBLOCK);
+use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
+
 
 use Exporter 'import'; # gives you Exporter's import() method directly
 
@@ -60,40 +62,75 @@
     close $_[1] or -1;
 }
 
+sub _set_flags {
+    # params: FH, FLAGS
+    local $!;
+    fcntl($_[0], F_SETFL, $_[1])
+      or die "Can't set flags for the filehandle: $!\n";
+
+}
+
+sub _get_flags {
+    # params: FH
+    local $!;
+    my $flags = fcntl($_[0], F_GETFL, 0)
+      or die "Can't get flags for the filehandle: $!\n";
+    return $flags;
+}
+
 sub READ {
     # params: SELF, BUF, LEN, FH
     my ($self, undef, $len, $fh) = @_;
 
-    # There is a bug in PerlIO::via (possibly in PerlIO ?). We would like
-    # to return -1 to signify error, but doing so doesn't work (it usually
-    # segfault), it looks like the implementation is not complete. So we
-    # return 0.
     my ($prop, $fd) = __PACKAGE__->_fh2prop($fh);
 
     my $timeout_enabled = $prop->{timeout_enabled};
     my $read_timeout    = $prop->{read_timeout};
 
     my $offset = 0;
-    while ($len) {
-        if ( $timeout_enabled && $read_timeout && $len && ! _can_read_write($fh, $fd, $read_timeout, 0)) {
-            $! ||= ETIMEDOUT;
-            return 0;
-        }
-        my $r = sysread($fh, $_[1], $len, $offset);
-        if (defined $r) {
-            last unless $r;
-            $len -= $r;
-            $offset += $r;
-        }
-        elsif ($! != EINTR) {
-            # There is a bug in PerlIO::via (possibly in PerlIO ?). We would like
-            # to return -1 to signify error, but doing so doesn't work (it usually
-            # segfault), it looks like the implementation is not complete. So we
-            # return 0.
-            return 0;
+
+    if ( ! $timeout_enabled || ! $read_timeout) {
+        while ($len) {
+            my $r = sysread($fh, $_[1], $len, $offset);
+            if (defined $r) {
+                last unless $r;
+                $len -= $r;
+                $offset += $r;
+            } elsif ($! != EINTR) {
+                # There is a bug in PerlIO::via (possibly in PerlIO ?). We would
+                # like to return -1 to signify error, but doing so doesn't work (it
+                # usually segfaults), it looks like the implementation is not
+                # complete. So we return 0.
+                return 0;
+            }
         }
+        return $offset;
+    } else {
+        my $flags = _get_flags($fh);
+        _set_flags($fh, $flags | O_NONBLOCK);
+        while ($len) {
+            if ($len && ! _can_read_write($fh, $fd, $read_timeout, 0)) {
+                $! ||= ETIMEDOUT;
+                $offset = 0;
+                last;
+            }
+            my $r = sysread($fh, $_[1], $len, $offset);
+            if (defined $r) {
+                last unless $r; #EOF
+                $len -= $r;
+                $offset += $r;
+            } elsif ($! != EINTR && $! != EAGAIN && $! != EWOULDBLOCK) {
+                # There is a bug in PerlIO::via (possibly in PerlIO ?). We would
+                # like to return -1 to signify error, but doing so doesn't work (it
+                # usually segfaults), it looks like the implementation is not
+                # complete. So we return 0.
+                $offset = 0;
+                last;
+            }
+        }
+        _set_flags($fh, $flags);
+        return $offset;
     }
-    return $offset;
 }
 
 sub WRITE {
@@ -107,22 +144,39 @@
 
     my $len = length $_[1];
     my $offset = 0;
-    while ($len) {
-        if ( $len && $timeout_enabled && $write_timeout && ! _can_read_write($fh, $fd, $write_timeout, 1)) {
-            $! ||= ETIMEDOUT;
-            return -1;
-        }
-        my $r = syswrite($fh, $_[1], $len, $offset);
-        if (defined $r) {
-            $len -= $r;
-            $offset += $r;
-            last unless $len;
+
+    if ( ! $timeout_enabled || ! $write_timeout) {
+        while ($len) {
+            my $r = syswrite($fh, $_[1], $len, $offset);
+            if (defined $r) {
+                $len -= $r;
+                $offset += $r;
+            } elsif ($! != EINTR) {
+                return -1;
+            }
         }
-        elsif ($! != EINTR) {
-            return -1;
+    } else {
+        my $flags = _get_flags($fh);
+        _set_flags($fh, $flags | O_NONBLOCK);
+        while ($len) {
+            if ( $len && ! _can_read_write($fh, $fd, $write_timeout, 1)) {
+                $! ||= ETIMEDOUT;
+                $offset = -1;
+                last;
+            }
+            my $r = syswrite($fh, $_[1], $len, $offset);
+            if (defined $r) {
+                $len -= $r;
+                $offset += $r;
+                last unless $len; # EOF
+            } elsif ($! != EINTR && $! != EAGAIN && $! != EWOULDBLOCK) {
+                $offset = -1;
+                last
+            }
         }
+        _set_flags($fh, $flags);
+        return $offset;
     }
-    return $offset;
 }
 
 sub _can_read_write {
@@ -145,8 +199,8 @@
         if ($nfound == -1) {
             $! == EINTR
               or croak(qq/select(2): '$!'/);
-            redo if !$timeout || ($pending = $timeout - (Time::HiRes::time -
-            $initial)) > 0;
+            !$timeout || ($pending -= Time::HiRes::time - $initial) > 0
+              and next;
             $nfound = 0;
         }
         last;
@@ -209,7 +263,7 @@
 
 =head1 VERSION
 
-version 0.30
+version 0.31
 
 =head1 SYNOPSIS

    

root＠hilbert.suse.de

tags

participants (1)