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 void
  15 mg_magical(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) {
  22             if (vtbl->svt_get)
  23                 SvGMAGICAL_on(sv);
  24             if (vtbl->svt_set)
  25                 SvSMAGICAL_on(sv);
  26             if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
  27                 SvRMAGICAL_on(sv);
  28         }
  29     }
  30 }
  31
  32 int
  33 mg_get(sv)
  34 SV* sv;
  35 {
  36     MAGIC* mg;
  37     U32 savemagic = SvMAGICAL(sv);
  38
  39     SvMAGICAL_off(sv);
  40     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  41
  42     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  43         MGVTBL* vtbl = mg->mg_virtual;
  44         if (vtbl && vtbl->svt_get)
  45             (*vtbl->svt_get)(sv, mg);
  46     }
  47
  48     SvFLAGS(sv) |= savemagic;
  49     assert(SvGMAGICAL(sv));
  50     SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  51
  52     return 0;
  53 }
  54
  55 int
  56 mg_set(sv)
  57 SV* sv;
  58 {
  59     MAGIC* mg;
  60     MAGIC* nextmg;
  61     U32 savemagic = SvMAGICAL(sv);
  62
  63     SvMAGICAL_off(sv);
  64
  65     for (mg = SvMAGIC(sv); mg; mg = nextmg) {
  66         MGVTBL* vtbl = mg->mg_virtual;
  67         nextmg = mg->mg_moremagic;      /* it may delete itself */
  68         if (vtbl && vtbl->svt_set)
  69             (*vtbl->svt_set)(sv, mg);
  70     }
  71
  72     if (SvMAGIC(sv)) {
  73         SvFLAGS(sv) |= savemagic;
  74         if (SvGMAGICAL(sv))
  75             SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  76     }
  77
  78     return 0;
  79 }
  80
  81 U32
  82 mg_len(sv)
  83 SV* sv;
  84 {
  85     MAGIC* mg;
  86     char *s;
  87     STRLEN len;
  88     U32 savemagic = SvMAGICAL(sv);
  89
  90     SvMAGICAL_off(sv);
  91     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  92
  93     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  94         MGVTBL* vtbl = mg->mg_virtual;
  95         if (vtbl && vtbl->svt_len)
  96             return (*vtbl->svt_len)(sv, mg);
  97     }
  98     mg_get(sv);
  99     s = SvPV(sv, len);
 100
 101     SvFLAGS(sv) |= savemagic;
 102     if (SvGMAGICAL(sv))
 103         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
 104
 105     return len;
 106 }
 107
 108 int
 109 mg_clear(sv)
 110 SV* sv;
 111 {
 112     MAGIC* mg;
 113     U32 savemagic = SvMAGICAL(sv);
 114
 115     SvMAGICAL_off(sv);
 116     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 117
 118     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 119         MGVTBL* vtbl = mg->mg_virtual;
 120         if (vtbl && vtbl->svt_clear)
 121             (*vtbl->svt_clear)(sv, mg);
 122     }
 123
 124     SvFLAGS(sv) |= savemagic;
 125     if (SvGMAGICAL(sv))
 126         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
 127
 128     return 0;
 129 }
 130
 131 MAGIC*
 132 #ifndef STANDARD_C
 133 mg_find(sv, type)
 134 SV* sv;
 135 char type;
 136 #else
 137 mg_find(SV *sv, char type)
 138 #endif /* STANDARD_C */
 139 {
 140     MAGIC* mg;
 141     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 142         if (mg->mg_type == type)
 143             return mg;
 144     }
 145     return 0;
 146 }
 147
 148 int
 149 mg_copy(sv, nsv, key, klen)
 150 SV* sv;
 151 SV* nsv;
 152 char *key;
 153 STRLEN klen;
 154 {
 155     int count = 0;
 156     MAGIC* mg;
 157     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 158         if (isUPPER(mg->mg_type)) {
 159             sv_magic(nsv, mg->mg_obj, tolower(mg->mg_type), key, klen);
 160             count++;
 161         }
 162     }
 163     return count;
 164 }
 165
 166 int
 167 mg_free(sv)
 168 SV* sv;
 169 {
 170     MAGIC* mg;
 171     MAGIC* moremagic;
 172     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
 173         MGVTBL* vtbl = mg->mg_virtual;
 174         moremagic = mg->mg_moremagic;
 175         if (vtbl && vtbl->svt_free)
 176             (*vtbl->svt_free)(sv, mg);
 177         if (mg->mg_ptr && mg->mg_type != 'g')
 178             Safefree(mg->mg_ptr);
 179         if (mg->mg_obj != sv)
 180             SvREFCNT_dec(mg->mg_obj);
 181         Safefree(mg);
 182     }
 183     SvMAGIC(sv) = 0;
 184     return 0;
 185 }
 186
 187 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 188 #include <signal.h>
 189 #endif
 190
 191 #ifdef VOIDSIG
 192 #define handlertype void
 193 #else
 194 #define handlertype int
 195 #endif
 196
 197 static handlertype sighandler();
 198
 199 U32
 200 magic_len(sv, mg)
 201 SV *sv;
 202 MAGIC *mg;
 203 {
 204     register I32 paren;
 205     register char *s;
 206     register I32 i;
 207
 208     switch (*mg->mg_ptr) {
 209     case '1': case '2': case '3': case '4':
 210     case '5': case '6': case '7': case '8': case '9': case '&':
 211         if (curpm) {
 212             paren = atoi(mg->mg_ptr);
 213           getparen:
 214             if (curpm->op_pmregexp &&
 215               paren <= curpm->op_pmregexp->nparens &&
 216               (s = curpm->op_pmregexp->startp[paren]) ) {
 217                 i = curpm->op_pmregexp->endp[paren] - s;
 218                 if (i >= 0)
 219                     return i;
 220                 else
 221                     return 0;
 222             }
 223             else
 224                 return 0;
 225         }
 226         break;
 227     case '+':
 228         if (curpm) {
 229             paren = curpm->op_pmregexp->lastparen;
 230             goto getparen;
 231         }
 232         break;
 233     case '`':
 234         if (curpm) {
 235             if (curpm->op_pmregexp &&
 236               (s = curpm->op_pmregexp->subbeg) ) {
 237                 i = curpm->op_pmregexp->startp[0] - s;
 238                 if (i >= 0)
 239                     return i;
 240                 else
 241                     return 0;
 242             }
 243             else
 244                 return 0;
 245         }
 246         break;
 247     case '\'':
 248         if (curpm) {
 249             if (curpm->op_pmregexp &&
 250               (s = curpm->op_pmregexp->endp[0]) ) {
 251                 return (STRLEN) (curpm->op_pmregexp->subend - s);
 252             }
 253             else
 254                 return 0;
 255         }
 256         break;
 257     case ',':
 258         return (STRLEN)ofslen;
 259     case '\\':
 260         return (STRLEN)orslen;
 261     }
 262     magic_get(sv,mg);
 263     if (!SvPOK(sv) && SvNIOK(sv))
 264         sv_2pv(sv, &na);
 265     if (SvPOK(sv))
 266         return SvCUR(sv);
 267     return 0;
 268 }
 269
 270 int
 271 magic_get(sv, mg)
 272 SV *sv;
 273 MAGIC *mg;
 274 {
 275     register I32 paren;
 276     register char *s;
 277     register I32 i;
 278
 279     switch (*mg->mg_ptr) {
 280     case '\004':                /* ^D */
 281         sv_setiv(sv,(I32)(debug & 32767));
 282         break;
 283     case '\006':                /* ^F */
 284         sv_setiv(sv,(I32)maxsysfd);
 285         break;
 286     case '\t':                  /* ^I */
 287         if (inplace)
 288             sv_setpv(sv, inplace);
 289         else
 290             sv_setsv(sv,&sv_undef);
 291         break;
 292     case '\020':                /* ^P */
 293         sv_setiv(sv,(I32)perldb);
 294         break;
 295     case '\024':                /* ^T */
 296         sv_setiv(sv,(I32)basetime);
 297         break;
 298     case '\027':                /* ^W */
 299         sv_setiv(sv,(I32)dowarn);
 300         break;
 301     case '1': case '2': case '3': case '4':
 302     case '5': case '6': case '7': case '8': case '9': case '&':
 303         if (curpm) {
 304             paren = atoi(GvENAME(mg->mg_obj));
 305           getparen:
 306             if (curpm->op_pmregexp &&
 307               paren <= curpm->op_pmregexp->nparens &&
 308               (s = curpm->op_pmregexp->startp[paren]) ) {
 309                 i = curpm->op_pmregexp->endp[paren] - s;
 310                 if (i >= 0)
 311                     sv_setpvn(sv,s,i);
 312                 else
 313                     sv_setsv(sv,&sv_undef);
 314             }
 315             else
 316                 sv_setsv(sv,&sv_undef);
 317         }
 318         break;
 319     case '+':
 320         if (curpm) {
 321             paren = curpm->op_pmregexp->lastparen;
 322             goto getparen;
 323         }
 324         break;
 325     case '`':
 326         if (curpm) {
 327             if (curpm->op_pmregexp &&
 328               (s = curpm->op_pmregexp->subbeg) ) {
 329                 i = curpm->op_pmregexp->startp[0] - s;
 330                 if (i >= 0)
 331                     sv_setpvn(sv,s,i);
 332                 else
 333                     sv_setpvn(sv,"",0);
 334             }
 335             else
 336                 sv_setpvn(sv,"",0);
 337         }
 338         break;
 339     case '\'':
 340         if (curpm) {
 341             if (curpm->op_pmregexp &&
 342               (s = curpm->op_pmregexp->endp[0]) ) {
 343                 sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
 344             }
 345             else
 346                 sv_setpvn(sv,"",0);
 347         }
 348         break;
 349     case '.':
 350 #ifndef lint
 351         if (last_in_gv && GvIO(last_in_gv)) {
 352             sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
 353         }
 354 #endif
 355         break;
 356     case '?':
 357         sv_setiv(sv,(I32)statusvalue);
 358         break;
 359     case '^':
 360         s = IoTOP_NAME(GvIO(defoutgv));
 361         if (s)
 362             sv_setpv(sv,s);
 363         else {
 364             sv_setpv(sv,GvENAME(defoutgv));
 365             sv_catpv(sv,"_TOP");
 366         }
 367         break;
 368     case '~':
 369         s = IoFMT_NAME(GvIO(defoutgv));
 370         if (!s)
 371             s = GvENAME(defoutgv);
 372         sv_setpv(sv,s);
 373         break;
 374 #ifndef lint
 375     case '=':
 376         sv_setiv(sv,(I32)IoPAGE_LEN(GvIO(defoutgv)));
 377         break;
 378     case '-':
 379         sv_setiv(sv,(I32)IoLINES_LEFT(GvIO(defoutgv)));
 380         break;
 381     case '%':
 382         sv_setiv(sv,(I32)IoPAGE(GvIO(defoutgv)));
 383         break;
 384 #endif
 385     case ':':
 386         break;
 387     case '/':
 388         break;
 389     case '[':
 390         sv_setiv(sv,(I32)arybase);
 391         break;
 392     case '|':
 393         if (!GvIO(defoutgv))
 394             GvIO(defoutgv) = newIO();
 395         sv_setiv(sv, (IoFLAGS(GvIO(defoutgv)) & IOf_FLUSH) != 0 );
 396         break;
 397     case ',':
 398         sv_setpvn(sv,ofs,ofslen);
 399         break;
 400     case '\\':
 401         sv_setpvn(sv,ors,orslen);
 402         break;
 403     case '#':
 404         sv_setpv(sv,ofmt);
 405         break;
 406     case '!':
 407         sv_setnv(sv,(double)errno);
 408         sv_setpv(sv, errno ? strerror(errno) : "");
 409         SvNOK_on(sv);   /* what a wonderful hack! */
 410         break;
 411     case '<':
 412         sv_setiv(sv,(I32)uid);
 413         break;
 414     case '>':
 415         sv_setiv(sv,(I32)euid);
 416         break;
 417     case '(':
 418         s = buf;
 419         (void)sprintf(s,"%d",(int)gid);
 420         goto add_groups;
 421     case ')':
 422         s = buf;
 423         (void)sprintf(s,"%d",(int)egid);
 424       add_groups:
 425         while (*s) s++;
 426 #ifdef HAS_GETGROUPS
 427 #ifndef NGROUPS
 428 #define NGROUPS 32
 429 #endif
 430         {
 431             GROUPSTYPE gary[NGROUPS];
 432
 433             i = getgroups(NGROUPS,gary);
 434             while (--i >= 0) {
 435                 (void)sprintf(s," %ld", (long)gary[i]);
 436                 while (*s) s++;
 437             }
 438         }
 439 #endif
 440         sv_setpv(sv,buf);
 441         break;
 442     case '*':
 443         break;
 444     case '0':
 445         break;
 446     }
 447 }
 448
 449 int
 450 magic_getuvar(sv, mg)
 451 SV *sv;
 452 MAGIC *mg;
 453 {
 454     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
 455
 456     if (uf && uf->uf_val)
 457         (*uf->uf_val)(uf->uf_index, sv);
 458     return 0;
 459 }
 460
 461 int
 462 magic_setenv(sv,mg)
 463 SV* sv;
 464 MAGIC* mg;
 465 {
 466     register char *s;
 467     I32 i;
 468     s = SvPV(sv,na);
 469     my_setenv(mg->mg_ptr,s);
 470                             /* And you'll never guess what the dog had */
 471                             /*   in its mouth... */
 472     if (tainting) {
 473         if (s && strEQ(mg->mg_ptr,"PATH")) {
 474             char *strend = SvEND(sv);
 475
 476             while (s < strend) {
 477                 s = cpytill(tokenbuf,s,strend,':',&i);
 478                 s++;
 479                 if (*tokenbuf != '/'
 480                   || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
 481                     MgTAINTEDDIR_on(mg);
 482             }
 483         }
 484     }
 485     return 0;
 486 }
 487
 488 int
 489 magic_setsig(sv,mg)
 490 SV* sv;
 491 MAGIC* mg;
 492 {
 493     register char *s;
 494     I32 i;
 495     s = SvPV(sv,na);
 496     i = whichsig(mg->mg_ptr);   /* ...no, a brick */
 497     if (!i && (dowarn || strEQ(mg->mg_ptr,"ALARM")))
 498         warn("No such signal: SIG%s", mg->mg_ptr);
 499     if (strEQ(s,"IGNORE"))
 500 #ifndef lint
 501         (void)signal(i,SIG_IGN);
 502 #else
 503         ;
 504 #endif
 505     else if (strEQ(s,"DEFAULT") || !*s)
 506         (void)signal(i,SIG_DFL);
 507     else {
 508         (void)signal(i,sighandler);
 509         if (!strchr(s,'\'')) {
 510             sprintf(tokenbuf, "main'%s",s);
 511             sv_setpv(sv,tokenbuf);
 512         }
 513     }
 514     return 0;
 515 }
 516
 517 int
 518 magic_setisa(sv,mg)
 519 SV* sv;
 520 MAGIC* mg;
 521 {
 522     sub_generation++;
 523     return 0;
 524 }
 525
 526 int
 527 magic_getpack(sv,mg)
 528 SV* sv;
 529 MAGIC* mg;
 530 {
 531     SV* rv = mg->mg_obj;
 532     HV* stash = SvSTASH(SvRV(rv));
 533     GV* gv = gv_fetchmethod(stash, "fetch");
 534     dSP;
 535     BINOP myop;
 536
 537     if (!gv || !GvCV(gv)) {
 538         croak("No fetch method for magical variable in package \"%s\"",
 539             HvNAME(stash));
 540     }
 541     Zero(&myop, 1, BINOP);
 542     myop.op_last = (OP *) &myop;
 543     myop.op_next = Nullop;
 544     myop.op_flags = OPf_STACKED;
 545
 546     ENTER;
 547     SAVESPTR(op);
 548     op = (OP *) &myop;
 549     PUTBACK;
 550     pp_pushmark();
 551
 552     EXTEND(sp, 4);
 553     PUSHs(gv);
 554     PUSHs(rv);
 555     if (mg->mg_ptr)
 556         PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len)));
 557     else if (mg->mg_len >= 0)
 558         PUSHs(sv_mortalcopy(newSViv(mg->mg_len)));
 559     PUTBACK;
 560
 561     if (op = pp_entersubr())
 562         run();
 563     LEAVE;
 564     SPAGAIN;
 565
 566     sv_setsv(sv, POPs);
 567     PUTBACK;
 568
 569     return 0;
 570 }
 571
 572 int
 573 magic_setpack(sv,mg)
 574 SV* sv;
 575 MAGIC* mg;
 576 {
 577     SV* rv = mg->mg_obj;
 578     HV* stash = SvSTASH(SvRV(rv));
 579     GV* gv = gv_fetchmethod(stash, "store");
 580     dSP;
 581     BINOP myop;
 582
 583     if (!gv || !GvCV(gv)) {
 584         croak("No store method for magical variable in package \"%s\"",
 585             HvNAME(stash));
 586     }
 587     Zero(&myop, 1, BINOP);
 588     myop.op_last = (OP *) &myop;
 589     myop.op_next = Nullop;
 590     myop.op_flags = OPf_STACKED;
 591
 592     ENTER;
 593     SAVESPTR(op);
 594     op = (OP *) &myop;
 595     PUTBACK;
 596     pp_pushmark();
 597
 598     EXTEND(sp, 4);
 599     PUSHs(gv);
 600     PUSHs(rv);
 601     if (mg->mg_ptr)
 602         PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len)));
 603     else if (mg->mg_len >= 0)
 604         PUSHs(sv_mortalcopy(newSViv(mg->mg_len)));
 605     PUSHs(sv);
 606     PUTBACK;
 607
 608     if (op = pp_entersubr())
 609         run();
 610     LEAVE;
 611     SPAGAIN;
 612
 613     POPs;
 614     PUTBACK;
 615
 616     return 0;
 617 }
 618
 619 int
 620 magic_clearpack(sv,mg)
 621 SV* sv;
 622 MAGIC* mg;
 623 {
 624     SV* rv = mg->mg_obj;
 625     HV* stash = SvSTASH(SvRV(rv));
 626     GV* gv = gv_fetchmethod(stash, "delete");
 627     dSP;
 628     BINOP myop;
 629
 630     if (!gv || !GvCV(gv)) {
 631         croak("No delete method for magical variable in package \"%s\"",
 632             HvNAME(stash));
 633     }
 634     Zero(&myop, 1, BINOP);
 635     myop.op_last = (OP *) &myop;
 636     myop.op_next = Nullop;
 637     myop.op_flags = OPf_STACKED;
 638
 639     ENTER;
 640     SAVESPTR(op);
 641     op = (OP *) &myop;
 642     PUTBACK;
 643     pp_pushmark();
 644
 645     EXTEND(sp, 4);
 646     PUSHs(gv);
 647     PUSHs(rv);
 648     if (mg->mg_ptr)
 649         PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len)));
 650     else
 651         PUSHs(sv_mortalcopy(newSViv(mg->mg_len)));
 652     PUTBACK;
 653
 654     if (op = pp_entersubr())
 655         run();
 656     LEAVE;
 657     SPAGAIN;
 658
 659     sv_setsv(sv, POPs);
 660     PUTBACK;
 661
 662     return 0;
 663 }
 664
 665 int
 666 magic_nextpack(sv,mg,key)
 667 SV* sv;
 668 MAGIC* mg;
 669 SV* key;
 670 {
 671     SV* rv = mg->mg_obj;
 672     HV* stash = SvSTASH(SvRV(rv));
 673     GV* gv = gv_fetchmethod(stash, SvOK(key) ? "nextkey" : "firstkey");
 674     dSP;
 675     BINOP myop;
 676
 677     if (!gv || !GvCV(gv)) {
 678         croak("No fetch method for magical variable in package \"%s\"",
 679             HvNAME(stash));
 680     }
 681     Zero(&myop, 1, BINOP);
 682     myop.op_last = (OP *) &myop;
 683     myop.op_next = Nullop;
 684     myop.op_flags = OPf_STACKED;
 685
 686     ENTER;
 687     SAVESPTR(op);
 688     op = (OP *) &myop;
 689     PUTBACK;
 690     pp_pushmark();
 691
 692     EXTEND(sp, 4);
 693     PUSHs(gv);
 694     PUSHs(rv);
 695     if (SvOK(key))
 696         PUSHs(key);
 697     PUTBACK;
 698
 699     if (op = pp_entersubr())
 700         run();
 701     LEAVE;
 702     SPAGAIN;
 703
 704     sv_setsv(key, POPs);
 705     PUTBACK;
 706
 707     return 0;
 708 }
 709
 710 int
 711 magic_setdbline(sv,mg)
 712 SV* sv;
 713 MAGIC* mg;
 714 {
 715     OP *o;
 716     I32 i;
 717     GV* gv;
 718     SV** svp;
 719
 720     gv = DBline;
 721     i = SvTRUE(sv);
 722     svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
 723     if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
 724         o->op_private = i;
 725     else
 726         warn("Can't break at that line\n");
 727     return 0;
 728 }
 729
 730 int
 731 magic_getarylen(sv,mg)
 732 SV* sv;
 733 MAGIC* mg;
 734 {
 735     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + arybase);
 736     return 0;
 737 }
 738
 739 int
 740 magic_setarylen(sv,mg)
 741 SV* sv;
 742 MAGIC* mg;
 743 {
 744     av_fill((AV*)mg->mg_obj, (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) - arybase);
 745     return 0;
 746 }
 747
 748 int
 749 magic_getglob(sv,mg)
 750 SV* sv;
 751 MAGIC* mg;
 752 {
 753     gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
 754     return 0;
 755 }
 756
 757 int
 758 magic_setglob(sv,mg)
 759 SV* sv;
 760 MAGIC* mg;
 761 {
 762     register char *s;
 763     GV* gv;
 764
 765     if (!SvOK(sv))
 766         return 0;
 767     s = SvPV(sv, na);
 768     if (*s == '*' && s[1])
 769         s++;
 770     gv = gv_fetchpv(s,TRUE);
 771     if (sv == (SV*)gv)
 772         return 0;
 773     if (GvGP(sv))
 774         gp_free(sv);
 775     GvGP(sv) = gp_ref(GvGP(gv));
 776     if (!GvAV(gv))
 777         gv_AVadd(gv);
 778     if (!GvHV(gv))
 779         gv_HVadd(gv);
 780     if (!GvIO(gv))
 781         GvIO(gv) = newIO();
 782     return 0;
 783 }
 784
 785 int
 786 magic_setsubstr(sv,mg)
 787 SV* sv;
 788 MAGIC* mg;
 789 {
 790     STRLEN len;
 791     char *tmps = SvPV(sv,len);
 792     sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
 793     return 0;
 794 }
 795
 796 int
 797 magic_gettaint(sv,mg)
 798 SV* sv;
 799 MAGIC* mg;
 800 {
 801     tainted = TRUE;
 802     return 0;
 803 }
 804
 805 int
 806 magic_settaint(sv,mg)
 807 SV* sv;
 808 MAGIC* mg;
 809 {
 810     if (!tainted)
 811         sv_unmagic(sv, 't');
 812     return 0;
 813 }
 814
 815 int
 816 magic_setvec(sv,mg)
 817 SV* sv;
 818 MAGIC* mg;
 819 {
 820     do_vecset(sv);      /* XXX slurp this routine */
 821     return 0;
 822 }
 823
 824 int
 825 magic_setmglob(sv,mg)
 826 SV* sv;
 827 MAGIC* mg;
 828 {
 829     mg->mg_ptr = 0;
 830     mg->mg_len = 0;
 831     return 0;
 832 }
 833
 834 int
 835 magic_setbm(sv,mg)
 836 SV* sv;
 837 MAGIC* mg;
 838 {
 839     sv_unmagic(sv, 'B');
 840     SvVALID_off(sv);
 841     return 0;
 842 }
 843
 844 int
 845 magic_setuvar(sv,mg)
 846 SV* sv;
 847 MAGIC* mg;
 848 {
 849     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
 850
 851     if (uf && uf->uf_set)
 852         (*uf->uf_set)(uf->uf_index, sv);
 853     return 0;
 854 }
 855
 856 int
 857 magic_set(sv,mg)
 858 SV* sv;
 859 MAGIC* mg;
 860 {
 861     register char *s;
 862     I32 i;
 863     STRLEN len;
 864     switch (*mg->mg_ptr) {
 865     case '\004':        /* ^D */
 866         debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
 867         DEBUG_x(dump_all());
 868         break;
 869     case '\006':        /* ^F */
 870         maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 871         break;
 872     case '\t':  /* ^I */
 873         if (inplace)
 874             Safefree(inplace);
 875         if (SvOK(sv))
 876             inplace = savestr(SvPV(sv,na));
 877         else
 878             inplace = Nullch;
 879         break;
 880     case '\020':        /* ^P */
 881         i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 882         if (i != perldb) {
 883             if (perldb)
 884                 oldlastpm = curpm;
 885             else
 886                 curpm = oldlastpm;
 887         }
 888         perldb = i;
 889         break;
 890     case '\024':        /* ^T */
 891         basetime = (time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 892         break;
 893     case '\027':        /* ^W */
 894         dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 895         break;
 896     case '.':
 897         if (localizing)
 898             save_sptr((SV**)&last_in_gv);
 899         break;
 900     case '^':
 901         Safefree(IoTOP_NAME(GvIO(defoutgv)));
 902         IoTOP_NAME(GvIO(defoutgv)) = s = savestr(SvPV(sv,na));
 903         IoTOP_GV(GvIO(defoutgv)) = gv_fetchpv(s,TRUE);
 904         break;
 905     case '~':
 906         Safefree(IoFMT_NAME(GvIO(defoutgv)));
 907         IoFMT_NAME(GvIO(defoutgv)) = s = savestr(SvPV(sv,na));
 908         IoFMT_GV(GvIO(defoutgv)) = gv_fetchpv(s,TRUE);
 909         break;
 910     case '=':
 911         IoPAGE_LEN(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 912         break;
 913     case '-':
 914         IoLINES_LEFT(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 915         if (IoLINES_LEFT(GvIO(defoutgv)) < 0L)
 916             IoLINES_LEFT(GvIO(defoutgv)) = 0L;
 917         break;
 918     case '%':
 919         IoPAGE(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 920         break;
 921     case '|':
 922         if (!GvIO(defoutgv))
 923             GvIO(defoutgv) = newIO();
 924         IoFLAGS(GvIO(defoutgv)) &= ~IOf_FLUSH;
 925         if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
 926             IoFLAGS(GvIO(defoutgv)) |= IOf_FLUSH;
 927         }
 928         break;
 929     case '*':
 930         i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 931         multiline = (i != 0);
 932         break;
 933     case '/':
 934         if (SvPOK(sv)) {
 935             nrs = rs = SvPV(sv,rslen);
 936             nrslen = rslen;
 937             if (rspara = !rslen) {
 938                 nrs = rs = "\n\n";
 939                 nrslen = rslen = 2;
 940             }
 941             nrschar = rschar = rs[rslen - 1];
 942         }
 943         else {
 944             nrschar = rschar = 0777;    /* fake a non-existent char */
 945             nrslen = rslen = 1;
 946         }
 947         break;
 948     case '\\':
 949         if (ors)
 950             Safefree(ors);
 951         ors = savestr(SvPV(sv,orslen));
 952         break;
 953     case ',':
 954         if (ofs)
 955             Safefree(ofs);
 956         ofs = savestr(SvPV(sv, ofslen));
 957         break;
 958     case '#':
 959         if (ofmt)
 960             Safefree(ofmt);
 961         ofmt = savestr(SvPV(sv,na));
 962         break;
 963     case '[':
 964         arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 965         break;
 966     case '?':
 967         statusvalue = U_S(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 968         break;
 969     case '!':
 970         errno = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);             /* will anyone ever use this? */
 971         break;
 972     case '<':
 973         uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 974         if (delaymagic) {
 975             delaymagic |= DM_RUID;
 976             break;                              /* don't do magic till later */
 977         }
 978 #ifdef HAS_SETRUID
 979         (void)setruid((UIDTYPE)uid);
 980 #else
 981 #ifdef HAS_SETREUID
 982         (void)setreuid((UIDTYPE)uid, (UIDTYPE)-1);
 983 #else
 984         if (uid == euid)                /* special case $< = $> */
 985             (void)setuid(uid);
 986         else
 987             croak("setruid() not implemented");
 988 #endif
 989 #endif
 990         uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 991         tainting |= (euid != uid || egid != gid);
 992         break;
 993     case '>':
 994         euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 995         if (delaymagic) {
 996             delaymagic |= DM_EUID;
 997             break;                              /* don't do magic till later */
 998         }
 999 #ifdef HAS_SETEUID
1000         (void)seteuid((UIDTYPE)euid);
1001 #else
1002 #ifdef HAS_SETREUID
1003         (void)setreuid((UIDTYPE)-1, (UIDTYPE)euid);
1004 #else
1005         if (euid == uid)                /* special case $> = $< */
1006             setuid(euid);
1007         else
1008             croak("seteuid() not implemented");
1009 #endif
1010 #endif
1011         euid = (I32)geteuid();
1012         tainting |= (euid != uid || egid != gid);
1013         break;
1014     case '(':
1015         gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1016         if (delaymagic) {
1017             delaymagic |= DM_RGID;
1018             break;                              /* don't do magic till later */
1019         }
1020 #ifdef HAS_SETRGID
1021         (void)setrgid((GIDTYPE)gid);
1022 #else
1023 #ifdef HAS_SETREGID
1024         (void)setregid((GIDTYPE)gid, (GIDTYPE)-1);
1025 #else
1026         if (gid == egid)                        /* special case $( = $) */
1027             (void)setgid(gid);
1028         else
1029             croak("setrgid() not implemented");
1030 #endif
1031 #endif
1032         gid = (I32)getgid();
1033         tainting |= (euid != uid || egid != gid);
1034         break;
1035     case ')':
1036         egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1037         if (delaymagic) {
1038             delaymagic |= DM_EGID;
1039             break;                              /* don't do magic till later */
1040         }
1041 #ifdef HAS_SETEGID
1042         (void)setegid((GIDTYPE)egid);
1043 #else
1044 #ifdef HAS_SETREGID
1045         (void)setregid((GIDTYPE)-1, (GIDTYPE)egid);
1046 #else
1047         if (egid == gid)                        /* special case $) = $( */
1048             (void)setgid(egid);
1049         else
1050             croak("setegid() not implemented");
1051 #endif
1052 #endif
1053         egid = (I32)getegid();
1054         tainting |= (euid != uid || egid != gid);
1055         break;
1056     case ':':
1057         chopset = SvPV(sv,na);
1058         break;
1059     case '0':
1060         if (!origalen) {
1061             s = origargv[0];
1062             s += strlen(s);
1063             /* See if all the arguments are contiguous in memory */
1064             for (i = 1; i < origargc; i++) {
1065                 if (origargv[i] == s + 1)
1066                     s += strlen(++s);   /* this one is ok too */
1067             }
1068             if (origenviron[0] == s + 1) {      /* can grab env area too? */
1069                 my_setenv("NoNeSuCh", Nullch);
1070                                             /* force copy of environment */
1071                 for (i = 0; origenviron[i]; i++)
1072                     if (origenviron[i] == s + 1)
1073                         s += strlen(++s);
1074             }
1075             origalen = s - origargv[0];
1076         }
1077         s = SvPV(sv,len);
1078         i = len;
1079         if (i >= origalen) {
1080             i = origalen;
1081             SvCUR_set(sv, i);
1082             *SvEND(sv) = '\0';
1083             Copy(s, origargv[0], i, char);
1084         }
1085         else {
1086             Copy(s, origargv[0], i, char);
1087             s = origargv[0]+i;
1088             *s++ = '\0';
1089             while (++i < origalen)
1090                 *s++ = ' ';
1091             s = origargv[0]+i;
1092             for (i = 1; i < origargc; i++)
1093                 origargv[i] = Nullch;
1094         }
1095         break;
1096     }
1097     return 0;
1098 }
1099
1100 I32
1101 whichsig(sig)
1102 char *sig;
1103 {
1104     register char **sigv;
1105
1106     for (sigv = sig_name+1; *sigv; sigv++)
1107         if (strEQ(sig,*sigv))
1108             return sigv - sig_name;
1109 #ifdef SIGCLD
1110     if (strEQ(sig,"CHLD"))
1111         return SIGCLD;
1112 #endif
1113 #ifdef SIGCHLD
1114     if (strEQ(sig,"CLD"))
1115         return SIGCHLD;
1116 #endif
1117     return 0;
1118 }
1119
1120 static handlertype
1121 sighandler(sig)
1122 I32 sig;
1123 {
1124     dSP;
1125     GV *gv;
1126     SV *sv;
1127     CV *cv;
1128     CONTEXT *cx;
1129     AV *oldstack;
1130     I32 hasargs = 1;
1131     I32 items = 1;
1132     I32 gimme = G_SCALAR;
1133
1134 #ifdef OS2              /* or anybody else who requires SIG_ACK */
1135     signal(sig, SIG_ACK);
1136 #endif
1137
1138     gv = gv_fetchpv(
1139         SvPVx(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]),
1140           TRUE), na), TRUE);
1141     cv = GvCV(gv);
1142     if (!cv && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
1143         if (sig_name[sig][1] == 'H')
1144             gv = gv_fetchpv(SvPVx(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE), na),
1145               TRUE);
1146         else
1147             gv = gv_fetchpv(SvPVx(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE), na),
1148               TRUE);
1149         cv = GvCV(gv);  /* gag */
1150     }
1151     if (!cv) {
1152         if (dowarn)
1153             warn("SIG%s handler \"%s\" not defined.\n",
1154                 sig_name[sig], GvENAME(gv) );
1155         return;
1156     }
1157
1158     oldstack = stack;
1159     SWITCHSTACK(stack, signalstack);
1160
1161     sv = sv_newmortal();
1162     sv_setpv(sv,sig_name[sig]);
1163     PUSHs(sv);
1164
1165     ENTER;
1166     SAVETMPS;
1167
1168     push_return(op);
1169     push_return(0);
1170     PUSHBLOCK(cx, CXt_SUB, sp);
1171     PUSHSUB(cx);
1172     cx->blk_sub.savearray = GvAV(defgv);
1173     cx->blk_sub.argarray = av_fake(items, sp);
1174     SAVEFREESV(cx->blk_sub.argarray);
1175     GvAV(defgv) = cx->blk_sub.argarray;
1176     CvDEPTH(cv)++;
1177     if (CvDEPTH(cv) >= 2) {
1178         if (CvDEPTH(cv) == 100 && dowarn)
1179             warn("Deep recursion on subroutine \"%s\"",GvENAME(gv));
1180     }
1181     op = CvSTART(cv);
1182     PUTBACK;
1183     run();              /* Does the LEAVE for us. */
1184
1185     SWITCHSTACK(signalstack, oldstack);
1186     op = pop_return();
1187
1188     return;
1189 }