/* mg.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
case '\020': /* ^P */
sv_setiv(sv, (IV)perldb);
break;
- case '\023': /* ^S */
- if (STATUS_NATIVE == -1)
- sv_setiv(sv, (IV)-1);
- else
- sv_setuv(sv, (UV)STATUS_NATIVE);
- break;
case '\024': /* ^T */
#ifdef BIG_TIME
sv_setnv(sv, basetime);
#endif
break;
case '?':
- sv_setiv(sv, (IV)STATUS_POSIX);
+ sv_setiv(sv, (IV)STATUS_CURRENT);
+#ifdef COMPLEX_STATUS
+ LvTARGOFF(sv) = statusvalue;
+ LvTARGLEN(sv) = statusvalue_vms;
+#endif
break;
case '^':
s = IoTOP_NAME(GvIOp(defoutgv));
char *ptr;
STRLEN len;
I32 i;
+
s = SvPV(sv,len);
ptr = MgPV(mg);
my_setenv(ptr, s);
+
#ifdef DYNAMIC_ENV_FETCH
/* We just undefd an environment var. Is a replacement */
/* waiting in the wings? */
if (!len) {
HE *envhe;
SV *keysv;
- if (mg->mg_len == HEf_SVKEY) keysv = (SV *)mg->mg_ptr;
- else keysv = newSVpv(mg->mg_ptr,mg->mg_len);
- if (envhe = hv_fetch_ent(GvHVn(envgv),keysv,FALSE,0))
- s = SvPV(HeVAL(envhe),len);
- if (mg->mg_len != HEf_SVKEY) SvREFCNT_dec(keysv);
+ if (mg->mg_len == HEf_SVKEY)
+ keysv = (SV *)mg->mg_ptr;
+ else
+ keysv = newSVpv(mg->mg_ptr, mg->mg_len);
+ if ((envhe = hv_fetch_ent(GvHVn(envgv), keysv, FALSE, 0)))
+ s = SvPV(HeVAL(envhe), len);
+ if (mg->mg_len != HEf_SVKEY)
+ SvREFCNT_dec(keysv);
}
#endif
+
+#if !defined(OS2) && !defined(AMIGAOS)
/* And you'll never guess what the dog had */
/* in its mouth... */
if (tainting) {
+ MgTAINTEDDIR_off(mg);
+#ifdef VMS
+ if (s && strnEQ(ptr, "DCL$PATH", 8)) {
+ char pathbuf[256], eltbuf[256], *cp, *elt = s;
+ struct stat sbuf;
+ int i = 0, j = 0;
+
+ do { /* DCL$PATH may be a search list */
+ while (1) { /* as may dev portion of any element */
+ if ( ((cp = strchr(elt,'[')) || (cp = strchr(elt,'<'))) ) {
+ if ( *(cp+1) == '.' || *(cp+1) == '-' ||
+ cando_by_name(S_IWUSR,0,elt) ) {
+ MgTAINTEDDIR_on(mg);
+ return 0;
+ }
+ }
+ if ((cp = strchr(elt, ':')) != Nullch)
+ *cp = '\0';
+ if (my_trnlnm(elt, eltbuf, j++))
+ elt = eltbuf;
+ else
+ break;
+ }
+ j = 0;
+ } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf));
+ }
+#endif /* VMS */
if (s && strEQ(ptr,"PATH")) {
char *strend = s + len;
while (s < strend) {
- s = cpytill(tokenbuf,s,strend,':',&i);
+ struct stat st;
+ s = cpytill(tokenbuf, s, strend, ':', &i);
s++;
if (*tokenbuf != '/'
- || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
+ || (Stat(tokenbuf, &st) == 0 && (st.st_mode & 2)) ) {
MgTAINTEDDIR_on(mg);
+ return 0;
+ }
}
}
}
+#endif /* neither OS2 nor AMIGAOS */
+
return 0;
}
warn("No such signal: SIG%s", s);
return 0;
}
- if(psig_ptr[i])
- SvREFCNT_dec(psig_ptr[i]);
+ SvREFCNT_dec(psig_name[i]);
+ SvREFCNT_dec(psig_ptr[i]);
psig_ptr[i] = SvREFCNT_inc(sv);
- if(psig_name[i])
- SvREFCNT_dec(psig_name[i]);
- psig_name[i] = newSVpv(s,strlen(s));
SvTEMP_off(sv); /* Make sure it doesn't go away on us */
+ psig_name[i] = newSVpv(s, strlen(s));
SvREADONLY_on(psig_name[i]);
}
if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
}
perldb = i;
break;
- case '\023': /* ^S */
- STATUS_NATIVE_SET(SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv));
- break;
case '\024': /* ^T */
#ifdef BIG_TIME
basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
case '?':
- STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+#ifdef COMPLEX_STATUS
+ if (localizing == 2) {
+ statusvalue = LvTARGOFF(sv);
+ statusvalue_vms = LvTARGLEN(sv);
+ }
+ else
+#endif
+#ifdef VMSISH_STATUS
+ if (VMSISH_STATUS)
+ STATUS_NATIVE_SET((U32)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)));
+ else
+#endif
+ STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '!':
SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),
SV *sv;
CV *cv;
AV *oldstack;
- int long_savestack = savestack_ix + 15 <= savestack_max;
- int long_cxstack = cxstack_ix < cxstack_max - 1;
-
- if (long_cxtack) cxstack_ix++; /* Protect from overwrite. */
- if(!psig_ptr[sig])
- die("Signal SIG%s received, but no signal handler set.\n",
- sig_name[sig]);
-
- /* Max number of items pushed there is 3*n or 4. We cannot fix
- infinity, so we fix 4 (in fact 5): */
- if (long_savestack) savestack_ix += 5; /* Protect save in progress. */
+
+ if (!psig_ptr[sig])
+ die("Signal SIG%s received, but no signal handler set.\n",
+ sig_name[sig]);
cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
if (!cv || !CvROOT(cv)) {
if(psig_name[sig])
sv = SvREFCNT_inc(psig_name[sig]);
else {
- sv = sv_newmortal();
- sv_setpv(sv,sig_name[sig]);
+ sv = sv_newmortal();
+ sv_setpv(sv,sig_name[sig]);
}
PUSHMARK(sp);
PUSHs(sv);
perl_call_sv((SV*)cv, G_DISCARD);
SWITCHSTACK(signalstack, oldstack);
- if (long_savestack) savestack_ix -= 5; /* Unprotect save in progress. */
- if (long_cxstack) cxstack_ix--;
-
+
return;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff