From: Vincent Pit <vince@profvince.com>
Date: Mon, 19 Apr 2010 22:46:22 +0000 (+0200)
Subject: Store the configure object into the map
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FSub-Op.git;a=commitdiff_plain;h=159088ccddecdea45fdae8093319b41c097adc86

Store the configure object into the map

And introduce SUB_OP_REGISTER_STEAL.
---

diff --git a/Op.xs b/Op.xs
index c5be45b..17fa468 100644
--- a/Op.xs
+++ b/Op.xs
@@ -126,6 +126,9 @@ void sub_op_init(sub_op_config_t *c) {
 void sub_op_register(pTHX_ const sub_op_config_t *c, U32 flags) {
  SV *key = newSViv(PTR2IV(c->pp));
 
+ if (!(flags & SUB_OP_REGISTER_STEAL))
+  c = sub_op_dup(aTHX_ c);
+
  if (!PL_custom_op_names)
   PL_custom_op_names = newHV();
  (void) hv_store_ent(PL_custom_op_names, key, newSVpv(c->name, c->namelen), 0);
@@ -134,15 +137,11 @@ void sub_op_register(pTHX_ const sub_op_config_t *c, U32 flags) {
   PL_custom_op_descs = newHV();
  (void) hv_store_ent(PL_custom_op_descs, key, newSVpv(c->name, c->namelen), 0);
 
- if (c->check) {
-  SV *check = newSViv(PTR2IV(c->check));
-  sv_magicext(key, check, PERL_MAGIC_ext, NULL, c->ud, 0);
-  SvREFCNT_dec(check);
- }
+ SvREFCNT_dec(key);
 
  {
   dMY_CXT;
-  (void) hv_store(MY_CXT.map, c->name, c->namelen, key, 0);
+  (void) hv_store(MY_CXT.map, c->name, c->namelen, newSViv(PTR2IV(c)), 0);
  }
 }
 
@@ -232,19 +231,18 @@ STATIC OP *so_ck_entersub(pTHX_ OP *o) {
   gv = cGVOPx_gv(gvop);
 
   {
-   SV *pp_sv, **svp;
-   CV *cv = NULL;
+   SV **svp;
+   CV  *cv = NULL;
    const char *name = GvNAME(gv);
    I32         len  = GvNAMELEN(gv);
+   const sub_op_config_t *c;
    dMY_CXT;
 
    svp = hv_fetch(MY_CXT.map, name, len, 0);
    if (!svp)
     goto skip;
 
-   pp_sv = *svp;
-   if (!pp_sv || !SvOK(pp_sv))
-    goto skip;
+   c = INT2PTR(const sub_op_config_t *, SvIVX(*svp));
 
    if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) {
     SvREFCNT_dec(cv);
@@ -252,20 +250,15 @@ STATIC OP *so_ck_entersub(pTHX_ OP *o) {
    }
 
    o->op_type   = OP_CUSTOM;
-   o->op_ppaddr = INT2PTR(Perl_ppaddr_t, SvIVX(pp_sv));
+   o->op_ppaddr = c->pp;
 
    if (last_arg)
     last_arg->op_sibling = NULL;
 
    op_free(rv2cv);
 
-   {
-    MAGIC *mg = mg_find(pp_sv, PERL_MAGIC_ext);
-    if (mg) {
-     sub_op_check_t check = INT2PTR(sub_op_check_t, SvIVX(mg->mg_obj));
-     o = CALL_FPTR(check)(aTHX_ o, mg->mg_ptr);
-    }
-   }
+   if (c->check)
+    o = CALL_FPTR(c->check)(aTHX_ o, c->ud);
 
    {
     so_op_name_t *on = PerlMemShared_malloc(sizeof(*on) + len);
diff --git a/lib/Sub/Op.pm b/lib/Sub/Op.pm
index 20cc912..44b3e9b 100644
--- a/lib/Sub/Op.pm
+++ b/lib/Sub/Op.pm
@@ -257,7 +257,7 @@ It will store safe defaults for members you won't set.
 
 Registers a name and its configuration into L<Sub::Op>.
 The caller is responsible for allocating and freeing the C<sub_op_config_t> object.
-No pointer to it or to its members is kept.
+No pointer to it or to its members is kept, except if you pass the flag C<SUB_OP_REGISTER_STEAL> in which case the configuration object will be stolen to be stored into L<Sub::Op>'s internal datastructure.
 
 =head2 C<sub_op_config_t *sub_op_dup(pTHX_ const sub_op_config_t *orig)>
 
diff --git a/sub_op.h b/sub_op.h
index 5dbb320..34d5571 100644
--- a/sub_op.h
+++ b/sub_op.h
@@ -14,6 +14,8 @@ typedef struct {
  void          *ud;
 } sub_op_config_t;
 
+#define SUB_OP_REGISTER_STEAL 1
+
 void             sub_op_init    (sub_op_config_t *c);
 void             sub_op_register(pTHX_ const sub_op_config_t *c, U32 flags);
 sub_op_config_t *sub_op_dup     (pTHX_ const sub_op_config_t *c);