6508
|
1 #include <XSUB.h>
|
|
2 #include <EXTERN.h>
|
|
3 #include <perl.h>
|
|
4 #include <glib.h>
|
|
5
|
|
6 #include "perl-common.h"
|
|
7
|
|
8 extern PerlInterpreter *my_perl;
|
|
9
|
|
10 static GHashTable *object_stashes = NULL;
|
|
11
|
|
12 static int
|
|
13 magic_free_object(pTHX_ SV *sv, MAGIC *mg)
|
|
14 {
|
|
15 sv_setiv(sv, 0);
|
|
16
|
|
17 return 0;
|
|
18 }
|
|
19
|
|
20 static MGVTBL vtbl_free_object =
|
|
21 {
|
|
22 NULL, NULL, NULL, NULL, magic_free_object
|
|
23 };
|
|
24
|
|
25 static SV *
|
|
26 create_sv_ptr(void *object)
|
|
27 {
|
|
28 SV *sv;
|
|
29
|
|
30 sv = newSViv((IV)object);
|
|
31
|
|
32 sv_magic(sv, NULL, '~', NULL, 0);
|
|
33
|
|
34 SvMAGIC(sv)->mg_private = 0x1551; /* HF */
|
|
35 SvMAGIC(sv)->mg_virtual = &vtbl_free_object;
|
|
36
|
|
37 return sv;
|
|
38 }
|
|
39
|
|
40 SV *
|
|
41 gaim_perl_bless_object(void *object, const char *stash_name)
|
|
42 {
|
|
43 HV *stash;
|
|
44 HV *hv;
|
|
45 void *hash;
|
|
46
|
|
47 if (object_stashes == NULL)
|
|
48 {
|
|
49 object_stashes = g_hash_table_new(g_direct_hash, g_direct_equal);
|
|
50 }
|
|
51
|
|
52 stash = gv_stashpv(stash_name, 1);
|
|
53
|
|
54 hv = newHV();
|
|
55 hv_store(hv, "_gaim", 5, create_sv_ptr(object), 0);
|
|
56
|
|
57 return sv_bless(newRV_noinc((SV *)hv), stash);
|
|
58
|
|
59 // return sv_bless(create_sv_ptr(object), gv_stashpv(stash, 1));
|
|
60 // return create_sv_ptr(object);
|
|
61
|
|
62 // dXSARGS;
|
|
63
|
|
64 // return sv_setref_pv(ST(0), "Gaim::Account", create_sv_ptr(object));
|
|
65 }
|
|
66
|
|
67 gboolean
|
|
68 gaim_perl_is_ref_object(SV *o)
|
|
69 {
|
|
70 SV **sv;
|
|
71 HV *hv;
|
|
72
|
|
73 hv = hvref(o);
|
|
74
|
|
75 if (hv != NULL)
|
|
76 {
|
|
77 sv = hv_fetch(hv, "_gaim", 5, 0);
|
|
78
|
|
79 if (sv != NULL)
|
|
80 return TRUE;
|
|
81 }
|
|
82
|
|
83 return FALSE;
|
|
84 }
|
|
85
|
|
86 void *
|
|
87 gaim_perl_ref_object(SV *o)
|
|
88 {
|
|
89 SV **sv;
|
|
90 HV *hv;
|
|
91 void *p;
|
|
92
|
|
93 hv = hvref(o);
|
|
94
|
|
95 if (hv == NULL)
|
|
96 return NULL;
|
|
97
|
|
98 sv = hv_fetch(hv, "_gaim", 5, 0);
|
|
99
|
|
100 if (sv == NULL)
|
|
101 croak("variable is damaged");
|
|
102
|
|
103 p = GINT_TO_POINTER(SvIV(*sv));
|
|
104
|
|
105 return p;
|
|
106 }
|
|
107
|