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

Last change on this file since 64294 was 64294, checked in by jmr@…, 11 years ago

error checking, sprintf -> snprintf, strcpy -> strncpy

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 10.9 KB
Line 
1/*
2 * util.c
3 * $Id: util.c 64294 2010-02-28 21:59:12Z jmr@macports.org $
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#include "entryobj.h"
39
40/**
41 * Generates a unique proc name starting with prefix.
42 *
43 * This function loops through the integers trying to find a name
44 * "<prefix><int>" such that no command with that name exists within the given
45 * Tcl interp context. This behavior is similar to that of the builtin
46 * `interp create` command, and is intended to generate names for created
47 * objects of a similar nature.
48 *
49 * TODO: add a int* parameter so that functions which need large numbers of
50 * unique names can keep track of the lower bound between calls,thereby turning
51 * N^2 to N. It'll be alchemy for the 21st century.
52 */
53char* unique_name(Tcl_Interp* interp, char* prefix) {
54    int result_size = strlen(prefix) + TCL_INTEGER_SPACE + 1;
55    char* result = malloc(result_size);
56    Tcl_CmdInfo info;
57    int i;
58    for (i=0; ; i++) {
59        snprintf(result, result_size, "%s%d", prefix, i);
60        if (Tcl_GetCommandInfo(interp, result, &info) == 0) {
61            break;
62        }
63    }
64    return result;
65}
66
67/**
68 * Parses flags given to a Tcl command.
69 *
70 * Starting at `objv[start]`, this function will loop through the remaining
71 * arguments until a non-flag argument is found, or an END_FLAGS flag is found,
72 * or an invalid flag is found. In the first two cases, TCL_OK will be returned
73 * and `start` will be moved to the first non-flag argument; in the third,
74 * TCL_ERROR will be returned.
75 *
76 * It is recommended that all callers of this function include the entry
77 * `{ "--", END_FLAGS }` in the NULL-terminated list `options`. For other,
78 * non-zero flag values in `options`, flags will be bitwise or'ed by that value.
79 *
80 * Note that `alpha -beta gamma -delta epsilon` will be recognized as three
81 * arguments following one flag. This could be changed but would make things
82 * much more difficult.
83 *
84 * TODO: support flags of the form ?-flag value?. No functions currently have a
85 * use for this yet, so it's not a priority, but it should be there for
86 * completeness.
87 */
88int parse_flags(Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[], int* start,
89        option_spec options[], int* flags) {
90    int i;
91    int index;
92    *flags = 0;
93    for (i=*start; i<objc; i++) {
94        if (Tcl_GetString(objv[i])[0] != '-') {
95            break;
96        }
97        if (Tcl_GetIndexFromObjStruct(interp, objv[i], options,
98                    sizeof(option_spec), "option", 0, &index) == TCL_OK) {
99            if (options[index].flag == END_FLAGS) {
100                i++;
101                break;
102            } else {
103                *flags |= options[index].flag;
104            }
105        } else {
106            return TCL_ERROR;
107        }
108    }
109    *start = i;
110    return TCL_OK;
111}
112
113/**
114 * Retrieves the object whose proc is named by `name`.
115 *
116 * A common design pattern is to have an object be a proc whose clientData
117 * points to the object and whose function points to an object function. This
118 * function retrieves such an object.
119 *
120 * `proc` is used to verify that a proc names an instance of the object. If not,
121 * `type` is used to construct an appropriate error message before it returns
122 * NULL.
123 */
124void* get_object(Tcl_Interp* interp, char* name, char* type,
125        Tcl_ObjCmdProc* proc, reg_error* errPtr) {
126    Tcl_CmdInfo info;
127    if (Tcl_GetCommandInfo(interp, name, &info) && info.objProc == proc){
128        return info.objClientData;
129    } else {
130        errPtr->code = "registry::not-found";
131        errPtr->description = sqlite3_mprintf("could not find %s \"%s\"", type,
132                name);
133        errPtr->free = (reg_error_destructor*)sqlite3_free;
134        return NULL;
135    }
136}
137
138/**
139 * Sets the object whose proc is named by `name`.
140 *
141 * See the documentation for `get_object`. This function registers such an
142 * object, and additionally requires the `deleteProc` argument, which will be
143 * used to free the object.
144 *
145 * TODO: cause the error used here not to leak memory. This probably needs to be
146 *       addressed as a generic "reg_error_free" routine
147 */
148int set_object(Tcl_Interp* interp, char* name, void* value, char* type,
149        Tcl_ObjCmdProc* proc, Tcl_CmdDeleteProc* deleteProc, reg_error* errPtr){
150    Tcl_CmdInfo info;
151    if (Tcl_GetCommandInfo(interp, name, &info) && info.objProc == proc) {
152        errPtr->code = "registry::duplicate-object";
153        errPtr->description = sqlite3_mprintf("%s named \"%s\" already exists, "
154                "cannot create", type, name);
155        errPtr->free = (reg_error_destructor*)sqlite3_free;
156        return 0;
157    }
158    Tcl_CreateObjCommand(interp, name, proc, value, deleteProc);
159    return 1;
160}
161
162/**
163 * Sets a given name to be an entry object.
164 *
165 * @param [in] interp  Tcl interpreter to create the entry within
166 * @param [in] name    name to associate the given entry with
167 * @param [in] entry   entry to associate with the given name
168 * @param [out] errPtr description of error if it couldn't be set
169 * @return             true if success; false if failure
170 * @see set_object
171 */
172int set_entry(Tcl_Interp* interp, char* name, reg_entry* entry,
173        reg_error* errPtr) {
174    if (set_object(interp, name, entry, "entry", entry_obj_cmd, NULL,
175                errPtr)) {
176        int size = strlen(name) + 1;
177        entry->proc = malloc(size*sizeof(char));
178        memcpy(entry->proc, name, size);
179        return 1;
180    }
181    return 0;
182}
183
184/**
185 * Reports a sqlite3 error to Tcl.
186 *
187 * Queries the database for the most recent error message and sets it as the
188 * result of the given interpreter. If a query is optionally passed, also
189 * records what it was.
190 */
191void set_sqlite_result(Tcl_Interp* interp, sqlite3* db, const char* query) {
192    Tcl_ResetResult(interp);
193    Tcl_SetErrorCode(interp, "registry::sqlite-error", NULL);
194    if (query == NULL) {
195        Tcl_AppendResult(interp, "sqlite error: ", sqlite3_errmsg(db), NULL);
196    } else {
197        Tcl_AppendResult(interp, "sqlite error executing \"", query, "\": ",
198                sqlite3_errmsg(db), NULL);
199    }
200}
201
202/**
203 * Sets the result of the interpreter to all objects returned by a query.
204 *
205 * This function executes `query` on `db` It expects that the query will return
206 * records of a single column, `rowid`. It will then use `prefix` to construct
207 * unique names for these records, and call `setter` to construct their proc
208 * objects. The result of `interp` will be set to a list of all such objects.
209 *
210 * If TCL_OK is returned, then a list is in the result. If TCL_ERROR is, then an
211 * error is there.
212 */
213int all_objects(Tcl_Interp* interp, sqlite3* db, char* query, char* prefix,
214        set_object_function* setter) {
215    sqlite3_stmt* stmt;
216    if (sqlite3_prepare(db, query, -1, &stmt, NULL) == SQLITE_OK) {
217        Tcl_Obj* result = Tcl_NewListObj(0, NULL);
218        Tcl_SetObjResult(interp, result);
219        while (sqlite3_step(stmt) == SQLITE_ROW) {
220            sqlite_int64 rowid = sqlite3_column_int64(stmt, 0);
221            char* name = unique_name(interp, prefix);
222            if (setter(interp, name, rowid) == TCL_OK) {
223                Tcl_Obj* element = Tcl_NewStringObj(name, -1);
224                Tcl_ListObjAppendElement(interp, result, element);
225                free(name);
226            } else {
227                free(name);
228                return TCL_ERROR;
229            }
230        }
231        return TCL_OK;
232    } else {
233        sqlite3_free(query);
234        set_sqlite_result(interp, db, query);
235        return TCL_ERROR;
236    }
237}
238
239const char* string_or_null(Tcl_Obj* obj) {
240    const char* string = Tcl_GetString(obj);
241    if (string[0] == '\0') {
242        return NULL;
243    } else {
244        return string;
245    }
246}
247
248int recast(void* userdata, cast_function* fn, free_function* del, void*** outv,
249        void** inv, int inc, reg_error* errPtr) {
250    void** result = malloc(inc*sizeof(void*));
251    int i;
252    for (i=0; i<inc; i++) {
253        if (!fn(userdata, &result[i], inv[i], errPtr)) {
254            if (del != NULL) {
255                for ( ; i>=0; i--) {
256                    del(userdata, result[i]);
257                }
258            }
259            free(result);
260            return 0;
261        }
262    }
263    *outv = result;
264    return 1;
265}
266
267int entry_to_obj(Tcl_Interp* interp, Tcl_Obj** obj, reg_entry* entry,
268        reg_error* errPtr) {
269    if (entry->proc == NULL) {
270        char* name = unique_name(interp, "::registry::entry");
271        if (!set_entry(interp, name, entry, errPtr)) {
272            free(name);
273            return 0;
274        }
275        free(name);
276    }
277    *obj = Tcl_NewStringObj(entry->proc, -1);
278    return 1;
279}
280
281int list_entry_to_obj(Tcl_Interp* interp, Tcl_Obj*** objs,
282        reg_entry** entries, int entry_count, reg_error* errPtr) {
283    return recast(interp, (cast_function*)entry_to_obj, NULL, (void***)objs,
284            (void**)entries, entry_count, errPtr);
285}
286
287static int obj_to_string(void* userdata UNUSED, char** string, Tcl_Obj* obj,
288        reg_error* errPtr UNUSED) {
289    *string = Tcl_GetString(obj);
290    return 1;
291}
292
293int list_obj_to_string(char*** strings, Tcl_Obj** objv, int objc,
294        reg_error* errPtr) {
295    return recast(NULL, (cast_function*)obj_to_string, NULL, (void***)strings,
296            (void**)objv, objc, errPtr);
297}
298
299static int string_to_obj(void* userdata UNUSED, Tcl_Obj** obj, char* string,
300        reg_error* errPtr UNUSED) {
301    *obj = Tcl_NewStringObj(string, -1);
302    return 1;
303}
304
305static void free_obj(void* userdata UNUSED, Tcl_Obj* obj) {
306    Tcl_DecrRefCount(obj);
307}
308
309int list_string_to_obj(Tcl_Obj*** objv, char** strings, int objc,
310        reg_error* errPtr) {
311    return recast(NULL, (cast_function*)string_to_obj, (free_function*)free_obj,
312            (void***)objv, (void**)strings, objc, errPtr);
313}
Note: See TracBrowser for help on using the repository browser.