From: gfx <gfuji@cpan.org>
Date: Fri, 26 Feb 2010 05:24:12 +0000 (+0900)
Subject: Move method modifier manipulators into XS
X-Git-Tag: 0.50_04~15
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cb60d0b55962e6ff8cdc07e51e59f7dd5feafd43;p=gitmo%2FMouse.git

Move method modifier manipulators into XS
---

diff --git a/lib/Mouse/Meta/Role.pm b/lib/Mouse/Meta/Role.pm
index a408522..e1f3f71 100644
--- a/lib/Mouse/Meta/Role.pm
+++ b/lib/Mouse/Meta/Role.pm
@@ -255,37 +255,13 @@ sub combine {
     return $composite;
 }
 
-sub add_before_method_modifier {
-    my ($self, $method_name, $method) = @_;
+sub add_before_method_modifier;
+sub add_around_method_modifier;
+sub add_after_method_modifier;
 
-    push @{ $self->{before_method_modifiers}{$method_name} ||= [] }, $method;
-    return;
-}
-sub add_around_method_modifier {
-    my ($self, $method_name, $method) = @_;
-
-    push @{ $self->{around_method_modifiers}{$method_name} ||= [] }, $method;
-    return;
-}
-sub add_after_method_modifier {
-    my ($self, $method_name, $method) = @_;
-
-    push @{ $self->{after_method_modifiers}{$method_name} ||= [] }, $method;
-    return;
-}
-
-sub get_before_method_modifiers {
-    my ($self, $method_name) = @_;
-    return @{ $self->{before_method_modifiers}{$method_name} ||= [] }
-}
-sub get_around_method_modifiers {
-    my ($self, $method_name) = @_;
-    return @{ $self->{around_method_modifiers}{$method_name} ||= [] }
-}
-sub get_after_method_modifiers {
-    my ($self, $method_name) = @_;
-    return @{ $self->{after_method_modifiers}{$method_name} ||= [] }
-}
+sub get_before_method_modifiers;
+sub get_around_method_modifiers;
+sub get_after_method_modifiers;
 
 sub add_override_method_modifier{
     my($self, $method_name, $method) = @_;
diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm
index ad2d35b..31e4a12 100644
--- a/lib/Mouse/PurePerl.pm
+++ b/lib/Mouse/PurePerl.pm
@@ -344,6 +344,38 @@ sub is_anon_role{
 
 sub get_roles { $_[0]->{roles} }
 
+sub add_before_method_modifier {
+    my ($self, $method_name, $method) = @_;
+
+    push @{ $self->{before_method_modifiers}{$method_name} ||= [] }, $method;
+    return;
+}
+sub add_around_method_modifier {
+    my ($self, $method_name, $method) = @_;
+
+    push @{ $self->{around_method_modifiers}{$method_name} ||= [] }, $method;
+    return;
+}
+sub add_after_method_modifier {
+    my ($self, $method_name, $method) = @_;
+
+    push @{ $self->{after_method_modifiers}{$method_name} ||= [] }, $method;
+    return;
+}
+
+sub get_before_method_modifiers {
+    my ($self, $method_name) = @_;
+    return @{ $self->{before_method_modifiers}{$method_name} ||= [] }
+}
+sub get_around_method_modifiers {
+    my ($self, $method_name) = @_;
+    return @{ $self->{around_method_modifiers}{$method_name} ||= [] }
+}
+sub get_after_method_modifiers {
+    my ($self, $method_name) = @_;
+    return @{ $self->{after_method_modifiers}{$method_name} ||= [] }
+}
+
 package Mouse::Meta::Attribute;
 
 require Mouse::Meta::Method::Accessor;
diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs
index 143228a..1759d04 100644
--- a/xs-src/Mouse.xs
+++ b/xs-src/Mouse.xs
@@ -41,6 +41,12 @@ enum mouse_xc_ix_t{
     MOUSE_XC_last
 };
 
+enum mouse_modifier_t {
+    MOUSE_M_BEFORE,
+    MOUSE_M_AROUND,
+    MOUSE_M_AFTER,
+};
+
 static MGVTBL mouse_xc_vtbl; /* for identity */
 
 static void
@@ -411,6 +417,47 @@ mouse_buildall(pTHX_ AV* const xc, SV* const object, SV* const args) {
     }
 }
 
+static AV*
+mouse_get_modifier_storage(pTHX_
+        SV* const meta,
+        enum mouse_modifier_t const m, SV* const name) {
+    static const char* const keys[] = {
+        "before",
+        "around",
+        "after",
+    };
+    SV* const key = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_method_modifiers", keys[m]));
+    SV* table;
+    SV* storage_ref;
+
+    SvGETMAGIC(name);
+    if(!SvOK(name)){
+        mouse_throw_error(meta, NULL, "You must define a method name for '%s' modifiers", keys[m]);
+    }
+
+    table = get_slot(meta, key);
+
+    if(!table){
+        /* $meta->{$key} = {} */
+        table = sv_2mortal(newRV_noinc((SV*)newHV()));
+        set_slot(meta, key, table);
+    }
+
+    storage_ref = get_slot(table, name);
+
+    if(!storage_ref){
+        storage_ref = sv_2mortal(newRV_noinc((SV*)newAV()));
+        set_slot(table, name, storage_ref);
+    }
+    else{
+        if(!IsArrayRef(storage_ref)){
+            croak("Modifier strorage for '%s' is not an ARRAY reference", keys[m]);
+        }
+    }
+
+    return (AV*)SvRV(storage_ref);
+}
+
 MODULE = Mouse  PACKAGE = Mouse
 
 PROTOTYPES: DISABLE
@@ -607,6 +654,39 @@ BOOT:
 
     INSTALL_CLASS_HOLDER(Role, method_metaclass,  "Mouse::Meta::Role::Method");
 
+void
+add_before_modifier(SV* self, SV* name, SV* modifier)
+CODE:
+{
+    av_push(mouse_get_modifier_storage(aTHX_ self, ix, name), newSVsv(modifier));
+}
+ALIAS:
+    add_before_method_modifier = MOUSE_M_BEFORE
+    add_around_method_modifier = MOUSE_M_AROUND
+    add_after_method_modifier  = MOUSE_M_AFTER
+
+void
+get_before_modifiers(SV* self, SV* name)
+ALIAS:
+    get_before_method_modifiers = MOUSE_M_BEFORE
+    get_around_method_modifiers = MOUSE_M_AROUND
+    get_after_method_modifiers  = MOUSE_M_AFTER
+PPCODE:
+{
+    AV* const storage = mouse_get_modifier_storage(aTHX_ self, ix, name);
+    I32 const len     = av_len(storage) + 1;
+    if(GIMME_V == G_ARRAY) {
+        I32 i;
+        EXTEND(SP, len);
+        for(i = 0; i < len; i++){
+            PUSHs(*av_fetch(storage, i, TRUE));
+        }
+    }
+    else{
+        mPUSHi(len);
+    }
+}
+
 MODULE = Mouse  PACKAGE = Mouse::Object
 
 SV*