comparison: plugins/perl/perl-common.c
plugins/perl/perl-common.c
- changeset 6508
- 57d1df1ca3a0
- child 6520
- 5386692555c9
equal
deleted
inserted
replaced
| 6507:ce503ec61af7 | 6508:57d1df1ca3a0 |
|---|---|
| 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 |
