diff options
| author | Perl 5 Porters <perl5-porters@africa.nicoh.com> | 1996-03-11 08:22:18 +0000 |
|---|---|---|
| committer | Charles Bailey <bailey@genetics.upenn.edu> | 1996-03-11 08:22:18 +0000 |
| commit | 28f234415169ceefd3e9ae6964e9ad36a4377502 (patch) | |
| tree | b290ee4f8c5a2abc2210e4c32e1a4798500f6c2e /mg.c | |
| parent | 65a54111ab1e8338aa2996456080bfb667a98148 (diff) | |
| download | perl-28f234415169ceefd3e9ae6964e9ad36a4377502.tar.gz | |
Add get/set magic for $^E and $^O
Diffstat (limited to 'mg.c')
| -rw-r--r-- | mg.c | 39 |
1 files changed, 38 insertions, 1 deletions
@@ -332,6 +332,25 @@ MAGIC *mg; case '\004': /* ^D */ sv_setiv(sv,(I32)(debug & 32767)); break; + case '\005': /* ^E */ +#ifdef VMS + { +# include <descrip.h> +# include <starlet.h> + char msg[255]; + $DESCRIPTOR(msgdsc,msg); + sv_setnv(sv,(double)vaxc$errno); + if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1) + sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length); + else + sv_setpv(sv,""); + } +#else + sv_setnv(sv,(double)errno); + sv_setpv(sv, errno ? Strerror(errno) : ""); +#endif + SvNOK_on(sv); /* what a wonderful hack! */ + break; case '\006': /* ^F */ sv_setiv(sv,(I32)maxsysfd); break; @@ -344,6 +363,9 @@ MAGIC *mg; else sv_setsv(sv,&sv_undef); break; + case '\017': /* ^O */ + sv_setpv(sv,osname); + break; case '\020': /* ^P */ sv_setiv(sv,(I32)perldb); break; @@ -1044,6 +1066,13 @@ MAGIC* mg; debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000; DEBUG_x(dump_all()); break; + case '\005': /* ^E */ +#ifdef VMS + set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); +#else + SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4); /* will anyone ever use this? */ +#endif + break; case '\006': /* ^F */ maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); break; @@ -1058,6 +1087,14 @@ MAGIC* mg; else inplace = Nullch; break; + case '\017': /* ^O */ + if (osname) + Safefree(osname); + if (SvOK(sv)) + osname = savepv(SvPV(sv,na)); + else + osname = Nullch; + break; case '\020': /* ^P */ i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); if (i != perldb) { @@ -1141,7 +1178,7 @@ MAGIC* mg; statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '!': - SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4); /* will anyone ever use this? */ + SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno); /* will anyone ever use this? */ break; case '<': uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); |