1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #include "ppport.h"
6
7 #include "xs_object_magic.h"
8
9 STATIC MGVTBL null_mg_vtbl = {
10 NULL, /* get */
11 NULL, /* set */
12 NULL, /* len */
13 NULL, /* clear */
14 NULL, /* free */
15 #if MGf_COPY
16 NULL, /* copy */
17 #endif /* MGf_COPY */
18 #if MGf_DUP
19 NULL, /* dup */
20 #endif /* MGf_DUP */
21 #if MGf_LOCAL
22 NULL, /* local */
23 #endif /* MGf_LOCAL */
24 };
25
xs_object_magic_attach_struct(pTHX_ SV * sv,void * ptr)26 void xs_object_magic_attach_struct (pTHX_ SV *sv, void *ptr) {
27 sv_magicext(sv, NULL, PERL_MAGIC_ext, &null_mg_vtbl, ptr, 0 );
28 }
29
xs_object_magic_detach_struct(pTHX_ SV * sv,void * ptr)30 int xs_object_magic_detach_struct (pTHX_ SV *sv, void *ptr) {
31 MAGIC *mg, *prevmagic, *moremagic = NULL;
32 int removed = 0;
33
34 if (SvTYPE(sv) < SVt_PVMG)
35 return 0;
36
37 /* find our magic, remembering the magic before and the magic after */
38 for (prevmagic = NULL, mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
39 moremagic = mg->mg_moremagic;
40 if (mg->mg_type == PERL_MAGIC_ext &&
41 mg->mg_virtual == &null_mg_vtbl &&
42 ( ptr == NULL || mg->mg_ptr == ptr )) {
43
44 if(prevmagic != NULL) {
45 prevmagic->mg_moremagic = moremagic;
46 }
47 else {
48 SvMAGIC_set(sv, moremagic);
49 }
50
51 mg->mg_moremagic = NULL;
52 Safefree(mg);
53
54 mg = prevmagic;
55 removed++;
56 }
57
58 }
59
60 return removed;
61 }
62
xs_object_magic_detach_struct_rv(pTHX_ SV * sv,void * ptr)63 int xs_object_magic_detach_struct_rv (pTHX_ SV *sv, void *ptr){
64 if(sv && SvROK(sv)) {
65 sv = SvRV(sv);
66 return xs_object_magic_detach_struct(aTHX_ sv, ptr);
67 }
68 return 0;
69 }
70
xs_object_magic_create(pTHX_ void * ptr,HV * stash)71 SV *xs_object_magic_create (pTHX_ void *ptr, HV *stash) {
72 HV *hv = newHV();
73 SV *obj = newRV_noinc((SV *)hv);
74
75 sv_bless(obj, stash);
76
77 xs_object_magic_attach_struct(aTHX_ (SV *)hv, ptr);
78
79 return obj;
80 }
81
xs_object_magic_get_mg(pTHX_ SV * sv)82 MAGIC *xs_object_magic_get_mg (pTHX_ SV *sv) {
83 MAGIC *mg;
84
85 if (SvTYPE(sv) >= SVt_PVMG) {
86 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
87 if (
88 (mg->mg_type == PERL_MAGIC_ext)
89 &&
90 (mg->mg_virtual == &null_mg_vtbl)
91 ) {
92 return mg;
93 }
94 }
95 }
96
97 return NULL;
98 }
99
xs_object_magic_has_struct(pTHX_ SV * sv)100 int xs_object_magic_has_struct (pTHX_ SV *sv) {
101 MAGIC *mg = xs_object_magic_get_mg(aTHX_ sv);
102 return mg ? 1 : 0;
103 }
104
xs_object_magic_has_struct_rv(pTHX_ SV * sv)105 int xs_object_magic_has_struct_rv (pTHX_ SV *sv) {
106 if( sv && SvROK(sv) ){
107 sv = SvRV(sv);
108 MAGIC *mg = xs_object_magic_get_mg(aTHX_ sv);
109 return mg ? 1 : 0;
110 }
111 return 0;
112 }
113
xs_object_magic_get_struct(pTHX_ SV * sv)114 void *xs_object_magic_get_struct (pTHX_ SV *sv) {
115 MAGIC *mg = xs_object_magic_get_mg(aTHX_ sv);
116
117 if ( mg )
118 return mg->mg_ptr;
119 else
120 return NULL;
121 }
122
xs_object_magic_get_struct_rv_pretty(pTHX_ SV * sv,const char * name)123 void *xs_object_magic_get_struct_rv_pretty (pTHX_ SV *sv, const char *name) {
124 if ( sv && SvROK(sv) ) {
125 MAGIC *mg = xs_object_magic_get_mg(aTHX_ SvRV(sv));
126
127 if ( mg )
128 return mg->mg_ptr;
129 else
130 croak("%s does not have a struct associated with it", name);
131 } else {
132 croak("%s is not a reference", name);
133 }
134 }
135
xs_object_magic_get_struct_rv(pTHX_ SV * sv)136 void *xs_object_magic_get_struct_rv (pTHX_ SV *sv) {
137 return xs_object_magic_get_struct_rv_pretty(aTHX_ sv, "argument");
138 }
139
140 /* stuff for the test follows */
141
142 typedef struct {
143 I32 i;
144 } _xs_magic_object_test_t;
145
146 static I32 destroyed = 0;
147
test_new()148 static _xs_magic_object_test_t *test_new () {
149 _xs_magic_object_test_t *t;
150 Newx(t, 1, _xs_magic_object_test_t);
151 t->i = 0;
152 return t;
153 }
154
test_count(_xs_magic_object_test_t * t)155 static int test_count (_xs_magic_object_test_t *t) {
156 return ++t->i;
157 }
158
test_DESTROY(_xs_magic_object_test_t * t)159 static void test_DESTROY (_xs_magic_object_test_t *t) {
160 Safefree(t);
161 destroyed++;
162 }
163
164
165 MODULE = XS::Object::Magic PACKAGE = XS::Object::Magic::Test PREFIX = test_
166 PROTOTYPES: DISABLE
167
168 SV *
169 new(char *class)
170 CODE:
171 RETVAL = xs_object_magic_create(aTHX_ (void *)test_new(), gv_stashpv(class, 0));
172 OUTPUT: RETVAL
173
174 I32
175 test_count (self)
176 _xs_magic_object_test_t *self;
177
178 void
179 test_has (self)
180 SV *self;
181 PPCODE:
182 if (xs_object_magic_has_struct_rv(aTHX_ self))
183 XSRETURN_YES;
184
185 XSRETURN_NO;
186
187 void
188 test_attach_again (self)
189 SV *self
190 void *s = xs_object_magic_get_struct_rv(aTHX_ self);
191 CODE:
192 xs_object_magic_attach_struct(aTHX_ SvRV(self), s );
193
194 int
195 test_detach_null (self)
196 SV *self;
197 CODE:
198 RETVAL = xs_object_magic_detach_struct_rv(aTHX_ self, NULL);
199 OUTPUT: RETVAL
200
201 int
202 test_detach_struct (self)
203 SV *self;
204 void *s = xs_object_magic_get_struct_rv(aTHX_ self);
205 CODE:
206 RETVAL = xs_object_magic_detach_struct_rv(aTHX_ self, s);
207 OUTPUT: RETVAL
208
209 int
210 test_detach_garbage (self)
211 SV *self;
212 void *s = (void *) 0x123456;
213 CODE:
214 RETVAL = xs_object_magic_detach_struct_rv(aTHX_ self, s);
215 OUTPUT: RETVAL
216
217 void
218 test_DESTROY (self)
219 _xs_magic_object_test_t *self;
220
221 I32
222 destroyed ()
223 CODE:
224 RETVAL = destroyed;
225 OUTPUT: RETVAL
226