Made get_pod support Perl 5.6 by removing use of in-memory filehandles

diff --git a/t/44_upgrade_db.t b/t/44_upgrade_db.t
index 48e53f2..db39f37 100644 (file)
--- a/t/44_upgrade_db.t
+++ b/t/44_upgrade_db.t
@@ -4,10 +4,13 @@ use Test::More;
 
 # Add skips here
 BEGIN {
-  eval { use Pod::Usage };
-  if ( $@ ) {
-    plan skip_all => "Pod::Usage must be installed to run these tests";
-  }
+    my @failures;
+    eval { use Pod::Usage; }; push @failures, 'Pod::Usage' if $@;
+    eval { use IO::Scalar; }; push @failures, 'IO::Scalar' if $@;
+    if ( @failures ) {
+        my $missing = join ',', @failures;
+        plan skip_all => "'$missing' must be installed to run these tests";
+    }
 }
 
 plan tests => 109;
@@ -127,21 +130,32 @@ foreach my $input_filename (
 ################################################################################
 
 sub run_prog {
-  #print "Launching '@_'\n";
-  #XXX This needs to be made OS-portable
-  open( my $fh, '-|', "@_ 2>&1" ) or die "Cannot launch '@_': $!\n";
-  return join '', <$fh>;
+    #print "Launching '@_'\n";
+    #XXX This needs to be made OS-portable
+    open( my $fh, '-|', "@_ 2>&1" ) or die "Cannot launch '@_': $!\n";
+    return join '', <$fh>;
 }
 
+# In 5.8, we could have used in-memory filehandles and done
+#     open( my $fh, '>', \my $pod ) or die "Cannot open in-memory filehandle: $!\n";
+#     ...
+#     return $pod;
+# However, DBM::Deep supports 5.6, so this set of contortions will do the trick.
 sub get_pod {
-  my ($p,$v) = @_;
-  #XXX This needs retro'ed to 5.6.0
-  open( my $fh, '>', \my $pod ) or die "Cannot open in-memory filehandle: $!\n";
-  pod2usage({
-    -input   => $p,
-    -output  => $fh,
-    -verbose => $v,
-    -exitval => 'NOEXIT',
-  });
-  return $pod;
+    my ($p,$v) = @_;
+
+    my ($fh, $fn) = new_fh();
+    close $fh;
+    open $fh, '>', $fn;
+
+    pod2usage({
+        -input   => $p,
+        -output  => $fh,
+        -verbose => $v,
+        -exitval => 'NOEXIT',
+    });
+
+    close $fh;
+    open $fh, '<', $fn;
+    return join '', <$fh>;
 }