comparison: libpurple/plugins/tcl/tcl_ref.c
libpurple/plugins/tcl/tcl_ref.c
- changeset 37581
- 1fb661b5f206
- parent 37580
- 498763742ea4
- child 37582
- ca3533cdddc7
equal
deleted
inserted
replaced
| 37580:498763742ea4 | 37581:1fb661b5f206 |
|---|---|
| 1 /** | |
| 2 * @file tcl_ref.c Purple Tcl typed references API | |
| 3 * | |
| 4 * purple | |
| 5 * | |
| 6 * Copyright (C) 2006 Ethan Blanton <eblanton@cs.purdue.edu> | |
| 7 * | |
| 8 * This program is free software; you can redistribute it and/or modify | |
| 9 * it under the terms of the GNU General Public License as published by | |
| 10 * the Free Software Foundation; either version 2 of the License, or | |
| 11 * (at your option) any later version. | |
| 12 * | |
| 13 * This program is distributed in the hope that it will be useful, | |
| 14 * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 16 * GNU General Public License for more details. | |
| 17 * | |
| 18 * You should have received a copy of the GNU General Public License | |
| 19 * along with this program; if not, write to the Free Software | |
| 20 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02111-1301 USA | |
| 21 */ | |
| 22 | |
| 23 #include <tcl.h> | |
| 24 #include <glib.h> | |
| 25 | |
| 26 #include "tcl_purple.h" | |
| 27 #include "stringref.h" | |
| 28 | |
| 29 /* Instead of all that internal representation mumbo jumbo, use these | |
| 30 * macros to access the internal representation of a PurpleTclRef */ | |
| 31 #define OBJ_REF_TYPE(obj) (obj->internalRep.twoPtrValue.ptr1) | |
| 32 #define OBJ_REF_VALUE(obj) (obj->internalRep.twoPtrValue.ptr2) | |
| 33 | |
| 34 static Tcl_FreeInternalRepProc purple_tcl_ref_free; | |
| 35 static Tcl_DupInternalRepProc purple_tcl_ref_dup; | |
| 36 static Tcl_UpdateStringProc purple_tcl_ref_update; | |
| 37 static Tcl_SetFromAnyProc purple_tcl_ref_set; | |
| 38 | |
| 39 static Tcl_ObjType purple_tcl_ref = { | |
| 40 "PurpleTclRef", | |
| 41 purple_tcl_ref_free, | |
| 42 purple_tcl_ref_dup, | |
| 43 purple_tcl_ref_update, | |
| 44 purple_tcl_ref_set | |
| 45 }; | |
| 46 | |
| 47 void purple_tcl_ref_init() | |
| 48 { | |
| 49 Tcl_RegisterObjType(&purple_tcl_ref); | |
| 50 } | |
| 51 | |
| 52 void *purple_tcl_ref_get(Tcl_Interp *interp, Tcl_Obj *obj, PurpleStringref *type) | |
| 53 { | |
| 54 if (obj->typePtr != &purple_tcl_ref) { | |
| 55 if (Tcl_ConvertToType(interp, obj, &purple_tcl_ref) != TCL_OK) | |
| 56 return NULL; | |
| 57 } | |
| 58 if (strcmp(purple_stringref_value(OBJ_REF_TYPE(obj)), | |
| 59 purple_stringref_value(type))) { | |
| 60 if (interp) { | |
| 61 Tcl_Obj *error = Tcl_NewStringObj("Bad Purple reference type: expected ", -1); | |
| 62 Tcl_AppendToObj(error, purple_stringref_value(type), -1); | |
| 63 Tcl_AppendToObj(error, " but got ", -1); | |
| 64 Tcl_AppendToObj(error, purple_stringref_value(OBJ_REF_TYPE(obj)), -1); | |
| 65 Tcl_SetObjResult(interp, error); | |
| 66 } | |
| 67 return NULL; | |
| 68 } | |
| 69 return OBJ_REF_VALUE(obj); | |
| 70 } | |
| 71 | |
| 72 Tcl_Obj *purple_tcl_ref_new(PurpleStringref *type, void *value) | |
| 73 { | |
| 74 Tcl_Obj *obj = Tcl_NewObj(); | |
| 75 obj->typePtr = &purple_tcl_ref; | |
| 76 OBJ_REF_TYPE(obj) = purple_stringref_ref(type); | |
| 77 OBJ_REF_VALUE(obj) = value; | |
| 78 Tcl_InvalidateStringRep(obj); | |
| 79 return obj; | |
| 80 } | |
| 81 | |
| 82 static void purple_tcl_ref_free(Tcl_Obj *obj) | |
| 83 { | |
| 84 purple_stringref_unref(OBJ_REF_TYPE(obj)); | |
| 85 } | |
| 86 | |
| 87 static void purple_tcl_ref_dup(Tcl_Obj *obj1, Tcl_Obj *obj2) | |
| 88 { | |
| 89 OBJ_REF_TYPE(obj2) = purple_stringref_ref(OBJ_REF_TYPE(obj1)); | |
| 90 OBJ_REF_VALUE(obj2) = OBJ_REF_VALUE(obj1); | |
| 91 } | |
| 92 | |
| 93 static void purple_tcl_ref_update(Tcl_Obj *obj) | |
| 94 { | |
| 95 size_t len; | |
| 96 /* This is ugly on memory, but we pretty much have to either | |
| 97 * do this or guesstimate lengths or introduce a varargs | |
| 98 * function in here ... ugh. */ | |
| 99 char *bytes = g_strdup_printf("purple-%s:%p", | |
| 100 purple_stringref_value(OBJ_REF_TYPE(obj)), | |
| 101 OBJ_REF_VALUE(obj)); | |
| 102 | |
| 103 obj->length = strlen(bytes); | |
| 104 len = obj->length + 1; | |
| 105 obj->bytes = ckalloc(len); | |
| 106 g_strlcpy(obj->bytes, bytes, len); | |
| 107 g_free(bytes); | |
| 108 } | |
| 109 | |
| 110 /* This isn't as memory-efficient as setting could be, because we | |
| 111 * essentially have to synthesize the Stringref here, where we would | |
| 112 * really rather dup it. Oh, well. */ | |
| 113 static int purple_tcl_ref_set(Tcl_Interp *interp, Tcl_Obj *obj) | |
| 114 { | |
| 115 char *bytes = Tcl_GetStringFromObj(obj, NULL); | |
| 116 char *ptr; | |
| 117 PurpleStringref *type; | |
| 118 void *value; | |
| 119 static const char prefix[] = "purple-"; | |
| 120 static const gsize prefixlen = sizeof(prefix) - 1; | |
| 121 | |
| 122 if (strlen(bytes) < prefixlen | |
| 123 || strncmp(bytes, prefix, prefixlen) | |
| 124 || (ptr = strchr(bytes, ':')) == NULL | |
| 125 || (gsize)(ptr - bytes) == prefixlen) | |
| 126 goto badobject; | |
| 127 | |
| 128 /* Bad Ethan */ | |
| 129 *ptr = '\0'; | |
| 130 type = purple_stringref_new(bytes + prefixlen); | |
| 131 *ptr = ':'; | |
| 132 ptr++; | |
| 133 | |
| 134 if (sscanf(ptr, "%p", &value) == 0) { | |
| 135 purple_stringref_unref(type); | |
| 136 goto badobject; | |
| 137 } | |
| 138 | |
| 139 /* At this point we know we have a good object; free the old and | |
| 140 * install our internal representation. */ | |
| 141 if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) | |
| 142 obj->typePtr->freeIntRepProc(obj); | |
| 143 | |
| 144 obj->typePtr = &purple_tcl_ref; | |
| 145 OBJ_REF_TYPE(obj) = type; | |
| 146 OBJ_REF_VALUE(obj) = value; | |
| 147 | |
| 148 return TCL_OK; | |
| 149 | |
| 150 badobject: | |
| 151 if (interp) { | |
| 152 Tcl_SetObjResult(interp, | |
| 153 Tcl_NewStringObj("invalid PurpleTclRef representation", -1)); | |
| 154 } | |
| 155 return TCL_ERROR; | |
| 156 } |
