source: trunk/base/src/registry2.0/util.c @ 27518

Last change on this file since 27518 was 27518, checked in by sfiera@…, 10 years ago

Committing registry2.0 to local branch

File size: 9.5 KB
Line 
1/*
2 * util.c
3 * $Id: $
4 *
5 * Copyright (c) 2007 Chris Pickel <sfiera@macports.org>
6 * All rights reserved.
7 *
8 * Redistribution and use in source and binary forms, with or without
9 * modification, are permitted provided that the following conditions
10 * are met:
11 * 1. Redistributions of source code must retain the above copyright
12 *    notice, this list of conditions and the following disclaimer.
13 * 2. Redistributions in binary form must reproduce the above copyright
14 *    notice, this list of conditions and the following disclaimer in the
15 *    documentation and/or other materials provided with the distribution.
16 *
17 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
18 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
19 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
20 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
21 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
22 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
23 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
24 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
25 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
26 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 */
28
29#if HAVE_CONFIG_H
30#include <config.h>
31#endif
32
33#include <string.h>
34#include <stdlib.h>
35#include <tcl.h>
36
37#include "util.h"
38
39/**
40 * Generates a unique proc name starting with prefix.
41 *
42 * This function loops through the integers trying to find a name
43 * "<prefix><int>" such that no command with that name exists within the given
44 * Tcl interp context. This behavior is similar to that of the builtin
45 * `interp create` command, and is intended to generate names for created
46 * objects of a similar nature.
47 *
48 * TODO: add a int* parameter so that functions which need large numbers of
49 * unique names can keep track of the lower bound between calls,thereby turning
50 * N^2 to N. It'll be alchemy for the 21st century.
51 */
52char* unique_name(Tcl_Interp* interp, char* prefix) {
53    char* result = malloc(strlen(prefix) + TCL_INTEGER_SPACE + 1);
54    Tcl_CmdInfo info;
55    int i;
56    for (i=0; ; i++) {
57        sprintf(result, "%s%d", prefix, i);
58        if (Tcl_GetCommandInfo(interp, result, &info) == 0) {
59            break;
60        }
61    }
62    return result;
63}
64
65/**
66 * Parses flags given to a Tcl command.
67 *
68 * Starting at `objv[start]`, this function will loop through the remaining
69 * arguments until a non-flag argument is found, or an END_FLAGS flag is found,
70 * or an invalid flag is found. In the first two cases, TCL_OK will be returned
71 * and `start` will be moved to the first non-flag argument; in the third,
72 * TCL_ERROR will be returned.
73 *
74 * It is recommended that all callers of this function include the entry
75 * `{ "--", END_FLAGS }` in the NULL-terminated list `options`. For other,
76 * non-zero flag values in `options`, flags will be bitwise or'ed by that value.
77 *
78 * Note that `alpha -beta gamma -delta epsilon` will be recognized as three
79 * arguments following one flag. This could be changed but would make things
80 * much more difficult.
81 *
82 * TODO: support flags of the form ?-flag value?. No functions currently have a
83 * use for this yet, so it's not a priority, but it should be there for
84 * completeness.
85 */
86int parse_flags(Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[], int* start,
87        option_spec options[], int* flags) {
88    int i;
89    int index;
90    *flags = 0;
91    for (i=*start; i<objc; i++) {
92        if (Tcl_GetString(objv[i])[0] != '-') {
93            break;
94        }
95        if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
96                    sizeof(option_spec), "option", 0, &index) == TCL_OK) {
97            if (options[index].flag == END_FLAGS) {
98                i++;
99                break;
100            } else {
101                *flags |= options[index].flag;
102            }
103        } else {
104            return TCL_ERROR;
105        }
106    }
107    *start = i;
108    return TCL_OK;
109}
110
111/**
112 * Retrieves the object whose proc is named by `name`.
113 *
114 * A common design pattern is to have an object be a proc whose clientData
115 * points to the object and whose function points to an object function. This
116 * function retrieves such an object.
117 *
118 * `proc` is used to verify that a proc names an instance of the object. If not,
119 * `type` is used to construct an appropriate error message before it returns
120 * NULL.
121 */
122void* get_object(Tcl_Interp* interp, char* name, char* type,
123        Tcl_ObjCmdProc* proc, reg_error* errPtr) {
124    Tcl_CmdInfo info;
125    if (Tcl_GetCommandInfo(interp, name, &info) && info.objProc == proc){
126        return info.objClientData;
127    } else {
128        errPtr->code = "registry::not-found";
129        errPtr->description = sqlite3_mprintf("could not find %s \"%s\"", type,
130                name);
131        errPtr->free = (reg_error_destructor*)sqlite3_free;
132        return NULL;
133    }
134}
135
136/**
137 * Sets the object whose proc is named by `name`.
138 *
139 * See the documentation for `get_object`. This function registers such an
140 * object, and additionally requires the `deleteProc` argument, which will be
141 * used to free the object.
142 *
143 * TODO: cause the error used here not to leak memory. This probably needs to be
144 *       addressed as a generic "reg_error_free" routine
145 */
146int set_object(Tcl_Interp* interp, char* name, void* value, char* type,
147        Tcl_ObjCmdProc* proc, Tcl_CmdDeleteProc* deleteProc, reg_error* errPtr){
148    Tcl_CmdInfo info;
149    if (Tcl_GetCommandInfo(interp, name, &info) && info.objProc == proc) {
150        errPtr->code = "registry::duplicate-object";
151        errPtr->description = sqlite3_mprintf("%s named \"%s\" already exists, "
152                "cannot create", type, name);
153        errPtr->free = (reg_error_destructor*)sqlite3_free;
154        return 0;
155    }
156    Tcl_CreateObjCommand(interp, name, proc, value, deleteProc);
157    return 1;
158}
159
160/**
161 * Reports a sqlite3 error to Tcl.
162 *
163 * Queries the database for the most recent error message and sets it as the
164 * result of the given interpreter. If a query is optionally passed, also
165 * records what it was.
166 */
167void set_sqlite_result(Tcl_Interp* interp, sqlite3* db, const char* query) {
168    Tcl_ResetResult(interp);
169    Tcl_SetErrorCode(interp, "registry::sqlite-error", NULL);
170    if (query == NULL) {
171        Tcl_AppendResult(interp, "sqlite error: ", sqlite3_errmsg(db), NULL);
172    } else {
173        Tcl_AppendResult(interp, "sqlite error executing \"", query, "\": ",
174                sqlite3_errmsg(db), NULL);
175    }
176}
177
178/**
179 * Sets the result of the interpreter to all objects returned by a query.
180 *
181 * This function executes `query` on `db` It expects that the query will return
182 * records of a single column, `rowid`. It will then use `prefix` to construct
183 * unique names for these records, and call `setter` to construct their proc
184 * objects. The result of `interp` will be set to a list of all such objects.
185 *
186 * If TCL_OK is returned, then a list is in the result. If TCL_ERROR is, then an
187 * error is there.
188 */
189int all_objects(Tcl_Interp* interp, sqlite3* db, char* query, char* prefix,
190        set_object_function* setter) {
191    sqlite3_stmt* stmt;
192    if (sqlite3_prepare(db, query, -1, &stmt, NULL) == SQLITE_OK) {
193        Tcl_Obj* result = Tcl_NewListObj(0, NULL);
194        Tcl_SetObjResult(interp, result);
195        while (sqlite3_step(stmt) == SQLITE_ROW) {
196            sqlite_int64 rowid = sqlite3_column_int64(stmt, 0);
197            char* name = unique_name(interp, prefix);
198            if (setter(interp, name, rowid) == TCL_OK) {
199                Tcl_Obj* element = Tcl_NewStringObj(name, -1);
200                Tcl_ListObjAppendElement(interp, result, element);
201                free(name);
202            } else {
203                free(name);
204                return TCL_ERROR;
205            }
206        }
207        return TCL_OK;
208    } else {
209        sqlite3_free(query);
210        set_sqlite_result(interp, db, query);
211        return TCL_ERROR;
212    }
213    return TCL_ERROR;
214}
215
216int recast(void* userdata, cast_function* fn, free_function* del, void*** outv,
217        void** inv, int inc, reg_error* errPtr) {
218    void** result = malloc(inc*sizeof(void*));
219    int i;
220    for (i=0; i<inc; i++) {
221        if (!fn(userdata, &result[i], inv[i], errPtr)) {
222            if (del != NULL) {
223                for ( ; i>=0; i--) {
224                    del(userdata, result[i]);
225                }
226            }
227            free(result);
228            return 0;
229        }
230    }
231    *outv = result;
232    return 1;
233}
234
235static int obj_to_string(void* userdata UNUSED, char** string, Tcl_Obj* obj,
236        reg_error* errPtr UNUSED) {
237    int length;
238    char* value = Tcl_GetStringFromObj(obj, &length);
239    *string = malloc((length+1)*sizeof(char));
240    memcpy(*string, value, length+1);
241    return 1;
242}
243
244void free_string(void* userdata UNUSED, char* string) {
245    free(string);
246}
247
248int list_obj_to_string(char*** strings, const Tcl_Obj** objv, int objc,
249        reg_error* errPtr) {
250    return recast(NULL, (cast_function*)obj_to_string,
251            (free_function*)free_string, (void***)strings, (void**)objv, objc,
252            errPtr);
253}
254
255static int string_to_obj(void* userdata UNUSED, Tcl_Obj** obj, char* string,
256        reg_error* errPtr UNUSED) {
257    *obj = Tcl_NewStringObj(string, -1);
258    return 1;
259}
260
261static void free_obj(void* userdata UNUSED, Tcl_Obj* obj) {
262    Tcl_DecrRefCount(obj);
263}
264
265int list_string_to_obj(Tcl_Obj*** objv, const char** strings, int objc,
266        reg_error* errPtr) {
267    return recast(NULL, (cast_function*)string_to_obj,
268            (free_function*)free_obj, (void***)objv, (void**)strings, objc,
269            errPtr);
270}
Note: See TracBrowser for help on using the repository browser.