From 06c7082d6226d352105bade1a7e185ff0a49e896 Mon Sep 17 00:00:00 2001
From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Sat, 20 Oct 2001 14:25:37 +0000
Subject: [PATCH] Extract doio.c's open(2) mode to string conversion as
 PerlIO_intmod2str() Use for non-PERLIO fdupopen().

p4raw-id: //depot/perlio@12532
---
 doio.c            | 42 ++----------------------------------------
 lib/Net/Domain.pm | 14 +++++++-------
 perlio.c          | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++++-
 perlio.h          |  2 ++
 4 files changed, 64 insertions(+), 48 deletions(-)

diff --git a/doio.c b/doio.c
index ebcd071..462c884 100644
--- a/doio.c
+++ b/doio.c
@@ -158,45 +158,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
 	rawmode |= O_LARGEFILE;	/* Transparently largefiley. */
 #endif
 
-#ifndef O_ACCMODE
-#define O_ACCMODE 3		/* Assume traditional implementation */
-#endif
-
-	switch (result = rawmode & O_ACCMODE) {
-	case O_RDONLY:
-	     IoTYPE(io) = IoTYPE_RDONLY;
-	     break;
-	case O_WRONLY:
-	     IoTYPE(io) = IoTYPE_WRONLY;
-	     break;
-	case O_RDWR:
-	default:
-	     IoTYPE(io) = IoTYPE_RDWR;
-	     break;
-	}
-	writing = (result != O_RDONLY);
-
-	if (result == O_RDONLY) {
-	    mode[ix++] = 'r';
-	}
-#ifdef O_APPEND
-	else if (rawmode & O_APPEND) {
-	    mode[ix++] = 'a';
-	    if (result != O_WRONLY)
-		mode[ix++] = '+';
-	}
-#endif
-	else {
-	    if (result == O_WRONLY)
-		mode[ix++] = 'w';
-	    else {
-		mode[ix++] = 'r';
-		mode[ix++] = '+';
-	    }
-	}
-	if (rawmode & O_BINARY)
-	    mode[ix++] = 'b';
-	mode[ix] = '\0';
+        IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing);
 
 	namesv = sv_2mortal(newSVpvn(name,strlen(name)));
 	num_svs = 1;
@@ -1693,7 +1655,7 @@ nothing in the core.
 
            if ( accessed == &PL_sv_undef && modified == &PL_sv_undef )
              utbufp = NULL;
-           
+
 	    Zero(&utbuf, sizeof utbuf, char);
 #ifdef BIG_TIME
            utbuf.actime = (Time_t)SvNVx(accessed);     /* time accessed */
diff --git a/lib/Net/Domain.pm b/lib/Net/Domain.pm
index 229bc16..03c24da 100644
--- a/lib/Net/Domain.pm
+++ b/lib/Net/Domain.pm
@@ -36,8 +36,8 @@ sub _hostname {
           my $a = shift(@addr);
           $host = gethostbyaddr($a,Socket::AF_INET());
           last if defined $host;
-         } 
-        if (index($host,'.') > 0) {
+         }
+        if (defined($host) && index($host,'.') > 0) {
            $fqdn = $host;
            ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/;
          }
@@ -102,7 +102,7 @@ sub _hostname {
 	};
     }
 
-    # remove garbage 
+    # remove garbage
     $host =~ s/[\0\r\n]+//go;
     $host =~ s/(\A\.+|\.+\Z)//go;
     $host =~ s/\.\.+/\./go;
@@ -147,7 +147,7 @@ sub _hostdomain {
 
     @hosts = ($host,"localhost");
 
-    unless($host =~ /\./) {
+    unless (defined($host) && $host =~ /\./) {
 	my $dom = undef;
         eval {
     	    my $tmp = "\0" x 256; ## preload scalar
@@ -179,19 +179,19 @@ sub _hostdomain {
 
     # Attempt to locate FQDN
 
-    foreach (@hosts) {
+    foreach (grep {defined $_} @hosts) {
     	my @info = gethostbyname($_);
 
     	next unless @info;
 
     	# look at real name & aliases
     	my $site;
-    	foreach $site ($info[0], split(/ /,$info[1])) { 
+    	foreach $site ($info[0], split(/ /,$info[1])) {
     	    if(rindex($site,".") > 0) {
 
     	    	# Extract domain from FQDN
 
-     	    	($domain = $site) =~ s/\A[^\.]+\.//; 
+     	    	($domain = $site) =~ s/\A[^\.]+\.//;
      	        return $domain;
     	    }
     	}
diff --git a/perlio.c b/perlio.c
index 963601a..96ecdd8 100644
--- a/perlio.c
+++ b/perlio.c
@@ -99,6 +99,55 @@ perlsio_binmode(FILE *fp, int iotype, int mode)
 #endif
 }
 
+#ifndef O_ACCMODE
+#define O_ACCMODE 3		/* Assume traditional implementation */
+#endif
+
+int
+PerlIO_intmode2str(int rawmode, char *mode, int *writing)
+{
+    int result = rawmode & O_ACCMODE;
+    int ix = 0;
+    int ptype;
+    switch (result) {
+    case O_RDONLY:
+	ptype = IoTYPE_RDONLY;
+	break;
+    case O_WRONLY:
+	ptype = IoTYPE_WRONLY;
+	break;
+    case O_RDWR:
+    default:
+	ptype = IoTYPE_RDWR;
+	break;
+    }
+    if (writing)
+	*writing = (result != O_RDONLY);
+
+    if (result == O_RDONLY) {
+	mode[ix++] = 'r';
+    }
+#ifdef O_APPEND
+    else if (rawmode & O_APPEND) {
+	mode[ix++] = 'a';
+	if (result != O_WRONLY)
+	    mode[ix++] = '+';
+    }
+#endif
+    else {
+	if (result == O_WRONLY)
+	    mode[ix++] = 'w';
+	else {
+	    mode[ix++] = 'r';
+	    mode[ix++] = '+';
+	}
+    }
+    if (rawmode & O_BINARY)
+	mode[ix++] = 'b';
+    mode[ix] = '\0';
+    return ptype;
+}
+
 #ifndef PERLIO_LAYERS
 int
 PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names)
@@ -134,8 +183,11 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
     if (f) {
 	int fd = PerlLIO_dup(PerlIO_fileno(f));
 	if (fd >= 0) {
+	    char mode[8];
+	    int omode = fcntl(fd, F_GETFL);
+	    PerlIO_intmode2str(omode,mode,NULL);
 	    /* the r+ is a hack */
-	    return PerlIO_fdopen(fd, "r+");
+	    return PerlIO_fdopen(fd, mode);
 	}
 	return NULL;
     }
diff --git a/perlio.h b/perlio.h
index 1921a52..c5a25f3 100644
--- a/perlio.h
+++ b/perlio.h
@@ -346,6 +346,8 @@ extern char *PerlIO_getname(PerlIO *, char *);
 
 extern void PerlIO_destruct(pTHX);
 
+extern int PerlIO_intmode2str(int rawmode, char *mode, int *writing);
+
 #ifndef PERLIO_IS_STDIO
 
 extern void PerlIO_cleanup(void);
-- 
2.7.4