diff options
| -rw-r--r-- | doio.c | 42 | ||||
| -rw-r--r-- | lib/Net/Domain.pm | 14 | ||||
| -rw-r--r-- | perlio.c | 54 | ||||
| -rw-r--r-- | perlio.h | 2 |
4 files changed, 64 insertions, 48 deletions
@@ -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 229bc16aa0..03c24da4a0 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; } } @@ -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; } @@ -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); |