mg.c

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