mg.c

   1 /* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:21:48 $
   2  *
   3  *    Copyright (c) 1993, 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  * $Log:        hash.c,v $
   9  */
  10
  11 #include "EXTERN.h"
  12 #include "perl.h"
  13
  14 int
  15 mg_get(sv)
  16 SV* sv;
  17 {
  18     MAGIC* mg;
  19     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  20         MGVTBL* vtbl = mg->mg_virtual;
  21         if (vtbl && vtbl->svt_get)
  22             (*vtbl->svt_get)(sv, mg);
  23     }
  24     return 0;
  25 }
  26
  27 int
  28 mg_set(sv)
  29 SV* sv;
  30 {
  31     MAGIC* mg;
  32     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  33         MGVTBL* vtbl = mg->mg_virtual;
  34         if (vtbl && vtbl->svt_set)
  35             (*vtbl->svt_set)(sv, mg);
  36     }
  37     return 0;
  38 }
  39
  40 U32
  41 mg_len(sv)
  42 SV* sv;
  43 {
  44     MAGIC* mg;
  45     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  46         MGVTBL* vtbl = mg->mg_virtual;
  47         if (vtbl && vtbl->svt_len)
  48             return (*vtbl->svt_len)(sv, mg);
  49     }
  50     mg_get(sv);
  51     if (!SvPOK(sv) && SvNIOK(sv))
  52         sv_2pv(sv);
  53     if (SvPOK(sv))
  54         return SvCUR(sv);
  55     return 0;
  56 }
  57
  58 int
  59 mg_clear(sv)
  60 SV* sv;
  61 {
  62     MAGIC* mg;
  63     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  64         MGVTBL* vtbl = mg->mg_virtual;
  65         if (vtbl && vtbl->svt_clear)
  66             (*vtbl->svt_clear)(sv, mg);
  67     }
  68     return 0;
  69 }
  70
  71 MAGIC*
  72 mg_find(sv, type)
  73 SV* sv;
  74 char type;
  75 {
  76     MAGIC* mg;
  77     MAGIC** mgp = &SvMAGIC(sv);
  78     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  79         if (mg->mg_type == type)
  80             return mg;
  81     }
  82     return 0;
  83 }
  84
  85 int
  86 mg_free(sv, type)
  87 SV* sv;
  88 char type;
  89 {
  90     MAGIC* mg;
  91     MAGIC** mgp = &SvMAGIC(sv);
  92     for (mg = *mgp; mg; mg = *mgp) {
  93         if (mg->mg_type == type) {
  94             MGVTBL* vtbl = mg->mg_virtual;
  95             *mgp = mg->mg_moremagic;
  96             if (vtbl && vtbl->svt_free)
  97                 (*vtbl->svt_free)(sv, mg);
  98             if (mg->mg_ptr && mg->mg_type != 'g')
  99                 Safefree(mg->mg_ptr);
 100             Safefree(mg);
 101         }
 102         else
 103             mgp = &mg->mg_moremagic;
 104     }
 105     return 0;
 106 }
 107
 108 int
 109 mg_freeall(sv)
 110 SV* sv;
 111 {
 112     MAGIC* mg;
 113     MAGIC* moremagic;
 114     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
 115         MGVTBL* vtbl = mg->mg_virtual;
 116         moremagic = mg->mg_moremagic;
 117         if (vtbl && vtbl->svt_free)
 118             (*vtbl->svt_free)(sv, mg);
 119         if (mg->mg_ptr && mg->mg_type != 'g')
 120             Safefree(mg->mg_ptr);
 121         Safefree(mg);
 122     }
 123     SvMAGIC(sv) = 0;
 124     return 0;
 125 }
 126
 127 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 128 #include <signal.h>
 129 #endif
 130
 131 #ifdef VOIDSIG
 132 #define handlertype void
 133 #else
 134 #define handlertype int
 135 #endif
 136
 137 static handlertype sighandler();
 138
 139 U32
 140 magic_len(sv, mg)
 141 SV *sv;
 142 MAGIC *mg;
 143 {
 144     register I32 paren;
 145     register char *s;
 146     register I32 i;
 147
 148     switch (*mg->mg_ptr) {
 149     case '1': case '2': case '3': case '4':
 150     case '5': case '6': case '7': case '8': case '9': case '&':
 151         if (curpm) {
 152             paren = atoi(mg->mg_ptr);
 153           getparen:
 154             if (curpm->op_pmregexp &&
 155               paren <= curpm->op_pmregexp->nparens &&
 156               (s = curpm->op_pmregexp->startp[paren]) ) {
 157                 i = curpm->op_pmregexp->endp[paren] - s;
 158                 if (i >= 0)
 159                     return i;
 160                 else
 161                     return 0;
 162             }
 163             else
 164                 return 0;
 165         }
 166         break;
 167     case '+':
 168         if (curpm) {
 169             paren = curpm->op_pmregexp->lastparen;
 170             goto getparen;
 171         }
 172         break;
 173     case '`':
 174         if (curpm) {
 175             if (curpm->op_pmregexp &&
 176               (s = curpm->op_pmregexp->subbeg) ) {
 177                 i = curpm->op_pmregexp->startp[0] - s;
 178                 if (i >= 0)
 179                     return i;
 180                 else
 181                     return 0;
 182             }
 183             else
 184                 return 0;
 185         }
 186         break;
 187     case '\'':
 188         if (curpm) {
 189             if (curpm->op_pmregexp &&
 190               (s = curpm->op_pmregexp->endp[0]) ) {
 191                 return (STRLEN) (curpm->op_pmregexp->subend - s);
 192             }
 193             else
 194                 return 0;
 195         }
 196         break;
 197     case ',':
 198         return (STRLEN)ofslen;
 199     case '\\':
 200         return (STRLEN)orslen;
 201     }
 202     magic_get(sv,mg);
 203     if (!SvPOK(sv) && SvNIOK(sv))
 204         sv_2pv(sv);
 205     if (SvPOK(sv))
 206         return SvCUR(sv);
 207     return 0;
 208 }
 209
 210 int
 211 magic_get(sv, mg)
 212 SV *sv;
 213 MAGIC *mg;
 214 {
 215     register I32 paren;
 216     register char *s;
 217     register I32 i;
 218
 219     switch (*mg->mg_ptr) {
 220     case '\004':                /* ^D */
 221         sv_setiv(sv,(I32)(debug & 32767));
 222         break;
 223     case '\006':                /* ^F */
 224         sv_setiv(sv,(I32)maxsysfd);
 225         break;
 226     case '\t':                  /* ^I */
 227         if (inplace)
 228             sv_setpv(sv, inplace);
 229         else
 230             sv_setsv(sv,&sv_undef);
 231         break;
 232     case '\020':                /* ^P */
 233         sv_setiv(sv,(I32)perldb);
 234         break;
 235     case '\024':                /* ^T */
 236         sv_setiv(sv,(I32)basetime);
 237         break;
 238     case '\027':                /* ^W */
 239         sv_setiv(sv,(I32)dowarn);
 240         break;
 241     case '1': case '2': case '3': case '4':
 242     case '5': case '6': case '7': case '8': case '9': case '&':
 243         if (curpm) {
 244             paren = atoi(GvENAME(mg->mg_obj));
 245           getparen:
 246             if (curpm->op_pmregexp &&
 247               paren <= curpm->op_pmregexp->nparens &&
 248               (s = curpm->op_pmregexp->startp[paren]) ) {
 249                 i = curpm->op_pmregexp->endp[paren] - s;
 250                 if (i >= 0)
 251                     sv_setpvn(sv,s,i);
 252                 else
 253                     sv_setsv(sv,&sv_undef);
 254             }
 255             else
 256                 sv_setsv(sv,&sv_undef);
 257         }
 258         break;
 259     case '+':
 260         if (curpm) {
 261             paren = curpm->op_pmregexp->lastparen;
 262             goto getparen;
 263         }
 264         break;
 265     case '`':
 266         if (curpm) {
 267             if (curpm->op_pmregexp &&
 268               (s = curpm->op_pmregexp->subbeg) ) {
 269                 i = curpm->op_pmregexp->startp[0] - s;
 270                 if (i >= 0)
 271                     sv_setpvn(sv,s,i);
 272                 else
 273                     sv_setpvn(sv,"",0);
 274             }
 275             else
 276                 sv_setpvn(sv,"",0);
 277         }
 278         break;
 279     case '\'':
 280         if (curpm) {
 281             if (curpm->op_pmregexp &&
 282               (s = curpm->op_pmregexp->endp[0]) ) {
 283                 sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
 284             }
 285             else
 286                 sv_setpvn(sv,"",0);
 287         }
 288         break;
 289     case '.':
 290 #ifndef lint
 291         if (last_in_gv && GvIO(last_in_gv)) {
 292             sv_setiv(sv,(I32)GvIO(last_in_gv)->lines);
 293         }
 294 #endif
 295         break;
 296     case '?':
 297         sv_setiv(sv,(I32)statusvalue);
 298         break;
 299     case '^':
 300         s = GvIO(defoutgv)->top_name;
 301         if (s)
 302             sv_setpv(sv,s);
 303         else {
 304             sv_setpv(sv,GvENAME(defoutgv));
 305             sv_catpv(sv,"_TOP");
 306         }
 307         break;
 308     case '~':
 309         s = GvIO(defoutgv)->fmt_name;
 310         if (!s)
 311             s = GvENAME(defoutgv);
 312         sv_setpv(sv,s);
 313         break;
 314 #ifndef lint
 315     case '=':
 316         sv_setiv(sv,(I32)GvIO(defoutgv)->page_len);
 317         break;
 318     case '-':
 319         sv_setiv(sv,(I32)GvIO(defoutgv)->lines_left);
 320         break;
 321     case '%':
 322         sv_setiv(sv,(I32)GvIO(defoutgv)->page);
 323         break;
 324 #endif
 325     case ':':
 326         break;
 327     case '/':
 328         break;
 329     case '[':
 330         sv_setiv(sv,(I32)arybase);
 331         break;
 332     case '|':
 333         if (!GvIO(defoutgv))
 334             GvIO(defoutgv) = newIO();
 335         sv_setiv(sv, (GvIO(defoutgv)->flags & IOf_FLUSH) != 0 );
 336         break;
 337     case ',':
 338         sv_setpvn(sv,ofs,ofslen);
 339         break;
 340     case '\\':
 341         sv_setpvn(sv,ors,orslen);
 342         break;
 343     case '#':
 344         sv_setpv(sv,ofmt);
 345         break;
 346     case '!':
 347         sv_setnv(sv,(double)errno);
 348         sv_setpv(sv, errno ? strerror(errno) : "");
 349         SvNOK_on(sv);   /* what a wonderful hack! */
 350         break;
 351     case '<':
 352         sv_setiv(sv,(I32)uid);
 353         break;
 354     case '>':
 355         sv_setiv(sv,(I32)euid);
 356         break;
 357     case '(':
 358         s = buf;
 359         (void)sprintf(s,"%d",(int)gid);
 360         goto add_groups;
 361     case ')':
 362         s = buf;
 363         (void)sprintf(s,"%d",(int)egid);
 364       add_groups:
 365         while (*s) s++;
 366 #ifdef HAS_GETGROUPS
 367 #ifndef NGROUPS
 368 #define NGROUPS 32
 369 #endif
 370         {
 371             GROUPSTYPE gary[NGROUPS];
 372
 373             i = getgroups(NGROUPS,gary);
 374             while (--i >= 0) {
 375                 (void)sprintf(s," %ld", (long)gary[i]);
 376                 while (*s) s++;
 377             }
 378         }
 379 #endif
 380         sv_setpv(sv,buf);
 381         break;
 382     case '*':
 383         break;
 384     case '0':
 385         break;
 386     }
 387 }
 388
 389 int
 390 magic_getuvar(sv, mg)
 391 SV *sv;
 392 MAGIC *mg;
 393 {
 394     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
 395
 396     if (uf && uf->uf_val)
 397         (*uf->uf_val)(uf->uf_index, sv);
 398     return 0;
 399 }
 400
 401 int
 402 magic_setenv(sv,mg)
 403 SV* sv;
 404 MAGIC* mg;
 405 {
 406     register char *s;
 407     I32 i;
 408     s = SvPV(sv);
 409     my_setenv(mg->mg_ptr,s);
 410                             /* And you'll never guess what the dog had */
 411                             /*   in its mouth... */
 412 #ifdef TAINT
 413     if (s && strEQ(mg->mg_ptr,"PATH")) {
 414         char *strend = SvEND(sv);
 415
 416         while (s < strend) {
 417             s = cpytill(tokenbuf,s,strend,':',&i);
 418             s++;
 419             if (*tokenbuf != '/'
 420               || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
 421                 sv->sv_tainted = 2;
 422         }
 423     }
 424 #endif
 425     return 0;
 426 }
 427
 428 int
 429 magic_setsig(sv,mg)
 430 SV* sv;
 431 MAGIC* mg;
 432 {
 433     register char *s;
 434     I32 i;
 435     s = SvPV(sv);
 436     i = whichsig(mg->mg_ptr);   /* ...no, a brick */
 437     if (!i && (dowarn || strEQ(mg->mg_ptr,"ALARM")))
 438         warn("No such signal: SIG%s", mg->mg_ptr);
 439     if (strEQ(s,"IGNORE"))
 440 #ifndef lint
 441         (void)signal(i,SIG_IGN);
 442 #else
 443         ;
 444 #endif
 445     else if (strEQ(s,"DEFAULT") || !*s)
 446         (void)signal(i,SIG_DFL);
 447     else {
 448         (void)signal(i,sighandler);
 449         if (!strchr(s,'\'')) {
 450             sprintf(tokenbuf, "main'%s",s);
 451             sv_setpv(sv,tokenbuf);
 452         }
 453     }
 454     return 0;
 455 }
 456
 457 int
 458 magic_setdbm(sv,mg)
 459 SV* sv;
 460 MAGIC* mg;
 461 {
 462     HV* hv = (HV*)mg->mg_obj;
 463     hv_dbmstore(hv,mg->mg_ptr,mg->mg_len,sv);   /* XXX slurp? */
 464     return 0;
 465 }
 466
 467 int
 468 magic_setdbline(sv,mg)
 469 SV* sv;
 470 MAGIC* mg;
 471 {
 472     OP *o;
 473     I32 i;
 474     GV* gv;
 475     SV** svp;
 476
 477     gv = DBline;
 478     i = SvTRUE(sv);
 479     svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
 480     if (svp && SvIOK(*svp) && (o = (OP*)SvSTASH(*svp)))
 481         o->op_private = i;
 482     else
 483         warn("Can't break at that line\n");
 484     return 0;
 485 }
 486
 487 int
 488 magic_getarylen(sv,mg)
 489 SV* sv;
 490 MAGIC* mg;
 491 {
 492     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + arybase);
 493     return 0;
 494 }
 495
 496 int
 497 magic_setarylen(sv,mg)
 498 SV* sv;
 499 MAGIC* mg;
 500 {
 501     av_fill((AV*)mg->mg_obj, (SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) - arybase);
 502     return 0;
 503 }
 504
 505 int
 506 magic_getglob(sv,mg)
 507 SV* sv;
 508 MAGIC* mg;
 509 {
 510     gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
 511     return 0;
 512 }
 513
 514 int
 515 magic_setglob(sv,mg)
 516 SV* sv;
 517 MAGIC* mg;
 518 {
 519     register char *s;
 520     GV* gv;
 521
 522     if (!SvOK(sv))
 523         return 0;
 524     s = SvPOK(sv) ? SvPV(sv) : sv_2pv(sv);
 525     if (*s == '*' && s[1])
 526         s++;
 527     gv = gv_fetchpv(s,TRUE);
 528     if (sv == (SV*)gv)
 529         return 0;
 530     if (GvGP(sv))
 531         gp_free(sv);
 532     GvGP(sv) = gp_ref(GvGP(gv));
 533     if (!GvAV(gv))
 534         gv_AVadd(gv);
 535     if (!GvHV(gv))
 536         gv_HVadd(gv);
 537     if (!GvIO(gv))
 538         GvIO(gv) = newIO();
 539     return 0;
 540 }
 541
 542 int
 543 magic_setsubstr(sv,mg)
 544 SV* sv;
 545 MAGIC* mg;
 546 {
 547     char *tmps = SvPV(sv);
 548     if (!tmps)
 549         tmps = "";
 550     sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps,SvCUR(sv));
 551     return 0;
 552 }
 553
 554 int
 555 magic_setvec(sv,mg)
 556 SV* sv;
 557 MAGIC* mg;
 558 {
 559     do_vecset(sv);      /* XXX slurp this routine */
 560     return 0;
 561 }
 562
 563 int
 564 magic_setmglob(sv,mg)
 565 SV* sv;
 566 MAGIC* mg;
 567 {
 568     mg->mg_ptr = 0;
 569     mg->mg_len = 0;
 570     return 0;
 571 }
 572
 573 int
 574 magic_setbm(sv,mg)
 575 SV* sv;
 576 MAGIC* mg;
 577 {
 578     mg_free(sv, 'B');
 579     SvVALID_off(sv);
 580     return 0;
 581 }
 582
 583 int
 584 magic_setuvar(sv,mg)
 585 SV* sv;
 586 MAGIC* mg;
 587 {
 588     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
 589
 590     if (uf && uf->uf_set)
 591         (*uf->uf_set)(uf->uf_index, sv);
 592     return 0;
 593 }
 594
 595 int
 596 magic_set(sv,mg)
 597 SV* sv;
 598 MAGIC* mg;
 599 {
 600     register char *s;
 601     I32 i;
 602     switch (*mg->mg_ptr) {
 603     case '\004':        /* ^D */
 604         debug = (SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) | 32768;
 605         DEBUG_x(dump_all());
 606         break;
 607     case '\006':        /* ^F */
 608         maxsysfd = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
 609         break;
 610     case '\t':  /* ^I */
 611         if (inplace)
 612             Safefree(inplace);
 613         if (SvOK(sv))
 614             inplace = savestr(SvPV(sv));
 615         else
 616             inplace = Nullch;
 617         break;
 618     case '\020':        /* ^P */
 619         i = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
 620         if (i != perldb) {
 621             if (perldb)
 622                 oldlastpm = curpm;
 623             else
 624                 curpm = oldlastpm;
 625         }
 626         perldb = i;
 627         break;
 628     case '\024':        /* ^T */
 629         basetime = (time_t)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
 630         break;
 631     case '\027':        /* ^W */
 632         dowarn = (bool)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
 633         break;
 634     case '.':
 635         if (localizing)
 636             save_sptr((SV**)&last_in_gv);
 637         break;
 638     case '^':
 639         Safefree(GvIO(defoutgv)->top_name);
 640         GvIO(defoutgv)->top_name = s = savestr(SvPV(sv));
 641         GvIO(defoutgv)->top_gv = gv_fetchpv(s,TRUE);
 642         break;
 643     case '~':
 644         Safefree(GvIO(defoutgv)->fmt_name);
 645         GvIO(defoutgv)->fmt_name = s = savestr(SvPV(sv));
 646         GvIO(defoutgv)->fmt_gv = gv_fetchpv(s,TRUE);
 647         break;
 648     case '=':
 649         GvIO(defoutgv)->page_len = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
 650         break;
 651     case '-':
 652         GvIO(defoutgv)->lines_left = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
 653         if (GvIO(defoutgv)->lines_left < 0L)
 654             GvIO(defoutgv)->lines_left = 0L;
 655         break;
 656     case '%':
 657         GvIO(defoutgv)->page = (long)(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
 658         break;
 659     case '|':
 660         if (!GvIO(defoutgv))
 661             GvIO(defoutgv) = newIO();
 662         GvIO(defoutgv)->flags &= ~IOf_FLUSH;
 663         if ((SvIOK(sv) ? SvIV(sv) : sv_2iv(sv)) != 0) {
 664             GvIO(defoutgv)->flags |= IOf_FLUSH;
 665         }
 666         break;
 667     case '*':
 668         i = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
 669         multiline = (i != 0);
 670         break;
 671     case '/':
 672         if (SvPOK(sv)) {
 673             nrs = rs = SvPV(sv);
 674             nrslen = rslen = SvCUR(sv);
 675             if (rspara = !rslen) {
 676                 nrs = rs = "\n\n";
 677                 nrslen = rslen = 2;
 678             }
 679             nrschar = rschar = rs[rslen - 1];
 680         }
 681         else {
 682             nrschar = rschar = 0777;    /* fake a non-existent char */
 683             nrslen = rslen = 1;
 684         }
 685         break;
 686     case '\\':
 687         if (ors)
 688             Safefree(ors);
 689         ors = savestr(SvPV(sv));
 690         orslen = SvCUR(sv);
 691         break;
 692     case ',':
 693         if (ofs)
 694             Safefree(ofs);
 695         ofs = savestr(SvPV(sv));
 696         ofslen = SvCUR(sv);
 697         break;
 698     case '#':
 699         if (ofmt)
 700             Safefree(ofmt);
 701         ofmt = savestr(SvPV(sv));
 702         break;
 703     case '[':
 704         arybase = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
 705         break;
 706     case '?':
 707         statusvalue = U_S(SvIOK(sv) ? SvIV(sv) : sv_2iv(sv));
 708         break;
 709     case '!':
 710         errno = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);              /* will anyone ever use this? */
 711         break;
 712     case '<':
 713         uid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
 714         if (delaymagic) {
 715             delaymagic |= DM_RUID;
 716             break;                              /* don't do magic till later */
 717         }
 718 #ifdef HAS_SETRUID
 719         (void)setruid((UIDTYPE)uid);
 720 #else
 721 #ifdef HAS_SETREUID
 722         (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1);
 723 #else
 724         if (uid == euid)                /* special case $< = $> */
 725             (void)setuid(uid);
 726         else
 727             fatal("setruid() not implemented");
 728 #endif
 729 #endif
 730         uid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
 731         break;
 732     case '>':
 733         euid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
 734         if (delaymagic) {
 735             delaymagic |= DM_EUID;
 736             break;                              /* don't do magic till later */
 737         }
 738 #ifdef HAS_SETEUID
 739         (void)seteuid((UIDTYPE)euid);
 740 #else
 741 #ifdef HAS_SETREUID
 742         (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid);
 743 #else
 744         if (euid == uid)                /* special case $> = $< */
 745             setuid(euid);
 746         else
 747             fatal("seteuid() not implemented");
 748 #endif
 749 #endif
 750         euid = (I32)geteuid();
 751         break;
 752     case '(':
 753         gid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
 754         if (delaymagic) {
 755             delaymagic |= DM_RGID;
 756             break;                              /* don't do magic till later */
 757         }
 758 #ifdef HAS_SETRGID
 759         (void)setrgid((GIDTYPE)gid);
 760 #else
 761 #ifdef HAS_SETREGID
 762         (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
 763 #else
 764         if (gid == egid)                        /* special case $( = $) */
 765             (void)setgid(gid);
 766         else
 767             fatal("setrgid() not implemented");
 768 #endif
 769 #endif
 770         gid = (I32)getgid();
 771         break;
 772     case ')':
 773         egid = SvIOK(sv) ? SvIV(sv) : sv_2iv(sv);
 774         if (delaymagic) {
 775             delaymagic |= DM_EGID;
 776             break;                              /* don't do magic till later */
 777         }
 778 #ifdef HAS_SETEGID
 779         (void)setegid((GIDTYPE)egid);
 780 #else
 781 #ifdef HAS_SETREGID
 782         (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
 783 #else
 784         if (egid == gid)                        /* special case $) = $( */
 785             (void)setgid(egid);
 786         else
 787             fatal("setegid() not implemented");
 788 #endif
 789 #endif
 790         egid = (I32)getegid();
 791         break;
 792     case ':':
 793         chopset = SvPV(sv);
 794         break;
 795     case '0':
 796         if (!origalen) {
 797             s = origargv[0];
 798             s += strlen(s);
 799             /* See if all the arguments are contiguous in memory */
 800             for (i = 1; i < origargc; i++) {
 801                 if (origargv[i] == s + 1)
 802                     s += strlen(++s);   /* this one is ok too */
 803             }
 804             if (origenviron[0] == s + 1) {      /* can grab env area too? */
 805                 my_setenv("NoNeSuCh", Nullch);
 806                                             /* force copy of environment */
 807                 for (i = 0; origenviron[i]; i++)
 808                     if (origenviron[i] == s + 1)
 809                         s += strlen(++s);
 810             }
 811             origalen = s - origargv[0];
 812         }
 813         s = SvPV(sv);
 814         i = SvCUR(sv);
 815         if (i >= origalen) {
 816             i = origalen;
 817             SvCUR_set(sv, i);
 818             *SvEND(sv) = '\0';
 819             Copy(s, origargv[0], i, char);
 820         }
 821         else {
 822             Copy(s, origargv[0], i, char);
 823             s = origargv[0]+i;
 824             *s++ = '\0';
 825             while (++i < origalen)
 826                 *s++ = ' ';
 827         }
 828         break;
 829     }
 830     return 0;
 831 }
 832
 833 I32
 834 whichsig(sig)
 835 char *sig;
 836 {
 837     register char **sigv;
 838
 839     for (sigv = sig_name+1; *sigv; sigv++)
 840         if (strEQ(sig,*sigv))
 841             return sigv - sig_name;
 842 #ifdef SIGCLD
 843     if (strEQ(sig,"CHLD"))
 844         return SIGCLD;
 845 #endif
 846 #ifdef SIGCHLD
 847     if (strEQ(sig,"CLD"))
 848         return SIGCHLD;
 849 #endif
 850     return 0;
 851 }
 852
 853 static handlertype
 854 sighandler(sig)
 855 I32 sig;
 856 {
 857     dSP;
 858     GV *gv;
 859     SV *sv;
 860     CV *cv;
 861     CONTEXT *cx;
 862     AV *oldstack;
 863     I32 hasargs = 1;
 864     I32 items = 1;
 865     I32 gimme = G_SCALAR;
 866
 867 #ifdef OS2              /* or anybody else who requires SIG_ACK */
 868     signal(sig, SIG_ACK);
 869 #endif
 870
 871     gv = gv_fetchpv(
 872         SvPVnx(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]),
 873           TRUE)), TRUE);
 874     cv = GvCV(gv);
 875     if (!cv && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
 876         if (sig_name[sig][1] == 'H')
 877             gv = gv_fetchpv(SvPVnx(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE)),
 878               TRUE);
 879         else
 880             gv = gv_fetchpv(SvPVnx(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE)),
 881               TRUE);
 882         cv = GvCV(gv);  /* gag */
 883     }
 884     if (!cv) {
 885         if (dowarn)
 886             warn("SIG%s handler \"%s\" not defined.\n",
 887                 sig_name[sig], GvENAME(gv) );
 888         return;
 889     }
 890
 891     oldstack = stack;
 892     SWITCHSTACK(stack, signalstack);
 893
 894     sv = sv_mortalcopy(&sv_undef);
 895     sv_setpv(sv,sig_name[sig]);
 896     PUSHs(sv);
 897
 898     ENTER;
 899     SAVETMPS;
 900
 901     push_return(op);
 902     push_return(0);
 903     PUSHBLOCK(cx, CXt_SUB, sp);
 904     PUSHSUB(cx);
 905     cx->blk_sub.savearray = GvAV(defgv);
 906     cx->blk_sub.argarray = av_fake(items, sp);
 907     GvAV(defgv) = cx->blk_sub.argarray;
 908     CvDEPTH(cv)++;
 909     if (CvDEPTH(cv) >= 2) {
 910         if (CvDEPTH(cv) == 100 && dowarn)
 911             warn("Deep recursion on subroutine \"%s\"",GvENAME(gv));
 912     }
 913     op = CvSTART(cv);
 914     PUTBACK;
 915     run();              /* Does the LEAVE for us. */
 916
 917     SWITCHSTACK(signalstack, oldstack);
 918     op = pop_return();
 919
 920     return;
 921 }