Add get/set magic for $^E and $^O

diff --git a/mg.c b/mg.c
index e88a8c5..5e649bb 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -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);