Mercurial > pidgin.yaz
comparison plugins/perl/perl-common.c @ 6508:cbd24b37350d
[gaim-migrate @ 7025]
Okay, ready for some breakage again? I rewrote the perl loader plugin. All
old scripts are broken, but the new API will be much better. Currently, you
can access accounts and do debug output, and that's it, but adding support
for new things is much easier. Please don't come after me with pitchforks.
committer: Tailor Script <tailor@pidgin.im>
author | Christian Hammond <chipx86@chipx86.com> |
---|---|
date | Tue, 19 Aug 2003 21:47:36 +0000 |
parents | |
children | 2e2593d95121 |
comparison
equal
deleted
inserted
replaced
6507:c8e31153eea7 | 6508:cbd24b37350d |
---|---|
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 |