Use 'test -f', not 'test -x'
[perl.git] / doop.c
1 /*    doop.c
2  *
3  *    Copyright (c) 1991-1997, 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  * "'So that was the job I felt I had to do when I started,' thought Sam."
12  */
13
14 #include "EXTERN.h"
15 #include "perl.h"
16
17 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
18 #include <signal.h>
19 #endif
20
21 I32
22 do_trans(sv,arg)
23 SV *sv;
24 OP *arg;
25 {
26     register short *tbl;
27     register U8 *s;
28     register U8 *send;
29     register U8 *d;
30     register I32 ch;
31     register I32 matches = 0;
32     register I32 squash = op->op_private & OPpTRANS_SQUASH;
33     STRLEN len;
34
35     if (SvREADONLY(sv))
36         croak(no_modify);
37     tbl = (short*)cPVOP->op_pv;
38     s = (U8*)SvPV(sv, len);
39     if (!len)
40         return 0;
41     if (!SvPOKp(sv))
42         s = (U8*)SvPV_force(sv, len);
43     (void)SvPOK_only(sv);
44     send = s + len;
45     if (!tbl || !s)
46         croak("panic: do_trans");
47     DEBUG_t( deb("2.TBL\n"));
48     if (!op->op_private) {
49         while (s < send) {
50             if ((ch = tbl[*s]) >= 0) {
51                 matches++;
52                 *s = ch;
53             }
54             s++;
55         }
56     }
57     else {
58         d = s;
59         while (s < send) {
60             if ((ch = tbl[*s]) >= 0) {
61                 *d = ch;
62                 if (matches++ && squash) {
63                     if (d[-1] == *d)
64                         matches--;
65                     else
66                         d++;
67                 }
68                 else
69                     d++;
70             }
71             else if (ch == -1)          /* -1 is unmapped character */
72                 *d++ = *s;              /* -2 is delete character */
73             s++;
74         }
75         matches += send - d;    /* account for disappeared chars */
76         *d = '\0';
77         SvCUR_set(sv, d - (U8*)SvPVX(sv));
78     }
79     SvSETMAGIC(sv);
80     return matches;
81 }
82
83 void
84 do_join(sv,del,mark,sp)
85 register SV *sv;
86 SV *del;
87 register SV **mark;
88 register SV **sp;
89 {
90     SV **oldmark = mark;
91     register I32 items = sp - mark;
92     register STRLEN len;
93     STRLEN delimlen;
94     register char *delim = SvPV(del, delimlen);
95     STRLEN tmplen;
96
97     mark++;
98     len = (items > 0 ? (delimlen * (items - 1) ) : 0);
99     if (SvTYPE(sv) < SVt_PV)
100         sv_upgrade(sv, SVt_PV);
101     if (SvLEN(sv) < len + items) {      /* current length is way too short */
102         while (items-- > 0) {
103             if (*mark) {
104                 SvPV(*mark, tmplen);
105                 len += tmplen;
106             }
107             mark++;
108         }
109         SvGROW(sv, len + 1);            /* so try to pre-extend */
110
111         mark = oldmark;
112         items = sp - mark;;
113         ++mark;
114     }
115
116     if (items-- > 0) {
117         char *s;
118
119         if (*mark) {
120             s = SvPV(*mark, tmplen);
121             sv_setpvn(sv, s, tmplen);
122         }
123         else
124             sv_setpv(sv, "");
125         mark++;
126     }
127     else
128         sv_setpv(sv,"");
129     len = delimlen;
130     if (len) {
131         for (; items > 0; items--,mark++) {
132             sv_catpvn(sv,delim,len);
133             sv_catsv(sv,*mark);
134         }
135     }
136     else {
137         for (; items > 0; items--,mark++)
138             sv_catsv(sv,*mark);
139     }
140     SvSETMAGIC(sv);
141 }
142
143 void
144 do_sprintf(sv,len,sarg)
145 register SV *sv;
146 register I32 len;
147 register SV **sarg;
148 {
149     register char *s;
150     register char *t;
151     register char *f;
152     char dotype;
153     char ch;
154     register char *send;
155     register SV *arg;
156     char *xs;
157     I32 xlen;
158     I32 pre;
159     I32 post;
160     double value;
161     STRLEN arglen;
162
163     sv_setpv(sv,"");
164     len--;                      /* don't count pattern string */
165     t = s = SvPV(*sarg, arglen);        /* XXX Don't know t is writeable */
166     send = s + arglen;
167     sarg++;
168     for ( ; ; len--) {
169
170         /*SUPPRESS 560*/
171         if (len <= 0 || !(arg = *sarg++))
172             arg = &sv_no;
173
174         /*SUPPRESS 530*/
175         for ( ; t < send && *t != '%'; t++) ;
176         if (t >= send)
177             break;              /* end of run_format string, ignore extra args */
178         f = t;
179         *buf = '\0';
180         xs = buf;
181         dotype = '\0';
182         pre = post = 0;
183         for (t++; t < send; t++) {
184             switch (*t) {
185             default:
186                 ch = *(++t);
187                 *t = '\0';
188                 (void)sprintf(xs,f);
189                 len++, sarg--;
190                 xlen = strlen(xs);
191                 break;
192             case 'n': case '*':
193                 croak("Use of %c in printf format not supported", *t);
194
195             case '0': case '1': case '2': case '3': case '4':
196             case '5': case '6': case '7': case '8': case '9': 
197             case '.': case '#': case '-': case '+': case ' ':
198                 continue;
199             case 'l':
200 #ifdef HAS_QUAD
201                 if (dotype == 'l')
202                     dotype = 'q';
203                 else
204 #endif
205                     dotype = 'l';
206                 continue;
207             case 'h':
208                 dotype = 's';
209                 continue;
210             case 'c':
211                 ch = *(++t);
212                 *t = '\0';
213                 xlen = SvIV(arg);
214                 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
215                     *xs = xlen;
216                     xs[1] = '\0';
217                     xlen = 1;
218                 }
219                 else {
220                     (void)sprintf(xs,f,xlen);
221                     xlen = strlen(xs);
222                 }
223                 break;
224             case 'D':
225                 dotype = 'l';
226                 /* FALL THROUGH */
227             case 'd':
228             case 'i':
229                 ch = *(++t);
230                 *t = '\0';
231                 switch (dotype) {
232 #ifdef HAS_QUAD
233                 case 'q':
234                     /* perl.h says that if quad is available, IV is quad */
235                     (void)sprintf(xs,f,(Quad_t)SvIV(arg));
236                     break;
237 #endif
238                 case 'l':
239                     (void)sprintf(xs,f,(long)SvIV(arg));
240                     break;
241                 default:
242                     (void)sprintf(xs,f,(int)SvIV(arg));
243                     break;
244                 case 's':
245                     (void)sprintf(xs,f,(short)SvIV(arg));
246                     break;
247                 }
248                 xlen = strlen(xs);
249                 break;
250             case 'X': case 'O':
251                 dotype = 'l';
252                 /* FALL THROUGH */
253             case 'x': case 'o': case 'u':
254                 ch = *(++t);
255                 *t = '\0';
256                 switch (dotype) {
257 #ifdef HAS_QUAD
258                 case 'q':
259                     /* perl.h says that if quad is available, UV is quad */
260                     (void)sprintf(xs,f,(unsigned Quad_t)SvUV(arg));
261                     break;
262 #endif
263                 case 'l':
264                     (void)sprintf(xs,f,(unsigned long)SvUV(arg));
265                     break;
266                 default:
267                     (void)sprintf(xs,f,(unsigned int)SvUV(arg));
268                     break;
269                 case 's':
270                     (void)sprintf(xs,f,(unsigned short)SvUV(arg));
271                     break;
272                 }
273                 xlen = strlen(xs);
274                 break;
275             case 'E': case 'e': case 'f': case 'G': case 'g':
276                 ch = *(++t);
277                 *t = '\0';
278                 (void)sprintf(xs,f,SvNV(arg));
279                 xlen = strlen(xs);
280 #ifdef LC_NUMERIC
281                 /*
282                  * User-defined locales may include arbitrary characters.
283                  * And, unfortunately, some system may alloc the "C" locale
284                  * to be overridden by a malicious user.
285                  */
286                 if (op->op_type == OP_SPRINTF)
287                     SvTAINTED_on(sv);
288 #endif /* LC_NUMERIC */
289                 break;
290             case 's':
291                 ch = *(++t);
292                 *t = '\0';
293                 xs = SvPV(arg, arglen);
294                 xlen = (I32)arglen;
295                 if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
296                     break;              /* so handle simple cases */
297                 }
298                 else if (f[1] == '-') {
299                     char *mp = strchr(f, '.');
300                     I32 min = atoi(f+2);
301
302                     if (mp) {
303                         I32 max = atoi(mp+1);
304
305                         if (xlen > max)
306                             xlen = max;
307                     }
308                     if (xlen < min)
309                         post = min - xlen;
310                     break;
311                 }
312                 else if (isDIGIT(f[1])) {
313                     char *mp = strchr(f, '.');
314                     I32 min = atoi(f+1);
315
316                     if (mp) {
317                         I32 max = atoi(mp+1);
318
319                         if (xlen > max)
320                             xlen = max;
321                     }
322                     if (xlen < min)
323                         pre = min - xlen;
324                     break;
325                 }
326                 strcpy(tokenbuf+64,f);  /* sprintf($s,...$s...) */
327                 *t = ch;
328                 (void)sprintf(buf,tokenbuf+64,xs);
329                 xs = buf;
330                 xlen = strlen(xs);
331                 break;
332             }
333             /* end of switch, copy results */
334             *t = ch;
335             if (xs == buf && xlen >= sizeof(buf)) {     /* Ooops! */
336                 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
337                 my_exit(1);
338             }
339             SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
340             sv_catpvn(sv, s, f - s);
341             if (pre) {
342                 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
343                 SvCUR(sv) += pre;
344             }
345             sv_catpvn(sv, xs, xlen);
346             if (post) {
347                 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
348                 SvCUR(sv) += post;
349             }
350             s = t;
351             break;              /* break from for loop */
352         }
353     }
354     sv_catpvn(sv, s, t - s);
355     SvSETMAGIC(sv);
356 }
357
358 void
359 do_vecset(sv)
360 SV *sv;
361 {
362     SV *targ = LvTARG(sv);
363     register I32 offset;
364     register I32 size;
365     register unsigned char *s;
366     register unsigned long lval;
367     I32 mask;
368     STRLEN targlen;
369     STRLEN len;
370
371     if (!targ)
372         return;
373     s = (unsigned char*)SvPV_force(targ, targlen);
374     lval = U_L(SvNV(sv));
375     offset = LvTARGOFF(sv);
376     size = LvTARGLEN(sv);
377     
378     len = (offset + size + 7) / 8;
379     if (len > targlen) {
380         s = (unsigned char*)SvGROW(targ, len + 1);
381         (void)memzero(s + targlen, len - targlen + 1);
382         SvCUR_set(targ, len);
383     }
384     
385     if (size < 8) {
386         mask = (1 << size) - 1;
387         size = offset & 7;
388         lval &= mask;
389         offset >>= 3;
390         s[offset] &= ~(mask << size);
391         s[offset] |= lval << size;
392     }
393     else {
394         offset >>= 3;
395         if (size == 8)
396             s[offset] = lval & 255;
397         else if (size == 16) {
398             s[offset] = (lval >> 8) & 255;
399             s[offset+1] = lval & 255;
400         }
401         else if (size == 32) {
402             s[offset] = (lval >> 24) & 255;
403             s[offset+1] = (lval >> 16) & 255;
404             s[offset+2] = (lval >> 8) & 255;
405             s[offset+3] = lval & 255;
406         }
407     }
408 }
409
410 void
411 do_chop(astr,sv)
412 register SV *astr;
413 register SV *sv;
414 {
415     STRLEN len;
416     char *s;
417     
418     if (SvTYPE(sv) == SVt_PVAV) {
419         register I32 i;
420         I32 max;
421         AV* av = (AV*)sv;
422         max = AvFILL(av);
423         for (i = 0; i <= max; i++) {
424             sv = (SV*)av_fetch(av, i, FALSE);
425             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
426                 do_chop(astr, sv);
427         }
428         return;
429     }
430     if (SvTYPE(sv) == SVt_PVHV) {
431         HV* hv = (HV*)sv;
432         HE* entry;
433         (void)hv_iterinit(hv);
434         /*SUPPRESS 560*/
435         while (entry = hv_iternext(hv))
436             do_chop(astr,hv_iterval(hv,entry));
437         return;
438     }
439     s = SvPV(sv, len);
440     if (len && !SvPOK(sv))
441         s = SvPV_force(sv, len);
442     if (s && len) {
443         s += --len;
444         sv_setpvn(astr, s, 1);
445         *s = '\0';
446         SvCUR_set(sv, len);
447         SvNIOK_off(sv);
448     }
449     else
450         sv_setpvn(astr, "", 0);
451     SvSETMAGIC(sv);
452
453
454 I32
455 do_chomp(sv)
456 register SV *sv;
457 {
458     register I32 count;
459     STRLEN len;
460     char *s;
461
462     if (RsSNARF(rs))
463         return 0;
464     count = 0;
465     if (SvTYPE(sv) == SVt_PVAV) {
466         register I32 i;
467         I32 max;
468         AV* av = (AV*)sv;
469         max = AvFILL(av);
470         for (i = 0; i <= max; i++) {
471             sv = (SV*)av_fetch(av, i, FALSE);
472             if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
473                 count += do_chomp(sv);
474         }
475         return count;
476     }
477     if (SvTYPE(sv) == SVt_PVHV) {
478         HV* hv = (HV*)sv;
479         HE* entry;
480         (void)hv_iterinit(hv);
481         /*SUPPRESS 560*/
482         while (entry = hv_iternext(hv))
483             count += do_chomp(hv_iterval(hv,entry));
484         return count;
485     }
486     s = SvPV(sv, len);
487     if (len && !SvPOKp(sv))
488         s = SvPV_force(sv, len);
489     if (s && len) {
490         s += --len;
491         if (RsPARA(rs)) {
492             if (*s != '\n')
493                 goto nope;
494             ++count;
495             while (len && s[-1] == '\n') {
496                 --len;
497                 --s;
498                 ++count;
499             }
500         }
501         else {
502             STRLEN rslen;
503             char *rsptr = SvPV(rs, rslen);
504             if (rslen == 1) {
505                 if (*s != *rsptr)
506                     goto nope;
507                 ++count;
508             }
509             else {
510                 if (len < rslen - 1)
511                     goto nope;
512                 len -= rslen - 1;
513                 s -= rslen - 1;
514                 if (memNE(s, rsptr, rslen))
515                     goto nope;
516                 count += rslen;
517             }
518         }
519         *s = '\0';
520         SvCUR_set(sv, len);
521         SvNIOK_off(sv);
522     }
523   nope:
524     SvSETMAGIC(sv);
525     return count;
526
527
528 void
529 do_vop(optype,sv,left,right)
530 I32 optype;
531 SV *sv;
532 SV *left;
533 SV *right;
534 {
535 #ifdef LIBERAL
536     register long *dl;
537     register long *ll;
538     register long *rl;
539 #endif
540     register char *dc;
541     STRLEN leftlen;
542     STRLEN rightlen;
543     register char *lc;
544     register char *rc;
545     register I32 len;
546     I32 lensave;
547     char *lsave;
548     char *rsave;
549
550     if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
551         sv_setpvn(sv, "", 0);   /* avoid undef warning on |= and ^= */
552     lsave = lc = SvPV(left, leftlen);
553     rsave = rc = SvPV(right, rightlen);
554     len = leftlen < rightlen ? leftlen : rightlen;
555     lensave = len;
556     if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
557         dc = SvPV_force(sv, na);
558         if (SvCUR(sv) < len) {
559             dc = SvGROW(sv, len + 1);
560             (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
561         }
562     }
563     else {
564         I32 needlen = ((optype == OP_BIT_AND)
565                         ? len : (leftlen > rightlen ? leftlen : rightlen));
566         Newz(801, dc, needlen + 1, char);
567         (void)sv_usepvn(sv, dc, needlen);
568         dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
569     }
570     SvCUR_set(sv, len);
571     (void)SvPOK_only(sv);
572 #ifdef LIBERAL
573     if (len >= sizeof(long)*4 &&
574         !((long)dc % sizeof(long)) &&
575         !((long)lc % sizeof(long)) &&
576         !((long)rc % sizeof(long)))     /* It's almost always aligned... */
577     {
578         I32 remainder = len % (sizeof(long)*4);
579         len /= (sizeof(long)*4);
580
581         dl = (long*)dc;
582         ll = (long*)lc;
583         rl = (long*)rc;
584
585         switch (optype) {
586         case OP_BIT_AND:
587             while (len--) {
588                 *dl++ = *ll++ & *rl++;
589                 *dl++ = *ll++ & *rl++;
590                 *dl++ = *ll++ & *rl++;
591                 *dl++ = *ll++ & *rl++;
592             }
593             break;
594         case OP_BIT_XOR:
595             while (len--) {
596                 *dl++ = *ll++ ^ *rl++;
597                 *dl++ = *ll++ ^ *rl++;
598                 *dl++ = *ll++ ^ *rl++;
599                 *dl++ = *ll++ ^ *rl++;
600             }
601             break;
602         case OP_BIT_OR:
603             while (len--) {
604                 *dl++ = *ll++ | *rl++;
605                 *dl++ = *ll++ | *rl++;
606                 *dl++ = *ll++ | *rl++;
607                 *dl++ = *ll++ | *rl++;
608             }
609         }
610
611         dc = (char*)dl;
612         lc = (char*)ll;
613         rc = (char*)rl;
614
615         len = remainder;
616     }
617 #endif
618     {
619         switch (optype) {
620         case OP_BIT_AND:
621             while (len--)
622                 *dc++ = *lc++ & *rc++;
623             break;
624         case OP_BIT_XOR:
625             while (len--)
626                 *dc++ = *lc++ ^ *rc++;
627             goto mop_up;
628         case OP_BIT_OR:
629             while (len--)
630                 *dc++ = *lc++ | *rc++;
631           mop_up:
632             len = lensave;
633             if (rightlen > len)
634                 sv_catpvn(sv, rsave + len, rightlen - len);
635             else if (leftlen > len)
636                 sv_catpvn(sv, lsave + len, leftlen - len);
637             else
638                 *SvEND(sv) = '\0';
639             break;
640         }
641     }
642 }
643
644 OP *
645 do_kv(ARGS)
646 dARGS
647 {
648     dSP;
649     HV *hv = (HV*)POPs;
650     register HE *entry;
651     SV *tmpstr;
652     I32 dokeys =   (op->op_type == OP_KEYS);
653     I32 dovalues = (op->op_type == OP_VALUES);
654
655     if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) 
656         dokeys = dovalues = TRUE;
657
658     if (!hv) {
659         if (op->op_flags & OPf_MOD) {   /* lvalue */
660             dTARGET;            /* make sure to clear its target here */
661             if (SvTYPE(TARG) == SVt_PVLV)
662                 LvTARG(TARG) = Nullsv;
663             PUSHs(TARG);
664         }
665         RETURN;
666     }
667
668     (void)hv_iterinit(hv);      /* always reset iterator regardless */
669
670     if (op->op_private & OPpLEAVE_VOID)
671         RETURN;
672
673     if (GIMME != G_ARRAY) {
674         I32 i;
675         dTARGET;
676
677         if (op->op_flags & OPf_MOD) {   /* lvalue */
678             if (SvTYPE(TARG) < SVt_PVLV) {
679                 sv_upgrade(TARG, SVt_PVLV);
680                 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
681             }
682             LvTYPE(TARG) = 'k';
683             LvTARG(TARG) = (SV*)hv;
684             PUSHs(TARG);
685             RETURN;
686         }
687
688         if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
689             i = HvKEYS(hv);
690         else {
691             i = 0;
692             /*SUPPRESS 560*/
693             while (entry = hv_iternext(hv)) {
694                 i++;
695             }
696         }
697         PUSHi( i );
698         RETURN;
699     }
700
701     /* Guess how much room we need.  hv_max may be a few too many.  Oh well. */
702     EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
703
704     PUTBACK;    /* hv_iternext and hv_iterval might clobber stack_sp */
705     while (entry = hv_iternext(hv)) {
706         SPAGAIN;
707         if (dokeys)
708             XPUSHs(hv_iterkeysv(entry));        /* won't clobber stack_sp */
709         if (dovalues) {
710             tmpstr = NEWSV(45,0);
711             PUTBACK;
712             sv_setsv(tmpstr,hv_iterval(hv,entry));
713             SPAGAIN;
714             DEBUG_H( {
715                         sprintf(buf,"%d%%%d=%d\n", HeHASH(entry),
716                                 HvMAX(hv)+1, HeHASH(entry) & HvMAX(hv));
717                         sv_setpv(tmpstr,buf);
718             } )
719             XPUSHs(sv_2mortal(tmpstr));
720         }
721         PUTBACK;
722     }
723     return NORMAL;
724 }
725