X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=b4ff2439b9d5ef70f8e6bd567c6d82c1f77b5360;hb=9e4e50e7055da570fbaa1116842593c536158e77;hp=ce1c4b339c29167983002ce03ef39347bb80bc03;hpb=7fe688dd66af2d55e8dae3d7a350cc05905dc988;p=perl%2Fmodules%2FVariable-Magic.git

diff --git a/Magic.xs b/Magic.xs
index ce1c4b3..b4ff243 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -63,6 +63,19 @@
 # define MY_CXT_CLONE NOOP
 #endif
 
+#if VMG_MULTIPLICITY
+
+STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) {
+#define vmg_clone(P, O) vmg_clone(aTHX_ (P), (O))
+ CLONE_PARAMS param;
+ param.stashes    = NULL; /* don't need it unless sv is a PVHV */
+ param.flags      = 0;
+ param.proto_perl = owner;
+ return sv_dup(sv, &param);
+}
+
+#endif /* VMG_MULTIPLICITY */
+
 /* --- Compatibility ------------------------------------------------------- */
 
 #ifndef Newx
@@ -713,6 +726,52 @@ STATIC U16 vmg_sv2sig(pTHX_ SV *sv) {
  return sig;
 }
 
+STATIC U16 vmg_wizard_sig(pTHX_ SV *wiz) {
+#define vmg_wizard_sig(W) vmg_wizard_sig(aTHX_ (W))
+ char buf[8];
+ U16 sig;
+
+ if (SvROK(wiz)) {
+  sig = SV2MGWIZ(SvRV(wiz))->sig;
+ } else if (SvOK(wiz)) {
+  sig = vmg_sv2sig(wiz);
+ } else {
+  croak(vmg_invalid_wiz);
+ }
+
+ dMY_CXT;
+
+ if (!hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0))
+  sig = 0;
+
+ return sig;
+}
+
+STATIC SV *vmg_wizard_wiz(pTHX_ SV *wiz) {
+#define vmg_wizard_wiz(W) vmg_wizard_wiz(aTHX_ (W))
+ char buf[8];
+ SV **old;
+ U16 sig;
+
+ if (SvROK(wiz)) {
+  wiz = SvRV(wiz);
+#if VMG_MULTIPLICITY
+  if (SV2MGWIZ(wiz)->owner == aTHX)
+   return wiz;
+#endif /* VMG_MULTIPLICITY */
+  sig = SV2MGWIZ(wiz)->sig;
+ } else if (SvOK(wiz)) {
+  sig = vmg_sv2sig(wiz);
+ } else {
+  croak(vmg_invalid_wiz);
+ }
+
+ dMY_CXT;
+
+ return (old = hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0))
+         ? *old : NULL;
+}
+
 #define VMG_SET_CB(S, N)              \
  cb = (S);                            \
  w->cb_ ## N = (SvOK(cb) && SvROK(cb)) ? newRV_inc(SvRV(cb)) : NULL;
@@ -729,15 +788,6 @@ STATIC U16 vmg_sv2sig(pTHX_ SV *sv) {
 
 #if VMG_MULTIPLICITY
 
-STATIC SV *vmg_clone(pTHX_ SV *sv, tTHX owner) {
-#define vmg_clone(P, O) vmg_clone(aTHX_ (P), (O))
- CLONE_PARAMS param;
- param.stashes    = NULL; /* don't need it unless sv is a PVHV */
- param.flags      = 0;
- param.proto_perl = owner;
- return sv_dup(sv, &param);
-}
-
 #define VMG_CLONE_CB(N) \
  z->cb_ ## N = (w->cb_ ## N) ? newRV_noinc(vmg_clone(SvRV(w->cb_ ## N), \
                                            w->owner))                   \
@@ -964,21 +1014,9 @@ PREINIT:
  AV *args = NULL;
  SV *ret;
 CODE:
- dMY_CXT;
- if (SvROK(wiz)) {
-  wiz = SvRV(wiz);
- } else if (SvOK(wiz)) {
-  char buf[8];
-  SV **old;
-  U16 sig = vmg_sv2sig(wiz);
-  if ((old = hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0))) {
-   wiz = *old;
-  } else {
-   XSRETURN_UNDEF;
-  }
- } else {
-  croak(vmg_invalid_sig);
- }
+ wiz = vmg_wizard_wiz(wiz);
+ if (!wiz)
+  XSRETURN_UNDEF;
  if (items > 2) {
   I32 i;
   args = newAV();
@@ -1001,18 +1039,9 @@ PREINIT:
  SV *data;
  U16 sig;
 CODE:
- dMY_CXT;
- if (SvROK(wiz)) {
-  sig = SV2MGWIZ(SvRV(wiz))->sig;
- } else if (SvOK(wiz)) {
-  char buf[8];
-  sig = vmg_sv2sig(wiz);
-  if (!hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0)) {
-   XSRETURN_UNDEF;
-  }
- } else {
-  croak(vmg_invalid_wiz);
- }
+ sig = vmg_wizard_sig(wiz);
+ if (!sig)
+  XSRETURN_UNDEF;
  data = vmg_data_get(SvRV(sv), sig);
  if (!data) { XSRETURN_UNDEF; }
  ST(0) = data;
@@ -1023,18 +1052,9 @@ PROTOTYPE: \[$@%&*]$
 PREINIT:
  U16 sig;
 CODE:
- dMY_CXT;
- if (SvROK(wiz)) {
-  sig = SV2MGWIZ(SvRV(wiz))->sig;
- } else if (SvOK(wiz)) {
-  char buf[8];
-  sig = vmg_sv2sig(wiz);
-  if (!hv_fetch(MY_CXT.wizz, buf, sprintf(buf, "%u", sig), 0)) {
-   XSRETURN_UNDEF;
-  }
- } else {
-  croak(vmg_invalid_wiz);
- }
+ sig = vmg_wizard_sig(wiz);
+ if (!sig)
+  XSRETURN_UNDEF;
  RETVAL = newSVuv(vmg_dispell(SvRV(sv), sig));
 OUTPUT:
  RETVAL