← Back to branch summary

~ubuntu-branches/ubuntu/maverick/evolution-data-server/maverick-proposed

« back to all changes in this revision

Viewing changes to libdb/tcl/tcl_util.c

  • Committer: Bazaar Package Importer
  • Author(s): Didier Roche
  • Date: 2010-05-17 17:02:06 UTC
  • mfrom: (1.1.79 upstream) (1.6.12 experimental)
  • Revision ID: james.westby@ubuntu.com-20100517170206-4ufr52vwrhh26yh0
Tags: 2.30.1-1ubuntu1
https://launchpad.net/bugs/42199
https://launchpad.net/bugs/229669
https://launchpad.net/bugs/173703
https://launchpad.net/bugs/360344
https://launchpad.net/bugs/508494
* Merge from debian experimental. Remaining change:
  (LP: #42199, #229669, #173703, #360344, #508494)
  + debian/control:
    - add Vcs-Bzr tag
    - don't use libgnome
    - Use Breaks instead of Conflicts against evolution 2.25 and earlier.
  + debian/evolution-data-server.install,
    debian/patches/45_libcamel_providers_version.patch:
    - use the upstream versioning, not a Debian-specific one 
  + debian/libedata-book1.2-dev.install, debian/libebackend-1.2-dev.install,
    debian/libcamel1.2-dev.install, debian/libedataserverui1.2-dev.install:
    - install html documentation
  + debian/rules:
    - don't build documentation it's shipped with the tarball

Show diffs side-by-side

added added

removed removed

Lines of Context:
libdb/tcl/tcl_util.c
1
 
/*-
2
 
 * See the file LICENSE for redistribution information.
3
 
 *
4
 
 * Copyright (c) 1999-2001
5
 
 *      Sleepycat Software.  All rights reserved.
6
 
 */
7
 
 
8
 
#include "db_config.h"
9
 
 
10
 
#ifndef lint
11
 
static const char revid[] = "$Id$";
12
 
#endif /* not lint */
13
 
 
14
 
#ifndef NO_SYSTEM_INCLUDES
15
 
#include <sys/types.h>
16
 
 
17
 
#include <fcntl.h>
18
 
#include <stdlib.h>
19
 
#include <string.h>
20
 
#include <tcl.h>
21
 
#endif
22
 
 
23
 
#include "db_int.h"
24
 
#include "dbinc/tcl_db.h"
25
 
 
26
 
/*
27
 
 * Prototypes for procedures defined later in this file:
28
 
 */
29
 
static int mutex_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*));
30
 
 
31
 
/*
32
 
 * bdb_RandCommand --
33
 
 *      Implements rand* functions.
34
 
 *
35
 
 * PUBLIC: int bdb_RandCommand __P((Tcl_Interp *, int, Tcl_Obj * CONST*));
36
 
 */
37
 
int
38
 
bdb_RandCommand(interp, objc, objv)
39
 
        Tcl_Interp *interp;             /* Interpreter */
40
 
        int objc;                       /* How many arguments? */
41
 
        Tcl_Obj *CONST objv[];          /* The argument objects */
42
 
{
43
 
        static char *rcmds[] = {
44
 
                "rand", "random_int",   "srand",
45
 
                NULL
46
 
        };
47
 
        enum rcmds {
48
 
                RRAND, RRAND_INT, RSRAND
49
 
        };
50
 
        long t;
51
 
        int cmdindex, hi, lo, result, ret;
52
 
        Tcl_Obj *res;
53
 
        char msg[MSG_SIZE];
54
 
 
55
 
        result = TCL_OK;
56
 
        /*
57
 
         * Get the command name index from the object based on the cmds
58
 
         * defined above.  This SHOULD NOT fail because we already checked
59
 
         * in the 'berkdb' command.
60
 
         */
61
 
        if (Tcl_GetIndexFromObj(interp,
62
 
            objv[1], rcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
63
 
                return (IS_HELP(objv[1]));
64
 
 
65
 
        res = NULL;
66
 
        switch ((enum rcmds)cmdindex) {
67
 
        case RRAND:
68
 
                /*
69
 
                 * Must be 0 args.  Error if different.
70
 
                 */
71
 
                if (objc != 2) {
72
 
                        Tcl_WrongNumArgs(interp, 2, objv, NULL);
73
 
                        return (TCL_ERROR);
74
 
                }
75
 
                ret = rand();
76
 
                res = Tcl_NewIntObj(ret);
77
 
                break;
78
 
        case RRAND_INT:
79
 
                /*
80
 
                 * Must be 4 args.  Error if different.
81
 
                 */
82
 
                if (objc != 4) {
83
 
                        Tcl_WrongNumArgs(interp, 2, objv, "lo hi");
84
 
                        return (TCL_ERROR);
85
 
                }
86
 
                result = Tcl_GetIntFromObj(interp, objv[2], &lo);
87
 
                if (result != TCL_OK)
88
 
                        break;
89
 
                result = Tcl_GetIntFromObj(interp, objv[3], &hi);
90
 
                if (result == TCL_OK) {
91
 
#ifndef RAND_MAX
92
 
#define RAND_MAX        0x7fffffff
93
 
#endif
94
 
                        t = rand();
95
 
                        if (t > RAND_MAX) {
96
 
                                snprintf(msg, MSG_SIZE,
97
 
                                    "Max random is higher than %ld\n",
98
 
                                    (long)RAND_MAX);
99
 
                                Tcl_SetResult(interp, msg, TCL_VOLATILE);
100
 
                                result = TCL_ERROR;
101
 
                                break;
102
 
                        }
103
 
                        _debug_check();
104
 
                        ret = (int)(((double)t / ((double)(RAND_MAX) + 1)) *
105
 
                            (hi - lo + 1));
106
 
                        ret += lo;
107
 
                        res = Tcl_NewIntObj(ret);
108
 
                }
109
 
                break;
110
 
        case RSRAND:
111
 
                /*
112
 
                 * Must be 1 arg.  Error if different.
113
 
                 */
114
 
                if (objc != 3) {
115
 
                        Tcl_WrongNumArgs(interp, 2, objv, "seed");
116
 
                        return (TCL_ERROR);
117
 
                }
118
 
                result = Tcl_GetIntFromObj(interp, objv[2], &lo);
119
 
                if (result == TCL_OK) {
120
 
                        srand((u_int)lo);
121
 
                        res = Tcl_NewIntObj(0);
122
 
                }
123
 
                break;
124
 
        }
125
 
        /*
126
 
         * Only set result if we have a res.  Otherwise, lower
127
 
         * functions have already done so.
128
 
         */
129
 
        if (result == TCL_OK && res)
130
 
                Tcl_SetObjResult(interp, res);
131
 
        return (result);
132
 
}
133
 
 
134
 
/*
135
 
 *
136
 
 * tcl_Mutex --
137
 
 *      Opens an env mutex.
138
 
 *
139
 
 * PUBLIC: int tcl_Mutex __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *,
140
 
 * PUBLIC:    DBTCL_INFO *));
141
 
 */
142
 
int
143
 
tcl_Mutex(interp, objc, objv, envp, envip)
144
 
        Tcl_Interp *interp;             /* Interpreter */
145
 
        int objc;                       /* How many arguments? */
146
 
        Tcl_Obj *CONST objv[];          /* The argument objects */
147
 
        DB_ENV *envp;                   /* Environment pointer */
148
 
        DBTCL_INFO *envip;              /* Info pointer */
149
 
{
150
 
        DBTCL_INFO *ip;
151
 
        Tcl_Obj *res;
152
 
        _MUTEX_DATA *md;
153
 
        int i, mode, nitems, result, ret;
154
 
        char newname[MSG_SIZE];
155
 
 
156
 
        md = NULL;
157
 
        result = TCL_OK;
158
 
        mode = nitems = ret = 0;
159
 
        memset(newname, 0, MSG_SIZE);
160
 
 
161
 
        if (objc != 4) {
162
 
                Tcl_WrongNumArgs(interp, 2, objv, "mode nitems");
163
 
                return (TCL_ERROR);
164
 
        }
165
 
        result = Tcl_GetIntFromObj(interp, objv[2], &mode);
166
 
        if (result != TCL_OK)
167
 
                return (TCL_ERROR);
168
 
        result = Tcl_GetIntFromObj(interp, objv[3], &nitems);
169
 
        if (result != TCL_OK)
170
 
                return (TCL_ERROR);
171
 
 
172
 
        snprintf(newname, sizeof(newname),
173
 
            "%s.mutex%d", envip->i_name, envip->i_envmutexid);
174
 
        ip = _NewInfo(interp, NULL, newname, I_MUTEX);
175
 
        if (ip == NULL) {
176
 
                Tcl_SetResult(interp, "Could not set up info",
177
 
                    TCL_STATIC);
178
 
                return (TCL_ERROR);
179
 
        }
180
 
        /*
181
 
         * Set up mutex.
182
 
         */
183
 
        /*
184
 
         * Map in the region.
185
 
         *
186
 
         * XXX
187
 
         * We don't bother doing this "right", i.e., using the shalloc
188
 
         * functions, just grab some memory knowing that it's correctly
189
 
         * aligned.
190
 
         */
191
 
        _debug_check();
192
 
        if (__os_calloc(NULL, 1, sizeof(_MUTEX_DATA), &md) != 0)
193
 
                goto posixout;
194
 
        md->env = envp;
195
 
        md->n_mutex = nitems;
196
 
        md->size = sizeof(_MUTEX_ENTRY) * nitems;
197
 
 
198
 
        md->reginfo.type = REGION_TYPE_MUTEX;
199
 
        md->reginfo.id = INVALID_REGION_TYPE;
200
 
        md->reginfo.mode = mode;
201
 
        md->reginfo.flags = REGION_CREATE_OK | REGION_JOIN_OK;
202
 
        if ((ret = __db_r_attach(envp, &md->reginfo, md->size)) != 0)
203
 
                goto posixout;
204
 
        md->marray = md->reginfo.addr;
205
 
 
206
 
        /* Initialize a created region. */
207
 
        if (F_ISSET(&md->reginfo, REGION_CREATE))
208
 
                for (i = 0; i < nitems; i++) {
209
 
                        md->marray[i].val = 0;
210
 
                        if ((ret = __db_mutex_init_int(envp,
211
 
                            &md->marray[i].m, i, 0)) != 0)
212
 
                                goto posixout;
213
 
                }
214
 
        R_UNLOCK(envp, &md->reginfo);
215
 
 
216
 
        /*
217
 
         * Success.  Set up return.  Set up new info
218
 
         * and command widget for this mutex.
219
 
         */
220
 
        envip->i_envmutexid++;
221
 
        ip->i_parent = envip;
222
 
        _SetInfoData(ip, md);
223
 
        Tcl_CreateObjCommand(interp, newname,
224
 
            (Tcl_ObjCmdProc *)mutex_Cmd, (ClientData)md, NULL);
225
 
        res = Tcl_NewStringObj(newname, strlen(newname));
226
 
        Tcl_SetObjResult(interp, res);
227
 
 
228
 
        return (TCL_OK);
229
 
 
230
 
posixout:
231
 
        if (ret > 0)
232
 
                Tcl_PosixError(interp);
233
 
        result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mutex");
234
 
        _DeleteInfo(ip);
235
 
 
236
 
        if (md != NULL) {
237
 
                if (md->reginfo.addr != NULL)
238
 
                        (void)__db_r_detach(md->env,
239
 
                            &md->reginfo, F_ISSET(&md->reginfo, REGION_CREATE));
240
 
                __os_free(md->env, md);
241
 
        }
242
 
        return (result);
243
 
}
244
 
 
245
 
/*
246
 
 * mutex_Cmd --
247
 
 *      Implements the "mutex" widget.
248
 
 */
249
 
static int
250
 
mutex_Cmd(clientData, interp, objc, objv)
251
 
        ClientData clientData;          /* Mutex handle */
252
 
        Tcl_Interp *interp;             /* Interpreter */
253
 
        int objc;                       /* How many arguments? */
254
 
        Tcl_Obj *CONST objv[];          /* The argument objects */
255
 
{
256
 
        static char *mxcmds[] = {
257
 
                "close",
258
 
                "get",
259
 
                "getval",
260
 
                "release",
261
 
                "setval",
262
 
                NULL
263
 
        };
264
 
        enum mxcmds {
265
 
                MXCLOSE,
266
 
                MXGET,
267
 
                MXGETVAL,
268
 
                MXRELE,
269
 
                MXSETVAL
270
 
        };
271
 
        DB_ENV *dbenv;
272
 
        DBTCL_INFO *envip, *mpip;
273
 
        _MUTEX_DATA *mp;
274
 
        Tcl_Obj *res;
275
 
        int cmdindex, id, result, newval;
276
 
 
277
 
        Tcl_ResetResult(interp);
278
 
        mp = (_MUTEX_DATA *)clientData;
279
 
        mpip = _PtrToInfo((void *)mp);
280
 
        envip = mpip->i_parent;
281
 
        dbenv = envip->i_envp;
282
 
        result = TCL_OK;
283
 
 
284
 
        if (mp == NULL) {
285
 
                Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC);
286
 
                return (TCL_ERROR);
287
 
        }
288
 
        if (mpip == NULL) {
289
 
                Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC);
290
 
                return (TCL_ERROR);
291
 
        }
292
 
 
293
 
        /*
294
 
         * Get the command name index from the object based on the dbcmds
295
 
         * defined above.
296
 
         */
297
 
        if (Tcl_GetIndexFromObj(interp,
298
 
            objv[1], mxcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK)
299
 
                return (IS_HELP(objv[1]));
300
 
 
301
 
        res = NULL;
302
 
        switch ((enum mxcmds)cmdindex) {
303
 
        case MXCLOSE:
304
 
                if (objc != 2) {
305
 
                        Tcl_WrongNumArgs(interp, 1, objv, NULL);
306
 
                        return (TCL_ERROR);
307
 
                }
308
 
                _debug_check();
309
 
                (void)__db_r_detach(mp->env, &mp->reginfo, 0);
310
 
                res = Tcl_NewIntObj(0);
311
 
                (void)Tcl_DeleteCommand(interp, mpip->i_name);
312
 
                _DeleteInfo(mpip);
313
 
                __os_free(mp->env, mp);
314
 
                break;
315
 
        case MXRELE:
316
 
                /*
317
 
                 * Check for 1 arg.  Error if different.
318
 
                 */
319
 
                if (objc != 3) {
320
 
                        Tcl_WrongNumArgs(interp, 2, objv, "id");
321
 
                        return (TCL_ERROR);
322
 
                }
323
 
                result = Tcl_GetIntFromObj(interp, objv[2], &id);
324
 
                if (result != TCL_OK)
325
 
                        break;
326
 
                MUTEX_UNLOCK(dbenv, &mp->marray[id].m);
327
 
                res = Tcl_NewIntObj(0);
328
 
                break;
329
 
        case MXGET:
330
 
                /*
331
 
                 * Check for 1 arg.  Error if different.
332
 
                 */
333
 
                if (objc != 3) {
334
 
                        Tcl_WrongNumArgs(interp, 2, objv, "id");
335
 
                        return (TCL_ERROR);
336
 
                }
337
 
                result = Tcl_GetIntFromObj(interp, objv[2], &id);
338
 
                if (result != TCL_OK)
339
 
                        break;
340
 
                MUTEX_LOCK(dbenv, &mp->marray[id].m);
341
 
                res = Tcl_NewIntObj(0);
342
 
                break;
343
 
        case MXGETVAL:
344
 
                /*
345
 
                 * Check for 1 arg.  Error if different.
346
 
                 */
347
 
                if (objc != 3) {
348
 
                        Tcl_WrongNumArgs(interp, 2, objv, "id");
349
 
                        return (TCL_ERROR);
350
 
                }
351
 
                result = Tcl_GetIntFromObj(interp, objv[2], &id);
352
 
                if (result != TCL_OK)
353
 
                        break;
354
 
                res = Tcl_NewLongObj((long)mp->marray[id].val);
355
 
                break;
356
 
        case MXSETVAL:
357
 
                /*
358
 
                 * Check for 2 args.  Error if different.
359
 
                 */
360
 
                if (objc != 4) {
361
 
                        Tcl_WrongNumArgs(interp, 2, objv, "id val");
362
 
                        return (TCL_ERROR);
363
 
                }
364
 
                result = Tcl_GetIntFromObj(interp, objv[2], &id);
365
 
                if (result != TCL_OK)
366
 
                        break;
367
 
                result = Tcl_GetIntFromObj(interp, objv[3], &newval);
368
 
                if (result != TCL_OK)
369
 
                        break;
370
 
                mp->marray[id].val = newval;
371
 
                res = Tcl_NewIntObj(0);
372
 
                break;
373
 
        }
374
 
        /*
375
 
         * Only set result if we have a res.  Otherwise, lower
376
 
         * functions have already done so.
377
 
         */
378
 
        if (result == TCL_OK && res)
379
 
                Tcl_SetObjResult(interp, res);
380
 
        return (result);
381
 
}