/*- * See the file LICENSE for redistribution information. * * Copyright (c) 1999, 2000 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint static const char revid[] = "$Id: tcl_internal.c,v 11.27 2000/05/22 18:36:51 sue Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES #include #include #include #include #endif #include "db_int.h" #include "tcl_db.h" #include "db_page.h" #include "db_am.h" #include "db_ext.h" /* * * internal.c -- * * This file contains internal functions we need to maintain * state for our Tcl interface. * * NOTE: This all uses a linear linked list. If we end up with * too many info structs such that this is a performance hit, it * should be redone using hashes or a list per type. The assumption * is that the user won't have more than a few dozen info structs * in operation at any given point in time. Even a complicated * application with a few environments, nested transactions, locking, * and several databases open, using cursors should not have a * negative performance impact, in terms of searching the list to * get/manipulate the info structure. */ /* * Prototypes for procedures defined later in this file: */ #define GLOB_CHAR(c) ((c) == '*' || (c) == '?') /* * PUBLIC: DBTCL_INFO *_NewInfo __P((Tcl_Interp *, * PUBLIC: void *, char *, enum INFOTYPE)); * * _NewInfo -- * * This function will create a new info structure and fill it in * with the name and pointer, id and type. */ DBTCL_INFO * _NewInfo(interp, anyp, name, type) Tcl_Interp *interp; void *anyp; char *name; enum INFOTYPE type; { DBTCL_INFO *p; int i, ret; if ((ret = __os_malloc(NULL, sizeof(DBTCL_INFO), NULL, &p)) != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); return (NULL); } if ((ret = __os_strdup(NULL, name, &p->i_name)) != 0) { Tcl_SetResult(interp, db_strerror(ret), TCL_STATIC); __os_free(p, sizeof(DBTCL_INFO)); return (NULL); } p->i_interp = interp; p->i_anyp = anyp; p->i_data = 0; p->i_data2 = 0; p->i_type = type; p->i_parent = NULL; p->i_err = NULL; p->i_errpfx = NULL; p->i_lockobj.data = NULL; for (i = 0; i < MAX_ID; i++) p->i_otherid[i] = 0; LIST_INSERT_HEAD(&__db_infohead, p, entries); return (p); } /* * PUBLIC: void *_NameToPtr __P((CONST char *)); */ void * _NameToPtr(name) CONST char *name; { DBTCL_INFO *p; for (p = LIST_FIRST(&__db_infohead); p != NULL; p = LIST_NEXT(p, entries)) if (strcmp(name, p->i_name) == 0) return (p->i_anyp); return (NULL); } /* * PUBLIC: char *_PtrToName __P((CONST void *)); */ char * _PtrToName(ptr) CONST void *ptr; { DBTCL_INFO *p; for (p = LIST_FIRST(&__db_infohead); p != NULL; p = LIST_NEXT(p, entries)) if (p->i_anyp == ptr) return (p->i_name); return (NULL); } /* * PUBLIC: DBTCL_INFO *_PtrToInfo __P((CONST void *)); */ DBTCL_INFO * _PtrToInfo(ptr) CONST void *ptr; { DBTCL_INFO *p; for (p = LIST_FIRST(&__db_infohead); p != NULL; p = LIST_NEXT(p, entries)) if (p->i_anyp == ptr) return (p); return (NULL); } /* * PUBLIC: DBTCL_INFO *_NameToInfo __P((CONST char *)); */ DBTCL_INFO * _NameToInfo(name) CONST char *name; { DBTCL_INFO *p; for (p = LIST_FIRST(&__db_infohead); p != NULL; p = LIST_NEXT(p, entries)) if (strcmp(name, p->i_name) == 0) return (p); return (NULL); } /* * PUBLIC: void _SetInfoData __P((DBTCL_INFO *, void *)); */ void _SetInfoData(p, data) DBTCL_INFO *p; void *data; { if (p == NULL) return; p->i_anyp = data; return; } /* * PUBLIC: void _DeleteInfo __P((DBTCL_INFO *)); */ void _DeleteInfo(p) DBTCL_INFO *p; { if (p == NULL) return; LIST_REMOVE(p, entries); if (p->i_lockobj.data != NULL) __os_free(p->i_lockobj.data, p->i_lockobj.size); if (p->i_err != NULL) { fclose(p->i_err); p->i_err = NULL; } if (p->i_errpfx != NULL) __os_freestr(p->i_errpfx); __os_freestr(p->i_name); __os_free(p, sizeof(DBTCL_INFO)); return; } /* * PUBLIC: int _SetListElem __P((Tcl_Interp *, * PUBLIC: Tcl_Obj *, void *, int, void *, int)); */ int _SetListElem(interp, list, elem1, e1cnt, elem2, e2cnt) Tcl_Interp *interp; Tcl_Obj *list; void *elem1, *elem2; int e1cnt, e2cnt; { Tcl_Obj *myobjv[2], *thislist; int myobjc; myobjc = 2; myobjv[0] = Tcl_NewByteArrayObj((u_char *)elem1, e1cnt); myobjv[1] = Tcl_NewByteArrayObj((u_char *)elem2, e2cnt); thislist = Tcl_NewListObj(myobjc, myobjv); if (thislist == NULL) return (TCL_ERROR); return (Tcl_ListObjAppendElement(interp, list, thislist)); } /* * PUBLIC: int _SetListElemInt __P((Tcl_Interp *, Tcl_Obj *, void *, int)); */ int _SetListElemInt(interp, list, elem1, elem2) Tcl_Interp *interp; Tcl_Obj *list; void *elem1; int elem2; { Tcl_Obj *myobjv[2], *thislist; int myobjc; myobjc = 2; myobjv[0] = Tcl_NewByteArrayObj((u_char *)elem1, strlen((char *)elem1)); myobjv[1] = Tcl_NewIntObj(elem2); thislist = Tcl_NewListObj(myobjc, myobjv); if (thislist == NULL) return (TCL_ERROR); return (Tcl_ListObjAppendElement(interp, list, thislist)); } /* * PUBLIC: int _SetListRecnoElem __P((Tcl_Interp *, Tcl_Obj *, * PUBLIC: db_recno_t, u_char *, int)); */ int _SetListRecnoElem(interp, list, elem1, elem2, e2size) Tcl_Interp *interp; Tcl_Obj *list; db_recno_t elem1; u_char *elem2; int e2size; { Tcl_Obj *myobjv[2], *thislist; int myobjc; myobjc = 2; myobjv[0] = Tcl_NewIntObj(elem1); myobjv[1] = Tcl_NewByteArrayObj(elem2, e2size); thislist = Tcl_NewListObj(myobjc, myobjv); if (thislist == NULL) return (TCL_ERROR); return (Tcl_ListObjAppendElement(interp, list, thislist)); } /* * PUBLIC: int _GetGlobPrefix __P((char *, char **)); */ int _GetGlobPrefix(pattern, prefix) char *pattern; char **prefix; { int i, j; char *p; /* * Duplicate it, we get enough space and most of the work is done. */ if (__os_strdup(NULL, pattern, prefix) != 0) return (1); p = *prefix; for (i = 0, j = 0; p[i] && !GLOB_CHAR(p[i]); i++, j++) /* * Check for an escaped character and adjust */ if (p[i] == '\\' && p[i+1]) { p[j] = p[i+1]; i++; } else p[j] = p[i]; p[j] = 0; return (0); } /* * PUBLIC: int _ReturnSetup __P((Tcl_Interp *, int, char *)); */ int _ReturnSetup(interp, ret, errmsg) Tcl_Interp *interp; int ret; char *errmsg; { char *msg; if (ret > 0) return (_ErrorSetup(interp, ret, errmsg)); /* * We either have success or a DB error. If a DB error, set up the * string. We return an error if not one of the errors we catch. * If anyone wants to reset the result to return anything different, * then the calling function is responsible for doing so via * Tcl_ResetResult or another Tcl_SetObjResult. */ if (ret == 0) { Tcl_SetResult(interp, "0", TCL_STATIC); return (TCL_OK); } msg = db_strerror(ret); Tcl_AppendResult(interp, msg, NULL); switch (ret) { case DB_NOTFOUND: case DB_KEYEXIST: case DB_KEYEMPTY: return (TCL_OK); default: Tcl_SetErrorCode(interp, "BerkeleyDB", msg, NULL); return (TCL_ERROR); } } /* * PUBLIC: int _ErrorSetup __P((Tcl_Interp *, int, char *)); */ int _ErrorSetup(interp, ret, errmsg) Tcl_Interp *interp; int ret; char *errmsg; { Tcl_SetErrno(ret); Tcl_AppendResult(interp, errmsg, ":", Tcl_PosixError(interp), NULL); return (TCL_ERROR); } /* * PUBLIC: void _ErrorFunc __P((CONST char *, char *)); */ void _ErrorFunc(pfx, msg) CONST char *pfx; char *msg; { DBTCL_INFO *p; Tcl_Interp *interp; int size; char *err; p = _NameToInfo(pfx); if (p == NULL) return; interp = p->i_interp; size = strlen(pfx) + strlen(msg) + 4; /* * If we cannot allocate enough to put together the prefix * and message then give them just the message. */ if (__os_malloc(NULL, size, NULL, &err) != 0) { Tcl_AddErrorInfo(interp, msg); Tcl_AppendResult(interp, msg, "\n", NULL); return; } snprintf(err, size, "%s: %s", pfx, msg); Tcl_AddErrorInfo(interp, err); Tcl_AppendResult(interp, err, "\n", NULL); __os_free(err, size); return; } #define INVALID_LSNMSG "Invalid LSN with %d parts. Should have 2.\n" /* * PUBLIC: int _GetLsn __P((Tcl_Interp *, Tcl_Obj *, DB_LSN *)); */ int _GetLsn(interp, obj, lsn) Tcl_Interp *interp; Tcl_Obj *obj; DB_LSN *lsn; { Tcl_Obj **myobjv; int itmp, myobjc, result; char msg[MSG_SIZE]; result = Tcl_ListObjGetElements(interp, obj, &myobjc, &myobjv); if (result == TCL_ERROR) return (result); if (myobjc != 2) { result = TCL_ERROR; snprintf(msg, MSG_SIZE, INVALID_LSNMSG, myobjc); Tcl_SetResult(interp, msg, TCL_VOLATILE); return (result); } result = Tcl_GetIntFromObj(interp, myobjv[0], &itmp); if (result == TCL_ERROR) return (result); lsn->file = itmp; result = Tcl_GetIntFromObj(interp, myobjv[1], &itmp); lsn->offset = itmp; return (result); } int __debug_stop, __debug_on, __debug_print, __debug_test; /* * PUBLIC: void _debug_check __P((void)); */ void _debug_check() { if (__debug_on == 0) return; if (__debug_print != 0) { printf("\r%6d:", __debug_on); fflush(stdout); } if (__debug_on++ == __debug_test || __debug_stop) __db_loadme(); }