#include "EXTERN.h"
#include "perl.h"
-/* Omit this -- it causes too much grief on mixed systems.
-#ifdef I_UNISTD
-#include <unistd.h>
-#endif
+/* XXX Omit this -- it causes too much grief on mixed systems.
+ Next time, I should force broken systems to unset i_unistd in
+ hint files.
*/
+#if 0
+# ifdef I_UNISTD
+# include <unistd.h>
+# endif
+#endif
/* Put this after #includes because fork and vfork prototypes may
conflict.
}
}
}
- statusvalue = my_pclose(fp);
+ statusvalue = FIXSTATUS(my_pclose(fp));
}
else {
statusvalue = -1;
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
- SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
+ SV *error = GvSV(errgv);
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...caught");
tmps = SvPV(TOPs, na);
}
if (!tmps || !*tmps) {
- SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
+ SV *error = GvSV(errgv);
(void)SvUPGRADE(error, SVt_PV);
if (SvPOK(error) && SvCUR(error))
sv_catpv(error, "\t...propagated");
if (MAXARG > 1)
sv = POPs;
- else
+ else if (SvTYPE(TOPs) == SVt_PVGV)
sv = GvSV(TOPs);
+ else
+ DIE(no_usym, "filehandle");
gv = (GV*)POPs;
tmps = SvPV(sv, len);
if (do_open(gv, tmps, len,Nullfp)) {
if (!rgv || !wgv)
goto badexit;
+ if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
+ DIE(no_usym, "filehandle");
rstio = GvIOn(rgv);
wstio = GvIOn(wgv);
stash = gv_stashsv(sv, FALSE);
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
PUTBACK;
- perl_requirepv("AnyDBM_File.pm");
+ perl_require_pv("AnyDBM_File.pm");
SPAGAIN;
if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
DIE("No dbm on this machine");
}
#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
+#ifdef __linux__
+ growsize = sizeof(fd_set);
+#else
growsize = maxlen; /* little endians can use vecs directly */
+#endif
#else
#ifdef NFDBITS
#endif
}
+void
+setdefout(gv)
+GV *gv;
+{
+ if (gv)
+ (void)SvREFCNT_inc(gv);
+ if (defoutgv)
+ SvREFCNT_dec(defoutgv);
+ defoutgv = gv;
+}
+
PP(pp_select)
{
dSP; dTARGET;
- GV *oldgv = defoutgv;
- if (op->op_private > 0) {
- defoutgv = (GV*)POPs;
- if (!GvIO(defoutgv))
- gv_IOadd(defoutgv);
+ GV *newdefout, *egv;
+ HV *hv;
+
+ newdefout = (op->op_private > 0) ? ((GV *) POPs) : NULL;
+
+ egv = GvEGV(defoutgv);
+ if (!egv)
+ egv = defoutgv;
+ hv = GvSTASH(egv);
+ if (! hv)
+ XPUSHs(&sv_undef);
+ else {
+ GV **gvp = hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
+ if (gvp && *gvp == egv)
+ gv_efullname(TARG, defoutgv);
+ else
+ sv_setsv(TARG, sv_2mortal(newRV(egv)));
+ XPUSHTARG;
+ }
+
+ if (newdefout) {
+ if (!GvIO(newdefout))
+ gv_IOadd(newdefout);
+ setdefout(newdefout);
}
- gv_efullname(TARG, oldgv);
- XPUSHTARG;
+
RETURN;
}
SAVESPTR(curpad);
curpad = AvARRAY((AV*)svp[1]);
- defoutgv = gv; /* locally select filehandle so $% et al work */
+ setdefout(gv); /* locally select filehandle so $% et al work */
return CvSTART(cv);
}
if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
formtarget != toptarget)
{
+ GV *fgv;
+ CV *cv;
if (!IoTOP_GV(io)) {
GV *topgv;
char tmpbuf[256];
if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear. It still doesn't fit. */
I32 lines = IoLINES_LEFT(io);
char *s = SvPVX(formtarget);
+ if (lines <= 0) /* Yow, header didn't even fit!!! */
+ goto forget_top;
while (lines-- > 0) {
s = strchr(s, '\n');
if (!s)
IoPAGE(io)++;
formtarget = toptarget;
IoFLAGS(io) |= IOf_DIDTOP;
- return doform(GvFORM(IoTOP_GV(io)),gv,op);
+ fgv = IoTOP_GV(io);
+ if (!fgv)
+ DIE("bad top format reference");
+ cv = GvFORM(fgv);
+ if (!cv) {
+ SV *tmpsv = sv_newmortal();
+ gv_efullname(tmpsv, fgv);
+ DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
+ }
+ return doform(cv,gv,op);
}
forget_top:
GV *tmpgv;
SETERRNO(0,0);
-#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE)
+#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
#ifdef HAS_TRUNCATE
if (op->op_flags & OPf_SPECIAL) {
tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
DIE("ioctl is not implemented");
#endif
else
-#ifdef DOSISH
+#if defined(DOSISH) && !defined(OS2)
DIE("fcntl is not implemented");
#else
# ifdef HAS_FCNTL
+# if defined(OS2) && defined(__EMX__)
+ retval = fcntl(fileno(IoIFP(io)), func, (int)s);
+# else
retval = fcntl(fileno(IoIFP(io)), func, s);
+# endif
# else
DIE("fcntl is not implemented");
# endif
int argtype;
GV *gv;
FILE *fp;
-#ifdef HAS_FLOCK
+
+#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
+# define flock lockf_emulate_flock
+#endif
+
+#if defined(HAS_FLOCK) || defined(flock)
argtype = POPi;
if (MAXARG <= 0)
gv = last_in_gv;
PUSHi(value);
RETURN;
#else
-# ifdef HAS_LOCKF
- DIE(no_func, "flock()"); /* XXX emulate flock() with lockf()? */
-# else
DIE(no_func, "flock()");
-# endif
#endif
}
PP(pp_accept)
{
- struct sockaddr_in saddr; /* use a struct to avoid alignment problems */
dSP; dTARGET;
#ifdef HAS_SOCKET
GV *ngv;
GV *ggv;
register IO *nstio;
register IO *gstio;
+ struct sockaddr saddr; /* use a struct to avoid alignment problems */
int len = sizeof saddr;
int fd;
RETPUSHNO;
}
-#if defined(USE_STD_STDIO) || defined(atarist) /* this will work with atariST */
-# define FBASE(f) ((f)->_base)
-# define FSIZE(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
-# define FPTR(f) ((f)->_ptr)
-# define FCOUNT(f) ((f)->_cnt)
-#else
-# if defined(USE_LINUX_STDIO)
-# define FBASE(f) ((f)->_IO_read_base)
-# define FSIZE(f) ((f)->_IO_read_end - FBASE(f))
-# define FPTR(f) ((f)->_IO_read_ptr)
-# define FCOUNT(f) ((f)->_IO_read_end - FPTR(f))
-# endif
+#if defined(atarist) /* this will work with atariST. Configure will
+ make guesses for other systems. */
+# define FILE_base(f) ((f)->_base)
+# define FILE_ptr(f) ((f)->_ptr)
+# define FILE_cnt(f) ((f)->_cnt)
+# define FILE_bufsiz(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
#endif
PP(pp_fttext)
io = GvIO(statgv);
}
if (io && IoIFP(io)) {
-#ifdef FBASE
+#ifdef FILE_base
Fstat(fileno(IoIFP(io)), &statcache);
if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */
if (op->op_type == OP_FTTEXT)
RETPUSHNO;
else
RETPUSHYES;
- if (FCOUNT(IoIFP(io)) <= 0) {
+ if (FILE_cnt(IoIFP(io)) <= 0) {
i = getc(IoIFP(io));
if (i != EOF)
(void)ungetc(i, IoIFP(io));
}
- if (FCOUNT(IoIFP(io)) <= 0) /* null file is anything */
+ if (FILE_cnt(IoIFP(io)) <= 0) /* null file is anything */
RETPUSHYES;
- len = FSIZE(IoIFP(io));
- s = FBASE(IoIFP(io));
+ len = FILE_bufsiz(IoIFP(io));
+ s = FILE_base(IoIFP(io));
#else
DIE("-T and -B not implemented on filehandles");
#endif
}
/* now scan s to look for textiness */
+ /* XXX ASCII dependent code */
for (i = 0; i < len; i++, s++) {
if (!*s) { /* null never allowed in text */
odd++;
}
- if ((odd * 30 > len) == (op->op_type == OP_FTTEXT)) /* allow 30% odd */
+ if ((odd * 3 > len) == (op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
RETPUSHNO;
else
RETPUSHYES;
#ifdef VMS
/* Clear the DEFAULT element of ENV so we'll get the new value
* in the future. */
- hv_delete(GvHVn(envgv),"DEFAULT",7);
+ hv_delete(GvHVn(envgv),"DEFAULT",7,G_DISCARD);
#endif
RETURN;
}
char *filename;
{
char mybuf[8192];
- char *s, *tmps;
+ char *s,
+ *save_filename = filename;
int anum = 1;
FILE *myfp;
return 0;
}
else { /* some mkdirs return no failure indication */
- anum = (Stat(filename, &statbuf) >= 0);
+ anum = (Stat(save_filename, &statbuf) >= 0);
if (op->op_type == OP_RMDIR)
anum = !anum;
if (anum)
else {
value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
}
+ statusvalue = FIXSTATUS(value);
do_execfree();
SP = ORIGMARK;
PUSHi(value);
(void)times((tbuffer_t *)×buf); /* time.h uses different name for */
/* struct tms, though same data */
/* is returned. */
+#undef HZ
+#define HZ CLK_TCK
#endif
PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
#endif
}
+#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
+
+/* XXX Emulate flock() with lockf(). This is just to increase
+ portability of scripts. The calls are not completely
+ interchangeable. What's really needed is a good file
+ locking module.
+*/
+
+/* We might need <unistd.h> because it sometimes defines the lockf()
+ constants. Unfortunately, <unistd.h> causes troubles on some mixed
+ (BSD/POSIX) systems, such as SunOS 4.1.3. We could just try including
+ <unistd.h> here in this part of the file, but that might
+ conflict with various other #defines and includes above, such as
+ #define vfork fork above.
+
+ Further, the lockf() constants aren't POSIX, so they might not be
+ visible if we're compiling with _POSIX_SOURCE defined. Thus, we'll
+ just stick in the SVID values and be done with it. Sigh.
+*/
+
+# ifndef F_ULOCK
+# define F_ULOCK 0 /* Unlock a previously locked region */
+# endif
+# ifndef F_LOCK
+# define F_LOCK 1 /* Lock a region for exclusive use */
+# endif
+# ifndef F_TLOCK
+# define F_TLOCK 2 /* Test and lock a region for exclusive use */
+# endif
+# ifndef F_TEST
+# 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
+
+int
+lockf_emulate_flock (fd, operation)
+int fd;
+int operation;
+{
+ int i;
+ switch (operation) {
+
+ /* LOCK_SH - get a shared lock */
+ case LOCK_SH:
+ /* LOCK_EX - get an exclusive lock */
+ case LOCK_EX:
+ i = lockf (fd, F_LOCK, 0);
+ break;
+
+ /* LOCK_SH|LOCK_NB - get a non-blocking shared lock */
+ case LOCK_SH|LOCK_NB:
+ /* LOCK_EX|LOCK_NB - get a non-blocking exclusive lock */
+ case LOCK_EX|LOCK_NB:
+ i = lockf (fd, F_TLOCK, 0);
+ if (i == -1)
+ if ((errno == EAGAIN) || (errno == EACCES))
+ errno = EWOULDBLOCK;
+ break;
+
+ /* LOCK_UN - unlock */
+ case LOCK_UN:
+ i = lockf (fd, F_ULOCK, 0);
+ break;
+
+ /* Default - can't decipher operation */
+ default:
+ i = -1;
+ errno = EINVAL;
+ break;
+ }
+ return (i);
+}
+#endif
projects / p5sagit/p5-mst-13.2.git / blobdiff