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