Sync with Scalar-List-Utils-1.07
Graham Barr [Mon, 18 Mar 2002 10:10:55 +0000 (10:10 +0000)]
p4raw-id: //depot/perl@15283

MANIFEST
ext/List/Util/ChangeLog
ext/List/Util/lib/List/Util.pm
ext/List/Util/lib/Scalar/Util.pm
ext/List/Util/t/openhan.t [new file with mode: 0644]

index 696fd32..07ee1a3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -459,6 +459,7 @@ ext/List/Util/t/max.t               List::Util
 ext/List/Util/t/maxstr.t       List::Util
 ext/List/Util/t/min.t          List::Util
 ext/List/Util/t/minstr.t       List::Util
+ext/List/Util/t/openhan.t      Scalar::Util
 ext/List/Util/t/readonly.t     Scalar::Util
 ext/List/Util/t/reduce.t       List::Util
 ext/List/Util/t/reftype.t      Scalar::Util
index 5ab668b..934643a 100644 (file)
@@ -1,3 +1,11 @@
+Change 713 on 2002/03/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Add Scalar::Util::openhandle()
+
+Change 647 on 2001/09/18 by <gbarr@pobox.com> (Graham Barr)
+
+       Release 1.06
+
 Change 645 on 2001/09/07 by <gbarr@pobox.com> (Graham Barr)
 
        Some platforms require the main executable to export symbols
index 91dbcdb..1843873 100644 (file)
@@ -11,7 +11,7 @@ require DynaLoader;
 
 our @ISA       = qw(Exporter DynaLoader);
 our @EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle);
-our $VERSION   = "1.06_00";
+our $VERSION   = "1.07_00";
 
 bootstrap List::Util $VERSION;
 
index 1329d1a..e518a4c 100644 (file)
@@ -10,9 +10,27 @@ require Exporter;
 require List::Util; # List::Util loads the XS
 
 our @ISA       = qw(Exporter);
-our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly);
+our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle);
 our $VERSION   = $List::Util::VERSION;
 
+sub openhandle ($) {
+  my $fh = shift;
+  my $rt = reftype($fh) || '';
+
+  return defined(fileno($fh)) ? $fh : undef
+    if $rt eq 'IO';
+
+  if (reftype(\$fh) eq 'GLOB') { # handle  openhandle(*DATA)
+    $fh = \(my $tmp=$fh);
+  }
+  elsif ($rt ne 'GLOB') {
+    return undef;
+  }
+
+  (tied(*$fh) or defined(fileno($fh)))
+    ? $fh : undef;
+}
+
 1;
 
 __END__
@@ -69,6 +87,16 @@ If EXPR is a scalar which is a weak reference the result is true.
     weaken($ref);
     $weak = isweak($ref);               # true
 
+=item openhandle FH
+
+Returns FH if FH may be used as a filehandle and is open, or FH is a tied
+handle. Otherwise C<undef> is returned.
+
+    $fh = openhandle(*STDIN);          # \*STDIN
+    $fh = openhandle(\*STDIN);         # \*STDIN
+    $fh = openhandle(*NOTOPEN);                # undef
+    $fh = openhandle("scalar");                # undef
+    
 =item readonly SCALAR
 
 Returns true if SCALAR is readonly.
diff --git a/ext/List/Util/t/openhan.t b/ext/List/Util/t/openhan.t
new file mode 100644 (file)
index 0000000..9eed5b9
--- /dev/null
@@ -0,0 +1,33 @@
+#!./perl
+
+BEGIN {
+    unless (-d 'blib') {
+       chdir 't' if -d 't';
+       @INC = '../lib';
+       require Config; import Config;
+       keys %Config; # Silence warning
+       if ($Config{extensions} !~ /\bList\/Util\b/) {
+           print "1..0 # Skip: List::Util was not built\n";
+           exit 0;
+       }
+    }
+}
+
+
+use Scalar::Util qw(openhandle);
+
+print "1..4\n";
+
+print "not " unless defined &openhandle;
+print "ok 1\n";
+
+my $fh = \*STDERR;
+print "not " unless openhandle($fh) == $fh;
+print "ok 2\n";
+
+print "not " unless fileno(openhandle(*STDERR)) == fileno(STDERR);
+print "ok 3\n";
+
+print "not " if openhandle(CLOSED);
+print "ok 4\n";
+