[DOCPATCH] File::Copy's synopsis
[p5sagit/p5-mst-13.2.git] / mg.c
diff --git a/mg.c b/mg.c
index 25f4585..408c7de 100644 (file)
--- a/mg.c
+++ b/mg.c
 #  endif
 #endif
 
+#ifdef __hpux
+#  include <sys/pstat.h>
+#endif
+
 /* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */
 #if !defined(HAS_SIGACTION) && defined(VMS)
 #  define  FAKE_PERSISTENT_SIGNAL_HANDLERS
@@ -814,7 +818,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '\\':
        if (PL_ors_sv)
-           sv_setpv(sv,SvPVX(PL_ors_sv));
+           sv_copypv(sv, PL_ors_sv);
        break;
     case '#':
        sv_setpv(sv,PL_ofmt);
@@ -872,11 +876,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     case '0':
        break;
 #endif
-#ifdef USE_5005THREADS
-    case '@':
-       sv_setsv(sv, thr->errsv);
-       break;
-#endif /* USE_5005THREADS */
     }
     return 0;
 }
@@ -1851,32 +1850,37 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        DEBUG_x(dump_all());
        break;
     case '\005':  /* ^E */
-        if (*(mg->mg_ptr+1) == '\0') {
+       if (*(mg->mg_ptr+1) == '\0') {
 #ifdef MACOS_TRADITIONAL
-             gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+           gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 #else
 #  ifdef VMS
-             set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+           set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 #  else
 #    ifdef WIN32
-             SetLastError( SvIV(sv) );
+           SetLastError( SvIV(sv) );
 #    else
 #      ifdef OS2
-             os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+           os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 #      else
-             /* will anyone ever use this? */
-             SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
+           /* will anyone ever use this? */
+           SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
 #      endif
 #    endif
 #  endif
 #endif
-        }
-        else if (strEQ(mg->mg_ptr+1, "NCODING")) {
-            if (PL_encoding)
-                sv_setsv(PL_encoding, sv);
-            else
-                PL_encoding = newSVsv(sv);
-        }
+       }
+       else if (strEQ(mg->mg_ptr+1, "NCODING")) {
+           if (PL_encoding)
+               SvREFCNT_dec(PL_encoding);
+           if (SvOK(sv) || SvGMAGICAL(sv)) {
+               PL_encoding = newSVsv(sv);
+           }
+           else {
+               PL_encoding = Nullsv;
+           }
+       }
+       break;
     case '\006':       /* ^F */
        PL_maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
        break;
@@ -2207,6 +2211,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        break;
 #ifndef MACOS_TRADITIONAL
     case '0':
+       LOCK_DOLLARZERO_MUTEX;
 #ifdef HAS_SETPROCTITLE
        /* The BSDs don't show the argv[] in ps(1) output, they
         * show a string from the process struct and provide
@@ -2231,6 +2236,14 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #   endif
        }
 #endif
+#if defined(__hpux) && defined(PSTAT_SETCMD)
+       {
+            union pstun un;
+            s = SvPV(sv, len);
+            un.pst_command = s;
+            pstat(PSTAT_SETCMD, un, len, 0, 0);
+       }
+#endif
        if (!PL_origalen) {
            s = PL_origargv[0];
            s += strlen(s);
@@ -2286,32 +2299,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
            for (i = 1; i < PL_origargc; i++)
                PL_origargv[i] = Nullch;
        }
+       UNLOCK_DOLLARZERO_MUTEX;
        break;
 #endif
-#ifdef USE_5005THREADS
-    case '@':
-       sv_setsv(thr->errsv, sv);
-       break;
-#endif /* USE_5005THREADS */
     }
     return 0;
 }
 
-#ifdef USE_5005THREADS
-int
-Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg)
-{
-    DEBUG_S(PerlIO_printf(Perl_debug_log,
-                         "0x%"UVxf": magic_mutexfree 0x%"UVxf"\n",
-                         PTR2UV(thr), PTR2UV(sv)));
-    if (MgOWNER(mg))
-       Perl_croak(aTHX_ "panic: magic_mutexfree");
-    MUTEX_DESTROY(MgMUTEXP(mg));
-    COND_DESTROY(MgCONDP(mg));
-    return 0;
-}
-#endif /* USE_5005THREADS */
-
 I32
 Perl_whichsig(pTHX_ char *sig)
 {