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