# define my_chsize chsize
#endif
-#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
- static int lockf_emulate_flock _((int fd, int operation));
-# define flock lockf_emulate_flock
-#endif
+#ifdef HAS_FLOCK
+# define FLOCK flock
+#else /* no flock() */
+
+ /* fcntl.h might not have been included, even if it exists, because
+ the current Configure only sets I_FCNTL if it's needed to pick up
+ the *_OK constants. Make sure it has been included before testing
+ the fcntl() locking constants. */
+# if defined(HAS_FCNTL) && !defined(I_FCNTL)
+# include <fcntl.h>
+# endif
+
+# if defined(HAS_FCNTL) && defined(F_SETLK) && defined (F_SETLKW)
+# define FLOCK fcntl_emulate_flock
+# define FCNTL_EMULATE_FLOCK
+# else /* no flock() or fcntl(F_SETLK,...) */
+# ifdef HAS_LOCKF
+# define FLOCK lockf_emulate_flock
+# define LOCKF_EMULATE_FLOCK
+# endif /* lockf */
+# endif /* no flock() or fcntl(F_SETLK,...) */
+
+# ifdef FLOCK
+ static int FLOCK _((int, int));
+
+ /*
+ * These are the flock() constants. Since this sytems doesn't have
+ * flock(), the values of the constants are probably not available.
+ */
+# ifndef LOCK_SH
+# define LOCK_SH 1
+# endif
+# ifndef LOCK_EX
+# define LOCK_EX 2
+# endif
+# ifndef LOCK_NB
+# define LOCK_NB 4
+# endif
+# ifndef LOCK_UN
+# define LOCK_UN 8
+# endif
+# endif /* emulating flock() */
+
+#endif /* no flock() */
/* Pushy I/O. */
if (MAXARG > 1)
sv = POPs;
- else if (SvTYPE(TOPs) == SVt_PVGV)
- sv = GvSV(TOPs);
- else
+ if (!isGV(TOPs))
DIE(no_usym, "filehandle");
+ if (MAXARG <= 1)
+ sv = GvSV(TOPs);
gv = (GV*)POPs;
- if (IoFLAGS(GvIOn(gv)) & IOf_UNTAINT) /* This GV has UNTAINT previously set */
- IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; /* Clear it. We don't carry that over */
+ if (!isGV(gv))
+ DIE(no_usym, "filehandle");
+ if (GvIOp(gv))
+ IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
tmps = SvPV(sv, len);
- if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp)) {
- IoLINES(GvIOp(gv)) = 0;
+ if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp))
PUSHi( (I32)forkprocess );
- }
else if (forkprocess == 0) /* we are a new child */
PUSHi(0);
else
methname = "TIESCALAR";
stash = gv_stashsv(mark[1], FALSE);
- if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
+ if (!stash || !(gv = gv_fetchmethod(stash, methname)))
DIE("Can't locate object method \"%s\" via package \"%s\"",
methname, SvPV(mark[1],na));
if (perldb && curstash != debstash)
op->op_private |= OPpENTERSUB_DB;
- XPUSHs((SV*)gv);
+ XPUSHs((SV*)GvCV(gv));
PUTBACK;
if (op = pp_entersub())
sv = sv_mortalcopy(&sv_no);
sv_setpv(sv, "AnyDBM_File");
stash = gv_stashsv(sv, FALSE);
- if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
+ if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
PUTBACK;
perl_require_pv("AnyDBM_File.pm");
SPAGAIN;
- if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
+ if (!(gv = gv_fetchmethod(stash, "TIEHASH")))
DIE("No dbm on this machine");
}
else
PUSHs(sv_2mortal(newSViv(O_RDWR)));
PUSHs(right);
- PUSHs((SV*)gv);
+ PUSHs((SV*)GvCV(gv));
PUTBACK;
if (op = pp_entersub())
PUSHs(left);
PUSHs(sv_2mortal(newSViv(O_RDONLY)));
PUSHs(right);
- PUSHs((SV*)gv);
+ PUSHs((SV*)GvCV(gv));
PUTBACK;
if (op = pp_entersub())
}
#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
-#ifdef __linux__
+#if defined(__linux__) || defined(OS2)
growsize = sizeof(fd_set);
#else
growsize = maxlen; /* little endians can use vecs directly */
goto just_say_no;
}
else {
-#ifdef LC_NUMERIC
+#ifdef USE_LOCALE_NUMERIC
if (op->op_private & OPpLOCALE)
- NUMERIC_LOCAL();
+ SET_NUMERIC_LOCAL();
else
- NUMERIC_STANDARD();
-#endif /* LC_NUMERIC */
+ SET_NUMERIC_STANDARD();
+#endif
do_sprintf(sv, SP - MARK, MARK + 1);
if (!do_print(sv, fp))
goto just_say_no;
if (!gv)
goto say_undef;
bufsv = *++MARK;
+ if (! SvOK(bufsv))
+ sv_setpvn(bufsv, "", 0);
buffer = SvPV_force(bufsv, blen);
length = SvIVx(*++MARK);
if (length < 0)
GV *gv;
PerlIO *fp;
-#if defined(HAS_FLOCK) || defined(flock)
+#ifdef FLOCK
argtype = POPi;
if (MAXARG <= 0)
gv = last_in_gv;
else
fp = Nullfp;
if (fp) {
- value = (I32)(flock(PerlIO_fileno(fp), argtype) >= 0);
+ value = (I32)(FLOCK(PerlIO_fileno(fp), argtype) >= 0);
}
else
value = 0;
goto nuts2;
break;
}
+#ifdef BOGUS_GETNAME_RETURN
+ /* Interactive Unix, getpeername() and getsockname()
+ does not return valid namelen */
+ if (aint == BOGUS_GETNAME_RETURN)
+ aint = sizeof(struct sockaddr);
+#endif
SvCUR_set(sv,aint);
*SvEND(sv) ='\0';
PUSHs(sv);
laststype = OP_STAT;
statgv = tmpgv;
sv_setpv(statname, "");
- if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
- Fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) {
- max = 0;
- laststatval = -1;
- }
+ laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv))
+ ? Fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &statcache) : -1);
}
- else if (laststatval < 0)
+ if (laststatval < 0)
max = 0;
}
else {
}
}
- EXTEND(SP, 13);
- EXTEND_MORTAL(13);
if (GIMME != G_ARRAY) {
+ EXTEND(SP, 1);
if (max)
RETPUSHYES;
else
RETPUSHUNDEF;
}
if (max) {
+ EXTEND(SP, max);
+ EXTEND_MORTAL(max);
+
PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
STDCHAR tbuf[512];
register STDCHAR *s;
register IO *io;
- SV *sv;
+ register SV *sv;
+ GV *gv;
- if (op->op_flags & OPf_REF) {
+ if (op->op_flags & OPf_REF)
+ gv = cGVOP->op_gv;
+ else if (isGV(TOPs))
+ gv = (GV*)POPs;
+ else if (SvROK(TOPs) && isGV(SvRV(TOPs)))
+ gv = (GV*)SvRV(POPs);
+ else
+ gv = Nullgv;
+
+ if (gv) {
EXTEND(SP, 1);
- if (cGVOP->op_gv == defgv) {
+ if (gv == defgv) {
if (statgv)
io = GvIO(statgv);
else {
}
}
else {
- statgv = cGVOP->op_gv;
+ statgv = gv;
+ laststatval = -1;
sv_setpv(statname, "");
io = GvIO(statgv);
}
if (io && IoIFP(io)) {
- if (PerlIO_has_base(IoIFP(io))) {
- Fstat(PerlIO_fileno(IoIFP(io)), &statcache);
+ if (! PerlIO_has_base(IoIFP(io)))
+ DIE("-T and -B not implemented on filehandles");
+ laststatval = Fstat(PerlIO_fileno(IoIFP(io)), &statcache);
+ if (laststatval < 0)
+ RETPUSHUNDEF;
if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */
if (op->op_type == OP_FTTEXT)
RETPUSHNO;
/* sfio can have large buffers - limit to 512 */
if (len > 512)
len = 512;
- }
- else {
- DIE("-T and -B not implemented on filehandles");
- }
}
else {
if (dowarn)
}
else {
sv = POPs;
+ really_filename:
statgv = Nullgv;
+ laststatval = -1;
sv_setpv(statname, SvPV(sv, na));
- really_filename:
#ifdef HAS_OPEN3
i = open(SvPV(sv, na), O_RDONLY, 0);
#else
warn(warn_nl, "open");
RETPUSHUNDEF;
}
- Fstat(i, &statcache);
+ laststatval = Fstat(i, &statcache);
+ if (laststatval < 0)
+ RETPUSHUNDEF;
len = read(i, tbuf, 512);
(void)close(i);
if (len <= 0) {
#ifdef HAS_RENAME
anum = rename(tmps, tmps2);
#else
- if (same_dirent(tmps2, tmps)) /* can always rename to same name */
- anum = 1;
- else {
- if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
- (void)UNLINK(tmps2);
- if (!(anum = link(tmps, tmps2)))
- anum = UNLINK(tmps);
+ if (!(anum = Stat(tmps, &statbuf))) {
+ if (same_dirent(tmps2, tmps)) /* can always rename to same name */
+ anum = 1;
+ else {
+ if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
+ (void)UNLINK(tmps2);
+ if (!(anum = link(tmps, tmps2)))
+ anum = UNLINK(tmps);
+ }
}
#endif
SETi( anum >= 0 );
sleep(5);
}
if (childpid > 0) {
- rsignalsave(SIGINT, SIG_IGN, &ihand);
- rsignalsave(SIGQUIT, SIG_IGN, &qhand);
+ rsignal_save(SIGINT, SIG_IGN, &ihand);
+ rsignal_save(SIGQUIT, SIG_IGN, &qhand);
do {
result = wait4pid(childpid, &status, 0);
} while (result == -1 && errno == EINTR);
- (void)rsignalrestore(SIGINT, &ihand);
- (void)rsignalrestore(SIGQUIT, &qhand);
+ (void)rsignal_restore(SIGINT, &ihand);
+ (void)rsignal_restore(SIGQUIT, &qhand);
statusvalue = FIXSTATUS(status);
if (result < 0)
value = -1;
}
else if (which == OP_GSBYPORT) {
char *proto = POPp;
- int port = POPi;
+ unsigned short port = POPu;
+#ifdef HAS_HTONS
+ port = htons(port);
+#endif
sent = getservbyport(port, proto);
}
else
#endif
}
-#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
+#ifdef FCNTL_EMULATE_FLOCK
+
+/* XXX Emulate flock() with fcntl().
+ What's really needed is a good file locking module.
+*/
+
+static int
+fcntl_emulate_flock(fd, operation)
+int fd;
+int operation;
+{
+ struct flock flock;
+
+ switch (operation & ~LOCK_NB) {
+ case LOCK_SH:
+ flock.l_type = F_RDLCK;
+ break;
+ case LOCK_EX:
+ flock.l_type = F_WRLCK;
+ break;
+ case LOCK_UN:
+ flock.l_type = F_UNLCK;
+ break;
+ default:
+ errno = EINVAL;
+ return -1;
+ }
+ flock.l_whence = SEEK_SET;
+ flock.l_start = flock.l_len = 0L;
+
+ return fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock);
+}
+
+#endif /* FCNTL_EMULATE_FLOCK */
+
+#ifdef LOCKF_EMULATE_FLOCK
/* XXX Emulate flock() with lockf(). This is just to increase
portability of scripts. The calls are not completely
# define F_TEST 3 /* Test a region for other processes locks */
# endif
-/* These are the flock() constants. Since this sytems doesn't have
- flock(), the values of the constants are probably not available.
-*/
-# ifndef LOCK_SH
-# define LOCK_SH 1
-# endif
-# ifndef LOCK_EX
-# define LOCK_EX 2
-# endif
-# ifndef LOCK_NB
-# define LOCK_NB 4
-# endif
-# ifndef LOCK_UN
-# define LOCK_UN 8
-# endif
-
static int
lockf_emulate_flock (fd, operation)
int fd;
errno = EWOULDBLOCK;
break;
- /* LOCK_UN - unlock */
+ /* LOCK_UN - unlock (non-blocking is a no-op) */
case LOCK_UN:
+ case LOCK_UN|LOCK_NB:
i = lockf (fd, F_ULOCK, 0);
break;
}
return (i);
}
-#endif
+
+#endif /* LOCKF_EMULATE_FLOCK */
projects / p5sagit/p5-mst-13.2.git / blobdiff