This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
perl 5.003_01: pp_hot.c
[perl5.git] / pp_sys.c
CommitLineData
a0d0e21e
LW		 1/* pp_sys.c
2 *
3 * Copyright (c) 1991-1994, Larry Wall
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
8 */
9
10/*
11 * But only a short way ahead its floor and the walls on either side were
12 * cloven by a great fissure, out of which the red glare came, now leaping
13 * up, now dying down into darkness; and all the while far below there was
14 * a rumour and a trouble as of great engines throbbing and labouring.
15 */
16
17#include "EXTERN.h"
18#include "perl.h"
19
16d20bd9
AD		 20/* XXX Omit this -- it causes too much grief on mixed systems.
21 Next time, I should force broken systems to unset i_unistd in
22 hint files.
a0d0e21e 23*/
16d20bd9
AD		 24#if 0
25# ifdef I_UNISTD
26# include <unistd.h>
27# endif
28#endif
a0d0e21e 29
94b6baf5
AD		 30/* Put this after #includes because fork and vfork prototypes may
31 conflict.
32*/
33#ifndef HAS_VFORK
34# define vfork fork
35#endif
36
a0d0e21e
LW		 37#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
38# include <sys/socket.h>
39# include <netdb.h>
40# ifndef ENOTSOCK
41# ifdef I_NET_ERRNO
42# include <net/errno.h>
43# endif
44# endif
45#endif
46
47#ifdef HAS_SELECT
48#ifdef I_SYS_SELECT
49#ifndef I_SYS_TIME
50#include <sys/select.h>
51#endif
52#endif
53#endif
54
55#ifdef HOST_NOT_FOUND
56extern int h_errno;
57#endif
58
59#ifdef HAS_PASSWD
60# ifdef I_PWD
61# include <pwd.h>
62# else
63 struct passwd *getpwnam _((char *));
64 struct passwd *getpwuid _((Uid_t));
65# endif
66 struct passwd *getpwent _((void));
67#endif
68
69#ifdef HAS_GROUP
70# ifdef I_GRP
71# include <grp.h>
72# else
73 struct group *getgrnam _((char *));
74 struct group *getgrgid _((Gid_t));
75# endif
76 struct group *getgrent _((void));
77#endif
78
79#ifdef I_UTIME
80#include <utime.h>
81#endif
82#ifdef I_FCNTL
83#include <fcntl.h>
84#endif
85#ifdef I_SYS_FILE
86#include <sys/file.h>
87#endif
88
a0d0e21e
LW		 89#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
90static int dooneliner _((char *cmd, char *filename));
91#endif
92/* Pushy I/O. */
93
94PP(pp_backtick)
95{
96 dSP; dTARGET;
97 FILE *fp;
98 char *tmps = POPp;
99 TAINT_PROPER("``");
100 fp = my_popen(tmps, "r");
101 if (fp) {
102 sv_setpv(TARG, ""); /* note that this preserves previous buffer */
103 if (GIMME == G_SCALAR) {
104 while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
105 /*SUPPRESS 530*/
106 ;
107 XPUSHs(TARG);
108 }
109 else {
110 SV *sv;
111
112 for (;;) {
113 sv = NEWSV(56, 80);
114 if (sv_gets(sv, fp, 0) == Nullch) {
115 SvREFCNT_dec(sv);
116 break;
117 }
118 XPUSHs(sv_2mortal(sv));
119 if (SvLEN(sv) - SvCUR(sv) > 20) {
120 SvLEN_set(sv, SvCUR(sv)+1);
121 Renew(SvPVX(sv), SvLEN(sv), char);
122 }
123 }
124 }
4633a7c4 125 statusvalue = FIXSTATUS(my_pclose(fp));
a0d0e21e
LW		 126 }
127 else {
128 statusvalue = -1;
129 if (GIMME == G_SCALAR)
130 RETPUSHUNDEF;
131 }
132
133 RETURN;
134}
135
136PP(pp_glob)
137{
138 OP *result;
139 ENTER;
a0d0e21e
LW		 140
141 SAVESPTR(last_in_gv); /* We don't want this to be permanent. */
142 last_in_gv = (GV*)*stack_sp--;
143
c07a80fd 144 SAVESPTR(rs); /* This is not permanent, either. */
145 rs = sv_2mortal(newSVpv("", 1));
146#ifndef DOSISH
147#ifndef CSH
148 *SvPVX(rs) = '\n';
a0d0e21e
LW		 149#endif /* !CSH */
150#endif /* !MSDOS */
c07a80fd 151
a0d0e21e
LW		 152 result = do_readline();
153 LEAVE;
154 return result;
155}
156
157PP(pp_indread)
158{
159 last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
160 return do_readline();
161}
162
163PP(pp_rcatline)
164{
165 last_in_gv = cGVOP->op_gv;
166 return do_readline();
167}
168
169PP(pp_warn)
170{
171 dSP; dMARK;
172 char *tmps;
173 if (SP - MARK != 1) {
174 dTARGET;
175 do_join(TARG, &sv_no, MARK, SP);
176 tmps = SvPV(TARG, na);
177 SP = MARK + 1;
178 }
179 else {
180 tmps = SvPV(TOPs, na);
181 }
182 if (!tmps || !*tmps) {
4633a7c4 183 SV *error = GvSV(errgv);
a0d0e21e
LW		 184 (void)SvUPGRADE(error, SVt_PV);
185 if (SvPOK(error) && SvCUR(error))
186 sv_catpv(error, "\t...caught");
187 tmps = SvPV(error, na);
188 }
189 if (!tmps || !*tmps)
190 tmps = "Warning: something's wrong";
191 warn("%s", tmps);
192 RETSETYES;
193}
194
195PP(pp_die)
196{
197 dSP; dMARK;
198 char *tmps;
199 if (SP - MARK != 1) {
200 dTARGET;
201 do_join(TARG, &sv_no, MARK, SP);
202 tmps = SvPV(TARG, na);
203 SP = MARK + 1;
204 }
205 else {
206 tmps = SvPV(TOPs, na);
207 }
208 if (!tmps || !*tmps) {
4633a7c4 209 SV *error = GvSV(errgv);
a0d0e21e
LW		 210 (void)SvUPGRADE(error, SVt_PV);
211 if (SvPOK(error) && SvCUR(error))
212 sv_catpv(error, "\t...propagated");
213 tmps = SvPV(error, na);
214 }
215 if (!tmps || !*tmps)
216 tmps = "Died";
217 DIE("%s", tmps);
218}
219
220/* I/O. */
221
222PP(pp_open)
223{
224 dSP; dTARGET;
225 GV *gv;
226 SV *sv;
227 char *tmps;
228 STRLEN len;
229
230 if (MAXARG > 1)
231 sv = POPs;
4633a7c4 232 else if (SvTYPE(TOPs) == SVt_PVGV)
a0d0e21e 233 sv = GvSV(TOPs);
4633a7c4
LW		 234 else
235 DIE(no_usym, "filehandle");
a0d0e21e
LW		 236 gv = (GV*)POPs;
237 tmps = SvPV(sv, len);
c07a80fd 238 if (do_open(gv, tmps, len, FALSE, 0, 0, Nullfp)) {
a0d0e21e
LW		 239 IoLINES(GvIOp(gv)) = 0;
240 PUSHi( (I32)forkprocess );
241 }
242 else if (forkprocess == 0) /* we are a new child */
243 PUSHi(0);
244 else
245 RETPUSHUNDEF;
246 RETURN;
247}
248
249PP(pp_close)
250{
251 dSP;
252 GV *gv;
253
254 if (MAXARG == 0)
255 gv = defoutgv;
256 else
257 gv = (GV*)POPs;
258 EXTEND(SP, 1);
259 PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
260 RETURN;
261}
262
263PP(pp_pipe_op)
264{
265 dSP;
266#ifdef HAS_PIPE
267 GV *rgv;
268 GV *wgv;
269 register IO *rstio;
270 register IO *wstio;
271 int fd[2];
272
273 wgv = (GV*)POPs;
274 rgv = (GV*)POPs;
275
276 if (!rgv || !wgv)
277 goto badexit;
278
4633a7c4
LW		 279 if (SvTYPE(rgv) != SVt_PVGV || SvTYPE(wgv) != SVt_PVGV)
280 DIE(no_usym, "filehandle");
a0d0e21e
LW		 281 rstio = GvIOn(rgv);
282 wstio = GvIOn(wgv);
283
284 if (IoIFP(rstio))
285 do_close(rgv, FALSE);
286 if (IoIFP(wstio))
287 do_close(wgv, FALSE);
288
289 if (pipe(fd) < 0)
290 goto badexit;
291
292 IoIFP(rstio) = fdopen(fd[0], "r");
293 IoOFP(wstio) = fdopen(fd[1], "w");
294 IoIFP(wstio) = IoOFP(wstio);
295 IoTYPE(rstio) = '<';
296 IoTYPE(wstio) = '>';
297
298 if (!IoIFP(rstio) || !IoOFP(wstio)) {
299 if (IoIFP(rstio)) fclose(IoIFP(rstio));
300 else close(fd[0]);
301 if (IoOFP(wstio)) fclose(IoOFP(wstio));
302 else close(fd[1]);
303 goto badexit;
304 }
305
306 RETPUSHYES;
307
308badexit:
309 RETPUSHUNDEF;
310#else
311 DIE(no_func, "pipe");
312#endif
313}
314
315PP(pp_fileno)
316{
317 dSP; dTARGET;
318 GV *gv;
319 IO *io;
320 FILE *fp;
321 if (MAXARG < 1)
322 RETPUSHUNDEF;
323 gv = (GV*)POPs;
324 if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
325 RETPUSHUNDEF;
326 PUSHi(fileno(fp));
327 RETURN;
328}
329
330PP(pp_umask)
331{
332 dSP; dTARGET;
333 int anum;
334
335#ifdef HAS_UMASK
336 if (MAXARG < 1) {
337 anum = umask(0);
338 (void)umask(anum);
339 }
340 else
341 anum = umask(POPi);
342 TAINT_PROPER("umask");
343 XPUSHi(anum);
344#else
345 DIE(no_func, "Unsupported function umask");
346#endif
347 RETURN;
348}
349
350PP(pp_binmode)
351{
352 dSP;
353 GV *gv;
354 IO *io;
355 FILE *fp;
356
357 if (MAXARG < 1)
358 RETPUSHUNDEF;
359
360 gv = (GV*)POPs;
361
362 EXTEND(SP, 1);
363 if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
364 RETSETUNDEF;
365
366#ifdef DOSISH
367#ifdef atarist
a5f75d66 368 if (!Fflush(fp) && (fp->_flag |= _IOBIN))
a0d0e21e
LW		 369 RETPUSHYES;
370 else
371 RETPUSHUNDEF;
372#else
373 if (setmode(fileno(fp), OP_BINARY) != -1)
374 RETPUSHYES;
375 else
376 RETPUSHUNDEF;
377#endif
378#else
379 RETPUSHYES;
380#endif
381}
382
383PP(pp_tie)
384{
385 dSP;
386 SV *varsv;
387 HV* stash;
388 GV *gv;
389 BINOP myop;
390 SV *sv;
391 SV **mark = stack_base + ++*markstack_ptr; /* reuse in entersub */
392 I32 markoff = mark - stack_base - 1;
393 char *methname;
394
395 varsv = mark[0];
396 if (SvTYPE(varsv) == SVt_PVHV)
397 methname = "TIEHASH";
398 else if (SvTYPE(varsv) == SVt_PVAV)
399 methname = "TIEARRAY";
400 else if (SvTYPE(varsv) == SVt_PVGV)
401 methname = "TIEHANDLE";
402 else
403 methname = "TIESCALAR";
404
405 stash = gv_stashsv(mark[1], FALSE);
406 if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
407 DIE("Can't locate object method \"%s\" via package \"%s\"",
408 methname, SvPV(mark[1],na));
409
410 Zero(&myop, 1, BINOP);
411 myop.op_last = (OP *) &myop;
412 myop.op_next = Nullop;
413 myop.op_flags = OPf_KNOW|OPf_STACKED;
414
415 ENTER;
416 SAVESPTR(op);
417 op = (OP *) &myop;
418
419 XPUSHs(gv);
420 PUTBACK;
421
422 if (op = pp_entersub())
53a31ece 423 runops();
a0d0e21e
LW		 424 SPAGAIN;
425
426 sv = TOPs;
427 if (sv_isobject(sv)) {
428 if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
429 sv_unmagic(varsv, 'P');
430 sv_magic(varsv, sv, 'P', Nullch, 0);
431 }
432 else {
433 sv_unmagic(varsv, 'q');
434 sv_magic(varsv, sv, 'q', Nullch, 0);
435 }
436 }
437 LEAVE;
438 SP = stack_base + markoff;
439 PUSHs(sv);
440 RETURN;
441}
442
443PP(pp_untie)
444{
445 dSP;
446 if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV)
447 sv_unmagic(TOPs, 'P');
448 else
449 sv_unmagic(TOPs, 'q');
450 RETSETYES;
451}
452
c07a80fd 453PP(pp_tied)
454{
a5f75d66 455 dSP;
c07a80fd 456 SV * sv ;
457 MAGIC * mg ;
458
459 sv = POPs;
460 if (SvMAGICAL(sv)) {
461 if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
462 mg = mg_find(sv, 'P') ;
463 else
464 mg = mg_find(sv, 'q') ;
465
466 if (mg) {
467 PUSHs(sv_2mortal(newSVsv(mg->mg_obj))) ;
468 RETURN ;
469 }
470 }
471
472 RETPUSHUNDEF;
473}
474
a0d0e21e
LW		 475PP(pp_dbmopen)
476{
477 dSP;
478 HV *hv;
479 dPOPPOPssrl;
480 HV* stash;
481 GV *gv;
482 BINOP myop;
483 SV *sv;
484
485 hv = (HV*)POPs;
486
487 sv = sv_mortalcopy(&sv_no);
488 sv_setpv(sv, "AnyDBM_File");
489 stash = gv_stashsv(sv, FALSE);
490 if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
491 PUTBACK;
4633a7c4 492 perl_require_pv("AnyDBM_File.pm");
a0d0e21e
LW		 493 SPAGAIN;
494 if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
495 DIE("No dbm on this machine");
496 }
497
498 Zero(&myop, 1, BINOP);
499 myop.op_last = (OP *) &myop;
500 myop.op_next = Nullop;
501 myop.op_flags = OPf_KNOW|OPf_STACKED;
502
503 ENTER;
504 SAVESPTR(op);
505 op = (OP *) &myop;
506 PUTBACK;
507 pp_pushmark();
508
509 EXTEND(sp, 5);
510 PUSHs(sv);
511 PUSHs(left);
512 if (SvIV(right))
513 PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
514 else
515 PUSHs(sv_2mortal(newSViv(O_RDWR)));
516 PUSHs(right);
517 PUSHs(gv);
518 PUTBACK;
519
520 if (op = pp_entersub())
53a31ece 521 runops();
a0d0e21e
LW		 522 SPAGAIN;
523
524 if (!sv_isobject(TOPs)) {
525 sp--;
526 op = (OP *) &myop;
527 PUTBACK;
528 pp_pushmark();
529
530 PUSHs(sv);
531 PUSHs(left);
532 PUSHs(sv_2mortal(newSViv(O_RDONLY)));
533 PUSHs(right);
534 PUSHs(gv);
535 PUTBACK;
536
537 if (op = pp_entersub())
53a31ece 538 runops();
a0d0e21e
LW		 539 SPAGAIN;
540 }
541
542 if (sv_isobject(TOPs))
543 sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
544 LEAVE;
545 RETURN;
546}
547
548PP(pp_dbmclose)
549{
550 return pp_untie(ARGS);
551}
552
553PP(pp_sselect)
554{
555 dSP; dTARGET;
556#ifdef HAS_SELECT
557 register I32 i;
558 register I32 j;
559 register char *s;
560 register SV *sv;
561 double value;
562 I32 maxlen = 0;
563 I32 nfound;
564 struct timeval timebuf;
565 struct timeval *tbuf = &timebuf;
566 I32 growsize;
567 char *fd_sets[4];
568#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
569 I32 masksize;
570 I32 offset;
571 I32 k;
572
573# if BYTEORDER & 0xf0000
574# define ORDERBYTE (0x88888888 - BYTEORDER)
575# else
576# define ORDERBYTE (0x4444 - BYTEORDER)
577# endif
578
579#endif
580
581 SP -= 4;
582 for (i = 1; i <= 3; i++) {
583 if (!SvPOK(SP[i]))
584 continue;
585 j = SvCUR(SP[i]);
586 if (maxlen < j)
587 maxlen = j;
588 }
589
590#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
4633a7c4
LW		 591#ifdef __linux__
592 growsize = sizeof(fd_set);
593#else
a0d0e21e 594 growsize = maxlen; /* little endians can use vecs directly */
4633a7c4 595#endif
a0d0e21e
LW		 596#else
597#ifdef NFDBITS
598
599#ifndef NBBY
600#define NBBY 8
601#endif
602
603 masksize = NFDBITS / NBBY;
604#else
605 masksize = sizeof(long); /* documented int, everyone seems to use long */
606#endif
607 growsize = maxlen + (masksize - (maxlen % masksize));
608 Zero(&fd_sets[0], 4, char*);
609#endif
610
611 sv = SP[4];
612 if (SvOK(sv)) {
613 value = SvNV(sv);
614 if (value < 0.0)
615 value = 0.0;
616 timebuf.tv_sec = (long)value;
617 value -= (double)timebuf.tv_sec;
618 timebuf.tv_usec = (long)(value * 1000000.0);
619 }
620 else
621 tbuf = Null(struct timeval*);
622
623 for (i = 1; i <= 3; i++) {
624 sv = SP[i];
625 if (!SvOK(sv)) {
626 fd_sets[i] = 0;
627 continue;
628 }
629 else if (!SvPOK(sv))
630 SvPV_force(sv,na); /* force string conversion */
631 j = SvLEN(sv);
632 if (j < growsize) {
633 Sv_Grow(sv, growsize);
a0d0e21e 634 }
c07a80fd 635 j = SvCUR(sv);
636 s = SvPVX(sv) + j;
637 while (++j <= growsize) {
638 *s++ = '\0';
639 }
640
a0d0e21e
LW		 641#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
642 s = SvPVX(sv);
643 New(403, fd_sets[i], growsize, char);
644 for (offset = 0; offset < growsize; offset += masksize) {
645 for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
646 fd_sets[i][j+offset] = s[(k % masksize) + offset];
647 }
648#else
649 fd_sets[i] = SvPVX(sv);
650#endif
651 }
652
653 nfound = select(
654 maxlen * 8,
655 (Select_fd_set_t) fd_sets[1],
656 (Select_fd_set_t) fd_sets[2],
657 (Select_fd_set_t) fd_sets[3],
658 tbuf);
659 for (i = 1; i <= 3; i++) {
660 if (fd_sets[i]) {
661 sv = SP[i];
662#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
663 s = SvPVX(sv);
664 for (offset = 0; offset < growsize; offset += masksize) {
665 for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
666 s[(k % masksize) + offset] = fd_sets[i][j+offset];
667 }
668 Safefree(fd_sets[i]);
669#endif
670 SvSETMAGIC(sv);
671 }
672 }
673
674 PUSHi(nfound);
675 if (GIMME == G_ARRAY && tbuf) {
676 value = (double)(timebuf.tv_sec) +
677 (double)(timebuf.tv_usec) / 1000000.0;
678 PUSHs(sv = sv_mortalcopy(&sv_no));
679 sv_setnv(sv, value);
680 }
681 RETURN;
682#else
683 DIE("select not implemented");
684#endif
685}
686
4633a7c4
LW		 687void
688setdefout(gv)
689GV *gv;
690{
691 if (gv)
692 (void)SvREFCNT_inc(gv);
693 if (defoutgv)
694 SvREFCNT_dec(defoutgv);
695 defoutgv = gv;
696}
697
a0d0e21e
LW		 698PP(pp_select)
699{
700 dSP; dTARGET;
4633a7c4
LW		 701 GV *newdefout, *egv;
702 HV *hv;
703
704 newdefout = (op->op_private > 0) ? ((GV *) POPs) : NULL;
705
706 egv = GvEGV(defoutgv);
707 if (!egv)
708 egv = defoutgv;
709 hv = GvSTASH(egv);
710 if (! hv)
711 XPUSHs(&sv_undef);
712 else {
713 GV **gvp = hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
714 if (gvp && *gvp == egv)
715 gv_efullname(TARG, defoutgv);
716 else
717 sv_setsv(TARG, sv_2mortal(newRV(egv)));
718 XPUSHTARG;
719 }
720
721 if (newdefout) {
722 if (!GvIO(newdefout))
723 gv_IOadd(newdefout);
724 setdefout(newdefout);
725 }
726
a0d0e21e
LW		 727 RETURN;
728}
729
730PP(pp_getc)
731{
732 dSP; dTARGET;
733 GV *gv;
734
735 if (MAXARG <= 0)
736 gv = stdingv;
737 else
738 gv = (GV*)POPs;
739 if (!gv)
740 gv = argvgv;
741 if (!gv || do_eof(gv)) /* make sure we have fp with something */
742 RETPUSHUNDEF;
743 TAINT_IF(1);
744 sv_setpv(TARG, " ");
745 *SvPVX(TARG) = getc(IoIFP(GvIOp(gv))); /* should never be EOF */
746 PUSHTARG;
747 RETURN;
748}
749
750PP(pp_read)
751{
752 return pp_sysread(ARGS);
753}
754
755static OP *
756doform(cv,gv,retop)
757CV *cv;
758GV *gv;
759OP *retop;
760{
761 register CONTEXT *cx;
762 I32 gimme = GIMME;
763 AV* padlist = CvPADLIST(cv);
764 SV** svp = AvARRAY(padlist);
765
766 ENTER;
767 SAVETMPS;
768
769 push_return(retop);
770 PUSHBLOCK(cx, CXt_SUB, stack_sp);
771 PUSHFORMAT(cx);
772 SAVESPTR(curpad);
773 curpad = AvARRAY((AV*)svp[1]);
774
4633a7c4 775 setdefout(gv); /* locally select filehandle so $% et al work */
a0d0e21e
LW		 776 return CvSTART(cv);
777}
778
779PP(pp_enterwrite)
780{
781 dSP;
782 register GV *gv;
783 register IO *io;
784 GV *fgv;
785 CV *cv;
786
787 if (MAXARG == 0)
788 gv = defoutgv;
789 else {
790 gv = (GV*)POPs;
791 if (!gv)
792 gv = defoutgv;
793 }
794 EXTEND(SP, 1);
795 io = GvIO(gv);
796 if (!io) {
797 RETPUSHNO;
798 }
799 if (IoFMT_GV(io))
800 fgv = IoFMT_GV(io);
801 else
802 fgv = gv;
803
804 cv = GvFORM(fgv);
805
806 if (!cv) {
807 if (fgv) {
748a9306
LW		 808 SV *tmpsv = sv_newmortal();
809 gv_efullname(tmpsv, gv);
810 DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
a0d0e21e
LW		 811 }
812 DIE("Not a format reference");
813 }
748a9306 814 IoFLAGS(io) &= ~IOf_DIDTOP;
a0d0e21e
LW		 815
816 return doform(cv,gv,op->op_next);
817}
818
819PP(pp_leavewrite)
820{
821 dSP;
822 GV *gv = cxstack[cxstack_ix].blk_sub.gv;
823 register IO *io = GvIOp(gv);
824 FILE *ofp = IoOFP(io);
825 FILE *fp;
826 SV **newsp;
827 I32 gimme;
828 register CONTEXT *cx;
829
830 DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n",
831 (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
832 if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
833 formtarget != toptarget)
834 {
4633a7c4
LW		 835 GV *fgv;
836 CV *cv;
a0d0e21e
LW		 837 if (!IoTOP_GV(io)) {
838 GV *topgv;
839 char tmpbuf[256];
840
841 if (!IoTOP_NAME(io)) {
842 if (!IoFMT_NAME(io))
843 IoFMT_NAME(io) = savepv(GvNAME(gv));
844 sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
845 topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
748a9306 846 if ((topgv && GvFORM(topgv)) ||
a0d0e21e
LW		 847 !gv_fetchpv("top",FALSE,SVt_PVFM))
848 IoTOP_NAME(io) = savepv(tmpbuf);
849 else
850 IoTOP_NAME(io) = savepv("top");
851 }
852 topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM);
853 if (!topgv || !GvFORM(topgv)) {
854 IoLINES_LEFT(io) = 100000000;
855 goto forget_top;
856 }
857 IoTOP_GV(io) = topgv;
858 }
748a9306
LW		 859 if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear. It still doesn't fit. */
860 I32 lines = IoLINES_LEFT(io);
861 char *s = SvPVX(formtarget);
8e07c86e
AD		 862 if (lines <= 0) /* Yow, header didn't even fit!!! */
863 goto forget_top;
748a9306
LW		 864 while (lines-- > 0) {
865 s = strchr(s, '\n');
866 if (!s)
867 break;
868 s++;
869 }
870 if (s) {
871 fwrite1(SvPVX(formtarget), s - SvPVX(formtarget), 1, ofp);
872 sv_chop(formtarget, s);
873 FmLINES(formtarget) -= IoLINES_LEFT(io);
874 }
875 }
a0d0e21e
LW		 876 if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
877 fwrite1(SvPVX(formfeed), SvCUR(formfeed), 1, ofp);
878 IoLINES_LEFT(io) = IoPAGE_LEN(io);
879 IoPAGE(io)++;
880 formtarget = toptarget;
748a9306 881 IoFLAGS(io) |= IOf_DIDTOP;
4633a7c4
LW		 882 fgv = IoTOP_GV(io);
883 if (!fgv)
884 DIE("bad top format reference");
885 cv = GvFORM(fgv);
886 if (!cv) {
887 SV *tmpsv = sv_newmortal();
888 gv_efullname(tmpsv, fgv);
889 DIE("Undefined top format \"%s\" called",SvPVX(tmpsv));
890 }
891 return doform(cv,gv,op);
a0d0e21e
LW		 892 }
893
894 forget_top:
895 POPBLOCK(cx,curpm);
896 POPFORMAT(cx);
897 LEAVE;
898
899 fp = IoOFP(io);
900 if (!fp) {
901 if (dowarn) {
902 if (IoIFP(io))
903 warn("Filehandle only opened for input");
904 else
905 warn("Write on closed filehandle");
906 }
907 PUSHs(&sv_no);
908 }
909 else {
910 if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
911 if (dowarn)
912 warn("page overflow");
913 }
914 if (!fwrite1(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) ||
915 ferror(fp))
916 PUSHs(&sv_no);
917 else {
918 FmLINES(formtarget) = 0;
919 SvCUR_set(formtarget, 0);
748a9306 920 *SvEND(formtarget) = '\0';
a0d0e21e 921 if (IoFLAGS(io) & IOf_FLUSH)
a5f75d66 922 (void)Fflush(fp);
a0d0e21e
LW		 923 PUSHs(&sv_yes);
924 }
925 }
926 formtarget = bodytarget;
927 PUTBACK;
928 return pop_return();
929}
930
931PP(pp_prtf)
932{
933 dSP; dMARK; dORIGMARK;
934 GV *gv;
935 IO *io;
936 FILE *fp;
937 SV *sv = NEWSV(0,0);
938
939 if (op->op_flags & OPf_STACKED)
940 gv = (GV*)*++MARK;
941 else
942 gv = defoutgv;
943 if (!(io = GvIO(gv))) {
748a9306
LW		 944 if (dowarn) {
945 gv_fullname(sv,gv);
946 warn("Filehandle %s never opened", SvPV(sv,na));
947 }
948 SETERRNO(EBADF,RMS$_IFI);
a0d0e21e
LW		 949 goto just_say_no;
950 }
951 else if (!(fp = IoOFP(io))) {
952 if (dowarn) {
748a9306 953 gv_fullname(sv,gv);
a0d0e21e 954 if (IoIFP(io))
748a9306 955 warn("Filehandle %s opened only for input", SvPV(sv,na));
a0d0e21e 956 else
748a9306 957 warn("printf on closed filehandle %s", SvPV(sv,na));
a0d0e21e 958 }
748a9306 959 SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
a0d0e21e
LW		 960 goto just_say_no;
961 }
962 else {
963 do_sprintf(sv, SP - MARK, MARK + 1);
964 if (!do_print(sv, fp))
965 goto just_say_no;
966
967 if (IoFLAGS(io) & IOf_FLUSH)
a5f75d66 968 if (Fflush(fp) == EOF)
a0d0e21e
LW		 969 goto just_say_no;
970 }
971 SvREFCNT_dec(sv);
972 SP = ORIGMARK;
973 PUSHs(&sv_yes);
974 RETURN;
975
976 just_say_no:
977 SvREFCNT_dec(sv);
978 SP = ORIGMARK;
979 PUSHs(&sv_undef);
980 RETURN;
981}
982
c07a80fd 983PP(pp_sysopen)
984{
a5f75d66 985 dSP;
c07a80fd 986 GV *gv;
c07a80fd 987 SV *sv;
988 char *tmps;
989 STRLEN len;
990 int mode, perm;
991
992 if (MAXARG > 3)
993 perm = POPi;
994 else
995 perm = 0666;
996 mode = POPi;
997 sv = POPs;
998 gv = (GV *)POPs;
999
1000 tmps = SvPV(sv, len);
1001 if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
1002 IoLINES(GvIOp(gv)) = 0;
1003 PUSHs(&sv_yes);
1004 }
1005 else {
1006 PUSHs(&sv_undef);
1007 }
1008 RETURN;
1009}
1010
a0d0e21e
LW		 1011PP(pp_sysread)
1012{
1013 dSP; dMARK; dORIGMARK; dTARGET;
1014 int offset;
1015 GV *gv;
1016 IO *io;
1017 char *buffer;
1018 int length;
1019 int bufsize;
748a9306 1020 SV *bufsv;
a0d0e21e
LW		 1021 STRLEN blen;
1022
1023 gv = (GV*)*++MARK;
1024 if (!gv)
1025 goto say_undef;
748a9306
LW		 1026 bufsv = *++MARK;
1027 buffer = SvPV_force(bufsv, blen);
a0d0e21e
LW		 1028 length = SvIVx(*++MARK);
1029 if (length < 0)
1030 DIE("Negative length");
748a9306 1031 SETERRNO(0,0);
a0d0e21e
LW		 1032 if (MARK < SP)
1033 offset = SvIVx(*++MARK);
1034 else
1035 offset = 0;
1036 io = GvIO(gv);
1037 if (!io || !IoIFP(io))
1038 goto say_undef;
1039#ifdef HAS_SOCKET
1040 if (op->op_type == OP_RECV) {
1041 bufsize = sizeof buf;
748a9306 1042 buffer = SvGROW(bufsv, length+1);
a0d0e21e
LW		 1043 length = recvfrom(fileno(IoIFP(io)), buffer, length, offset,
1044 (struct sockaddr *)buf, &bufsize);
1045 if (length < 0)
1046 RETPUSHUNDEF;
748a9306
LW		 1047 SvCUR_set(bufsv, length);
1048 *SvEND(bufsv) = '\0';
1049 (void)SvPOK_only(bufsv);
1050 SvSETMAGIC(bufsv);
a0d0e21e 1051 if (tainting)
748a9306 1052 sv_magic(bufsv, Nullsv, 't', Nullch, 0);
a0d0e21e
LW		 1053 SP = ORIGMARK;
1054 sv_setpvn(TARG, buf, bufsize);
1055 PUSHs(TARG);
1056 RETURN;
1057 }
1058#else
1059 if (op->op_type == OP_RECV)
1060 DIE(no_sock_func, "recv");
1061#endif
748a9306 1062 buffer = SvGROW(bufsv, length+offset+1);
a0d0e21e
LW		 1063 if (op->op_type == OP_SYSREAD) {
1064 length = read(fileno(IoIFP(io)), buffer+offset, length);
1065 }
1066 else
1067#ifdef HAS_SOCKET__bad_code_maybe
1068 if (IoTYPE(io) == 's') {
1069 bufsize = sizeof buf;
1070 length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0,
1071 (struct sockaddr *)buf, &bufsize);
1072 }
1073 else
1074#endif
1075 length = fread(buffer+offset, 1, length, IoIFP(io));
1076 if (length < 0)
1077 goto say_undef;
748a9306
LW		 1078 SvCUR_set(bufsv, length+offset);
1079 *SvEND(bufsv) = '\0';
1080 (void)SvPOK_only(bufsv);
1081 SvSETMAGIC(bufsv);
a0d0e21e 1082 if (tainting)
748a9306 1083 sv_magic(bufsv, Nullsv, 't', Nullch, 0);
a0d0e21e
LW		 1084 SP = ORIGMARK;
1085 PUSHi(length);
1086 RETURN;
1087
1088 say_undef:
1089 SP = ORIGMARK;
1090 RETPUSHUNDEF;
1091}
1092
1093PP(pp_syswrite)
1094{
1095 return pp_send(ARGS);
1096}
1097
1098PP(pp_send)
1099{
1100 dSP; dMARK; dORIGMARK; dTARGET;
1101 GV *gv;
1102 IO *io;
1103 int offset;
748a9306 1104 SV *bufsv;
a0d0e21e
LW		 1105 char *buffer;
1106 int length;
1107 STRLEN blen;
1108
1109 gv = (GV*)*++MARK;
1110 if (!gv)
1111 goto say_undef;
748a9306
LW		 1112 bufsv = *++MARK;
1113 buffer = SvPV(bufsv, blen);
a0d0e21e
LW		 1114 length = SvIVx(*++MARK);
1115 if (length < 0)
1116 DIE("Negative length");
748a9306 1117 SETERRNO(0,0);
a0d0e21e
LW		 1118 io = GvIO(gv);
1119 if (!io || !IoIFP(io)) {
1120 length = -1;
1121 if (dowarn) {
1122 if (op->op_type == OP_SYSWRITE)
1123 warn("Syswrite on closed filehandle");
1124 else
1125 warn("Send on closed socket");
1126 }
1127 }
1128 else if (op->op_type == OP_SYSWRITE) {
1129 if (MARK < SP)
1130 offset = SvIVx(*++MARK);
1131 else
1132 offset = 0;
1133 if (length > blen - offset)
1134 length = blen - offset;
1135 length = write(fileno(IoIFP(io)), buffer+offset, length);
1136 }
1137#ifdef HAS_SOCKET
1138 else if (SP > MARK) {
1139 char *sockbuf;
1140 STRLEN mlen;
1141 sockbuf = SvPVx(*++MARK, mlen);
1142 length = sendto(fileno(IoIFP(io)), buffer, blen, length,
1143 (struct sockaddr *)sockbuf, mlen);
1144 }
1145 else
1146 length = send(fileno(IoIFP(io)), buffer, blen, length);
1147#else
1148 else
1149 DIE(no_sock_func, "send");
1150#endif
1151 if (length < 0)
1152 goto say_undef;
1153 SP = ORIGMARK;
1154 PUSHi(length);
1155 RETURN;
1156
1157 say_undef:
1158 SP = ORIGMARK;
1159 RETPUSHUNDEF;
1160}
1161
1162PP(pp_recv)
1163{
1164 return pp_sysread(ARGS);
1165}
1166
1167PP(pp_eof)
1168{
1169 dSP;
1170 GV *gv;
1171
1172 if (MAXARG <= 0)
1173 gv = last_in_gv;
1174 else
1175 gv = last_in_gv = (GV*)POPs;
1176 PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no);
1177 RETURN;
1178}
1179
1180PP(pp_tell)
1181{
1182 dSP; dTARGET;
1183 GV *gv;
1184
1185 if (MAXARG <= 0)
1186 gv = last_in_gv;
1187 else
1188 gv = last_in_gv = (GV*)POPs;
1189 PUSHi( do_tell(gv) );
1190 RETURN;
1191}
1192
1193PP(pp_seek)
1194{
1195 dSP;
1196 GV *gv;
1197 int whence = POPi;
1198 long offset = POPl;
1199
1200 gv = last_in_gv = (GV*)POPs;
1201 PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no );
1202 RETURN;
1203}
1204
1205PP(pp_truncate)
1206{
1207 dSP;
1208 Off_t len = (Off_t)POPn;
1209 int result = 1;
1210 GV *tmpgv;
1211
748a9306 1212 SETERRNO(0,0);
5d94fbed 1213#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
a0d0e21e
LW		 1214#ifdef HAS_TRUNCATE
1215 if (op->op_flags & OPf_SPECIAL) {
1216 tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
1217 if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
1218 ftruncate(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
1219 result = 0;
1220 }
1221 else if (truncate(POPp, len) < 0)
1222 result = 0;
1223#else
1224 if (op->op_flags & OPf_SPECIAL) {
1225 tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
1226 if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
1227 chsize(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
1228 result = 0;
1229 }
1230 else {
1231 int tmpfd;
1232
1233 if ((tmpfd = open(POPp, 0)) < 0)
1234 result = 0;
1235 else {
1236 if (chsize(tmpfd, len) < 0)
1237 result = 0;
1238 close(tmpfd);
1239 }
1240 }
1241#endif
1242
1243 if (result)
1244 RETPUSHYES;
1245 if (!errno)
748a9306 1246 SETERRNO(EBADF,RMS$_IFI);
a0d0e21e
LW		 1247 RETPUSHUNDEF;
1248#else
1249 DIE("truncate not implemented");
1250#endif
1251}
1252
1253PP(pp_fcntl)
1254{
1255 return pp_ioctl(ARGS);
1256}
1257
1258PP(pp_ioctl)
1259{
1260 dSP; dTARGET;
748a9306 1261 SV *argsv = POPs;
a0d0e21e
LW		 1262 unsigned int func = U_I(POPn);
1263 int optype = op->op_type;
1264 char *s;
1265 int retval;
1266 GV *gv = (GV*)POPs;
1267 IO *io = GvIOn(gv);
1268
748a9306
LW		 1269 if (!io || !argsv || !IoIFP(io)) {
1270 SETERRNO(EBADF,RMS$_IFI); /* well, sort of... */
a0d0e21e
LW		 1271 RETPUSHUNDEF;
1272 }
1273
748a9306 1274 if (SvPOK(argsv) || !SvNIOK(argsv)) {
a0d0e21e 1275 STRLEN len;
748a9306 1276 s = SvPV_force(argsv, len);
a0d0e21e
LW		 1277 retval = IOCPARM_LEN(func);
1278 if (len < retval) {
748a9306
LW		 1279 s = Sv_Grow(argsv, retval+1);
1280 SvCUR_set(argsv, retval);
a0d0e21e
LW		 1281 }
1282
748a9306 1283 s[SvCUR(argsv)] = 17; /* a little sanity check here */
a0d0e21e
LW		 1284 }
1285 else {
748a9306 1286 retval = SvIV(argsv);
a0d0e21e
LW		 1287#ifdef DOSISH
1288 s = (char*)(long)retval; /* ouch */
1289#else
1290 s = (char*)retval; /* ouch */
1291#endif
1292 }
1293
1294 TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
1295
1296 if (optype == OP_IOCTL)
1297#ifdef HAS_IOCTL
1298 retval = ioctl(fileno(IoIFP(io)), func, s);
1299#else
1300 DIE("ioctl is not implemented");
1301#endif
1302 else
4633a7c4 1303#if defined(DOSISH) && !defined(OS2)
a0d0e21e
LW		 1304 DIE("fcntl is not implemented");
1305#else
1306# ifdef HAS_FCNTL
4633a7c4
LW		 1307# if defined(OS2) && defined(__EMX__)
1308 retval = fcntl(fileno(IoIFP(io)), func, (int)s);
1309# else
a0d0e21e 1310 retval = fcntl(fileno(IoIFP(io)), func, s);
4633a7c4 1311# endif
a0d0e21e
LW		 1312# else
1313 DIE("fcntl is not implemented");
1314# endif
1315#endif
1316
748a9306
LW		 1317 if (SvPOK(argsv)) {
1318 if (s[SvCUR(argsv)] != 17)
a0d0e21e
LW		 1319 DIE("Possible memory corruption: %s overflowed 3rd argument",
1320 op_name[optype]);
748a9306
LW		 1321 s[SvCUR(argsv)] = 0; /* put our null back */
1322 SvSETMAGIC(argsv); /* Assume it has changed */
a0d0e21e
LW		 1323 }
1324
1325 if (retval == -1)
1326 RETPUSHUNDEF;
1327 if (retval != 0) {
1328 PUSHi(retval);
1329 }
1330 else {
1331 PUSHp("0 but true", 10);
1332 }
1333 RETURN;
1334}
1335
1336PP(pp_flock)
1337{
1338 dSP; dTARGET;
1339 I32 value;
1340 int argtype;
1341 GV *gv;
1342 FILE *fp;
16d20bd9
AD		 1343
1344#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
1345# define flock lockf_emulate_flock
1346#endif
1347
1348#if defined(HAS_FLOCK) || defined(flock)
a0d0e21e
LW		 1349 argtype = POPi;
1350 if (MAXARG <= 0)
1351 gv = last_in_gv;
1352 else
1353 gv = (GV*)POPs;
1354 if (gv && GvIO(gv))
1355 fp = IoIFP(GvIOp(gv));
1356 else
1357 fp = Nullfp;
1358 if (fp) {
1359 value = (I32)(flock(fileno(fp), argtype) >= 0);
1360 }
1361 else
1362 value = 0;
1363 PUSHi(value);
1364 RETURN;
1365#else
a0d0e21e 1366 DIE(no_func, "flock()");
a0d0e21e
LW		 1367#endif
1368}
1369
1370/* Sockets. */
1371
1372PP(pp_socket)
1373{
1374 dSP;
1375#ifdef HAS_SOCKET
1376 GV *gv;
1377 register IO *io;
1378 int protocol = POPi;
1379 int type = POPi;
1380 int domain = POPi;
1381 int fd;
1382
1383 gv = (GV*)POPs;
1384
1385 if (!gv) {
748a9306 1386 SETERRNO(EBADF,LIB$_INVARG);
a0d0e21e
LW		 1387 RETPUSHUNDEF;
1388 }
1389
1390 io = GvIOn(gv);
1391 if (IoIFP(io))
1392 do_close(gv, FALSE);
1393
1394 TAINT_PROPER("socket");
1395 fd = socket(domain, type, protocol);
1396 if (fd < 0)
1397 RETPUSHUNDEF;
1398 IoIFP(io) = fdopen(fd, "r"); /* stdio gets confused about sockets */
1399 IoOFP(io) = fdopen(fd, "w");
1400 IoTYPE(io) = 's';
1401 if (!IoIFP(io) || !IoOFP(io)) {
1402 if (IoIFP(io)) fclose(IoIFP(io));
1403 if (IoOFP(io)) fclose(IoOFP(io));
1404 if (!IoIFP(io) && !IoOFP(io)) close(fd);
1405 RETPUSHUNDEF;
1406 }
1407
1408 RETPUSHYES;
1409#else
1410 DIE(no_sock_func, "socket");
1411#endif
1412}
1413
1414PP(pp_sockpair)
1415{
1416 dSP;
1417#ifdef HAS_SOCKETPAIR
1418 GV *gv1;
1419 GV *gv2;
1420 register IO *io1;
1421 register IO *io2;
1422 int protocol = POPi;
1423 int type = POPi;
1424 int domain = POPi;
1425 int fd[2];
1426
1427 gv2 = (GV*)POPs;
1428 gv1 = (GV*)POPs;
1429 if (!gv1 || !gv2)
1430 RETPUSHUNDEF;
1431
1432 io1 = GvIOn(gv1);
1433 io2 = GvIOn(gv2);
1434 if (IoIFP(io1))
1435 do_close(gv1, FALSE);
1436 if (IoIFP(io2))
1437 do_close(gv2, FALSE);
1438
1439 TAINT_PROPER("socketpair");
1440 if (socketpair(domain, type, protocol, fd) < 0)
1441 RETPUSHUNDEF;
1442 IoIFP(io1) = fdopen(fd[0], "r");
1443 IoOFP(io1) = fdopen(fd[0], "w");
1444 IoTYPE(io1) = 's';
1445 IoIFP(io2) = fdopen(fd[1], "r");
1446 IoOFP(io2) = fdopen(fd[1], "w");
1447 IoTYPE(io2) = 's';
1448 if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
1449 if (IoIFP(io1)) fclose(IoIFP(io1));
1450 if (IoOFP(io1)) fclose(IoOFP(io1));
1451 if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
1452 if (IoIFP(io2)) fclose(IoIFP(io2));
1453 if (IoOFP(io2)) fclose(IoOFP(io2));
1454 if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
1455 RETPUSHUNDEF;
1456 }
1457
1458 RETPUSHYES;
1459#else
1460 DIE(no_sock_func, "socketpair");
1461#endif
1462}
1463
1464PP(pp_bind)
1465{
1466 dSP;
1467#ifdef HAS_SOCKET
748a9306 1468 SV *addrsv = POPs;
a0d0e21e
LW		 1469 char *addr;
1470 GV *gv = (GV*)POPs;
1471 register IO *io = GvIOn(gv);
1472 STRLEN len;
1473
1474 if (!io || !IoIFP(io))
1475 goto nuts;
1476
748a9306 1477 addr = SvPV(addrsv, len);
a0d0e21e
LW		 1478 TAINT_PROPER("bind");
1479 if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
1480 RETPUSHYES;
1481 else
1482 RETPUSHUNDEF;
1483
1484nuts:
1485 if (dowarn)
1486 warn("bind() on closed fd");
748a9306 1487 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1488 RETPUSHUNDEF;
1489#else
1490 DIE(no_sock_func, "bind");
1491#endif
1492}
1493
1494PP(pp_connect)
1495{
1496 dSP;
1497#ifdef HAS_SOCKET
748a9306 1498 SV *addrsv = POPs;
a0d0e21e
LW		 1499 char *addr;
1500 GV *gv = (GV*)POPs;
1501 register IO *io = GvIOn(gv);
1502 STRLEN len;
1503
1504 if (!io || !IoIFP(io))
1505 goto nuts;
1506
748a9306 1507 addr = SvPV(addrsv, len);
a0d0e21e
LW		 1508 TAINT_PROPER("connect");
1509 if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
1510 RETPUSHYES;
1511 else
1512 RETPUSHUNDEF;
1513
1514nuts:
1515 if (dowarn)
1516 warn("connect() on closed fd");
748a9306 1517 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1518 RETPUSHUNDEF;
1519#else
1520 DIE(no_sock_func, "connect");
1521#endif
1522}
1523
1524PP(pp_listen)
1525{
1526 dSP;
1527#ifdef HAS_SOCKET
1528 int backlog = POPi;
1529 GV *gv = (GV*)POPs;
1530 register IO *io = GvIOn(gv);
1531
1532 if (!io || !IoIFP(io))
1533 goto nuts;
1534
1535 if (listen(fileno(IoIFP(io)), backlog) >= 0)
1536 RETPUSHYES;
1537 else
1538 RETPUSHUNDEF;
1539
1540nuts:
1541 if (dowarn)
1542 warn("listen() on closed fd");
748a9306 1543 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1544 RETPUSHUNDEF;
1545#else
1546 DIE(no_sock_func, "listen");
1547#endif
1548}
1549
1550PP(pp_accept)
1551{
1552 dSP; dTARGET;
1553#ifdef HAS_SOCKET
1554 GV *ngv;
1555 GV *ggv;
1556 register IO *nstio;
1557 register IO *gstio;
4633a7c4 1558 struct sockaddr saddr; /* use a struct to avoid alignment problems */
748a9306 1559 int len = sizeof saddr;
a0d0e21e
LW		 1560 int fd;
1561
1562 ggv = (GV*)POPs;
1563 ngv = (GV*)POPs;
1564
1565 if (!ngv)
1566 goto badexit;
1567 if (!ggv)
1568 goto nuts;
1569
1570 gstio = GvIO(ggv);
1571 if (!gstio || !IoIFP(gstio))
1572 goto nuts;
1573
1574 nstio = GvIOn(ngv);
1575 if (IoIFP(nstio))
1576 do_close(ngv, FALSE);
1577
748a9306 1578 fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
a0d0e21e
LW		 1579 if (fd < 0)
1580 goto badexit;
1581 IoIFP(nstio) = fdopen(fd, "r");
1582 IoOFP(nstio) = fdopen(fd, "w");
1583 IoTYPE(nstio) = 's';
1584 if (!IoIFP(nstio) || !IoOFP(nstio)) {
1585 if (IoIFP(nstio)) fclose(IoIFP(nstio));
1586 if (IoOFP(nstio)) fclose(IoOFP(nstio));
1587 if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
1588 goto badexit;
1589 }
1590
748a9306 1591 PUSHp((char *)&saddr, len);
a0d0e21e
LW		 1592 RETURN;
1593
1594nuts:
1595 if (dowarn)
1596 warn("accept() on closed fd");
748a9306 1597 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1598
1599badexit:
1600 RETPUSHUNDEF;
1601
1602#else
1603 DIE(no_sock_func, "accept");
1604#endif
1605}
1606
1607PP(pp_shutdown)
1608{
1609 dSP; dTARGET;
1610#ifdef HAS_SOCKET
1611 int how = POPi;
1612 GV *gv = (GV*)POPs;
1613 register IO *io = GvIOn(gv);
1614
1615 if (!io || !IoIFP(io))
1616 goto nuts;
1617
1618 PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 );
1619 RETURN;
1620
1621nuts:
1622 if (dowarn)
1623 warn("shutdown() on closed fd");
748a9306 1624 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1625 RETPUSHUNDEF;
1626#else
1627 DIE(no_sock_func, "shutdown");
1628#endif
1629}
1630
1631PP(pp_gsockopt)
1632{
1633#ifdef HAS_SOCKET
1634 return pp_ssockopt(ARGS);
1635#else
1636 DIE(no_sock_func, "getsockopt");
1637#endif
1638}
1639
1640PP(pp_ssockopt)
1641{
1642 dSP;
1643#ifdef HAS_SOCKET
1644 int optype = op->op_type;
1645 SV *sv;
1646 int fd;
1647 unsigned int optname;
1648 unsigned int lvl;
1649 GV *gv;
1650 register IO *io;
748a9306 1651 int aint;
a0d0e21e
LW		 1652
1653 if (optype == OP_GSOCKOPT)
1654 sv = sv_2mortal(NEWSV(22, 257));
1655 else
1656 sv = POPs;
1657 optname = (unsigned int) POPi;
1658 lvl = (unsigned int) POPi;
1659
1660 gv = (GV*)POPs;
1661 io = GvIOn(gv);
1662 if (!io || !IoIFP(io))
1663 goto nuts;
1664
1665 fd = fileno(IoIFP(io));
1666 switch (optype) {
1667 case OP_GSOCKOPT:
748a9306 1668 SvGROW(sv, 257);
a0d0e21e 1669 (void)SvPOK_only(sv);
748a9306
LW		 1670 SvCUR_set(sv,256);
1671 *SvEND(sv) ='\0';
1672 aint = SvCUR(sv);
1673 if (getsockopt(fd, lvl, optname, SvPVX(sv), &aint) < 0)
a0d0e21e 1674 goto nuts2;
748a9306
LW		 1675 SvCUR_set(sv,aint);
1676 *SvEND(sv) ='\0';
a0d0e21e
LW		 1677 PUSHs(sv);
1678 break;
1679 case OP_SSOCKOPT: {
a0d0e21e
LW		 1680 STRLEN len = 0;
1681 char *buf = 0;
1682 if (SvPOKp(sv))
1683 buf = SvPV(sv, len);
1684 else if (SvOK(sv)) {
1685 aint = (int)SvIV(sv);
1686 buf = (char*)&aint;
1687 len = sizeof(int);
1688 }
1689 if (setsockopt(fd, lvl, optname, buf, (int)len) < 0)
1690 goto nuts2;
1691 PUSHs(&sv_yes);
1692 }
1693 break;
1694 }
1695 RETURN;
1696
1697nuts:
1698 if (dowarn)
1699 warn("[gs]etsockopt() on closed fd");
748a9306 1700 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1701nuts2:
1702 RETPUSHUNDEF;
1703
1704#else
1705 DIE(no_sock_func, "setsockopt");
1706#endif
1707}
1708
1709PP(pp_getsockname)
1710{
1711#ifdef HAS_SOCKET
1712 return pp_getpeername(ARGS);
1713#else
1714 DIE(no_sock_func, "getsockname");
1715#endif
1716}
1717
1718PP(pp_getpeername)
1719{
1720 dSP;
1721#ifdef HAS_SOCKET
1722 int optype = op->op_type;
1723 SV *sv;
1724 int fd;
1725 GV *gv = (GV*)POPs;
1726 register IO *io = GvIOn(gv);
748a9306 1727 int aint;
a0d0e21e
LW		 1728
1729 if (!io || !IoIFP(io))
1730 goto nuts;
1731
1732 sv = sv_2mortal(NEWSV(22, 257));
748a9306
LW		 1733 (void)SvPOK_only(sv);
1734 SvCUR_set(sv,256);
1735 *SvEND(sv) ='\0';
1736 aint = SvCUR(sv);
a0d0e21e
LW		 1737 fd = fileno(IoIFP(io));
1738 switch (optype) {
1739 case OP_GETSOCKNAME:
748a9306 1740 if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
a0d0e21e
LW		 1741 goto nuts2;
1742 break;
1743 case OP_GETPEERNAME:
748a9306 1744 if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
a0d0e21e
LW		 1745 goto nuts2;
1746 break;
1747 }
748a9306
LW		 1748 SvCUR_set(sv,aint);
1749 *SvEND(sv) ='\0';
a0d0e21e
LW		 1750 PUSHs(sv);
1751 RETURN;
1752
1753nuts:
1754 if (dowarn)
1755 warn("get{sock, peer}name() on closed fd");
748a9306 1756 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1757nuts2:
1758 RETPUSHUNDEF;
1759
1760#else
1761 DIE(no_sock_func, "getpeername");
1762#endif
1763}
1764
1765/* Stat calls. */
1766
1767PP(pp_lstat)
1768{
1769 return pp_stat(ARGS);
1770}
1771
1772PP(pp_stat)
1773{
1774 dSP;
1775 GV *tmpgv;
1776 I32 max = 13;
1777
1778 if (op->op_flags & OPf_REF) {
1779 tmpgv = cGVOP->op_gv;
748a9306 1780 do_fstat:
a0d0e21e
LW		 1781 if (tmpgv != defgv) {
1782 laststype = OP_STAT;
1783 statgv = tmpgv;
1784 sv_setpv(statname, "");
1785 if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
1786 Fstat(fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) {
1787 max = 0;
1788 laststatval = -1;
1789 }
1790 }
1791 else if (laststatval < 0)
1792 max = 0;
1793 }
1794 else {
748a9306
LW		 1795 SV* sv = POPs;
1796 if (SvTYPE(sv) == SVt_PVGV) {
1797 tmpgv = (GV*)sv;
1798 goto do_fstat;
1799 }
1800 else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
1801 tmpgv = (GV*)SvRV(sv);
1802 goto do_fstat;
1803 }
1804 sv_setpv(statname, SvPV(sv,na));
a0d0e21e
LW		 1805 statgv = Nullgv;
1806#ifdef HAS_LSTAT
1807 laststype = op->op_type;
1808 if (op->op_type == OP_LSTAT)
1809 laststatval = lstat(SvPV(statname, na), &statcache);
1810 else
1811#endif
1812 laststatval = Stat(SvPV(statname, na), &statcache);
1813 if (laststatval < 0) {
1814 if (dowarn && strchr(SvPV(statname, na), '\n'))
1815 warn(warn_nl, "stat");
1816 max = 0;
1817 }
1818 }
1819
1820 EXTEND(SP, 13);
1821 if (GIMME != G_ARRAY) {
1822 if (max)
1823 RETPUSHYES;
1824 else
1825 RETPUSHUNDEF;
1826 }
1827 if (max) {
1828 PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
1829 PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
1830 PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
1831 PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
1832 PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
1833 PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
1834 PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
1835 PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
1836 PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
1837 PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
1838 PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
1839#ifdef USE_STAT_BLOCKS
1840 PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
1841 PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
1842#else
1843 PUSHs(sv_2mortal(newSVpv("", 0)));
1844 PUSHs(sv_2mortal(newSVpv("", 0)));
1845#endif
1846 }
1847 RETURN;
1848}
1849
1850PP(pp_ftrread)
1851{
1852 I32 result = my_stat(ARGS);
1853 dSP;
1854 if (result < 0)
1855 RETPUSHUNDEF;
1856 if (cando(S_IRUSR, 0, &statcache))
1857 RETPUSHYES;
1858 RETPUSHNO;
1859}
1860
1861PP(pp_ftrwrite)
1862{
1863 I32 result = my_stat(ARGS);
1864 dSP;
1865 if (result < 0)
1866 RETPUSHUNDEF;
1867 if (cando(S_IWUSR, 0, &statcache))
1868 RETPUSHYES;
1869 RETPUSHNO;
1870}
1871
1872PP(pp_ftrexec)
1873{
1874 I32 result = my_stat(ARGS);
1875 dSP;
1876 if (result < 0)
1877 RETPUSHUNDEF;
1878 if (cando(S_IXUSR, 0, &statcache))
1879 RETPUSHYES;
1880 RETPUSHNO;
1881}
1882
1883PP(pp_fteread)
1884{
1885 I32 result = my_stat(ARGS);
1886 dSP;
1887 if (result < 0)
1888 RETPUSHUNDEF;
1889 if (cando(S_IRUSR, 1, &statcache))
1890 RETPUSHYES;
1891 RETPUSHNO;
1892}
1893
1894PP(pp_ftewrite)
1895{
1896 I32 result = my_stat(ARGS);
1897 dSP;
1898 if (result < 0)
1899 RETPUSHUNDEF;
1900 if (cando(S_IWUSR, 1, &statcache))
1901 RETPUSHYES;
1902 RETPUSHNO;
1903}
1904
1905PP(pp_fteexec)
1906{
1907 I32 result = my_stat(ARGS);
1908 dSP;
1909 if (result < 0)
1910 RETPUSHUNDEF;
1911 if (cando(S_IXUSR, 1, &statcache))
1912 RETPUSHYES;
1913 RETPUSHNO;
1914}
1915
1916PP(pp_ftis)
1917{
1918 I32 result = my_stat(ARGS);
1919 dSP;
1920 if (result < 0)
1921 RETPUSHUNDEF;
1922 RETPUSHYES;
1923}
1924
1925PP(pp_fteowned)
1926{
1927 return pp_ftrowned(ARGS);
1928}
1929
1930PP(pp_ftrowned)
1931{
1932 I32 result = my_stat(ARGS);
1933 dSP;
1934 if (result < 0)
1935 RETPUSHUNDEF;
1936 if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
1937 RETPUSHYES;
1938 RETPUSHNO;
1939}
1940
1941PP(pp_ftzero)
1942{
1943 I32 result = my_stat(ARGS);
1944 dSP;
1945 if (result < 0)
1946 RETPUSHUNDEF;
1947 if (!statcache.st_size)
1948 RETPUSHYES;
1949 RETPUSHNO;
1950}
1951
1952PP(pp_ftsize)
1953{
1954 I32 result = my_stat(ARGS);
1955 dSP; dTARGET;
1956 if (result < 0)
1957 RETPUSHUNDEF;
1958 PUSHi(statcache.st_size);
1959 RETURN;
1960}
1961
1962PP(pp_ftmtime)
1963{
1964 I32 result = my_stat(ARGS);
1965 dSP; dTARGET;
1966 if (result < 0)
1967 RETPUSHUNDEF;
53a31ece 1968 PUSHn( ((I32)basetime - (I32)statcache.st_mtime) / 86400.0 );
a0d0e21e
LW		 1969 RETURN;
1970}
1971
1972PP(pp_ftatime)
1973{
1974 I32 result = my_stat(ARGS);
1975 dSP; dTARGET;
1976 if (result < 0)
1977 RETPUSHUNDEF;
53a31ece 1978 PUSHn( ((I32)basetime - (I32)statcache.st_atime) / 86400.0 );
a0d0e21e
LW		 1979 RETURN;
1980}
1981
1982PP(pp_ftctime)
1983{
1984 I32 result = my_stat(ARGS);
1985 dSP; dTARGET;
1986 if (result < 0)
1987 RETPUSHUNDEF;
53a31ece 1988 PUSHn( ((I32)basetime - (I32)statcache.st_ctime) / 86400.0 );
a0d0e21e
LW		 1989 RETURN;
1990}
1991
1992PP(pp_ftsock)
1993{
1994 I32 result = my_stat(ARGS);
1995 dSP;
1996 if (result < 0)
1997 RETPUSHUNDEF;
1998 if (S_ISSOCK(statcache.st_mode))
1999 RETPUSHYES;
2000 RETPUSHNO;
2001}
2002
2003PP(pp_ftchr)
2004{
2005 I32 result = my_stat(ARGS);
2006 dSP;
2007 if (result < 0)
2008 RETPUSHUNDEF;
2009 if (S_ISCHR(statcache.st_mode))
2010 RETPUSHYES;
2011 RETPUSHNO;
2012}
2013
2014PP(pp_ftblk)
2015{
2016 I32 result = my_stat(ARGS);
2017 dSP;
2018 if (result < 0)
2019 RETPUSHUNDEF;
2020 if (S_ISBLK(statcache.st_mode))
2021 RETPUSHYES;
2022 RETPUSHNO;
2023}
2024
2025PP(pp_ftfile)
2026{
2027 I32 result = my_stat(ARGS);
2028 dSP;
2029 if (result < 0)
2030 RETPUSHUNDEF;
2031 if (S_ISREG(statcache.st_mode))
2032 RETPUSHYES;
2033 RETPUSHNO;
2034}
2035
2036PP(pp_ftdir)
2037{
2038 I32 result = my_stat(ARGS);
2039 dSP;
2040 if (result < 0)
2041 RETPUSHUNDEF;
2042 if (S_ISDIR(statcache.st_mode))
2043 RETPUSHYES;
2044 RETPUSHNO;
2045}
2046
2047PP(pp_ftpipe)
2048{
2049 I32 result = my_stat(ARGS);
2050 dSP;
2051 if (result < 0)
2052 RETPUSHUNDEF;
2053 if (S_ISFIFO(statcache.st_mode))
2054 RETPUSHYES;
2055 RETPUSHNO;
2056}
2057
2058PP(pp_ftlink)
2059{
2060 I32 result = my_lstat(ARGS);
2061 dSP;
2062 if (result < 0)
2063 RETPUSHUNDEF;
2064 if (S_ISLNK(statcache.st_mode))
2065 RETPUSHYES;
2066 RETPUSHNO;
2067}
2068
2069PP(pp_ftsuid)
2070{
2071 dSP;
2072#ifdef S_ISUID
2073 I32 result = my_stat(ARGS);
2074 SPAGAIN;
2075 if (result < 0)
2076 RETPUSHUNDEF;
2077 if (statcache.st_mode & S_ISUID)
2078 RETPUSHYES;
2079#endif
2080 RETPUSHNO;
2081}
2082
2083PP(pp_ftsgid)
2084{
2085 dSP;
2086#ifdef S_ISGID
2087 I32 result = my_stat(ARGS);
2088 SPAGAIN;
2089 if (result < 0)
2090 RETPUSHUNDEF;
2091 if (statcache.st_mode & S_ISGID)
2092 RETPUSHYES;
2093#endif
2094 RETPUSHNO;
2095}
2096
2097PP(pp_ftsvtx)
2098{
2099 dSP;
2100#ifdef S_ISVTX
2101 I32 result = my_stat(ARGS);
2102 SPAGAIN;
2103 if (result < 0)
2104 RETPUSHUNDEF;
2105 if (statcache.st_mode & S_ISVTX)
2106 RETPUSHYES;
2107#endif
2108 RETPUSHNO;
2109}
2110
2111PP(pp_fttty)
2112{
2113 dSP;
2114 int fd;
2115 GV *gv;
2116 char *tmps;
2117 if (op->op_flags & OPf_REF) {
2118 gv = cGVOP->op_gv;
2119 tmps = "";
2120 }
2121 else
2122 gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
2123 if (GvIO(gv) && IoIFP(GvIOp(gv)))
2124 fd = fileno(IoIFP(GvIOp(gv)));
2125 else if (isDIGIT(*tmps))
2126 fd = atoi(tmps);
2127 else
2128 RETPUSHUNDEF;
2129 if (isatty(fd))
2130 RETPUSHYES;
2131 RETPUSHNO;
2132}
2133
16d20bd9
AD		 2134#if defined(atarist) /* this will work with atariST. Configure will
2135 make guesses for other systems. */
2136# define FILE_base(f) ((f)->_base)
2137# define FILE_ptr(f) ((f)->_ptr)
2138# define FILE_cnt(f) ((f)->_cnt)
2139# define FILE_bufsiz(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
a0d0e21e
LW		 2140#endif
2141
2142PP(pp_fttext)
2143{
2144 dSP;
2145 I32 i;
2146 I32 len;
2147 I32 odd = 0;
2148 STDCHAR tbuf[512];
2149 register STDCHAR *s;
2150 register IO *io;
2151 SV *sv;
2152
2153 if (op->op_flags & OPf_REF) {
2154 EXTEND(SP, 1);
2155 if (cGVOP->op_gv == defgv) {
2156 if (statgv)
2157 io = GvIO(statgv);
2158 else {
2159 sv = statname;
2160 goto really_filename;
2161 }
2162 }
2163 else {
2164 statgv = cGVOP->op_gv;
2165 sv_setpv(statname, "");
2166 io = GvIO(statgv);
2167 }
2168 if (io && IoIFP(io)) {
16d20bd9 2169#ifdef FILE_base
a0d0e21e
LW		 2170 Fstat(fileno(IoIFP(io)), &statcache);
2171 if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */
2172 if (op->op_type == OP_FTTEXT)
2173 RETPUSHNO;
2174 else
2175 RETPUSHYES;
16d20bd9 2176 if (FILE_cnt(IoIFP(io)) <= 0) {
a0d0e21e
LW		 2177 i = getc(IoIFP(io));
2178 if (i != EOF)
2179 (void)ungetc(i, IoIFP(io));
2180 }
16d20bd9 2181 if (FILE_cnt(IoIFP(io)) <= 0) /* null file is anything */
a0d0e21e 2182 RETPUSHYES;
16d20bd9
AD		 2183 len = FILE_bufsiz(IoIFP(io));
2184 s = FILE_base(IoIFP(io));
a0d0e21e
LW		 2185#else
2186 DIE("-T and -B not implemented on filehandles");
2187#endif
2188 }
2189 else {
2190 if (dowarn)
2191 warn("Test on unopened file <%s>",
2192 GvENAME(cGVOP->op_gv));
748a9306 2193 SETERRNO(EBADF,RMS$_IFI);
a0d0e21e
LW		 2194 RETPUSHUNDEF;
2195 }
2196 }
2197 else {
2198 sv = POPs;
2199 statgv = Nullgv;
2200 sv_setpv(statname, SvPV(sv, na));
2201 really_filename:
2202#ifdef HAS_OPEN3
2203 i = open(SvPV(sv, na), O_RDONLY, 0);
2204#else
2205 i = open(SvPV(sv, na), 0);
2206#endif
2207 if (i < 0) {
2208 if (dowarn && strchr(SvPV(sv, na), '\n'))
2209 warn(warn_nl, "open");
2210 RETPUSHUNDEF;
2211 }
2212 Fstat(i, &statcache);
2213 len = read(i, tbuf, 512);
2214 (void)close(i);
2215 if (len <= 0) {
2216 if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
2217 RETPUSHNO; /* special case NFS directories */
2218 RETPUSHYES; /* null file is anything */
2219 }
2220 s = tbuf;
2221 }
2222
2223 /* now scan s to look for textiness */
4633a7c4 2224 /* XXX ASCII dependent code */
a0d0e21e
LW		 2225
2226 for (i = 0; i < len; i++, s++) {
2227 if (!*s) { /* null never allowed in text */
2228 odd += len;
2229 break;
2230 }
2231 else if (*s & 128)
2232 odd++;
2233 else if (*s < 32 &&
2234 *s != '\n' && *s != '\r' && *s != '\b' &&
2235 *s != '\t' && *s != '\f' && *s != 27)
2236 odd++;
2237 }
2238
4633a7c4 2239 if ((odd * 3 > len) == (op->op_type == OP_FTTEXT)) /* allow 1/3 odd */
a0d0e21e
LW		 2240 RETPUSHNO;
2241 else
2242 RETPUSHYES;
2243}
2244
2245PP(pp_ftbinary)
2246{
2247 return pp_fttext(ARGS);
2248}
2249
2250/* File calls. */
2251
2252PP(pp_chdir)
2253{
2254 dSP; dTARGET;
2255 char *tmps;
2256 SV **svp;
2257
2258 if (MAXARG < 1)
2259 tmps = Nullch;
2260 else
2261 tmps = POPp;
2262 if (!tmps || !*tmps) {
2263 svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
2264 if (svp)
2265 tmps = SvPV(*svp, na);
2266 }
2267 if (!tmps || !*tmps) {
2268 svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
2269 if (svp)
2270 tmps = SvPV(*svp, na);
2271 }
2272 TAINT_PROPER("chdir");
2273 PUSHi( chdir(tmps) >= 0 );
748a9306
LW		 2274#ifdef VMS
2275 /* Clear the DEFAULT element of ENV so we'll get the new value
2276 * in the future. */
4633a7c4 2277 hv_delete(GvHVn(envgv),"DEFAULT",7,G_DISCARD);
748a9306 2278#endif
a0d0e21e
LW		 2279 RETURN;
2280}
2281
2282PP(pp_chown)
2283{
2284 dSP; dMARK; dTARGET;
2285 I32 value;
2286#ifdef HAS_CHOWN
2287 value = (I32)apply(op->op_type, MARK, SP);
2288 SP = MARK;
2289 PUSHi(value);
2290 RETURN;
2291#else
2292 DIE(no_func, "Unsupported function chown");
2293#endif
2294}
2295
2296PP(pp_chroot)
2297{
2298 dSP; dTARGET;
2299 char *tmps;
2300#ifdef HAS_CHROOT
2301 tmps = POPp;
2302 TAINT_PROPER("chroot");
2303 PUSHi( chroot(tmps) >= 0 );
2304 RETURN;
2305#else
2306 DIE(no_func, "chroot");
2307#endif
2308}
2309
2310PP(pp_unlink)
2311{
2312 dSP; dMARK; dTARGET;
2313 I32 value;
2314 value = (I32)apply(op->op_type, MARK, SP);
2315 SP = MARK;
2316 PUSHi(value);
2317 RETURN;
2318}
2319
2320PP(pp_chmod)
2321{
2322 dSP; dMARK; dTARGET;
2323 I32 value;
2324 value = (I32)apply(op->op_type, MARK, SP);
2325 SP = MARK;
2326 PUSHi(value);
2327 RETURN;
2328}
2329
2330PP(pp_utime)
2331{
2332 dSP; dMARK; dTARGET;
2333 I32 value;
2334 value = (I32)apply(op->op_type, MARK, SP);
2335 SP = MARK;
2336 PUSHi(value);
2337 RETURN;
2338}
2339
2340PP(pp_rename)
2341{
2342 dSP; dTARGET;
2343 int anum;
2344
2345 char *tmps2 = POPp;
2346 char *tmps = SvPV(TOPs, na);
2347 TAINT_PROPER("rename");
2348#ifdef HAS_RENAME
2349 anum = rename(tmps, tmps2);
2350#else
2351 if (same_dirent(tmps2, tmps)) /* can always rename to same name */
2352 anum = 1;
2353 else {
2354 if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
2355 (void)UNLINK(tmps2);
2356 if (!(anum = link(tmps, tmps2)))
2357 anum = UNLINK(tmps);
2358 }
2359#endif
2360 SETi( anum >= 0 );
2361 RETURN;
2362}
2363
2364PP(pp_link)
2365{
2366 dSP; dTARGET;
2367#ifdef HAS_LINK
2368 char *tmps2 = POPp;
2369 char *tmps = SvPV(TOPs, na);
2370 TAINT_PROPER("link");
2371 SETi( link(tmps, tmps2) >= 0 );
2372#else
2373 DIE(no_func, "Unsupported function link");
2374#endif
2375 RETURN;
2376}
2377
2378PP(pp_symlink)
2379{
2380 dSP; dTARGET;
2381#ifdef HAS_SYMLINK
2382 char *tmps2 = POPp;
2383 char *tmps = SvPV(TOPs, na);
2384 TAINT_PROPER("symlink");
2385 SETi( symlink(tmps, tmps2) >= 0 );
2386 RETURN;
2387#else
2388 DIE(no_func, "symlink");
2389#endif
2390}
2391
2392PP(pp_readlink)
2393{
2394 dSP; dTARGET;
2395#ifdef HAS_SYMLINK
2396 char *tmps;
2397 int len;
2398 tmps = POPp;
2399 len = readlink(tmps, buf, sizeof buf);
2400 EXTEND(SP, 1);
2401 if (len < 0)
2402 RETPUSHUNDEF;
2403 PUSHp(buf, len);
2404 RETURN;
2405#else
2406 EXTEND(SP, 1);
2407 RETSETUNDEF; /* just pretend it's a normal file */
2408#endif
2409}
2410
2411#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
2412static int
2413dooneliner(cmd, filename)
2414char *cmd;
2415char *filename;
2416{
2417 char mybuf[8192];
16d20bd9 2418 char *s,
5d94fbed 2419 *save_filename = filename;
a0d0e21e
LW		 2420 int anum = 1;
2421 FILE *myfp;
2422
2423 strcpy(mybuf, cmd);
2424 strcat(mybuf, " ");
2425 for (s = mybuf+strlen(mybuf); *filename; ) {
2426 *s++ = '\\';
2427 *s++ = *filename++;
2428 }
2429 strcpy(s, " 2>&1");
2430 myfp = my_popen(mybuf, "r");
2431 if (myfp) {
2432 *mybuf = '\0';
2433 s = fgets(mybuf, sizeof mybuf, myfp);
2434 (void)my_pclose(myfp);
2435 if (s != Nullch) {
2436 for (errno = 1; errno < sys_nerr; errno++) {
2437#ifdef HAS_SYS_ERRLIST
2438 if (instr(mybuf, sys_errlist[errno])) /* you don't see this */
2439 return 0;
2440#else
2441 char *errmsg; /* especially if it isn't there */
2442
2443 if (instr(mybuf,
2444 (errmsg = strerror(errno)) ? errmsg : "NoErRoR"))
2445 return 0;
2446#endif
2447 }
748a9306 2448 SETERRNO(0,0);
a0d0e21e
LW		 2449#ifndef EACCES
2450#define EACCES EPERM
2451#endif
2452 if (instr(mybuf, "cannot make"))
748a9306 2453 SETERRNO(EEXIST,RMS$_FEX);
a0d0e21e 2454 else if (instr(mybuf, "existing file"))
748a9306 2455 SETERRNO(EEXIST,RMS$_FEX);
a0d0e21e 2456 else if (instr(mybuf, "ile exists"))
748a9306 2457 SETERRNO(EEXIST,RMS$_FEX);
a0d0e21e 2458 else if (instr(mybuf, "non-exist"))
748a9306 2459 SETERRNO(ENOENT,RMS$_FNF);
a0d0e21e 2460 else if (instr(mybuf, "does not exist"))
748a9306 2461 SETERRNO(ENOENT,RMS$_FNF);
a0d0e21e 2462 else if (instr(mybuf, "not empty"))
748a9306 2463 SETERRNO(EBUSY,SS$_DEVOFFLINE);
a0d0e21e 2464 else if (instr(mybuf, "cannot access"))
748a9306 2465 SETERRNO(EACCES,RMS$_PRV);
a0d0e21e 2466 else
748a9306 2467 SETERRNO(EPERM,RMS$_PRV);
a0d0e21e
LW		 2468 return 0;
2469 }
2470 else { /* some mkdirs return no failure indication */
5d94fbed 2471 anum = (Stat(save_filename, &statbuf) >= 0);
a0d0e21e
LW		 2472 if (op->op_type == OP_RMDIR)
2473 anum = !anum;
2474 if (anum)
748a9306 2475 SETERRNO(0,0);
a0d0e21e 2476 else
748a9306 2477 SETERRNO(EACCES,RMS$_PRV); /* a guess */
a0d0e21e
LW		 2478 }
2479 return anum;
2480 }
2481 else
2482 return 0;
2483}
2484#endif
2485
2486PP(pp_mkdir)
2487{
2488 dSP; dTARGET;
2489 int mode = POPi;
2490#ifndef HAS_MKDIR
2491 int oldumask;
2492#endif
2493 char *tmps = SvPV(TOPs, na);
2494
2495 TAINT_PROPER("mkdir");
2496#ifdef HAS_MKDIR
2497 SETi( mkdir(tmps, mode) >= 0 );
2498#else
2499 SETi( dooneliner("mkdir", tmps) );
2500 oldumask = umask(0);
2501 umask(oldumask);
2502 chmod(tmps, (mode & ~oldumask) & 0777);
2503#endif
2504 RETURN;
2505}
2506
2507PP(pp_rmdir)
2508{
2509 dSP; dTARGET;
2510 char *tmps;
2511
2512 tmps = POPp;
2513 TAINT_PROPER("rmdir");
2514#ifdef HAS_RMDIR
2515 XPUSHi( rmdir(tmps) >= 0 );
2516#else
2517 XPUSHi( dooneliner("rmdir", tmps) );
2518#endif
2519 RETURN;
2520}
2521
2522/* Directory calls. */
2523
2524PP(pp_open_dir)
2525{
2526 dSP;
2527#if defined(Direntry_t) && defined(HAS_READDIR)
2528 char *dirname = POPp;
2529 GV *gv = (GV*)POPs;
2530 register IO *io = GvIOn(gv);
2531
2532 if (!io)
2533 goto nope;
2534
2535 if (IoDIRP(io))
2536 closedir(IoDIRP(io));
2537 if (!(IoDIRP(io) = opendir(dirname)))
2538 goto nope;
2539
2540 RETPUSHYES;
2541nope:
2542 if (!errno)
748a9306 2543 SETERRNO(EBADF,RMS$_DIR);
a0d0e21e
LW		 2544 RETPUSHUNDEF;
2545#else
2546 DIE(no_dir_func, "opendir");
2547#endif
2548}
2549
2550PP(pp_readdir)
2551{
2552 dSP;
2553#if defined(Direntry_t) && defined(HAS_READDIR)
2554#ifndef I_DIRENT
2555 Direntry_t *readdir _((DIR *));
2556#endif
2557 register Direntry_t *dp;
2558 GV *gv = (GV*)POPs;
2559 register IO *io = GvIOn(gv);
2560
2561 if (!io || !IoDIRP(io))
2562 goto nope;
2563
2564 if (GIMME == G_ARRAY) {
2565 /*SUPPRESS 560*/
2566 while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
2567#ifdef DIRNAMLEN
2568 XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
2569#else
2570 XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
2571#endif
2572 }
2573 }
2574 else {
2575 if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
2576 goto nope;
2577#ifdef DIRNAMLEN
2578 XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
2579#else
2580 XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
2581#endif
2582 }
2583 RETURN;
2584
2585nope:
2586 if (!errno)
748a9306 2587 SETERRNO(EBADF,RMS$_ISI);
a0d0e21e
LW		 2588 if (GIMME == G_ARRAY)
2589 RETURN;
2590 else
2591 RETPUSHUNDEF;
2592#else
2593 DIE(no_dir_func, "readdir");
2594#endif
2595}
2596
2597PP(pp_telldir)
2598{
2599 dSP; dTARGET;
2600#if defined(HAS_TELLDIR) || defined(telldir)
2601#if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
2602 long telldir _((DIR *));
2603#endif
2604 GV *gv = (GV*)POPs;
2605 register IO *io = GvIOn(gv);
2606
2607 if (!io || !IoDIRP(io))
2608 goto nope;
2609
2610 PUSHi( telldir(IoDIRP(io)) );
2611 RETURN;
2612nope:
2613 if (!errno)
748a9306 2614 SETERRNO(EBADF,RMS$_ISI);
a0d0e21e
LW		 2615 RETPUSHUNDEF;
2616#else
2617 DIE(no_dir_func, "telldir");
2618#endif
2619}
2620
2621PP(pp_seekdir)
2622{
2623 dSP;
2624#if defined(HAS_SEEKDIR) || defined(seekdir)
2625 long along = POPl;
2626 GV *gv = (GV*)POPs;
2627 register IO *io = GvIOn(gv);
2628
2629 if (!io || !IoDIRP(io))
2630 goto nope;
2631
2632 (void)seekdir(IoDIRP(io), along);
2633
2634 RETPUSHYES;
2635nope:
2636 if (!errno)
748a9306 2637 SETERRNO(EBADF,RMS$_ISI);
a0d0e21e
LW		 2638 RETPUSHUNDEF;
2639#else
2640 DIE(no_dir_func, "seekdir");
2641#endif
2642}
2643
2644PP(pp_rewinddir)
2645{
2646 dSP;
2647#if defined(HAS_REWINDDIR) || defined(rewinddir)
2648 GV *gv = (GV*)POPs;
2649 register IO *io = GvIOn(gv);
2650
2651 if (!io || !IoDIRP(io))
2652 goto nope;
2653
2654 (void)rewinddir(IoDIRP(io));
2655 RETPUSHYES;
2656nope:
2657 if (!errno)
748a9306 2658 SETERRNO(EBADF,RMS$_ISI);
a0d0e21e
LW		 2659 RETPUSHUNDEF;
2660#else
2661 DIE(no_dir_func, "rewinddir");
2662#endif
2663}
2664
2665PP(pp_closedir)
2666{
2667 dSP;
2668#if defined(Direntry_t) && defined(HAS_READDIR)
2669 GV *gv = (GV*)POPs;
2670 register IO *io = GvIOn(gv);
2671
2672 if (!io || !IoDIRP(io))
2673 goto nope;
2674
2675#ifdef VOID_CLOSEDIR
2676 closedir(IoDIRP(io));
2677#else
748a9306
LW		 2678 if (closedir(IoDIRP(io)) < 0) {
2679 IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
a0d0e21e 2680 goto nope;
748a9306 2681 }
a0d0e21e
LW		 2682#endif
2683 IoDIRP(io) = 0;
2684
2685 RETPUSHYES;
2686nope:
2687 if (!errno)
748a9306 2688 SETERRNO(EBADF,RMS$_IFI);
a0d0e21e
LW		 2689 RETPUSHUNDEF;
2690#else
2691 DIE(no_dir_func, "closedir");
2692#endif
2693}
2694
2695/* Process control. */
2696
2697PP(pp_fork)
2698{
2699 dSP; dTARGET;
2700 int childpid;
2701 GV *tmpgv;
2702
2703 EXTEND(SP, 1);
2704#ifdef HAS_FORK
2705 childpid = fork();
2706 if (childpid < 0)
2707 RETSETUNDEF;
2708 if (!childpid) {
2709 /*SUPPRESS 560*/
2710 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
2711 sv_setiv(GvSV(tmpgv), (I32)getpid());
2712 hv_clear(pidstatus); /* no kids, so don't wait for 'em */
2713 }
2714 PUSHi(childpid);
2715 RETURN;
2716#else
2717 DIE(no_func, "Unsupported function fork");
2718#endif
2719}
2720
2721PP(pp_wait)
2722{
2723 dSP; dTARGET;
2724 int childpid;
2725 int argflags;
2726 I32 value;
2727
2728 EXTEND(SP, 1);
2729#ifdef HAS_WAIT
2730 childpid = wait(&argflags);
2731 if (childpid > 0)
2732 pidgone(childpid, argflags);
2733 value = (I32)childpid;
748a9306 2734 statusvalue = FIXSTATUS(argflags);
a0d0e21e
LW		 2735 PUSHi(value);
2736 RETURN;
2737#else
2738 DIE(no_func, "Unsupported function wait");
2739#endif
2740}
2741
2742PP(pp_waitpid)
2743{
2744 dSP; dTARGET;
2745 int childpid;
2746 int optype;
2747 int argflags;
2748 I32 value;
2749
2750#ifdef HAS_WAIT
2751 optype = POPi;
2752 childpid = TOPi;
2753 childpid = wait4pid(childpid, &argflags, optype);
2754 value = (I32)childpid;
748a9306 2755 statusvalue = FIXSTATUS(argflags);
a0d0e21e
LW		 2756 SETi(value);
2757 RETURN;
2758#else
2759 DIE(no_func, "Unsupported function wait");
2760#endif
2761}
2762
2763PP(pp_system)
2764{
2765 dSP; dMARK; dORIGMARK; dTARGET;
2766 I32 value;
2767 int childpid;
2768 int result;
2769 int status;
ecfc5424
AD		 2770 Signal_t (*ihand)(); /* place to save signal during system() */
2771 Signal_t (*qhand)(); /* place to save signal during system() */
a0d0e21e 2772
c3293030 2773#if defined(HAS_FORK) && !defined(VMS) && !defined(OS2)
a0d0e21e
LW		 2774 if (SP - MARK == 1) {
2775 if (tainting) {
2776 char *junk = SvPV(TOPs, na);
2777 TAINT_ENV();
2778 TAINT_PROPER("system");
2779 }
2780 }
2781 while ((childpid = vfork()) == -1) {
2782 if (errno != EAGAIN) {
2783 value = -1;
2784 SP = ORIGMARK;
2785 PUSHi(value);
2786 RETURN;
2787 }
2788 sleep(5);
2789 }
2790 if (childpid > 0) {
2791 ihand = signal(SIGINT, SIG_IGN);
2792 qhand = signal(SIGQUIT, SIG_IGN);
748a9306
LW		 2793 do {
2794 result = wait4pid(childpid, &status, 0);
2795 } while (result == -1 && errno == EINTR);
a0d0e21e
LW		 2796 (void)signal(SIGINT, ihand);
2797 (void)signal(SIGQUIT, qhand);
748a9306 2798 statusvalue = FIXSTATUS(status);
a0d0e21e
LW		 2799 if (result < 0)
2800 value = -1;
2801 else {
2802 value = (I32)((unsigned int)status & 0xffff);
2803 }
2804 do_execfree(); /* free any memory child malloced on vfork */
2805 SP = ORIGMARK;
2806 PUSHi(value);
2807 RETURN;
2808 }
2809 if (op->op_flags & OPf_STACKED) {
2810 SV *really = *++MARK;
2811 value = (I32)do_aexec(really, MARK, SP);
2812 }
2813 else if (SP - MARK != 1)
2814 value = (I32)do_aexec(Nullsv, MARK, SP);
2815 else {
2816 value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
2817 }
2818 _exit(-1);
c3293030 2819#else /* ! FORK or VMS or OS/2 */
a0d0e21e
LW		 2820 if (op->op_flags & OPf_STACKED) {
2821 SV *really = *++MARK;
2822 value = (I32)do_aspawn(really, MARK, SP);
2823 }
2824 else if (SP - MARK != 1)
2825 value = (I32)do_aspawn(Nullsv, MARK, SP);
2826 else {
2827 value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
2828 }
4633a7c4 2829 statusvalue = FIXSTATUS(value);
a0d0e21e
LW		 2830 do_execfree();
2831 SP = ORIGMARK;
2832 PUSHi(value);
2833#endif /* !FORK or VMS */
2834 RETURN;
2835}
2836
2837PP(pp_exec)
2838{
2839 dSP; dMARK; dORIGMARK; dTARGET;
2840 I32 value;
2841
2842 if (op->op_flags & OPf_STACKED) {
2843 SV *really = *++MARK;
2844 value = (I32)do_aexec(really, MARK, SP);
2845 }
2846 else if (SP - MARK != 1)
2847#ifdef VMS
2848 value = (I32)vms_do_aexec(Nullsv, MARK, SP);
2849#else
2850 value = (I32)do_aexec(Nullsv, MARK, SP);
2851#endif
2852 else {
2853 if (tainting) {
2854 char *junk = SvPV(*SP, na);
2855 TAINT_ENV();
2856 TAINT_PROPER("exec");
2857 }
2858#ifdef VMS
2859 value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
2860#else
2861 value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
2862#endif
2863 }
2864 SP = ORIGMARK;
2865 PUSHi(value);
2866 RETURN;
2867}
2868
2869PP(pp_kill)
2870{
2871 dSP; dMARK; dTARGET;
2872 I32 value;
2873#ifdef HAS_KILL
2874 value = (I32)apply(op->op_type, MARK, SP);
2875 SP = MARK;
2876 PUSHi(value);
2877 RETURN;
2878#else
2879 DIE(no_func, "Unsupported function kill");
2880#endif
2881}
2882
2883PP(pp_getppid)
2884{
2885#ifdef HAS_GETPPID
2886 dSP; dTARGET;
2887 XPUSHi( getppid() );
2888 RETURN;
2889#else
2890 DIE(no_func, "getppid");
2891#endif
2892}
2893
2894PP(pp_getpgrp)
2895{
2896#ifdef HAS_GETPGRP
2897 dSP; dTARGET;
2898 int pid;
2899 I32 value;
2900
2901 if (MAXARG < 1)
2902 pid = 0;
2903 else
2904 pid = SvIVx(POPs);
c3293030
IZ		 2905#ifdef BSD_GETPGRP
2906 value = (I32)BSD_GETPGRP(pid);
a0d0e21e
LW		 2907#else
2908 if (pid != 0)
2909 DIE("POSIX getpgrp can't take an argument");
2910 value = (I32)getpgrp();
2911#endif
2912 XPUSHi(value);
2913 RETURN;
2914#else
2915 DIE(no_func, "getpgrp()");
2916#endif
2917}
2918
2919PP(pp_setpgrp)
2920{
2921#ifdef HAS_SETPGRP
2922 dSP; dTARGET;
2923 int pgrp;
2924 int pid;
2925 if (MAXARG < 2) {
2926 pgrp = 0;
2927 pid = 0;
2928 }
2929 else {
2930 pgrp = POPi;
2931 pid = TOPi;
2932 }
2933
2934 TAINT_PROPER("setpgrp");
c3293030
IZ		 2935#ifdef BSD_SETPGRP
2936 SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
a0d0e21e
LW		 2937#else
2938 if ((pgrp != 0) || (pid != 0)) {
2939 DIE("POSIX setpgrp can't take an argument");
2940 }
2941 SETi( setpgrp() >= 0 );
2942#endif /* USE_BSDPGRP */
2943 RETURN;
2944#else
2945 DIE(no_func, "setpgrp()");
2946#endif
2947}
2948
2949PP(pp_getpriority)
2950{
2951 dSP; dTARGET;
2952 int which;
2953 int who;
2954#ifdef HAS_GETPRIORITY
2955 who = POPi;
2956 which = TOPi;
2957 SETi( getpriority(which, who) );
2958 RETURN;
2959#else
2960 DIE(no_func, "getpriority()");
2961#endif
2962}
2963
2964PP(pp_setpriority)
2965{
2966 dSP; dTARGET;
2967 int which;
2968 int who;
2969 int niceval;
2970#ifdef HAS_SETPRIORITY
2971 niceval = POPi;
2972 who = POPi;
2973 which = TOPi;
2974 TAINT_PROPER("setpriority");
2975 SETi( setpriority(which, who, niceval) >= 0 );
2976 RETURN;
2977#else
2978 DIE(no_func, "setpriority()");
2979#endif
2980}
2981
2982/* Time calls. */
2983
2984PP(pp_time)
2985{
2986 dSP; dTARGET;
2987 XPUSHi( time(Null(Time_t*)) );
2988 RETURN;
2989}
2990
2991#ifndef HZ
2992#define HZ 60
2993#endif
2994
2995PP(pp_tms)
2996{
2997 dSP;
2998
2999#if defined(MSDOS) || !defined(HAS_TIMES)
3000 DIE("times not implemented");
3001#else
3002 EXTEND(SP, 4);
3003
3004#ifndef VMS
3005 (void)times(&timesbuf);
3006#else
3007 (void)times((tbuffer_t *)&timesbuf); /* time.h uses different name for */
3008 /* struct tms, though same data */
3009 /* is returned. */
4633a7c4
LW		 3010#undef HZ
3011#define HZ CLK_TCK
a0d0e21e
LW		 3012#endif
3013
3014 PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
3015 if (GIMME == G_ARRAY) {
3016 PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
3017 PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
3018 PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
3019 }
3020 RETURN;
3021#endif /* MSDOS */
3022}
3023
3024PP(pp_localtime)
3025{
3026 return pp_gmtime(ARGS);
3027}
3028
3029PP(pp_gmtime)
3030{
3031 dSP;
3032 Time_t when;
3033 struct tm *tmbuf;
3034 static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
3035 static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
3036 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
3037
3038 if (MAXARG < 1)
3039 (void)time(&when);
3040 else
3041 when = (Time_t)SvIVx(POPs);
3042
3043 if (op->op_type == OP_LOCALTIME)
3044 tmbuf = localtime(&when);
3045 else
3046 tmbuf = gmtime(&when);
3047
3048 EXTEND(SP, 9);
3049 if (GIMME != G_ARRAY) {
3050 dTARGET;
3051 char mybuf[30];
3052 if (!tmbuf)
3053 RETPUSHUNDEF;
3054 sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
3055 dayname[tmbuf->tm_wday],
3056 monname[tmbuf->tm_mon],
3057 tmbuf->tm_mday,
3058 tmbuf->tm_hour,
3059 tmbuf->tm_min,
3060 tmbuf->tm_sec,
3061 tmbuf->tm_year + 1900);
3062 PUSHp(mybuf, strlen(mybuf));
3063 }
3064 else if (tmbuf) {
3065 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
3066 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
3067 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
3068 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
3069 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
3070 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
3071 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
3072 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
3073 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
3074 }
3075 RETURN;
3076}
3077
3078PP(pp_alarm)
3079{
3080 dSP; dTARGET;
3081 int anum;
3082#ifdef HAS_ALARM
3083 anum = POPi;
3084 anum = alarm((unsigned int)anum);
3085 EXTEND(SP, 1);
3086 if (anum < 0)
3087 RETPUSHUNDEF;
3088 PUSHi((I32)anum);
3089 RETURN;
3090#else
3091 DIE(no_func, "Unsupported function alarm");
a0d0e21e
LW		 3092#endif
3093}
3094
3095PP(pp_sleep)
3096{
3097 dSP; dTARGET;
3098 I32 duration;
3099 Time_t lasttime;
3100 Time_t when;
3101
3102 (void)time(&lasttime);
3103 if (MAXARG < 1)
3104 pause();
3105 else {
3106 duration = POPi;
3107 sleep((unsigned int)duration);
3108 }
3109 (void)time(&when);
3110 XPUSHi(when - lasttime);
3111 RETURN;
3112}
3113
3114/* Shared memory. */
3115
3116PP(pp_shmget)
3117{
3118 return pp_semget(ARGS);
3119}
3120
3121PP(pp_shmctl)
3122{
3123 return pp_semctl(ARGS);
3124}
3125
3126PP(pp_shmread)
3127{
3128 return pp_shmwrite(ARGS);
3129}
3130
3131PP(pp_shmwrite)
3132{
3133#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3134 dSP; dMARK; dTARGET;
3135 I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
3136 SP = MARK;
3137 PUSHi(value);
3138 RETURN;
3139#else
748a9306 3140 return pp_semget(ARGS);
a0d0e21e
LW		 3141#endif
3142}
3143
3144/* Message passing. */
3145
3146PP(pp_msgget)
3147{
3148 return pp_semget(ARGS);
3149}
3150
3151PP(pp_msgctl)
3152{
3153 return pp_semctl(ARGS);
3154}
3155
3156PP(pp_msgsnd)
3157{
3158#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3159 dSP; dMARK; dTARGET;
3160 I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
3161 SP = MARK;
3162 PUSHi(value);
3163 RETURN;
3164#else
748a9306 3165 return pp_semget(ARGS);
a0d0e21e
LW		 3166#endif
3167}
3168
3169PP(pp_msgrcv)
3170{
3171#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3172 dSP; dMARK; dTARGET;
3173 I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
3174 SP = MARK;
3175 PUSHi(value);
3176 RETURN;
3177#else
748a9306 3178 return pp_semget(ARGS);
a0d0e21e
LW		 3179#endif
3180}
3181
3182/* Semaphores. */
3183
3184PP(pp_semget)
3185{
3186#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3187 dSP; dMARK; dTARGET;
3188 int anum = do_ipcget(op->op_type, MARK, SP);
3189 SP = MARK;
3190 if (anum == -1)
3191 RETPUSHUNDEF;
3192 PUSHi(anum);
3193 RETURN;
3194#else
3195 DIE("System V IPC is not implemented on this machine");
3196#endif
3197}
3198
3199PP(pp_semctl)
3200{
3201#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3202 dSP; dMARK; dTARGET;
3203 int anum = do_ipcctl(op->op_type, MARK, SP);
3204 SP = MARK;
3205 if (anum == -1)
3206 RETSETUNDEF;
3207 if (anum != 0) {
3208 PUSHi(anum);
3209 }
3210 else {
3211 PUSHp("0 but true",10);
3212 }
3213 RETURN;
3214#else
748a9306 3215 return pp_semget(ARGS);
a0d0e21e
LW		 3216#endif
3217}
3218
3219PP(pp_semop)
3220{
3221#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3222 dSP; dMARK; dTARGET;
3223 I32 value = (I32)(do_semop(MARK, SP) >= 0);
3224 SP = MARK;
3225 PUSHi(value);
3226 RETURN;
3227#else
748a9306 3228 return pp_semget(ARGS);
a0d0e21e
LW		 3229#endif
3230}
3231
3232/* Get system info. */
3233
3234PP(pp_ghbyname)
3235{
3236#ifdef HAS_SOCKET
3237 return pp_ghostent(ARGS);
3238#else
3239 DIE(no_sock_func, "gethostbyname");
3240#endif
3241}
3242
3243PP(pp_ghbyaddr)
3244{
3245#ifdef HAS_SOCKET
3246 return pp_ghostent(ARGS);
3247#else
3248 DIE(no_sock_func, "gethostbyaddr");
3249#endif
3250}
3251
3252PP(pp_ghostent)
3253{
3254 dSP;
3255#ifdef HAS_SOCKET
3256 I32 which = op->op_type;
3257 register char **elem;
3258 register SV *sv;
3259 struct hostent *gethostbyname();
3260 struct hostent *gethostbyaddr();
3261#ifdef HAS_GETHOSTENT
3262 struct hostent *gethostent();
3263#endif
3264 struct hostent *hent;
3265 unsigned long len;
3266
3267 EXTEND(SP, 10);
3268 if (which == OP_GHBYNAME) {
3269 hent = gethostbyname(POPp);
3270 }
3271 else if (which == OP_GHBYADDR) {
3272 int addrtype = POPi;
748a9306 3273 SV *addrsv = POPs;
a0d0e21e 3274 STRLEN addrlen;
748a9306 3275 char *addr = SvPV(addrsv, addrlen);
a0d0e21e
LW		 3276
3277 hent = gethostbyaddr(addr, addrlen, addrtype);
3278 }
3279 else
3280#ifdef HAS_GETHOSTENT
3281 hent = gethostent();
3282#else
3283 DIE("gethostent not implemented");
3284#endif
3285
3286#ifdef HOST_NOT_FOUND
3287 if (!hent)
748a9306 3288 statusvalue = FIXSTATUS(h_errno);
a0d0e21e
LW		 3289#endif
3290
3291 if (GIMME != G_ARRAY) {
3292 PUSHs(sv = sv_newmortal());
3293 if (hent) {
3294 if (which == OP_GHBYNAME) {
fd0af264 3295 if (hent->h_addr)
3296 sv_setpvn(sv, hent->h_addr, hent->h_length);
a0d0e21e
LW		 3297 }
3298 else
3299 sv_setpv(sv, (char*)hent->h_name);
3300 }
3301 RETURN;
3302 }
3303
3304 if (hent) {
3305 PUSHs(sv = sv_mortalcopy(&sv_no));
3306 sv_setpv(sv, (char*)hent->h_name);
3307 PUSHs(sv = sv_mortalcopy(&sv_no));
3308 for (elem = hent->h_aliases; elem && *elem; elem++) {
3309 sv_catpv(sv, *elem);
3310 if (elem[1])
3311 sv_catpvn(sv, " ", 1);
3312 }
3313 PUSHs(sv = sv_mortalcopy(&sv_no));
3314 sv_setiv(sv, (I32)hent->h_addrtype);
3315 PUSHs(sv = sv_mortalcopy(&sv_no));
3316 len = hent->h_length;
3317 sv_setiv(sv, (I32)len);
3318#ifdef h_addr
3319 for (elem = hent->h_addr_list; elem && *elem; elem++) {
3320 XPUSHs(sv = sv_mortalcopy(&sv_no));
3321 sv_setpvn(sv, *elem, len);
3322 }
3323#else
3324 PUSHs(sv = sv_mortalcopy(&sv_no));
fd0af264 3325 if (hent->h_addr)
3326 sv_setpvn(sv, hent->h_addr, len);
a0d0e21e
LW		 3327#endif /* h_addr */
3328 }
3329 RETURN;
3330#else
3331 DIE(no_sock_func, "gethostent");
3332#endif
3333}
3334
3335PP(pp_gnbyname)
3336{
3337#ifdef HAS_SOCKET
3338 return pp_gnetent(ARGS);
3339#else
3340 DIE(no_sock_func, "getnetbyname");
3341#endif
3342}
3343
3344PP(pp_gnbyaddr)
3345{
3346#ifdef HAS_SOCKET
3347 return pp_gnetent(ARGS);
3348#else
3349 DIE(no_sock_func, "getnetbyaddr");
3350#endif
3351}
3352
3353PP(pp_gnetent)
3354{
3355 dSP;
3356#ifdef HAS_SOCKET
3357 I32 which = op->op_type;
3358 register char **elem;
3359 register SV *sv;
3360 struct netent *getnetbyname();
3361 struct netent *getnetbyaddr();
3362 struct netent *getnetent();
3363 struct netent *nent;
3364
3365 if (which == OP_GNBYNAME)
3366 nent = getnetbyname(POPp);
3367 else if (which == OP_GNBYADDR) {
3368 int addrtype = POPi;
3369 unsigned long addr = U_L(POPn);
3370 nent = getnetbyaddr((long)addr, addrtype);
3371 }
3372 else
3373 nent = getnetent();
3374
3375 EXTEND(SP, 4);
3376 if (GIMME != G_ARRAY) {
3377 PUSHs(sv = sv_newmortal());
3378 if (nent) {
3379 if (which == OP_GNBYNAME)
3380 sv_setiv(sv, (I32)nent->n_net);
3381 else
3382 sv_setpv(sv, nent->n_name);
3383 }
3384 RETURN;
3385 }
3386
3387 if (nent) {
3388 PUSHs(sv = sv_mortalcopy(&sv_no));
3389 sv_setpv(sv, nent->n_name);
3390 PUSHs(sv = sv_mortalcopy(&sv_no));
3391 for (elem = nent->n_aliases; *elem; elem++) {
3392 sv_catpv(sv, *elem);
3393 if (elem[1])
3394 sv_catpvn(sv, " ", 1);
3395 }
3396 PUSHs(sv = sv_mortalcopy(&sv_no));
3397 sv_setiv(sv, (I32)nent->n_addrtype);
3398 PUSHs(sv = sv_mortalcopy(&sv_no));
3399 sv_setiv(sv, (I32)nent->n_net);
3400 }
3401
3402 RETURN;
3403#else
3404 DIE(no_sock_func, "getnetent");
3405#endif
3406}
3407
3408PP(pp_gpbyname)
3409{
3410#ifdef HAS_SOCKET
3411 return pp_gprotoent(ARGS);
3412#else
3413 DIE(no_sock_func, "getprotobyname");
3414#endif
3415}
3416
3417PP(pp_gpbynumber)
3418{
3419#ifdef HAS_SOCKET
3420 return pp_gprotoent(ARGS);
3421#else
3422 DIE(no_sock_func, "getprotobynumber");
3423#endif
3424}
3425
3426PP(pp_gprotoent)
3427{
3428 dSP;
3429#ifdef HAS_SOCKET
3430 I32 which = op->op_type;
3431 register char **elem;
3432 register SV *sv;
3433 struct protoent *getprotobyname();
3434 struct protoent *getprotobynumber();
3435 struct protoent *getprotoent();
3436 struct protoent *pent;
3437
3438 if (which == OP_GPBYNAME)
3439 pent = getprotobyname(POPp);
3440 else if (which == OP_GPBYNUMBER)
3441 pent = getprotobynumber(POPi);
3442 else
3443 pent = getprotoent();
3444
3445 EXTEND(SP, 3);
3446 if (GIMME != G_ARRAY) {
3447 PUSHs(sv = sv_newmortal());
3448 if (pent) {
3449 if (which == OP_GPBYNAME)
3450 sv_setiv(sv, (I32)pent->p_proto);
3451 else
3452 sv_setpv(sv, pent->p_name);
3453 }
3454 RETURN;
3455 }
3456
3457 if (pent) {
3458 PUSHs(sv = sv_mortalcopy(&sv_no));
3459 sv_setpv(sv, pent->p_name);
3460 PUSHs(sv = sv_mortalcopy(&sv_no));
3461 for (elem = pent->p_aliases; *elem; elem++) {
3462 sv_catpv(sv, *elem);
3463 if (elem[1])
3464 sv_catpvn(sv, " ", 1);
3465 }
3466 PUSHs(sv = sv_mortalcopy(&sv_no));
3467 sv_setiv(sv, (I32)pent->p_proto);
3468 }
3469
3470 RETURN;
3471#else
3472 DIE(no_sock_func, "getprotoent");
3473#endif
3474}
3475
3476PP(pp_gsbyname)
3477{
3478#ifdef HAS_SOCKET
3479 return pp_gservent(ARGS);
3480#else
3481 DIE(no_sock_func, "getservbyname");
3482#endif
3483}
3484
3485PP(pp_gsbyport)
3486{
3487#ifdef HAS_SOCKET
3488 return pp_gservent(ARGS);
3489#else
3490 DIE(no_sock_func, "getservbyport");
3491#endif
3492}
3493
3494PP(pp_gservent)
3495{
3496 dSP;
3497#ifdef HAS_SOCKET
3498 I32 which = op->op_type;
3499 register char **elem;
3500 register SV *sv;
3501 struct servent *getservbyname();
3502 struct servent *getservbynumber();
3503 struct servent *getservent();
3504 struct servent *sent;
3505
3506 if (which == OP_GSBYNAME) {
3507 char *proto = POPp;
3508 char *name = POPp;
3509
3510 if (proto && !*proto)
3511 proto = Nullch;
3512
3513 sent = getservbyname(name, proto);
3514 }
3515 else if (which == OP_GSBYPORT) {
3516 char *proto = POPp;
3517 int port = POPi;
3518
3519 sent = getservbyport(port, proto);
3520 }
3521 else
3522 sent = getservent();
3523
3524 EXTEND(SP, 4);
3525 if (GIMME != G_ARRAY) {
3526 PUSHs(sv = sv_newmortal());
3527 if (sent) {
3528 if (which == OP_GSBYNAME) {
3529#ifdef HAS_NTOHS
3530 sv_setiv(sv, (I32)ntohs(sent->s_port));
3531#else
3532 sv_setiv(sv, (I32)(sent->s_port));
3533#endif
3534 }
3535 else
3536 sv_setpv(sv, sent->s_name);
3537 }
3538 RETURN;
3539 }
3540
3541 if (sent) {
3542 PUSHs(sv = sv_mortalcopy(&sv_no));
3543 sv_setpv(sv, sent->s_name);
3544 PUSHs(sv = sv_mortalcopy(&sv_no));
3545 for (elem = sent->s_aliases; *elem; elem++) {
3546 sv_catpv(sv, *elem);
3547 if (elem[1])
3548 sv_catpvn(sv, " ", 1);
3549 }
3550 PUSHs(sv = sv_mortalcopy(&sv_no));
3551#ifdef HAS_NTOHS
3552 sv_setiv(sv, (I32)ntohs(sent->s_port));
3553#else
3554 sv_setiv(sv, (I32)(sent->s_port));
3555#endif
3556 PUSHs(sv = sv_mortalcopy(&sv_no));
3557 sv_setpv(sv, sent->s_proto);
3558 }
3559
3560 RETURN;
3561#else
3562 DIE(no_sock_func, "getservent");
3563#endif
3564}
3565
3566PP(pp_shostent)
3567{
3568 dSP;
3569#ifdef HAS_SOCKET
3570 sethostent(TOPi);
3571 RETSETYES;
3572#else
3573 DIE(no_sock_func, "sethostent");
3574#endif
3575}
3576
3577PP(pp_snetent)
3578{
3579 dSP;
3580#ifdef HAS_SOCKET
3581 setnetent(TOPi);
3582 RETSETYES;
3583#else
3584 DIE(no_sock_func, "setnetent");
3585#endif
3586}
3587
3588PP(pp_sprotoent)
3589{
3590 dSP;
3591#ifdef HAS_SOCKET
3592 setprotoent(TOPi);
3593 RETSETYES;
3594#else
3595 DIE(no_sock_func, "setprotoent");
3596#endif
3597}
3598
3599PP(pp_sservent)
3600{
3601 dSP;
3602#ifdef HAS_SOCKET
3603 setservent(TOPi);
3604 RETSETYES;
3605#else
3606 DIE(no_sock_func, "setservent");
3607#endif
3608}
3609
3610PP(pp_ehostent)
3611{
3612 dSP;
3613#ifdef HAS_SOCKET
3614 endhostent();
3615 EXTEND(sp,1);
3616 RETPUSHYES;
3617#else
3618 DIE(no_sock_func, "endhostent");
3619#endif
3620}
3621
3622PP(pp_enetent)
3623{
3624 dSP;
3625#ifdef HAS_SOCKET
3626 endnetent();
3627 EXTEND(sp,1);
3628 RETPUSHYES;
3629#else
3630 DIE(no_sock_func, "endnetent");
3631#endif
3632}
3633
3634PP(pp_eprotoent)
3635{
3636 dSP;
3637#ifdef HAS_SOCKET
3638 endprotoent();
3639 EXTEND(sp,1);
3640 RETPUSHYES;
3641#else
3642 DIE(no_sock_func, "endprotoent");
3643#endif
3644}
3645
3646PP(pp_eservent)
3647{
3648 dSP;
3649#ifdef HAS_SOCKET
3650 endservent();
3651 EXTEND(sp,1);
3652 RETPUSHYES;
3653#else
3654 DIE(no_sock_func, "endservent");
3655#endif
3656}
3657
3658PP(pp_gpwnam)
3659{
3660#ifdef HAS_PASSWD
3661 return pp_gpwent(ARGS);
3662#else
3663 DIE(no_func, "getpwnam");
3664#endif
3665}
3666
3667PP(pp_gpwuid)
3668{
3669#ifdef HAS_PASSWD
3670 return pp_gpwent(ARGS);
3671#else
3672 DIE(no_func, "getpwuid");
3673#endif
3674}
3675
3676PP(pp_gpwent)
3677{
3678 dSP;
3679#ifdef HAS_PASSWD
3680 I32 which = op->op_type;
3681 register SV *sv;
3682 struct passwd *pwent;
3683
3684 if (which == OP_GPWNAM)
3685 pwent = getpwnam(POPp);
3686 else if (which == OP_GPWUID)
3687 pwent = getpwuid(POPi);
3688 else
3689 pwent = (struct passwd *)getpwent();
3690
3691 EXTEND(SP, 10);
3692 if (GIMME != G_ARRAY) {
3693 PUSHs(sv = sv_newmortal());
3694 if (pwent) {
3695 if (which == OP_GPWNAM)
3696 sv_setiv(sv, (I32)pwent->pw_uid);
3697 else
3698 sv_setpv(sv, pwent->pw_name);
3699 }
3700 RETURN;
3701 }
3702
3703 if (pwent) {
3704 PUSHs(sv = sv_mortalcopy(&sv_no));
3705 sv_setpv(sv, pwent->pw_name);
3706 PUSHs(sv = sv_mortalcopy(&sv_no));
3707 sv_setpv(sv, pwent->pw_passwd);
3708 PUSHs(sv = sv_mortalcopy(&sv_no));
3709 sv_setiv(sv, (I32)pwent->pw_uid);
3710 PUSHs(sv = sv_mortalcopy(&sv_no));
3711 sv_setiv(sv, (I32)pwent->pw_gid);
3712 PUSHs(sv = sv_mortalcopy(&sv_no));
3713#ifdef PWCHANGE
3714 sv_setiv(sv, (I32)pwent->pw_change);
3715#else
3716#ifdef PWQUOTA
3717 sv_setiv(sv, (I32)pwent->pw_quota);
3718#else
3719#ifdef PWAGE
3720 sv_setpv(sv, pwent->pw_age);
3721#endif
3722#endif
3723#endif
3724 PUSHs(sv = sv_mortalcopy(&sv_no));
3725#ifdef PWCLASS
3726 sv_setpv(sv, pwent->pw_class);
3727#else
3728#ifdef PWCOMMENT
3729 sv_setpv(sv, pwent->pw_comment);
3730#endif
3731#endif
3732 PUSHs(sv = sv_mortalcopy(&sv_no));
3733 sv_setpv(sv, pwent->pw_gecos);
3734 PUSHs(sv = sv_mortalcopy(&sv_no));
3735 sv_setpv(sv, pwent->pw_dir);
3736 PUSHs(sv = sv_mortalcopy(&sv_no));
3737 sv_setpv(sv, pwent->pw_shell);
3738#ifdef PWEXPIRE
3739 PUSHs(sv = sv_mortalcopy(&sv_no));
3740 sv_setiv(sv, (I32)pwent->pw_expire);
3741#endif
3742 }
3743 RETURN;
3744#else
3745 DIE(no_func, "getpwent");
3746#endif
3747}
3748
3749PP(pp_spwent)
3750{
3751 dSP;
3752#ifdef HAS_PASSWD
3753 setpwent();
3754 RETPUSHYES;
3755#else
3756 DIE(no_func, "setpwent");
3757#endif
3758}
3759
3760PP(pp_epwent)
3761{
3762 dSP;
3763#ifdef HAS_PASSWD
3764 endpwent();
3765 RETPUSHYES;
3766#else
3767 DIE(no_func, "endpwent");
3768#endif
3769}
3770
3771PP(pp_ggrnam)
3772{
3773#ifdef HAS_GROUP
3774 return pp_ggrent(ARGS);
3775#else
3776 DIE(no_func, "getgrnam");
3777#endif
3778}
3779
3780PP(pp_ggrgid)
3781{
3782#ifdef HAS_GROUP
3783 return pp_ggrent(ARGS);
3784#else
3785 DIE(no_func, "getgrgid");
3786#endif
3787}
3788
3789PP(pp_ggrent)
3790{
3791 dSP;
3792#ifdef HAS_GROUP
3793 I32 which = op->op_type;
3794 register char **elem;
3795 register SV *sv;
3796 struct group *grent;
3797
3798 if (which == OP_GGRNAM)
3799 grent = (struct group *)getgrnam(POPp);
3800 else if (which == OP_GGRGID)
3801 grent = (struct group *)getgrgid(POPi);
3802 else
3803 grent = (struct group *)getgrent();
3804
3805 EXTEND(SP, 4);
3806 if (GIMME != G_ARRAY) {
3807 PUSHs(sv = sv_newmortal());
3808 if (grent) {
3809 if (which == OP_GGRNAM)
3810 sv_setiv(sv, (I32)grent->gr_gid);
3811 else
3812 sv_setpv(sv, grent->gr_name);
3813 }
3814 RETURN;
3815 }
3816
3817 if (grent) {
3818 PUSHs(sv = sv_mortalcopy(&sv_no));
3819 sv_setpv(sv, grent->gr_name);
3820 PUSHs(sv = sv_mortalcopy(&sv_no));
3821 sv_setpv(sv, grent->gr_passwd);
3822 PUSHs(sv = sv_mortalcopy(&sv_no));
3823 sv_setiv(sv, (I32)grent->gr_gid);
3824 PUSHs(sv = sv_mortalcopy(&sv_no));
3825 for (elem = grent->gr_mem; *elem; elem++) {
3826 sv_catpv(sv, *elem);
3827 if (elem[1])
3828 sv_catpvn(sv, " ", 1);
3829 }
3830 }
3831
3832 RETURN;
3833#else
3834 DIE(no_func, "getgrent");
3835#endif
3836}
3837
3838PP(pp_sgrent)
3839{
3840 dSP;
3841#ifdef HAS_GROUP
3842 setgrent();
3843 RETPUSHYES;
3844#else
3845 DIE(no_func, "setgrent");
3846#endif
3847}
3848
3849PP(pp_egrent)
3850{
3851 dSP;
3852#ifdef HAS_GROUP
3853 endgrent();
3854 RETPUSHYES;
3855#else
3856 DIE(no_func, "endgrent");
3857#endif
3858}
3859
3860PP(pp_getlogin)
3861{
3862 dSP; dTARGET;
3863#ifdef HAS_GETLOGIN
3864 char *tmps;
3865 EXTEND(SP, 1);
3866 if (!(tmps = getlogin()))
3867 RETPUSHUNDEF;
3868 PUSHp(tmps, strlen(tmps));
3869 RETURN;
3870#else
3871 DIE(no_func, "getlogin");
3872#endif
3873}
3874
3875/* Miscellaneous. */
3876
3877PP(pp_syscall)
3878{
3879#ifdef HAS_SYSCALL
3880 dSP; dMARK; dORIGMARK; dTARGET;
3881 register I32 items = SP - MARK;
3882 unsigned long a[20];
3883 register I32 i = 0;
3884 I32 retval = -1;
748a9306 3885 MAGIC *mg;
a0d0e21e
LW		 3886
3887 if (tainting) {
3888 while (++MARK <= SP) {
748a9306
LW		 3889 if (SvGMAGICAL(*MARK) && SvSMAGICAL(*MARK) &&
3890 (mg = mg_find(*MARK, 't')) && mg->mg_len & 1)
a0d0e21e
LW		 3891 tainted = TRUE;
3892 }
3893 MARK = ORIGMARK;
3894 TAINT_PROPER("syscall");
3895 }
3896
3897 /* This probably won't work on machines where sizeof(long) != sizeof(int)
3898 * or where sizeof(long) != sizeof(char*). But such machines will
3899 * not likely have syscall implemented either, so who cares?
3900 */
3901 while (++MARK <= SP) {
3902 if (SvNIOK(*MARK) || !i)
3903 a[i++] = SvIV(*MARK);
748a9306
LW		 3904 else if (*MARK == &sv_undef)
3905 a[i++] = 0;
3906 else
3907 a[i++] = (unsigned long)SvPV_force(*MARK, na);
a0d0e21e
LW		 3908 if (i > 15)
3909 break;
3910 }
3911 switch (items) {
3912 default:
3913 DIE("Too many args to syscall");
3914 case 0:
3915 DIE("Too few args to syscall");
3916 case 1:
3917 retval = syscall(a[0]);
3918 break;
3919 case 2:
3920 retval = syscall(a[0],a[1]);
3921 break;
3922 case 3:
3923 retval = syscall(a[0],a[1],a[2]);
3924 break;
3925 case 4:
3926 retval = syscall(a[0],a[1],a[2],a[3]);
3927 break;
3928 case 5:
3929 retval = syscall(a[0],a[1],a[2],a[3],a[4]);
3930 break;
3931 case 6:
3932 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]);
3933 break;
3934 case 7:
3935 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);
3936 break;
3937 case 8:
3938 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
3939 break;
3940#ifdef atarist
3941 case 9:
3942 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
3943 break;
3944 case 10:
3945 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
3946 break;
3947 case 11:
3948 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3949 a[10]);
3950 break;
3951 case 12:
3952 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3953 a[10],a[11]);
3954 break;
3955 case 13:
3956 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3957 a[10],a[11],a[12]);
3958 break;
3959 case 14:
3960 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3961 a[10],a[11],a[12],a[13]);
3962 break;
3963#endif /* atarist */
3964 }
3965 SP = ORIGMARK;
3966 PUSHi(retval);
3967 RETURN;
3968#else
3969 DIE(no_func, "syscall");
3970#endif
3971}
3972
16d20bd9
AD		 3973#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
3974
3975/* XXX Emulate flock() with lockf(). This is just to increase
3976 portability of scripts. The calls are not completely
3977 interchangeable. What's really needed is a good file
3978 locking module.
3979*/
3980
3981/* We might need <unistd.h> because it sometimes defines the lockf()
3982 constants. Unfortunately, <unistd.h> causes troubles on some mixed
3983 (BSD/POSIX) systems, such as SunOS 4.1.3. We could just try including
3984 <unistd.h> here in this part of the file, but that might
3985 conflict with various other #defines and includes above, such as
3986 #define vfork fork above.
3987
3988 Further, the lockf() constants aren't POSIX, so they might not be
3989 visible if we're compiling with _POSIX_SOURCE defined. Thus, we'll
3990 just stick in the SVID values and be done with it. Sigh.
3991*/
3992
3993# ifndef F_ULOCK
3994# define F_ULOCK 0 /* Unlock a previously locked region */
3995# endif
3996# ifndef F_LOCK
3997# define F_LOCK 1 /* Lock a region for exclusive use */
3998# endif
3999# ifndef F_TLOCK
4000# define F_TLOCK 2 /* Test and lock a region for exclusive use */
4001# endif
4002# ifndef F_TEST
4003# define F_TEST 3 /* Test a region for other processes locks */
4004# endif
4005
4006/* These are the flock() constants. Since this sytems doesn't have
4007 flock(), the values of the constants are probably not available.
4008*/
4009# ifndef LOCK_SH
4010# define LOCK_SH 1
4011# endif
4012# ifndef LOCK_EX
4013# define LOCK_EX 2
4014# endif
4015# ifndef LOCK_NB
4016# define LOCK_NB 4
4017# endif
4018# ifndef LOCK_UN
4019# define LOCK_UN 8
4020# endif
4021
4022int
4023lockf_emulate_flock (fd, operation)
4024int fd;
4025int operation;
4026{
4027 int i;
4028 switch (operation) {
4029
4030 /* LOCK_SH - get a shared lock */
4031 case LOCK_SH:
4032 /* LOCK_EX - get an exclusive lock */
4033 case LOCK_EX:
4034 i = lockf (fd, F_LOCK, 0);
4035 break;
4036
4037 /* LOCK_SH|LOCK_NB - get a non-blocking shared lock */
4038 case LOCK_SH|LOCK_NB:
4039 /* LOCK_EX|LOCK_NB - get a non-blocking exclusive lock */
4040 case LOCK_EX|LOCK_NB:
4041 i = lockf (fd, F_TLOCK, 0);
4042 if (i == -1)
4043 if ((errno == EAGAIN) || (errno == EACCES))
4044 errno = EWOULDBLOCK;
4045 break;
4046
4047 /* LOCK_UN - unlock */
4048 case LOCK_UN:
4049 i = lockf (fd, F_ULOCK, 0);
4050 break;
4051
4052 /* Default - can't decipher operation */
4053 default:
4054 i = -1;
4055 errno = EINVAL;
4056 break;
4057 }
4058 return (i);
4059}
4060#endif
Unnamed repository; edit this file 'description' to name the repository.