mg.c

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