X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=62b7de9fb54eef6959b21c2955d1a91a7216be92;hb=64f14228217abb04a437553319642d6e7a82a3e8;hp=14ecf1a47d6e6a6cea7b300bd558eefafb1fcda6;hpb=ff0cee690d2ef6ba882e59dd4baaa0c944adb7a2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index 14ecf1a..62b7de9 100644 --- a/doio.c +++ b/doio.c @@ -1,6 +1,6 @@ /* doio.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -34,7 +34,11 @@ #endif #ifdef I_UTIME -#include +# ifdef _MSC_VER +# include +# else +# include +# endif #endif #ifdef I_FCNTL #include @@ -62,6 +66,15 @@ # endif #endif +/* Put this after #includes because defines _XOPEN_*. */ +#ifndef Sock_size_t +# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__) +# define Sock_size_t Size_t +# else +# define Sock_size_t int +# endif +#endif + bool do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp) GV *gv; @@ -284,9 +297,10 @@ PerlIO *supplied_fp; !statbuf.st_mode #endif ) { - int buflen = sizeof tokenbuf; - if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0 - || errno != ENOTSOCK) + Sock_size_t buflen = sizeof tokenbuf; + if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, + &buflen) >= 0 + || errno != ENOTSOCK) IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */ /* but some return 0 for streams too, sigh */ } @@ -467,7 +481,10 @@ register GV *gv; #ifdef HAS_FCHMOD (void)fchmod(lastfd,filemode); #else +# if !(defined(WIN32) && defined(__BORLANDC__)) + /* Borland runtime creates a readonly file! */ (void)chmod(oldname,filemode); +# endif #endif if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) { #ifdef HAS_FCHOWN @@ -584,8 +601,8 @@ IO* io; if (IoIFP(io)) { if (IoTYPE(io) == '|') { status = my_pclose(IoIFP(io)); - retval = (status == 0); STATUS_NATIVE_SET(status); + retval = (STATUS_POSIX == 0); } else if (IoTYPE(io) == '-') retval = TRUE; @@ -646,22 +663,15 @@ do_tell(gv) GV *gv; { register IO *io; + register PerlIO *fp; - if (!gv) - goto phooey; - - io = GvIO(gv); - if (!io || !IoIFP(io)) - goto phooey; - + if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { #ifdef ULTRIX_STDIO_BOTCH - if (PerlIO_eof(IoIFP(io))) - (void)PerlIO_seek (IoIFP(io), 0L, 2); /* ultrix 1.2 workaround */ + if (PerlIO_eof(fp)) + (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */ #endif - - return PerlIO_tell(IoIFP(io)); - -phooey: + return PerlIO_tell(fp); + } if (dowarn) warn("tell() on unopened file"); SETERRNO(EBADF,RMS$_IFI); @@ -675,28 +685,38 @@ long pos; int whence; { register IO *io; + register PerlIO *fp; - if (!gv) - goto nuts; - - io = GvIO(gv); - if (!io || !IoIFP(io)) - goto nuts; - + if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { #ifdef ULTRIX_STDIO_BOTCH - if (PerlIO_eof(IoIFP(io))) - (void)PerlIO_seek (IoIFP(io), 0L, 2); /* ultrix 1.2 workaround */ + if (PerlIO_eof(fp)) + (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */ #endif - - return PerlIO_seek(IoIFP(io), pos, whence) >= 0; - -nuts: + return PerlIO_seek(fp, pos, whence) >= 0; + } if (dowarn) warn("seek() on unopened file"); SETERRNO(EBADF,RMS$_IFI); return FALSE; } +long +do_sysseek(gv, pos, whence) +GV *gv; +long pos; +int whence; +{ + register IO *io; + register PerlIO *fp; + + if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) + return lseek(PerlIO_fileno(fp), pos, whence); + if (dowarn) + warn("sysseek() on unopened file"); + SETERRNO(EBADF,RMS$_IFI); + return -1L; +} + #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) /* code courtesy of William Kucharski */ #define HAS_CHSIZE @@ -705,7 +725,6 @@ I32 my_chsize(fd, length) I32 fd; /* file descriptor */ Off_t length; /* length to set file to */ { - extern long lseek(); struct flock fl; struct stat filebuf; @@ -1314,6 +1333,9 @@ SV **sp; char *a; I32 id, n, cmd, infosize, getinfo; I32 ret = -1; +#ifdef __linux__ /* XXX Need metaconfig test */ + union semun unsemds; +#endif id = SvIVx(*++mark); n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; @@ -1342,11 +1364,29 @@ SV **sp; infosize = sizeof(struct semid_ds); else if (cmd == GETALL || cmd == SETALL) { +#ifdef __linux__ /* XXX Need metaconfig test */ +/* linux uses : + int semctl (int semid, int semnun, int cmd, union semun arg) + + union semun { + int val; + struct semid_ds *buf; + ushort *array; + }; +*/ + union semun semds; + if (semctl(id, 0, IPC_STAT, semds) == -1) +#else struct semid_ds semds; if (semctl(id, 0, IPC_STAT, &semds) == -1) +#endif return -1; getinfo = (cmd == GETALL); +#ifdef __linux__ /* XXX Need metaconfig test */ + infosize = semds.buf->sem_nsems * sizeof(short); +#else infosize = semds.sem_nsems * sizeof(short); +#endif /* "short" is technically wrong but much more portable than guessing about u_?short(_t)? */ } @@ -1370,13 +1410,13 @@ SV **sp; { a = SvPV(astr, len); if (len != infosize) - croak("Bad arg length for %s, is %d, should be %ld", - op_desc[optype], len, (long)infosize); + croak("Bad arg length for %s, is %lu, should be %ld", + op_desc[optype], (unsigned long)len, (long)infosize); } } else { - I32 i = SvIV(astr); + IV i = SvIV(astr); a = (char *)i; /* ouch */ } SETERRNO(0,0); @@ -1389,7 +1429,12 @@ SV **sp; #endif #ifdef HAS_SEM case OP_SEMCTL: +#ifdef __linux__ /* XXX Need metaconfig test */ + unsemds.buf = (struct semid_ds *)a; + ret = semctl(id, n, cmd, unsemds); +#else ret = semctl(id, n, cmd, (struct semid_ds *)a); +#endif break; #endif #ifdef HAS_SHM