[PATCH 0/4] Perl 5.10.1 compatibility fixes

[PATCH 0/4] Perl 5.10.1 compatibility fixes

[Eric Wong]

Aside from the highlight.pm-dependent stuff, everything seems
to work fine after these patches under Perl 5.10.1.

Getting 5.10.1 to run required Devel::PatchPerl to make it
build on modern systems and LOTS of waiting for CPAN modules
to download and build, though :<

Eric Wong (4):
  daemon: provide TCP_DEFER_ACCEPT for Perl <5.14
  avoid relying on IO::Handle/IO::File autoload
  t/hl_mod: document IO::Handle for autoflush
  t/v2reindex.t: 5.10.1 glob compatibility

 lib/PublicInbox/Daemon.pm |  5 +++--
 lib/PublicInbox/Qspawn.pm |  2 +-
 t/hl_mod.t                |  1 +
 t/httpd-corner.t          | 11 ++++++-----
 t/httpd-https.t           |  2 +-
 t/httpd.t                 |  2 +-
 t/import.t                |  7 +++----
 t/nntpd-tls.t             |  2 +-
 t/v2reindex.t             |  6 +++---
 9 files changed, 20 insertions(+), 18 deletions(-)

[PATCH 1/4] daemon: provide TCP_DEFER_ACCEPT for Perl <5.14

[Eric Wong]

Socket::TCP_DEFER_ACCEPT() did not appear in the Socket module
distributed with Perl until 5.14, despite it being available
since Linux 2.4.
---
 lib/PublicInbox/Daemon.pm | 5 +++--
 t/httpd-corner.t          | 9 +++++----
 t/httpd-https.t           | 2 +-
 t/httpd.t                 | 2 +-
 t/nntpd-tls.t             | 2 +-
 5 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/lib/PublicInbox/Daemon.pm b/lib/PublicInbox/Daemon.pm
index 278c80f5..15d8bd31 100644
--- a/lib/PublicInbox/Daemon.pm
+++ b/lib/PublicInbox/Daemon.pm
@@ -566,11 +566,12 @@ sub defer_accept ($$) {
 	my ($s, $af_name) = @_;
 	return unless defined $af_name;
 	if ($^O eq 'linux') {
-		my $x = getsockopt($s, IPPROTO_TCP, Socket::TCP_DEFER_ACCEPT());
+		my $TCP_DEFER_ACCEPT = 9; # Socket::TCP_DEFER_ACCEPT is in 5.14+
+		my $x = getsockopt($s, IPPROTO_TCP, $TCP_DEFER_ACCEPT);
 		return unless defined $x; # may be Unix socket
 		my $sec = unpack('i', $x);
 		return if $sec > 0; # systemd users may set a higher value
-		setsockopt($s, IPPROTO_TCP, Socket::TCP_DEFER_ACCEPT(), 1);
+		setsockopt($s, IPPROTO_TCP, $TCP_DEFER_ACCEPT, 1);
 	} elsif ($^O eq 'freebsd') {
 		my $x = getsockopt($s, SOL_SOCKET, SO_ACCEPTFILTER);
 		return if defined $x; # don't change if set
diff --git a/t/httpd-corner.t b/t/httpd-corner.t
index 4ed34934..1f2bb53f 100644
--- a/t/httpd-corner.t
+++ b/t/httpd-corner.t
@@ -28,10 +28,11 @@ open(STDIN, '<', '/dev/null') or die 'no /dev/null: $!';
 
 # Make sure we don't clobber socket options set by systemd or similar
 # using socket activation:
-my ($defer_accept_val, $accf_arg);
+my ($defer_accept_val, $accf_arg, $TCP_DEFER_ACCEPT);
 if ($^O eq 'linux') {
-	setsockopt($sock, IPPROTO_TCP, Socket::TCP_DEFER_ACCEPT(), 5) or die;
-	my $x = getsockopt($sock, IPPROTO_TCP, Socket::TCP_DEFER_ACCEPT());
+	$TCP_DEFER_ACCEPT = eval { Socket::TCP_DEFER_ACCEPT() } // 9;
+	setsockopt($sock, IPPROTO_TCP, $TCP_DEFER_ACCEPT, 5) or die;
+	my $x = getsockopt($sock, IPPROTO_TCP, $TCP_DEFER_ACCEPT);
 	defined $x or die "getsockopt: $!";
 	$defer_accept_val = unpack('i', $x);
 	if ($defer_accept_val <= 0) {
@@ -526,7 +527,7 @@ SKIP: {
 
 SKIP: {
 	skip 'TCP_DEFER_ACCEPT is Linux-only', 1 if $^O ne 'linux';
-	my $var = Socket::TCP_DEFER_ACCEPT();
+	my $var = $TCP_DEFER_ACCEPT;
 	defined(my $x = getsockopt($sock, IPPROTO_TCP, $var)) or die;
 	is(unpack('i', $x), $defer_accept_val,
 		'TCP_DEFER_ACCEPT unchanged if previously set');
diff --git a/t/httpd-https.t b/t/httpd-https.t
index 9ce060c8..ee5ced0f 100644
--- a/t/httpd-https.t
+++ b/t/httpd-https.t
@@ -87,7 +87,7 @@ for my $args (
 
 	SKIP: {
 		skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux';
-		my $var = Socket::TCP_DEFER_ACCEPT();
+		my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9;
 		defined(my $x = getsockopt($https, IPPROTO_TCP, $var)) or die;
 		ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set on https');
 	};
diff --git a/t/httpd.t b/t/httpd.t
index 880c69e6..2972afb2 100644
--- a/t/httpd.t
+++ b/t/httpd.t
@@ -81,7 +81,7 @@ EOF
 
 SKIP: {
 	skip 'TCP_DEFER_ACCEPT is Linux-only', 1 if $^O ne 'linux';
-	my $var = Socket::TCP_DEFER_ACCEPT();
+	my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9;
 	defined(my $x = getsockopt($sock, IPPROTO_TCP, $var)) or die;
 	ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set');
 };
diff --git a/t/nntpd-tls.t b/t/nntpd-tls.t
index edc1fab4..c97d179d 100644
--- a/t/nntpd-tls.t
+++ b/t/nntpd-tls.t
@@ -174,7 +174,7 @@ for my $args (
 
 	SKIP: {
 		skip 'TCP_DEFER_ACCEPT is Linux-only', 2 if $^O ne 'linux';
-		my $var = Socket::TCP_DEFER_ACCEPT();
+		my $var = eval { Socket::TCP_DEFER_ACCEPT() } // 9;
 		defined(my $x = getsockopt($nntps, IPPROTO_TCP, $var)) or die;
 		ok(unpack('i', $x) > 0, 'TCP_DEFER_ACCEPT set on NNTPS');
 		defined($x = getsockopt($starttls, IPPROTO_TCP, $var)) or die;

[PATCH 2/4] avoid relying on IO::Handle/IO::File autoload

[Eric Wong]

Perl 5.14+ gained the ability to autoload IO::File
(and IO::Handle) on missing methods, so relying on
this breaks under 5.10.1.

There's no reason to load IO::File or IO::Handle
when built-in perlops work fine and are even a hair
faster.
---
 lib/PublicInbox/Qspawn.pm | 2 +-
 t/httpd-corner.t          | 2 +-
 t/import.t                | 7 +++----
 3 files changed, 5 insertions(+), 6 deletions(-)

diff --git a/lib/PublicInbox/Qspawn.pm b/lib/PublicInbox/Qspawn.pm
index 31a1583d..3425e5e4 100644
--- a/lib/PublicInbox/Qspawn.pm
+++ b/lib/PublicInbox/Qspawn.pm
@@ -164,7 +164,7 @@ reread:
 		$async->async_pass($self->{psgi_env}->{'psgix.io'},
 					$qx_fh, \$buf);
 	} elsif (defined $r) {
-		$r ? $qx_fh->write($buf) : event_step($self, undef);
+		$r ? (print $qx_fh $buf) : event_step($self, undef);
 	} else {
 		return if $! == EAGAIN; # try again when notified
 		goto reread if $! == EINTR;
diff --git a/t/httpd-corner.t b/t/httpd-corner.t
index 1f2bb53f..879a023a 100644
--- a/t/httpd-corner.t
+++ b/t/httpd-corner.t
@@ -278,7 +278,7 @@ SKIP: {
 	waitpid($pid, 0);
 	is($?, 0, 'curl exited successfully');
 	is(-s $cerr, 0, 'no errors from curl');
-	$cout->seek(0, SEEK_SET);
+	seek($cout, 0, SEEK_SET);
 	is(<$cout>, sha1_hex($str), 'read expected body');
 
 	open my $fh, '-|', qw(curl -sS), "$base/async-big" or die $!;
diff --git a/t/import.t b/t/import.t
index cfbe501b..ecf2c590 100644
--- a/t/import.t
+++ b/t/import.t
@@ -7,8 +7,7 @@ use PublicInbox::MIME;
 use PublicInbox::Git;
 use PublicInbox::Import;
 use PublicInbox::Spawn qw(spawn);
-use IO::File;
-use Fcntl qw(:DEFAULT);
+use Fcntl qw(:DEFAULT SEEK_SET);
 use File::Temp qw/tempfile/;
 use PublicInbox::TestCommon;
 my ($dir, $for_destroy) = tmpdir();
@@ -42,12 +41,12 @@ if ($v2) {
 	my $in = tempfile();
 	print $in $mime->as_string or die "write failed: $!";
 	$in->flush or die "flush failed: $!";
-	$in->seek(0, SEEK_SET);
+	seek($in, 0, SEEK_SET);
 	my $out = tempfile();
 	my $pid = spawn(\@cmd, {}, { 0 => $in, 1 => $out });
 	is(waitpid($pid, 0), $pid, 'waitpid succeeds on hash-object');
 	is($?, 0, 'hash-object');
-	$out->seek(0, SEEK_SET);
+	seek($out, 0, SEEK_SET);
 	chomp(my $hashed_obj = <$out>);
 	is($hashed_obj, $info->[0], "last object_id matches exp");
 }

[PATCH 3/4] t/hl_mod: document IO::Handle for autoflush

[Eric Wong]

We don't need IO::File for this test, but IO::Handle
is needed for ->autoflush with Perl <5.14.

Note: I haven't tested highlight.pm under 5.10.1 since
it's a weird dependency which isn't easy to install w/o
distro support.
---
 t/hl_mod.t | 1 +
 1 file changed, 1 insertion(+)

diff --git a/t/hl_mod.t b/t/hl_mod.t
index 4942404c..351dfe22 100644
--- a/t/hl_mod.t
+++ b/t/hl_mod.t
@@ -5,6 +5,7 @@ use strict;
 use warnings;
 use Test::More;
 use PublicInbox::Spawn qw(which spawn);
+use IO::Handle; # ->autoflush
 use Fcntl qw(:seek);
 eval { require highlight } or
 	plan skip_all => "failed to load highlight.pm for $0";

[PATCH 4/4] t/v2reindex.t: 5.10.1 glob compatibility

[Eric Wong]

I'm not sure when `for (<"quoted string/glob/*">)' became
supported, and maybe it was inadvertant, but it fails
with Perl 5.10.1.  Just use the glob() function to be
explicit.
---
 t/v2reindex.t | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/t/v2reindex.t b/t/v2reindex.t
index 2c6bdd57..990513a3 100644
--- a/t/v2reindex.t
+++ b/t/v2reindex.t
@@ -157,7 +157,7 @@ ok(!-d $xap, 'Xapian directories removed again');
 	is($ibx->mm->num_highwater, 10, 'num_highwater as expected');
 	my $mset = $ibx->search->query($phrase, {mset=>1});
 	isnt($mset->size, 0, "phrase search succeeds on indexlevel=full");
-	for (<"$xap/*/*">) { $sizes{$ibx->{indexlevel}} += -s _ if -f $_ }
+	for (glob("$xap/*/*")) { $sizes{$ibx->{indexlevel}} += -s _ if -f $_ }
 
 	my ($min, $max) = $ibx->mm->minmax;
 	is_deeply($ibx->mm->msg_range(\$min, $max), $msgmap, 'msgmap unchanged');
@@ -193,7 +193,7 @@ ok(!-d $xap, 'Xapian directories removed again');
 	$words =~ tr/"'//d;
 	my $mset = $ibx->search->query($words, {mset=>1});
 	isnt($mset->size, 0, "normal search works on indexlevel=medium");
-	for (<"$xap/*/*">) { $sizes{$ibx->{indexlevel}} += -s _ if -f $_ }
+	for (glob("$xap/*/*")) { $sizes{$ibx->{indexlevel}} += -s _ if -f $_ }
 
 	ok($sizes{full} > $sizes{medium}, 'medium is smaller than full');
 
@@ -223,7 +223,7 @@ ok(!-d $xap, 'Xapian directories removed again');
 
 	isnt($ibx->search, 'no search for basic');
 
-	for (<"$xap/*/*">) { $sizes{$ibx->{indexlevel}} += -s _ if -f $_ }
+	for (glob("$xap/*/*")) { $sizes{$ibx->{indexlevel}} += -s _ if -f $_ }
 	ok($sizes{medium} > $sizes{basic}, 'basic is smaller than medium');
 
 	my ($min, $max) = $ibx->mm->minmax;