home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / mg.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-10-30  |  22.8 KB  |  1,255 lines  |  [TEXT/MPS ]
  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. #ifdef macintosh
  951.     basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
  952. #else
  953.     basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  954. #endif
  955.     break;
  956.     case '\027':    /* ^W */
  957.     dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  958.     break;
  959.     case '.':
  960.     if (localizing)
  961.         save_sptr((SV**)&last_in_gv);
  962.     else if (SvOK(sv))
  963.         IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
  964.     break;
  965.     case '^':
  966.     Safefree(IoTOP_NAME(GvIOp(defoutgv)));
  967.     IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  968.     IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  969.     break;
  970.     case '~':
  971.     Safefree(IoFMT_NAME(GvIOp(defoutgv)));
  972.     IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  973.     IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  974.     break;
  975.     case '=':
  976.     IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  977.     break;
  978.     case '-':
  979.     IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  980.     if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
  981.         IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
  982.     break;
  983.     case '%':
  984.     IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  985.     break;
  986.     case '|':
  987.     IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
  988.     if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
  989.         IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
  990.     }
  991.     break;
  992.     case '*':
  993.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  994.     multiline = (i != 0);
  995.     break;
  996.     case '/':
  997.     if (SvOK(sv)) {
  998.         nrs = rs = SvPV_force(sv,rslen);
  999.         nrslen = rslen;
  1000.         if (rspara = !rslen) {
  1001.         nrs = rs = "\n\n";
  1002.         nrslen = rslen = 2;
  1003.         }
  1004.         nrschar = rschar = rs[rslen - 1];
  1005.     }
  1006.     else {
  1007.         nrschar = rschar = 0777;    /* fake a non-existent char */
  1008.         nrslen = rslen = 1;
  1009.     }
  1010.     break;
  1011.     case '\\':
  1012.     if (ors)
  1013.         Safefree(ors);
  1014.     ors = savepv(SvPV(sv,orslen));
  1015.     break;
  1016.     case ',':
  1017.     if (ofs)
  1018.         Safefree(ofs);
  1019.     ofs = savepv(SvPV(sv, ofslen));
  1020.     break;
  1021.     case '#':
  1022.     if (ofmt)
  1023.         Safefree(ofmt);
  1024.     ofmt = savepv(SvPV(sv,na));
  1025.     break;
  1026.     case '[':
  1027.     compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1028.     break;
  1029.     case '?':
  1030.     statusvalue = U_S(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1031.     break;
  1032.     case '!':
  1033.     errno = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);        /* will anyone ever use this? */
  1034.     break;
  1035.     case '<':
  1036.     uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1037.     if (delaymagic) {
  1038.         delaymagic |= DM_RUID;
  1039.         break;                /* don't do magic till later */
  1040.     }
  1041. #ifdef HAS_SETRUID
  1042.     (void)setruid((Uid_t)uid);
  1043. #else
  1044. #ifdef HAS_SETREUID
  1045.     (void)setreuid((Uid_t)uid, (Uid_t)-1);
  1046. #ifdef HAS_SETRESUID
  1047.       (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
  1048. #else
  1049.     if (uid == euid)        /* special case $< = $> */
  1050.         (void)setuid(uid);
  1051.     else {
  1052.         uid = (I32)getuid();
  1053.         croak("setruid() not implemented");
  1054.     }
  1055. #endif
  1056. #endif
  1057. #endif
  1058.     uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1059.     tainting |= (euid != uid || egid != gid);
  1060.     break;
  1061.     case '>':
  1062.     euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1063.     if (delaymagic) {
  1064.         delaymagic |= DM_EUID;
  1065.         break;                /* don't do magic till later */
  1066.     }
  1067. #ifdef HAS_SETEUID
  1068.     (void)seteuid((Uid_t)euid);
  1069. #else
  1070. #ifdef HAS_SETREUID
  1071.     (void)setreuid((Uid_t)-1, (Uid_t)euid);
  1072. #else
  1073. #ifdef HAS_SETRESUID
  1074.     (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
  1075. #else
  1076.     if (euid == uid)        /* special case $> = $< */
  1077.         setuid(euid);
  1078.     else {
  1079.         euid = (I32)geteuid();
  1080.         croak("seteuid() not implemented");
  1081.     }
  1082. #endif
  1083. #endif
  1084. #endif
  1085.     euid = (I32)geteuid();
  1086.     tainting |= (euid != uid || egid != gid);
  1087.     break;
  1088.     case '(':
  1089.     gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1090.     if (delaymagic) {
  1091.         delaymagic |= DM_RGID;
  1092.         break;                /* don't do magic till later */
  1093.     }
  1094. #ifdef HAS_SETRGID
  1095.     (void)setrgid((Gid_t)gid);
  1096. #else
  1097. #ifdef HAS_SETREGID
  1098.     (void)setregid((Gid_t)gid, (Gid_t)-1);
  1099. #else
  1100. #ifdef HAS_SETRESGID
  1101.       (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
  1102. #else
  1103.     if (gid == egid)            /* special case $( = $) */
  1104.         (void)setgid(gid);
  1105.     else
  1106.         croak("setrgid() not implemented");
  1107. #endif
  1108. #endif
  1109. #endif
  1110.     gid = (I32)getgid();
  1111.     tainting |= (euid != uid || egid != gid);
  1112.     break;
  1113.     case ')':
  1114.     egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1115.     if (delaymagic) {
  1116.         delaymagic |= DM_EGID;
  1117.         break;                /* don't do magic till later */
  1118.     }
  1119. #ifdef HAS_SETEGID
  1120.     (void)setegid((Gid_t)egid);
  1121. #else
  1122. #ifdef HAS_SETREGID
  1123.     (void)setregid((Gid_t)-1, (Gid_t)egid);
  1124. #else
  1125. #ifdef HAS_SETRESGID
  1126.     (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
  1127. #else
  1128.     if (egid == gid)            /* special case $) = $( */
  1129.         (void)setgid(egid);
  1130.     else
  1131.         croak("setegid() not implemented");
  1132. #endif
  1133. #endif
  1134. #endif
  1135.     egid = (I32)getegid();
  1136.     tainting |= (euid != uid || egid != gid);
  1137.     break;
  1138.     case ':':
  1139.     chopset = SvPV_force(sv,na);
  1140.     break;
  1141.     case '0':
  1142.     if (!origalen) {
  1143.         s = origargv[0];
  1144.         s += strlen(s);
  1145.         /* See if all the arguments are contiguous in memory */
  1146.         for (i = 1; i < origargc; i++) {
  1147.         if (origargv[i] == s + 1)
  1148.             s += strlen(++s);    /* this one is ok too */
  1149.         }
  1150.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  1151.         my_setenv("NoNeSuCh", Nullch);
  1152.                         /* force copy of environment */
  1153.         for (i = 0; origenviron[i]; i++)
  1154.             if (origenviron[i] == s + 1)
  1155.             s += strlen(++s);
  1156.         }
  1157.         origalen = s - origargv[0];
  1158.     }
  1159.     s = SvPV_force(sv,len);
  1160.     i = len;
  1161.     if (i >= origalen) {
  1162.         i = origalen;
  1163.         SvCUR_set(sv, i);
  1164.         *SvEND(sv) = '\0';
  1165.         Copy(s, origargv[0], i, char);
  1166.     }
  1167.     else {
  1168.         Copy(s, origargv[0], i, char);
  1169.         s = origargv[0]+i;
  1170.         *s++ = '\0';
  1171.         while (++i < origalen)
  1172.         *s++ = ' ';
  1173.         s = origargv[0]+i;
  1174.         for (i = 1; i < origargc; i++)
  1175.         origargv[i] = Nullch;
  1176.     }
  1177.     break;
  1178.     }
  1179.     return 0;
  1180. }
  1181.  
  1182. I32
  1183. whichsig(sig)
  1184. char *sig;
  1185. {
  1186.     register char **sigv;
  1187.  
  1188.     for (sigv = sig_name+1; *sigv; sigv++)
  1189.     if (strEQ(sig,*sigv))
  1190.         return sigv - sig_name;
  1191. #ifdef SIGCLD
  1192.     if (strEQ(sig,"CHLD"))
  1193.     return SIGCLD;
  1194. #endif
  1195. #ifdef SIGCHLD
  1196.     if (strEQ(sig,"CLD"))
  1197.     return SIGCHLD;
  1198. #endif
  1199.     return 0;
  1200. }
  1201.  
  1202. VOIDRET
  1203. sighandler(sig)
  1204. int sig;
  1205. {
  1206.     dSP;
  1207.     GV *gv;
  1208.     HV *st;
  1209.     SV *sv;
  1210.     CV *cv;
  1211.     AV *oldstack;
  1212.  
  1213. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  1214.     signal(sig, SIG_ACK);
  1215. #endif
  1216.  
  1217.     cv = sv_2cv(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]),
  1218.               TRUE),
  1219.         &st, &gv, TRUE);
  1220.     if (!cv || !CvROOT(cv) &&
  1221.     *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) {
  1222.     
  1223.     if (sig_name[sig][1] == 'H')
  1224.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE),
  1225.             &st, &gv, TRUE);
  1226.     else
  1227.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE),
  1228.             &st, &gv, TRUE);
  1229.     /* gag */
  1230.     }
  1231.     if (!cv || !CvROOT(cv)) {
  1232.     if (dowarn)
  1233.         warn("SIG%s handler \"%s\" not defined.\n",
  1234.         sig_name[sig], GvENAME(gv) );
  1235.     return;
  1236.     }
  1237.  
  1238.     oldstack = stack;
  1239.     if (stack != signalstack)
  1240.     AvFILL(signalstack) = 0;
  1241.     SWITCHSTACK(stack, signalstack);
  1242.  
  1243.     sv = sv_newmortal();
  1244.     sv_setpv(sv,sig_name[sig]);
  1245.     PUSHMARK(sp);
  1246.     PUSHs(sv);
  1247.     PUTBACK;
  1248.  
  1249.     perl_call_sv((SV*)cv, G_DISCARD);
  1250.  
  1251.     SWITCHSTACK(signalstack, oldstack);
  1252.  
  1253.     return;
  1254. }
  1255.