/[webpac]/trunk2/openisis/tcl/openisistcl.c
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk2/openisis/tcl/openisistcl.c

Parent Directory Parent Directory | Revision Log Revision Log

Revision 337 - (hide annotations)
Thu Jun 10 19:22:40 2004 UTC (19 years, 10 months ago) by dpavlin
File MIME type: text/plain
File size: 57085 byte(s) 
new trunk for webpac v2
1 dpavlin 237 /*
2     openisis - an open implementation of the CDS/ISIS database
3     Version 0.8.x (patchlevel see file Version)
4     Copyright (C) 2001-2003 by Erik Grziwotz, erik@openisis.org
5    
6     This library is free software; you can redistribute it and/or
7     modify it under the terms of the GNU Lesser General Public
8     License as published by the Free Software Foundation; either
9     version 2.1 of the License, or (at your option) any later version.
10    
11     This library is distributed in the hope that it will be useful,
12     but WITHOUT ANY WARRANTY; without even the implied warranty of
13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14     Lesser General Public License for more details.
15    
16     You should have received a copy of the GNU Lesser General Public
17     License along with this library; if not, write to the Free Software
18     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19    
20     see README for more information
21     EOH */
22    
23     /*
24     $Id: openisistcl.c,v 1.77 2003/06/24 11:01:53 mawag Exp $
25     tcl/tk binding
26     */
27    
28    
29     #include "openisis.h"
30     #include "openisistcl.h"
31     #include "luti.h"
32     /* luti_getembed,
33     * luti_ptrincr,
34     * luti_parse_path,
35     * luti_free,
36     * luti_append
37     */
38     #include "ldsp.h" /* openIsisEnc2Utf8,openIsisEval */
39     #include "lses.h" /* SESGET() */
40    
41     /*
42     include this after the Tcl stuff for the benefit of those
43     who use the 150% braindead gcc 2.96
44     which barfs on
45     declaration of `index' shadows global declaration
46     in generic/tclDecls.h
47     cause string.h declares
48     char *index(const char *s, int c)
49     */
50     #include <errno.h>
51     #include <limits.h>
52     #include <stdio.h>
53     #include <stdlib.h>
54     #include <string.h>
55    
56     #ifdef WIN32
57     #define snprintf _snprintf
58     #endif
59    
60     /*
61     #ifdef _REENTRANT
62     unusable because of POSIX stdfoo.h braindamage
63     -- they mix up MT with reentrant.
64    
65     Hmm, actually, _REENTRANT *is* the wrong flag for threads.
66     But, unfortunately, the *thread* thing #define errno *errnolocation()
67     is bound to this flag by POSIX (mas o menos).
68     You need the reentrant functions in every stupid single threaded signal handler.
69     Therefore, it's a pretty poor idea of Solaris (albeit very POSIX compliant)
70     to not define them unless _REENTRANT.
71    
72     *sigh*
73    
74     from /opt/TclTk/tcl8.3.5/unix/configure:
75     SunOS-5.[0-6]*)
76    
77     # Note: If _REENTRANT isn't defined, then Solaris
78     # won't define thread-safe library routines.
79    
80     cat >> confdefs.h <<\EOF
81     #define _REENTRANT 1
82     EOF
83     */
84     #ifdef TCL_THREADS
85     extern int openisis_threaded;
86     static int *link_dummy = &openisis_threaded; /* force correct linkage */
87     #endif
88    
89    
90     /* ============================ types ==================================
91     */
92    
93     /* name of local schema */
94     #define OIT_STB0 "openIsisRoot"
95    
96     typedef enum {
97     /* record commands */
98     RC_ADD,
99     RC_CLON,
100     RC_COPY,
101     RC_DB, /* stub, too */
102     RC_DEL,
103     RC_DESER,
104     RC_DO,
105     RC_DONE, /* stub, too */
106     RC_FDT, /* stub, too */
107     RC_FMT,
108     RC_GET,
109     RC_ROW,
110     RC_LEN,
111     RC_SERI,
112     RC_SET,
113     RC_WRAP,
114     RC_LAST = RC_WRAP, /* used for checking last rec cmd */
115     /* stub commands */
116     SC_NEW,
117     SC_RECV,
118     SC_RQS,
119     SC_ARQS,
120     SC_ARSP
121     } OITCmd;
122    
123     static const char *OITOpts[] = {
124     /* record commands */
125     "add",
126     "clone",
127     "copy",
128     "db",
129     "delete",
130     "deserialize",
131     "do",
132     "done",
133     "fdt",
134     "format",
135     "get",
136     "rowid",
137     "length",
138     "serialize",
139     "set",
140     "wrap",
141     /* stub commands */
142     "new",
143     "recv",
144     "request",
145     ".req",
146     ".res",
147     0
148     };
149    
150     #define OIT_RS_SZM 0x000FF /* size mask */
151     #define OIT_RS_RQS 0x00100 /* schemas request rec */
152     #define OIT_RS_RSP 0x00200 /* schemas response rec */
153     #define OIT_RS_STC 0x00400 /* schemas config rec */
154     #define OIT_RS_DBC 0x00800 /* db config rec */
155     #define OIT_RS_DBF 0x01000 /* db fdt rec */
156     #define OIT_RS_USED 0x10000 /* rec is in use */
157     #define OIT_RS_FRE 0x20000 /* free associated memory */
158     #define OIT_RS_OWNF 0x40000 /* record has own fdt that must be freed */
159    
160     #define RecType(r) (0x01F00 & (r)->stat)
161     #define NonWritable(r) (0x01A00 & (r)->stat)
162     #define NonDeletable(r) (0x00700 & (r)->stat)
163    
164     typedef struct OITSess OITSess;
165    
166     typedef struct {
167     OpenIsisRec *rec;
168     OpenIsisDb *db; /* own db; tmp set to target db in rqs */
169     const OpenIsisFdt *fdt; /* own fdt */
170     const char *cmd; /* associated tcl ip cmd */
171     int sid; /* allocator */
172     int stat;
173     } OITRec;
174    
175     #define RecSess(r) \
176     (0 <= ((OITRec*)(r))->sid && NumSessions > ((OITRec*)(r))->sid ? \
177     Sessions + ((OITRec*)(r))->sid : 0)
178    
179     typedef struct {
180     OITRec env;
181     OpenIsisStub stb;
182     OITRec **recs; /* embedded recs */
183     int numr;
184     } OITCont;
185    
186     #define OIT_ST_ROOT 0x0001
187     #define OIT_ST_TCL 0x0002
188     #define OIT_ST_OINIT 0x0004
189    
190     typedef struct {
191     OpenIsisStub stb;
192     OITRec cfg; /* direct schema copy allocated by ses0 */
193     OITCont *rqs;
194     OITCont *rsp;
195     const char *cmd; /* associated tcl ip cmd */
196     Tcl_Obj *dfltproc;
197     Tcl_Obj *actproc;
198     int ases; /* act session of rqs and rsp */
199     int stat;
200     } OITStub;
201    
202     #define StbSess(s) (0 <= (s)->ases && NumSessions > (s)->ases ? \
203     Sessions + (s)->ases : 0)
204    
205     struct OITSess {
206     Tcl_Interp *ip;
207     OITRec **recs;
208     int numr;
209     int six;
210     };
211    
212     static OITSess *Sessions = 0;
213     static int NumSessions = 0;
214    
215     /* ============================ records ================================
216     */
217    
218     #define OIT_RECINCR 32
219     #define OIT_MAXRECS 65535
220     #define OIT_SESSINCR 1
221     #define OIT_MAXSESS 255
222    
223     static void CtorRec (OITRec *that, int sid, int siz) {
224     memset (that, 0, (unsigned)siz);
225     that->stat = siz;
226     that->sid = sid;
227     }
228    
229     static int AllcRec (OITSess *ois, int siz, int type) {
230     int j;
231     if (siz > OIT_RS_SZM) {
232     return openIsisSMsg (OPENISIS_ERR_TRASH,
233     "[openIsisTcl] AllcRec: unexpected size %d", siz);
234     }
235     for (j = ois->numr; 0 <= --j; ) {
236     if (! ois->recs[j]) {
237     goto allcj;
238     }
239     if (! (OIT_RS_USED & ois->recs[j]->stat) &&
240     siz == (OIT_RS_SZM & ois->recs[j]->stat) /* may be <= */
241     ) {
242     goto done;
243     }
244     }
245     j = luti_ptrincr (
246     &ois->recs, &ois->numr, OIT_RECINCR, sizeof (OITRec*), OIT_MAXRECS);
247     if (0 > j) {
248     return openIsisSMsg (OPENISIS_ERR_TRASH,
249     "[openIsisTcl] AllcRec: out of memory");
250     }
251     allcj:
252     ois->recs[j] = (OITRec*) openIsisMAlloc (siz);
253     if (! ois->recs[j]) {
254     return openIsisSMsg (OPENISIS_ERR_TRASH,
255     "[openIsisTcl] AllcRec: out of memory");
256     }
257     CtorRec (ois->recs[j], ois->six, siz);
258     done:
259     ois->recs[j]->stat |= type | OIT_RS_USED;
260     return j;
261     }
262    
263     static int NewRec (
264     OITSess *ois, OpenIsisDb *db, const OpenIsisFdt *fdt, int type
265     ) {
266     int j = AllcRec (ois, sizeof (OITRec), type);
267     if (0 <= j) {
268     ois->recs[j]->db = db;
269     ois->recs[j]->fdt = fdt;
270     }
271     return j;
272     }
273    
274     static int NewCont (OITSess *ois, const OpenIsisFdt *fdt, int type) {
275     int j = AllcRec (ois, sizeof (OITCont), type);
276     if (0 <= j) {
277     ois->recs[j]->fdt = fdt;
278     }
279     return j;
280     }
281    
282     static void DtorRecs (OITRec **recs, int numr, int frmem);
283    
284     static void DtorRec (OITRec *that, int frmem) {
285     if (that) {
286     OITCont *con;
287     OITSess *ois;
288     int siz, type;
289     ois = RecSess (that);
290     if (! ois) {
291     openIsisSMsg (OPENISIS_ERR_TRASH,
292     "[openIsisTcl] DtorRec: illegal sid %d(%d)",
293     that->sid, NumSessions);
294     return;
295     }
296     if (that->cmd) {
297     if (frmem) {
298     that->stat |= OIT_RS_FRE;
299     }
300     Tcl_DeleteCommand (ois->ip, (char*)that->cmd);
301     return;
302     }
303     type = RecType (that);
304     siz = OIT_RS_SZM & that->stat;
305     switch (type) {
306     case 0:
307     case OIT_RS_DBF:
308     if (that->rec) {
309     openIsisMFree (that->rec);
310     }
311     break;
312     case OIT_RS_DBC:
313     /* that->rec = 0; readonly cfg handled by db */
314     break;
315     case OIT_RS_RQS:
316     if (that->rec) {
317     openIsisMFree (that->rec);
318     }
319     /* fall thru */
320     case OIT_RS_RSP:
321     /* that->rec = 0; response record handled by stub */
322     con = (OITCont*)that;
323     DtorRecs (con->recs, con->numr, 0);
324     break;
325     default:
326     /* OIT_RS_STC embedded in OITStub and handled by stub */
327     openIsisSMsg (OPENISIS_ERR_TRASH,
328     "[openIsisTcl] DtorRec: unexpected type %x", type);
329     return;
330     }
331     if ((OIT_RS_OWNF & that->stat)) {
332     openIsisFFree ((OpenIsisFdt*)that->fdt);
333     }
334     if (frmem || (OIT_RS_FRE & that->stat)) {
335     openIsisMFree (that);
336     }
337     else {
338     CtorRec (that, ois->six, siz);
339     }
340     }
341     }
342    
343     static void DtorRecs (OITRec **recs, int numr, int frmem) {
344     if (recs) {
345     while (0 <= --numr) {
346     DtorRec (recs[numr], frmem);
347     }
348     openIsisMFree (recs);
349     }
350     }
351    
352     static int CtorSess (Tcl_Interp *ip) {
353     int j = luti_ptrincr (
354     &Sessions, &NumSessions, OIT_SESSINCR, sizeof (OITSess), OIT_MAXSESS);
355     if (0 > j) {
356     return -1;
357     }
358     Sessions[j].ip = ip;
359     Sessions[j].six = j;
360     return j;
361     }
362    
363     static void DtorSess (OITSess *that) {
364     DtorRecs (that->recs, that->numr, !0);
365     }
366    
367     static void ExitSess () {
368     int j;
369     if (NumSessions) {
370     for (j = NumSessions; 0 <= --j; ) {
371     DtorSess (Sessions + j);
372     }
373     openIsisMFree (Sessions);
374     Sessions = 0;
375     NumSessions = 0;
376     }
377     }
378    
379     /* ---------------------------------------------------------------------
380     */
381    
382     static unsigned _RecId = 0;
383    
384     static char* NewRecId (char *buf) {
385     sprintf (buf, "openIsisRec%u", ++_RecId);
386     return buf;
387     }
388    
389     static void TclDelRec (ClientData cld) {
390     OITRec *that = (OITRec*)cld;
391     if (that->cmd) {
392     openIsisMFree ((void*)that->cmd);
393     that->cmd = 0;
394     }
395     DtorRec ((OITRec*)cld, 0);
396     }
397    
398     static int CmdRec (
399     ClientData rid, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
400     );
401    
402     static int CrtRecCmd (OITSess *ois, const char *name, OITRec *rec, int srst) {
403     char buf[64];
404     if (! name || ! *name) {
405     name = NewRecId (buf);
406     }
407     rec->cmd = (const char*) openIsisMDup (name, -1);
408     if (! rec->cmd) {
409     Tcl_AppendResult (ois->ip, "CrtRecCmd: out of memory", 0);
410     return TCL_ERROR;
411     }
412     Tcl_CreateObjCommand (ois->ip, (char*)name, &CmdRec, rec, &TclDelRec);
413     if (srst) {
414     Tcl_SetResult (ois->ip, (char*)name, TCL_VOLATILE);
415     }
416     return TCL_OK;
417     }
418    
419     static char **ToArgv (
420     Tcl_Obj* const objv[], int objc, char* buf, int siz
421     ) {
422     char *str, *nb;
423     char *res = buf;
424     int posp = 0;
425     int stav = objc * sizeof (char*);
426     int posv = stav;
427     int j, len, nsz;
428     for (j = 0; objc > j; ++j) {
429     str = Tcl_GetStringFromObj (objv[j], &len);
430     nsz = posv + 1 + len;
431     if (siz < nsz) {
432     char **S, **T;
433     int k, diff;
434     nsz *= 2;
435     nb = (char*) openIsisMAlloc (nsz);
436     if (! nb) {
437     openIsisSMsg (OPENISIS_ERR_NOMEM,
438     "[openIsisTcl] ToArgv: out of memory");
439     return 0;
440     }
441     diff = nb - res;
442     for (k = j, S = (char**)res, T = (char**)nb ; 0 <= --k; ) {
443     *T++ = *S++ + diff;
444     }
445     memcpy (nb + stav, res + stav, (unsigned)(posv - stav));
446     if (res != buf) {
447     openIsisMFree (res);
448     }
449     siz = nsz;
450     res = nb;
451     }
452     *(char**)(res + posp) = res + posv;
453     ((char*) memcpy (res + posv, str, len)) [len] = 0;
454     posp += sizeof (char*);
455     posv += 1 + len;
456     }
457     return (char**)res;
458     }
459    
460     static OITRec* TclCmd2Rec (
461     Tcl_Interp *ip, const char *cmd, const char *arg0
462     ) {
463     Tcl_CmdInfo info;
464     if (! cmd) {
465     if (arg0) {
466     Tcl_AppendResult (ip, arg0, ": record command not given", 0);
467     }
468     return 0;
469     }
470     if (! Tcl_GetCommandInfo (ip, cmd, &info)) {
471     if (arg0) {
472     Tcl_AppendResult (ip, arg0, ": no such record: ", cmd, 0);
473     }
474     return 0;
475     }
476     if (info.objProc != &CmdRec) {
477     if (arg0) {
478     Tcl_AppendResult (ip, arg0, ": ", cmd, " is not a record", 0);
479     }
480     return 0;
481     }
482     if (! info.objClientData) {
483     if (arg0) {
484     Tcl_AppendResult (ip, arg0, ": ", cmd, " is corrupted", 0);
485     }
486     return 0;
487     }
488     return (OITRec*) info.objClientData;
489     }
490    
491     static int BuildEmbRecs (
492     OITCont *that, OpenIsisRec **recs, int numr, int frr
493     ) {
494     OITSess *ois;
495     OITRec **oirs;
496     int buf[1000];
497     int *idx = buf;
498     int j;
499     ois = RecSess (that);
500     if (! ois) {
501     return openIsisSMsg (OPENISIS_ERR_TRASH,
502     "[openIsisTcl] BuildEmbRecs: illegal sid %d(%d)",
503     that->env.sid, NumSessions);
504     }
505     oirs = (OITRec**) openIsisMAlloc ( (int) (numr * sizeof (OITRec*)));
506     if (! oirs) {
507     if (frr) {
508     luti_free ((void**)recs, numr);
509     }
510     return openIsisSMsg (OPENISIS_ERR_NOMEM,
511     "[openIsisTcl] BuildEmbRecs(%d): out of memory", numr);
512     }
513     if (1000 < numr) {
514     idx = (int*) openIsisMAlloc ( (int) (numr * sizeof (int)));
515     if (! idx) {
516     if (frr) {
517     luti_free ((void**)recs, numr);
518     }
519     openIsisMFree (oirs);
520     return openIsisSMsg (OPENISIS_ERR_NOMEM,
521     "[openIsisTcl] BuildEmbRecs(%d): out of memory", numr);
522     }
523     }
524     for (j = numr; 0 <= --j; ) {
525     idx[j] = NewRec (ois, 0, 0, 0);
526     if (0 > idx[j]) {
527     if (frr) {
528     luti_free ((void**)recs, numr);
529     }
530     openIsisMFree (oirs);
531     if (idx != buf) {
532     openIsisMFree (idx);
533     }
534     return openIsisSMsg (OPENISIS_ERR_NOMEM,
535     "[openIsisTcl] BuildEmbRecs(%d): out of memory", numr);
536     }
537     }
538     for (j = numr; 0 <= --j; ) {
539     oirs[j] = ois->recs[idx[j]];
540     oirs[j]->rec = recs[j];
541     }
542     that->recs = oirs;
543     that->numr = numr;
544     if (idx != buf) {
545     openIsisMFree (idx);
546     }
547     if (frr) {
548     openIsisMFree (recs);
549     }
550     return numr;
551     }
552    
553     static int BuildRqsRecs (OITCont *that) {
554     OpenIsisRec *recs[4] = { 0, 0, 0, 0 }; /* REC, IDX, CFG, fdt */
555     int numr;
556     numr = BuildEmbRecs (that, recs, 4, 0);
557     if (4 == numr) {
558     if ((that->recs[0]->db = that->env.db)) {
559     that->recs[0]->fdt = that->env.db->fdt;
560     }
561     that->recs[2]->fdt = openIsisFdtDbpar;
562     that->recs[3]->fdt = openIsisFdtFdt;
563     }
564     return numr;
565     }
566    
567     static int BuildRspRecs (OITCont *that, Tcl_Interp *ip, const char *arg0) {
568     OpenIsisRec **recs;
569     OpenIsisDb *db;
570     int *rows; /* save rowid in recs */
571     int numr, j;
572     numr = openIsisNGetResult (that->stb, &rows, &recs, &db, 0);
573     if (0 > numr) {
574     Tcl_AppendResult (ip, arg0,
575     ": child allocation failure", 0);
576     return numr;
577     }
578     if (rows) {
579     openIsisMFree (rows);
580     }
581     if (0 == numr || ! recs) {
582     return 0;
583     }
584     j = BuildEmbRecs (that, recs, numr, !0);
585     if (j != numr) {
586     Tcl_AppendResult (ip, arg0,
587     ": child allocation failure", 0);
588     return j;
589     }
590     if (db) {
591     for (j = numr; 0 <= --j; ) {
592     that->recs[j]->db = db;
593     that->recs[j]->fdt = db->fdt;
594     }
595     }
596     return numr;
597     }
598    
599     static int UsageRec (Tcl_Interp *ip, const char *arg0) {
600     if (! arg0) {
601     arg0 = "<openIsisRecord>";
602     }
603     Tcl_AppendResult (ip,
604     "usage: ", arg0,
605     " add field value ?field value ...? |",
606     " clone ?options? newname ?field value ...? |",
607     " copy source |",
608     " db ?options? |",
609     " delete ?field ...? |",
610     " deserialize line |",
611     " do ?tagvar? valvar body |",
612     " done |",
613     " fdt ?options? |",
614     " format ?options? format |",
615     " get ?-tags | -tagnames | field ...? |",
616     " rowid |",
617     " serialize |",
618     " set field ?value field value ...? |",
619     " wrap ?options? recname |",
620     " .path ?option arg ...?",
621     0);
622     return TCL_ERROR;
623     }
624    
625     static int OpPath (
626     OITRec *that, Tcl_Interp *ip, const char *arg0,
627     Tcl_Obj *arg1, int argc, Tcl_Obj* const argv[]
628     );
629    
630     static int OpDb (Tcl_Interp *ip,
631     OITSess *ois, OpenIsisDb *db, int argc, Tcl_Obj* const argv[]
632     ) {
633     OITRec *oir;
634     int rt;
635     rt = NewRec (ois, 0, openIsisFdtDbpar, OIT_RS_DBC);
636     if (0 > rt) {
637     Tcl_AppendResult (ip, "openIsisDb: out of memory", 0);
638     return TCL_ERROR;
639     }
640     oir = ois->recs[rt];
641     oir->rec = db->cfg;
642     if (argc) {
643     rt = OpPath (oir, ip, "openIsisDb", argv[0], argc - 1, argv + 1);
644     DtorRec (oir, 0);
645     return rt;
646     }
647     return CrtRecCmd (ois, 0, oir, !0);
648     }
649    
650     static int OpFdt (Tcl_Interp *ip,
651     OITSess *ois, const OpenIsisFdt *fdt, int argc, Tcl_Obj* const argv[]
652     ) {
653     OITRec *oir;
654     int rt;
655     rt = NewRec (ois, 0, openIsisFdtFdt, OIT_RS_DBF);
656     if (0 > rt) {
657     Tcl_AppendResult (ip, "openIsisFdt: out of memory", 0);
658     return TCL_ERROR;
659     }
660     oir = ois->recs[rt];
661     oir->rec = openIsisFFdt2Rec (fdt, 0, 0);
662     if (argc) {
663     rt = OpPath (oir, ip, "openIsisFdt", argv[0], argc - 1, argv + 1);
664     DtorRec (oir, 0);
665     return rt;
666     }
667     return CrtRecCmd (ois, 0, oir, !0);
668     }
669    
670     #define FldObj( f ) Tcl_NewStringObj( (f)->val, (f)->len )
671    
672     static Tcl_Obj* FdObj (OpenIsisField *fld, const OpenIsisFdt *fdt) {
673     if (fdt) {
674     OpenIsisFd *fd = openIsisFById (fdt, fld->tag, 0);
675     if (fd) {
676     return Tcl_NewStringObj (fd->name, -1);
677     }
678     }
679     return Tcl_NewIntObj (fld->tag);
680     }
681    
682     static int OpRec (
683     OITRec *that, Tcl_Interp *ip, const char *arg0,
684     const OITCmd cmd, int argc, Tcl_Obj* const argv[]
685     ) {
686     OITSess *ois = RecSess (that);
687     if (! ois) {
688     Tcl_AppendResult (ip, arg0, ": record corrupted", 0);
689     return TCL_ERROR;
690     }
691    
692     switch (cmd) {
693    
694     case RC_SET:
695     case RC_ADD: {
696     char buf[2048];
697     OpenIsisRec *oldrec;
698     char **argp = 0;
699     char **args = 0;
700     int setf = 0;
701     int len;
702     if (0 == argc) {
703     return UsageRec (ip, arg0);
704     }
705     if (RC_SET == cmd) {
706     if (1 == argc) {
707     goto op_get;
708     }
709     if ( that->rec ) {
710     setf = OPENISIS_RCHG;
711     }
712     }
713     if (NonWritable (that)) {
714     Tcl_AppendResult (ip, arg0, ": readonly record", 0);
715     return TCL_ERROR;
716     }
717     args = argp = ToArgv (argv, argc, buf, sizeof (buf));
718     if (! argp) {
719     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
720     return TCL_ERROR;
721     }
722     while (argc) {
723     if ('-' != args[0][0]) {
724     break;
725     }
726     len = strlen (args[0]);
727     if (1 == len || '-' == args[0][1]) {
728     break;
729     }
730     if (0 == strncmp ("-ignore", args[0], len)) {
731     setf |= OPENISIS_RIGN;
732     ++args;
733     --argc;
734     continue;
735     }
736     if (RC_SET != cmd) {
737     break;
738     }
739     if (0 == strncmp ("-default", args[0], len)) {
740     setf = OPENISIS_RDFLT | (OPENISIS_RIGN & setf);
741     ++args;
742     --argc;
743     continue;
744     }
745     break;
746     }
747     oldrec = that->rec;
748     that->rec = openIsisRSet (oldrec,
749     OPENISIS_RARGV | OPENISIS_RFDT | OPENISIS_RDIS | setf | argc,
750     that->fdt, args);
751     if (argp != (char**)buf) {
752     openIsisMFree (argp);
753     }
754     if (! that->rec && (oldrec || (argc && !(OPENISIS_RIGN & setf)))) {
755     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
756     return TCL_ERROR;
757     }
758     return TCL_OK;
759     } /* RC_SET, RC_ADD */
760    
761     case RC_CLON: {
762     char buf[64];
763     OITRec *nrec;
764     char *opt = 0;
765     char *name = 0;
766     int empty = 0;
767     int nn = 0;
768     int j, len, rt, id;
769     if ((OIT_RS_RQS | OIT_RS_RSP) & that->stat) {
770     Tcl_AppendResult (ip, arg0,
771     ": container cloning not allowed", 0);
772     return TCL_ERROR;
773     }
774     for (j = 0; argc > j; ++j) {
775     opt = Tcl_GetStringFromObj (argv[j], &len);
776     if (0 == len) {
777     return UsageRec (ip, arg0);
778     }
779     if ('-' != *opt) {
780     break;
781     }
782     if (0 == opt[1]) {
783     nn = !0;
784     ++j;
785     break;
786     }
787     if (0 == strncmp ("-empty", opt, len)) {
788     empty = !0;
789     continue;
790     }
791     return UsageRec (ip, arg0);
792     }
793     if (argc > j && ! nn) {
794     name = Tcl_GetStringFromObj (argv[j], &len);
795     if (0 == len) {
796     return UsageRec (ip, arg0);
797     }
798     ++j;
799     }
800     if (! name) {
801     name = NewRecId (buf);
802     }
803     id = NewRec (ois, that->db, that->fdt, 0);
804     if (0 > id) {
805     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
806     return TCL_ERROR;
807     }
808     nrec = ois->recs[id];
809     if (! empty) {
810     nrec->rec = openIsisRDup (that->rec, 0, 0);
811     }
812     if (argc > j) {
813     rt = OpRec (nrec,
814     ip, name, RC_SET, argc - j, argv + j);
815     if (TCL_OK != rt) {
816     return rt;
817     }
818     }
819     rt = CrtRecCmd (ois, name, ois->recs[id], !0);
820     return rt;
821     } /* RC_CLON */
822    
823     case RC_COPY: {
824     char buf[64];
825     OITRec *src;
826     Field *fld;
827     int j;
828     if (1 != argc) {
829     return UsageRec (ip, arg0);
830     }
831     src = TclCmd2Rec (ip, Tcl_GetStringFromObj (argv[0], 0), arg0);
832     if (! src) {
833     return TCL_ERROR;
834     }
835     if (! src->rec || ! src->rec->len) {
836     Tcl_SetResult (ip, "0", TCL_STATIC);
837     return TCL_OK;
838     }
839     fld = src->rec->field;
840     j = src->rec->len;
841     sprintf (buf, "%d", j);
842     Tcl_SetResult (ip, buf, TCL_VOLATILE);
843     while (j) {
844     OPENISIS_RADD (that->rec, fld->tag, fld->val, fld->len, !0);
845     ++fld;
846     --j;
847     }
848     return TCL_OK;
849     } /* RC_COPY */
850    
851     case RC_DB:
852     if (! that->db) {
853     Tcl_AppendResult (ip, arg0, ": no db", 0);
854     return TCL_ERROR;
855     }
856     return OpDb (ip, ois, that->db, argc, argv);
857    
858     case RC_DEL: {
859     if (NonWritable (that)) {
860     Tcl_AppendResult (ip, arg0, ": readonly record", 0);
861     return TCL_ERROR;
862     }
863     if (argc) {
864     char buf[2048];
865     char **argp = ToArgv (argv, argc, buf, sizeof (buf));
866     if (! argp) {
867     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
868     return TCL_ERROR;
869     }
870     that->rec = openIsisRSet (that->rec,
871     OPENISIS_RARGV | OPENISIS_RFDT | OPENISIS_RDEL | argc,
872     that->fdt, argp);
873     if (argp != (char**)buf) {
874     openIsisMFree (argp);
875     }
876     return TCL_OK;
877     }
878     if (that->rec) {
879     OPENISIS_CLRREC( that->rec );
880     }
881     if (OIT_RS_RQS == RecType (that)) {
882     OITCont *con = (OITCont*)that;
883     if (con->numr) {
884     DtorRecs (con->recs, con->numr, 0);
885     con->numr = 0;
886     con->recs = 0;
887     }
888     }
889     return TCL_OK;
890     } /* RC_DEL */
891    
892     case RC_DO: {
893     Tcl_Obj *tagvar = 0;
894     Tcl_Obj *valvar;
895     Tcl_Obj *tag = 0;
896     Tcl_Obj *val;
897     Tcl_Obj *body;
898     OpenIsisField *f;
899     int i, rt;
900     if ( 2 > argc )
901     return UsageRec (ip, arg0);
902     body = argv[--argc];
903     valvar = argv[--argc];
904     if ( 1 == argc )
905     tagvar = argv[0];
906     #ifndef DONTREUSE
907     /* prepare object for var */
908     if ( ! Tcl_ObjSetVar2( ip, valvar, 0,
909     val = Tcl_NewObj(), TCL_LEAVE_ERR_MSG )
910     )
911     return TCL_ERROR;
912     if ( tagvar && ! Tcl_ObjSetVar2( ip, tagvar, 0,
913     tag = Tcl_NewIntObj(0), TCL_LEAVE_ERR_MSG )
914     )
915     return TCL_ERROR;
916     #endif
917    
918     /* go loop */
919     rt = TCL_OK;
920     for ( i = that->rec->len, f = that->rec->field; i--; f++ ) {
921     #ifndef DONTREUSE
922     /*
923     if somebody shares the object, we have to set a new one
924     (or Tcl_SetStringObj will panic).
925     if it's not owned by the var, it's either owned by someone else
926     or nobody, i.e. deleted
927     */
928     if ( val == Tcl_ObjGetVar2( ip, valvar, 0, TCL_LEAVE_ERR_MSG )
929     && !Tcl_IsShared( val )
930     )
931     Tcl_SetStringObj( val, (char*)f->val, f->len );
932     else
933     #endif
934     if ( !Tcl_ObjSetVar2( ip, valvar, 0,
935     val = FldObj( f ), TCL_LEAVE_ERR_MSG )
936     )
937     return TCL_ERROR;
938     if ( tagvar ) {
939     #ifndef DONTREUSE
940     if ( tag == Tcl_ObjGetVar2( ip, tagvar, 0, TCL_LEAVE_ERR_MSG )
941     && !Tcl_IsShared( tag )
942     )
943     Tcl_SetIntObj( tag, f->tag );
944     else
945     #endif
946     if ( !Tcl_ObjSetVar2( ip, tagvar, 0,
947     tag = Tcl_NewIntObj( f->tag ), TCL_LEAVE_ERR_MSG )
948     )
949     return TCL_ERROR;
950     } /* tagvar */
951     switch (rt = Tcl_EvalObjEx( ip, body, 0 )) {
952     case TCL_CONTINUE:
953     rt = TCL_OK;
954     case TCL_OK:
955     continue;
956     case TCL_BREAK:
957     rt = TCL_OK;
958     case TCL_RETURN:
959     case TCL_ERROR:
960     default:
961     return rt;
962     }
963     }
964     return rt;
965     } /* RC_DO */
966    
967     case RC_DONE: {
968     if (! that->cmd) {
969     Tcl_AppendResult (ip, arg0, ": no command bound to rec", 0);
970     return TCL_ERROR;
971     }
972     if (strcmp (that->cmd, arg0)) {
973     Tcl_AppendResult (ip, arg0, ": command mismatch: ", that->cmd, 0);
974     return TCL_ERROR;
975     }
976     if (NonDeletable (that)) {
977     Tcl_AppendResult (ip, arg0, ": record not deletable", 0);
978     return TCL_ERROR;
979     }
980     Tcl_DeleteCommand (ip, (char*)arg0);
981     return TCL_OK;
982     } /* RC_DONE */
983    
984     case RC_FDT:
985     if (! that->fdt) {
986     Tcl_AppendResult (ip, arg0, ": no fdt", 0);
987     return TCL_ERROR;
988     }
989     return OpFdt (ip, ois, that->fdt, argc, argv);
990    
991     case RC_FMT: {
992     Tcl_AppendResult (ip, arg0, ": sorry, format not implemented yet", 0);
993     return TCL_ERROR;
994     } /* RC_FMT */
995    
996     case RC_GET:
997     op_get: {
998     OpenIsisField *fld;
999     const char *path, *rem;
1000     int tag, occ, i, j, objc, len, reclen;
1001     int witht = 0;
1002     int usedf = !0;
1003     Tcl_Obj *list, *dflt, *val;
1004     Tcl_Obj **objv;
1005    
1006     Tcl_ResetResult (ip);
1007     reclen = that->rec ? that->rec->len : 0;
1008     list = val = 0;
1009     if (1 == argc) {
1010     path = Tcl_GetStringFromObj (argv[0], &i);
1011     if (3 < i && *path == '-') {
1012     if (0 == strncmp ("-tags", path, i)) {
1013     --argc;
1014     witht = 1;
1015     }
1016     else if (0 == strncmp ("-tagnames", path, i)) {
1017     --argc;
1018     witht = 2;
1019     }
1020     }
1021     }
1022     if (! argc) {
1023     list = Tcl_NewListObj( 0, 0 );
1024     if (reclen) {
1025     for (i = reclen, fld = that->rec->field; i--; fld++) {
1026     if (witht) {
1027     if (TCL_OK != Tcl_ListObjAppendElement (ip, list,
1028     FdObj (fld, 2 == witht ? that->fdt : 0))) {
1029     goto geterr;
1030     }
1031     }
1032     if (TCL_OK != Tcl_ListObjAppendElement (ip, list,
1033     FldObj (fld))) {
1034     goto geterr;
1035     }
1036     }
1037     }
1038     Tcl_SetObjResult( ip, list );
1039     return TCL_OK;
1040     }
1041     for (j = 0; argc > j; ) {
1042     path = Tcl_GetStringFromObj (argv[j], &len);
1043     if (3 <= len &&
1044     '-' == *path &&
1045     0 == strncmp ("-nodefaults", path, len)) {
1046     usedf = 0;
1047     ++j;
1048     continue;
1049     }
1050     val = dflt = 0;
1051     if (usedf &&
1052     TCL_OK ==
1053     Tcl_ListObjGetElements (0, argv[j], &objc, &objv) &&
1054     2 == objc
1055     ) {
1056     path = Tcl_GetStringFromObj (objv[0], 0);
1057     dflt = objv[1];
1058     }
1059     rem = luti_parse_path (path, that->fdt, 0, &tag, &occ);
1060     if (! rem || *rem) {
1061     Tcl_ResetResult (ip);
1062     Tcl_AppendResult (ip, arg0,
1063     ": no such path: ", path, 0);
1064     goto geterr;
1065     }
1066     if (reclen) {
1067     if ( 0 > occ ) {
1068     for ( i = reclen, fld = that->rec->field;
1069     i--;
1070     fld++ ) {
1071     if ( tag == fld->tag ) {
1072     if (! val) {
1073     val = Tcl_NewListObj (0, 0);
1074     }
1075     if (TCL_OK != Tcl_ListObjAppendElement (
1076     ip, val, FldObj(fld))) {
1077     goto geterr;
1078     }
1079     }
1080     }
1081     }
1082     else { /* specific occ wanted */
1083     fld = openIsisROccurence (that->rec, tag, occ);
1084     if (fld) {
1085     val = FldObj(fld);
1086     }
1087     }
1088     }
1089     if (! val) {
1090     if (! dflt) {
1091     Tcl_ResetResult (ip);
1092     Tcl_AppendResult (ip, arg0,
1093     ": no such field: ", path, 0);
1094     goto geterr;
1095     }
1096     /* don't force a list even for empty default
1097     -- take the default as list.
1098     A literal default foo IS the list containing foo.
1099     If you REALLY wan't a list with one empty element as default,
1100     you can explicitly specify one.
1101     if (0 > occ) {
1102     Tcl_Obj *tmp[1];
1103     tmp[0] = dflt;
1104     val = Tcl_NewListObj (1, tmp);
1105     } else
1106     */
1107     val = dflt;
1108     }
1109     if (++j >= argc) {
1110     if (! list) {
1111     Tcl_SetObjResult( ip, val );
1112     return TCL_OK;
1113     }
1114     if (TCL_OK != Tcl_ListObjAppendElement(ip, list, val)) {
1115     goto geterr;
1116     }
1117     break;
1118     }
1119     if (! list) {
1120     list = Tcl_NewListObj( 0, 0 );
1121     }
1122     if (TCL_OK != Tcl_ListObjAppendElement(ip, list, val)) {
1123     goto geterr;
1124     }
1125     }
1126     if (! list) {
1127     return UsageRec (ip, arg0);
1128     }
1129     Tcl_SetObjResult( ip, list );
1130     return TCL_OK;
1131     geterr:
1132     /* free */
1133     if (val) {
1134     Tcl_DecrRefCount (val);
1135     }
1136     if (list) {
1137     Tcl_DecrRefCount( list );
1138     }
1139     return TCL_ERROR;
1140     } /* RC_GET */
1141    
1142     case RC_ROW:
1143     Tcl_SetObjResult( ip, Tcl_NewIntObj(
1144     (that->rec && 0<that->rec->rowid) ? that->rec->rowid : 0
1145     ) );
1146     return TCL_OK;
1147    
1148     case RC_LEN:
1149     Tcl_SetObjResult( ip, Tcl_NewIntObj(
1150     (that->rec && 0<that->rec->len) ? that->rec->len : 0
1151     ) );
1152     return TCL_OK;
1153    
1154     case RC_SERI: {
1155     char buf[2048];
1156     char *b;
1157     int len;
1158    
1159     if (! that->rec) {
1160     Tcl_ResetResult (ip);
1161     return TCL_OK;
1162     }
1163     len = sizeof (buf);
1164     b = openIsisRSerializeAlloc (that->rec, buf, &len);
1165     if (! b) {
1166     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1167     return TCL_ERROR;
1168     }
1169     /* do NOT include the final blankline */
1170     Tcl_SetObjResult( ip, Tcl_NewStringObj( b, len-1 ) );
1171     /*
1172     faster, but not allowed :(
1173     Tcl_Obj *ret = Tcl_NewStringObj(0,0);
1174     Tcl_SetObjLength( ret, that->rec->used );
1175     Tcl_SetObjLength( ret, openIsisRSerialize( ret->bytes, that->rec ) );
1176     */
1177     if ( buf != b )
1178     mFree( b );
1179     return TCL_OK;
1180     } /* RC_SERI */
1181    
1182     case RC_DESER: {
1183     char *b;
1184     int len;
1185    
1186     if ( 1 != argc )
1187     return UsageRec (ip, arg0);
1188     if (NonWritable (that)) {
1189     Tcl_AppendResult (ip, arg0, ": readonly record", 0);
1190     return TCL_ERROR;
1191     }
1192     b = Tcl_GetStringFromObj( argv[0], &len );
1193     if ( ! b )
1194     Tcl_ResetResult (ip);
1195     else {
1196     int ret = openIsisRDeserialize( &that->rec,
1197     b, len, OPENISIS_RDIS|OPENISIS_STOPONEMPTY );
1198     Tcl_SetObjResult( ip, Tcl_NewIntObj( ret ) );
1199     }
1200    
1201     return TCL_OK;
1202     } /* RC_DESER */
1203    
1204     case RC_WRAP: {
1205     char buf[2048];
1206     OITRec *emb = 0;
1207     char **argp = (char**)buf;
1208     char *name = 0;
1209     char *tgnm = 0;
1210     int tag = -1;
1211     int num = -1;
1212     int del = 0;
1213     int len, j;
1214    
1215     if (NonWritable (that)) {
1216     Tcl_AppendResult (ip, arg0, ": readonly record", 0);
1217     return TCL_ERROR;
1218     }
1219     argp = ToArgv (argv, argc, buf, sizeof(buf));
1220     if (! argp) {
1221     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1222     return TCL_ERROR;
1223     }
1224     for (j = 0; argc > j; ++j) {
1225     if (! *argp[j]) {
1226     goto wuserr;
1227     }
1228     if ('-' == *argp[j]) {
1229     len = strlen (argp[j]);
1230     if (2 > len) {
1231     goto wuserr;
1232     }
1233     if (0 == strncmp ("-done", argp[j], len)) {
1234     del = !0;
1235     continue;
1236     }
1237     if (0 == strncmp ("-number", argp[j], len)) {
1238     if (argc <= ++j) {
1239     goto wuserr;
1240     }
1241     num = openIsisA2id (argp[j], -1, -1);
1242     if (0 > num) {
1243     goto wuserr;
1244     }
1245     continue;
1246     }
1247     if (0 == strncmp ("-tag", argp[j], len)) {
1248     if (argc <= ++j) {
1249     goto wuserr;
1250     }
1251     tag = openIsisA2id (argp[j], -1, 0);
1252     if (0 >= tag) {
1253     goto wuserr;
1254     }
1255     continue;
1256     }
1257     goto wuserr;
1258     }
1259     if (0 > tag && 0 == tgnm) {
1260     tgnm = argp[j];
1261     continue;
1262     }
1263     if (name) {
1264     goto wuserr;
1265     }
1266     name = argp[j];
1267     emb = TclCmd2Rec (ip, name, arg0);
1268     if (! emb) {
1269     goto wrperr;
1270     }
1271     } /* for argc */
1272    
1273     if (tgnm) {
1274     OpenIsisFd *fd = openIsisFByName (that->fdt, tgnm);
1275     if (! fd) {
1276     Tcl_AppendResult (ip, arg0,
1277     ": no such field description: ", tgnm, 0);
1278     goto wrperr;
1279     }
1280     tag = fd->id;
1281     }
1282     if (0 > tag) {
1283     goto wuserr;
1284     }
1285     if (num && ! emb) {
1286     Tcl_AppendResult (ip, arg0, ": record to embed not given", 0);
1287     goto wrperr;
1288     }
1289    
1290     if (0 <= num) {
1291     that->rec = openIsisRAddI (that->rec, tag, num, !0);
1292     if (num) {
1293     if (! emb->rec || ! (len = emb->rec->len)) {
1294     Tcl_AppendResult (ip, arg0,
1295     ": record to embed is empty", 0);
1296     goto wrperr;
1297     }
1298     that->rec = luti_append (that->rec, emb->rec);
1299     }
1300     if (! that->rec) {
1301     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1302     goto wrperr;
1303     }
1304     }
1305     else {
1306     len = that->rec || emb->rec;
1307     that->rec = luti_wrap (that->rec, emb->rec, tag);
1308     if (len && ! that->rec) {
1309     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1310     goto wrperr;
1311     }
1312     }
1313    
1314     if (del && emb) {
1315     len = OpRec (emb, ip, name, RC_DONE, 0, 0);
1316     if (TCL_OK != len) {
1317     goto wrperr;
1318     }
1319     }
1320     if (argp != (char**)buf) {
1321     openIsisMFree (argp);
1322     }
1323     return TCL_OK;
1324    
1325     wuserr:
1326     Tcl_AppendResult (ip, "usage: " , arg0, " wrap [-done] ",
1327     "[-number <numsubrecs>] {-tag <tag> | <tagname>} recname", 0);
1328     wrperr:
1329     if (argp != (char**)buf) {
1330     openIsisMFree (argp);
1331     }
1332     return TCL_ERROR;
1333     } /* RC_WRAP */
1334    
1335     default: {
1336     char buf[654];
1337     openIsisI2a (buf, cmd);
1338     Tcl_AppendResult (ip, arg0, ": unrecognized command ", buf, 0);
1339     return TCL_ERROR;
1340     } /* default */
1341    
1342     } /* switch */
1343     }
1344    
1345     static int OpPath (
1346     OITRec *that, Tcl_Interp *ip, const char *arg0,
1347     Tcl_Obj *arg1, int argc, Tcl_Obj* const argv[]
1348     ) {
1349     char buf[128];
1350     OITSess *ois;
1351     const char *path;
1352     int cmd, rt;
1353    
1354     if (! arg1) {
1355     return UsageRec (ip, arg0);
1356     }
1357     if (! arg0) {
1358     arg0 = "<openIsisRecord>";
1359     }
1360     if (! that || ! (ois = RecSess (that))) {
1361     Tcl_AppendResult (ip, arg0, ": record corrupted", 0);
1362     return TCL_ERROR;
1363     }
1364     if (ip != ois->ip) {
1365     Tcl_AppendResult (ip, arg0, ": session corrupted", 0);
1366     return TCL_ERROR;
1367     }
1368    
1369     path = Tcl_GetStringFromObj (arg1, 0);
1370    
1371     /* path to embedded rec */
1372     if ('.' == *path) {
1373     int type = RecType (that);
1374     switch (type) {
1375     case OIT_RS_RQS:
1376     { OITCont *con;
1377     OITRec *rec;
1378     const char *p2;
1379     int tag, occ;
1380     con = (OITCont*) that;
1381     if (strncmp (".fdt", path, 4)) {
1382     p2 = luti_parse_path (path, openIsisFdtRqs,
1383     0, &tag, &occ);
1384     if (0 == p2 || 0 < occ) {
1385     Tcl_AppendResult (ip, arg0,
1386     ": no such child: ", path, 0);
1387     return TCL_ERROR;
1388     }
1389     }
1390     else {
1391     p2 = path + 4;
1392     tag = -42;
1393     occ = 0;
1394     }
1395     if (! con->numr) {
1396     rt = BuildRqsRecs (con);
1397     if (0 > rt) {
1398     Tcl_AppendResult (ip, arg0,
1399     ": child allocation failure", 0);
1400     return TCL_ERROR;
1401     }
1402     }
1403     switch (tag) {
1404     case OPENISIS_COM_REC: rec = con->recs[0]; break;
1405     case OPENISIS_RQS_IDX: rec = con->recs[1]; break;
1406     case OPENISIS_COM_CFG: rec = con->recs[2]; break;
1407     case -42: rec = con->recs[3]; break;
1408     default:
1409     Tcl_AppendResult (ip, arg0,
1410     ": no such child: ", path, 0);
1411     return TCL_ERROR;
1412     }
1413     NewRecId (buf);
1414     if (*p2) {
1415     Tcl_Obj *obj = Tcl_NewStringObj (p2, (int) strlen (p2));
1416     if (obj) {
1417     Tcl_IncrRefCount (obj);
1418     rt = OpPath (rec, ip, buf, obj, argc, argv);
1419     Tcl_DecrRefCount (obj);
1420     return rt;
1421     }
1422     return TCL_ERROR;
1423     }
1424     if (! argc) {
1425     return CrtRecCmd (ois, buf, rec, !0);
1426     }
1427     return OpPath (rec, ip, buf, argv[0], argc - 1, argv + 1);
1428     }
1429     case OIT_RS_RSP:
1430     { OITCont *con;
1431     OITRec *rec;
1432     const char *p2;
1433     int tag, occ;
1434     con = (OITCont*) that;
1435     p2 = luti_parse_path (path, openIsisFdtRsp,
1436     0, &tag, &occ);
1437     if (0 == p2 ||
1438     OPENISIS_COM_REC != tag
1439     ) {
1440     Tcl_AppendResult (ip, arg0,
1441     ": no such child: ", path, 0);
1442     return TCL_ERROR;
1443     }
1444     if (!(rt = con->numr)) {
1445     rt = BuildRspRecs (con, ip, arg0);
1446     if (0 > rt) {
1447     return TCL_ERROR;
1448     }
1449     }
1450     if (0 > occ) {
1451     occ = 0;
1452     }
1453     if (rt <= occ) {
1454     sprintf (buf, "%d", rt);
1455     Tcl_AppendResult (ip, arg0, ": no such child: ", path,
1456     ", have ", buf, " childs", 0);
1457     return TCL_ERROR;
1458     }
1459     rec = con->recs[occ];
1460     NewRecId (buf);
1461     if (*p2) {
1462     Tcl_Obj *obj = Tcl_NewStringObj (p2, (int) strlen (p2));
1463     if (obj) {
1464     Tcl_IncrRefCount (obj);
1465     rt = OpPath (rec, ip, buf, obj, argc, argv);
1466     Tcl_DecrRefCount (obj);
1467     return rt;
1468     }
1469     return TCL_ERROR;
1470     }
1471     if (! argc) {
1472     return CrtRecCmd (ois, buf, rec, !0);
1473     }
1474     return OpPath (rec, ip, buf, argv[0], argc - 1, argv + 1);
1475     }
1476     default:
1477     { OpenIsisRec *rec;
1478     OITRec *oir;
1479     rec = luti_getembed (that->rec, path, that->fdt);
1480     if (! rec) {
1481     Tcl_AppendResult (ip, arg0,
1482     ": no such child: ", path, 0);
1483     return TCL_ERROR;
1484     }
1485     rt = NewRec (ois, 0,
1486     OIT_RS_DBF == RecType(that) ? openIsisFdtFd : 0,
1487     0);
1488     if (0 > rt) {
1489     Tcl_AppendResult (ip, "OpPath: out of memory", 0);
1490     return TCL_ERROR;
1491     }
1492     oir = ois->recs[rt];
1493     oir->rec = rec;
1494     NewRecId (buf);
1495     if (! argc) {
1496     return CrtRecCmd (ois, buf, oir, !0);
1497     }
1498     rt = OpPath (oir, ip, buf, argv[0], argc - 1, argv + 1);
1499     DtorRec (oir, 0);
1500     return rt;
1501     }
1502     }
1503     } /* path */
1504    
1505     rt = Tcl_GetIndexFromObj (ip, arg1, OITOpts, "option", 0, &cmd);
1506     if (TCL_OK != rt) {
1507     return TCL_ERROR;
1508     }
1509     if (RC_LAST < cmd) {
1510     return UsageRec (ip, arg0);
1511     }
1512    
1513     return OpRec (that, ip, arg0, (OITCmd)cmd, argc, argv);
1514     }
1515    
1516     static int CmdRec (
1517     ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
1518     ) {
1519     const char *arg0 = 0 >= argc ? 0 : Tcl_GetStringFromObj (argv[0], 0);
1520     if (1 >= argc) {
1521     return UsageRec (ip, arg0);
1522     }
1523     return OpPath ((OITRec*)cld, ip, arg0, argv[1], argc - 2, argv + 2);
1524     }
1525    
1526     /* ============================== stubs ================================
1527     */
1528    
1529     static int RspCb (
1530     void *cld, OpenIsisStub stb, OpenIsisRec *rsp, OpenIsisDb *db
1531     ) {
1532     OITStub *that = (OITStub*) cld;
1533     OITSess *ois;
1534     const char *res;
1535     int rt;
1536    
1537     (void)db;
1538     if (! that) {
1539     return openIsisSMsg (OPENISIS_ERR_TRASH,
1540     "[openIsisTcl] RspCb: response without stub");
1541     }
1542     if (stb != that->stb) {
1543     return openIsisSMsg (OPENISIS_ERR_TRASH,
1544     "[openIsisTcl] RspCb: stub changed");
1545     }
1546     ois = StbSess (that);
1547     if (! ois) {
1548     return openIsisSMsg (OPENISIS_ERR_TRASH,
1549     "[openIsisTcl] RspCb: response without session");
1550     }
1551     if (! that->rqs) {
1552     return openIsisSMsg (OPENISIS_ERR_TRASH,
1553     "[openIsisTcl] RspCb: response without request");
1554     }
1555     if (that->rsp) {
1556     if (that->rsp->env.rec) {
1557     openIsisSMsg (OPENISIS_ERR_TRASH,
1558     "[openIsisTcl] RspCb: multiple responses");
1559     DtorRec ((OITRec*)that->rsp, 0);
1560     }
1561     }
1562    
1563     rt = NewCont (ois, openIsisFdtRsp, OIT_RS_RSP);
1564     if (0 > rt) {
1565     return rt;
1566     }
1567     that->rsp = (OITCont*) ois->recs[rt];
1568     that->rsp->env.rec = rsp;
1569     that->rsp->stb = that->stb;
1570    
1571     if (! that->actproc) {
1572     if (! that->dfltproc) {
1573     return 0;
1574     }
1575     rt = Tcl_EvalObj (ois->ip, that->dfltproc);
1576     }
1577     else {
1578     rt = Tcl_EvalObj (ois->ip, that->actproc);
1579     }
1580     res = Tcl_GetStringResult (ois->ip);
1581     if (! res) {
1582     res = "<null>";
1583     }
1584     if (TCL_ERROR == rt) {
1585     return openIsisSMsg (OPENISIS_ERR_IDIOT,
1586     "[openIsisTcl] callback eval: %s", res);
1587     }
1588     if (TCL_OK != rt) {
1589     openIsisSMsg (OPENISIS_LOG_WARN,
1590     "[openIsisTcl] callback eval = %d, %s", rt, res);
1591     return 0;
1592     }
1593     openIsisSMsg (OPENISIS_LOG_INFO,
1594     "[openIsisTcl] callback eval : %s", res);
1595     return 0;
1596     }
1597    
1598     static void StbDelCb (void *cld, OpenIsisStub stb, void *cbd);
1599     static void TclDelStb (ClientData cld);
1600     static int CmdStub (
1601     ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
1602     );
1603    
1604     static OITStub* CtorStub (Tcl_Interp *ip,
1605     const char *name, int argc, const char **argv, const char *proc
1606     ) {
1607     OpenIsisStubCbData scd;
1608     OpenIsisSchema *sch;
1609     OITStub *that;
1610     int stat = 0;
1611    
1612     if (! name) {
1613     name = OIT_STB0;
1614     stat = OIT_ST_ROOT;
1615     }
1616     if (! NumSessions) {
1617     openIsisSMsg (OPENISIS_ERR_TRASH,
1618     "[openIsisTcl] CtorStub(%s): no root session", name);
1619     return 0;
1620     }
1621     if (ip != Sessions->ip) {
1622     openIsisSMsg (OPENISIS_ERR_TRASH,
1623     "[openIsisTcl] CtorStub(%s): must not create stub in derived session",
1624     name);
1625     return 0;
1626     }
1627     that = (OITStub*) openIsisMAlloc (sizeof (OITStub));
1628     if (! that) {
1629     openIsisSMsg (OPENISIS_ERR_NOMEM,
1630     "[openIsisTcl] CtorStub(%s): out of memory", name);
1631     return 0;
1632     }
1633     that->cmd = openIsisMDup (name, -1);
1634     if (! that->cmd) {
1635     openIsisMFree (that);
1636     openIsisSMsg (OPENISIS_ERR_NOMEM,
1637     "[openIsisTcl] CtorStub(%s): out of memory", name);
1638     return 0;
1639     }
1640     that->ases = -1;
1641    
1642     memset (&scd, 0, sizeof (OpenIsisStubCbData));
1643     scd.dfltcb = &RspCb;
1644     scd.delcb = &StbDelCb;
1645     scd.dfltcld = scd.delcld = that;
1646    
1647     if (OIT_ST_ROOT & stat) {
1648     that->cfg.fdt = openIsisFdtSyspar;
1649     that->stb = openIsisNInit (argc, argv, &scd);
1650     }
1651     else {
1652     that->cfg.fdt = openIsisFdtScheme;
1653     that->stb = openIsisNOpen (name, argc, argv, &scd);
1654     }
1655     if (! that->stb) {
1656     openIsisMFree ((void*)that->cmd);
1657     openIsisMFree (that);
1658     openIsisSMsg (OPENISIS_ERR_IDIOT,
1659     "[openIsisTcl] CtorStub(%s): deficient configuration", name);
1660     return 0;
1661     }
1662    
1663     sch = openIsisNSchema (that->stb);
1664     that->cfg.rec = sch->cfg;
1665     that->cfg.sid = 0;
1666     that->cfg.stat = OIT_RS_USED | OIT_RS_STC;
1667    
1668     if (proc) {
1669     that->dfltproc = Tcl_NewStringObj (proc, (int) strlen (proc));
1670     if (that->dfltproc) {
1671     Tcl_IncrRefCount (that->dfltproc);
1672     }
1673     }
1674    
1675     that->stat = stat | OIT_ST_TCL | OIT_ST_OINIT;
1676    
1677     Tcl_CreateObjCommand (ip, (char*)that->cmd, &CmdStub, that, &TclDelStb);
1678     Tcl_SetResult (ip, (char*)that->cmd, TCL_VOLATILE);
1679     return that;
1680     }
1681    
1682     static void DtorStub (OITStub *that, int where) {
1683     const char *cmd = that->cmd;
1684     if (! cmd) {
1685     cmd = "<<NULL>>";
1686     }
1687     if (! NumSessions) {
1688     openIsisSMsg (OPENISIS_ERR_TRASH,
1689     "[openIsisTcl] DtorStub(%s): no root session", cmd);
1690     return;
1691     }
1692     that->stat &= ~where;
1693     if (OIT_ST_TCL & that->stat) {
1694     if (! that->cmd) {
1695     openIsisSMsg (OPENISIS_ERR_TRASH,
1696     "[openIsisTcl] DtorStub: no command");
1697     return;
1698     }
1699     Tcl_DeleteCommand (Sessions->ip, (char*)that->cmd);
1700     return;
1701     }
1702     if (OIT_ST_OINIT & that->stat) {
1703     if (OIT_ST_ROOT & that->stat) {
1704     openIsisNDeinit ();
1705     }
1706     else {
1707     openIsisNClose (that->stb);
1708     }
1709     return;
1710     }
1711     if (that->dfltproc) {
1712     Tcl_DecrRefCount (that->dfltproc);
1713     }
1714     if (that->actproc) {
1715     Tcl_DecrRefCount (that->actproc);
1716     }
1717     if (that->rqs) {
1718     DtorRec ((OITRec*)that->rqs, 0);
1719     }
1720     if (that->rsp) {
1721     DtorRec ((OITRec*)that->rsp, 0);
1722     }
1723     /* that->cfg.rec holds the same ref as stub->cfg,
1724     which is freed in openIsisNClose
1725     */
1726     if (that->cmd) {
1727     openIsisMFree ((void*)that->cmd);
1728     }
1729     openIsisMFree (that);
1730     }
1731    
1732     static void TclDelStb (ClientData cld) {
1733     DtorStub ((OITStub*)cld, OIT_ST_TCL);
1734     }
1735    
1736     static void StbDelCb (void *cld, OpenIsisStub stb, void *cbd) {
1737     (void) stb;
1738     if (cbd) {
1739     if (((OITStub*)cbd)->actproc) {
1740     Tcl_DecrRefCount (((OITStub*)cbd)->actproc);
1741     ((OITStub*)cbd)->actproc = 0;
1742     }
1743     return;
1744     }
1745     DtorStub ((OITStub*)cld, OIT_ST_OINIT);
1746     }
1747    
1748     static int BuildRqsCont (OITStub *that, Tcl_Interp *ip,
1749     const char *arg0, OITSess *ois, int *argc, Tcl_Obj* const **argv
1750     ) {
1751     OpenIsisDb *db;
1752     char *dbn;
1753     int rt;
1754     if (! that->rqs) {
1755     rt = NewCont (ois, openIsisFdtRqs, OIT_RS_RQS);
1756     if (0 > rt) {
1757     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1758     return 0;
1759     }
1760     that->rqs = (OITCont*) ois->recs[rt];
1761     }
1762     if (1 < *argc &&
1763     0 == strcmp ("-db", Tcl_GetStringFromObj ((*argv)[0], 0))) {
1764     dbn = Tcl_GetStringFromObj ((*argv)[1], 0);
1765     db = openIsisNDbByName (that->stb, dbn);
1766     if (! db) {
1767     Tcl_AppendResult (ip, arg0, ": no such db: ", dbn, 0);
1768     return 0;
1769     }
1770     that->rqs->env.db = db;
1771     *argc -= 2;
1772     *argv += 2;
1773     }
1774     return !0;
1775     }
1776    
1777     static const OpenIsisFdt* SysFdtFromName (const char *dbn, int len) {
1778     switch (dbn[1]) {
1779     case 'd':
1780     if (0 == strncmp (dbn, "-dbpar", len)) {
1781     return openIsisFdtDbpar;
1782     }
1783     return 0;
1784     case 'f':
1785     if ('d' == dbn[2]) {
1786     if (0 == dbn[3]) {
1787     return openIsisFdtFd;
1788     }
1789     if ('t' == dbn[3] && 0 == dbn[4]) {
1790     return openIsisFdtFdt;
1791     }
1792     }
1793     return 0;
1794     case 'r':
1795     if (3 < len) {
1796     if (0 == strncmp (dbn, "-request", len)) {
1797     return openIsisFdtRqs;
1798     }
1799     if (0 == strncmp (dbn, "-response", len)) {
1800     return openIsisFdtRsp;
1801     }
1802     }
1803     return 0;
1804     case 's':
1805     if (2 < len) {
1806     if (0 == strncmp (dbn, "-syspar", len)) {
1807     return openIsisFdtSyspar;
1808     }
1809     if (0 == strncmp (dbn, "-scheme", len)) {
1810     return openIsisFdtScheme;
1811     }
1812     }
1813     return 0;
1814     }
1815     return 0;
1816     }
1817    
1818     static int UsageStub (Tcl_Interp *ip, const char *argv0) {
1819     Tcl_AppendResult (ip,
1820     "usage: ",
1821     (argv0 ? argv0 : "<openIsisStub>"),
1822     " db db ?option ...? |",
1823     " fdt db ?option ...? |",
1824     " new -schema name ?-cfg val ...? |",
1825     " new ?-db db? ?name? |",
1826     " recv |",
1827     " request ?-db db? ?-param val? |",
1828     " .req ?-db db? ?option ...? |",
1829     " .res ?option ...?",
1830     0);
1831     return TCL_ERROR;
1832     }
1833    
1834     static int CmdStub (
1835     ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
1836     ) {
1837     OITStub *that = (OITStub*) cld;
1838     OITSess *ois;
1839     const char *arg0;
1840     OITCmd cmd;
1841     int rt;
1842    
1843     if (1 > argc) {
1844     return TCL_ERROR;
1845     }
1846     arg0 = Tcl_GetStringFromObj (argv[0], 0);
1847     if (2 > argc) {
1848     return UsageStub (ip, arg0);
1849     }
1850    
1851     ois = StbSess (that);
1852     if (! ois) {
1853     if (! NumSessions) {
1854     Tcl_AppendResult (ip, arg0, ": no session", 0);
1855     return TCL_ERROR;
1856     }
1857     ois = Sessions;
1858     that->ases = 0;
1859     }
1860     if (ip != ois->ip) {
1861     Tcl_AppendResult (ip, arg0, ": session changed", 0);
1862     return TCL_ERROR;
1863     }
1864    
1865     rt = Tcl_GetIndexFromObj (ip, argv[1], OITOpts, "option", 0, (int*)&cmd);
1866     if (TCL_OK != rt) {
1867     return UsageStub (ip, arg0);
1868     }
1869    
1870     argc -= 2;
1871     argv += 2;
1872    
1873     switch (cmd) {
1874    
1875     case RC_DB: {
1876     OpenIsisDb *db;
1877     char *dbn;
1878     if (! argc) {
1879     return UsageStub (ip, arg0);
1880     }
1881     dbn = Tcl_GetStringFromObj (argv[0], 0);
1882     db = openIsisNDbByName (that->stb, dbn);
1883     if (! db) {
1884     Tcl_AppendResult (ip, arg0, ": no such db <", dbn, ">", 0);
1885     return TCL_ERROR;
1886     }
1887     return OpDb (ip, ois, db, argc - 1, argv + 1);
1888     } /* RC_DB */
1889    
1890     case RC_DONE:
1891     Tcl_DeleteCommand (ip, (char*)arg0);
1892     return TCL_OK;
1893    
1894     case RC_FDT: {
1895     const OpenIsisFdt *fdt = 0;
1896     OpenIsisDb *db;
1897     char *dbn;
1898     int len;
1899     if (! argc) {
1900     return UsageStub (ip, arg0);
1901     }
1902     dbn = Tcl_GetStringFromObj (argv[0], &len);
1903     if (1 < len && '-' == *dbn) {
1904     fdt = SysFdtFromName (dbn, len);
1905     }
1906     if (! fdt) {
1907     db = openIsisNDbByName (that->stb, dbn);
1908     if (! db) {
1909     Tcl_AppendResult (ip, arg0, ": no such db <", dbn, ">", 0);
1910     return TCL_ERROR;
1911     }
1912     fdt = db->fdt;
1913     if (! fdt) {
1914     Tcl_AppendResult (ip, arg0, ": ", dbn, " has no fdt", 0);
1915     return TCL_ERROR;
1916     }
1917     }
1918     return OpFdt (ip, ois, fdt, argc - 1, argv + 1);
1919     } /* RC_FDT */
1920    
1921     case SC_NEW: {
1922     char buf[2048];
1923     OITStub *nstb = 0;
1924     const OpenIsisFdt *fdt = 0;
1925     OpenIsisDb *db = 0;
1926     const char *arg2 = 0;
1927     const char *dbn = 0;
1928     const char *proc = 0;
1929     char *name = 0;
1930     char **argp = 0;
1931     int len = 0;
1932     int dbl = 0;
1933    
1934     switch (argc) {
1935     /* new record */
1936     case 0:
1937     goto newrec;
1938     case 1:
1939     name = Tcl_GetStringFromObj (argv[0], 0);
1940     goto newrec;
1941     case 3:
1942     arg2 = Tcl_GetStringFromObj (argv[0], &len);
1943     if (2 > len || 0 != strncmp ("-db", arg2, len)) {
1944     return UsageStub (ip, arg0);
1945     }
1946     dbn = Tcl_GetStringFromObj (argv[1], &dbl);
1947     name = Tcl_GetStringFromObj (argv[2], 0);
1948     newrec:
1949     if (1 < dbl && '-' == *dbn) {
1950     fdt = SysFdtFromName (dbn, dbl);
1951     }
1952     if (! fdt) {
1953     if (! dbn) {
1954     dbn = openIsisRString (that->cfg.rec,
1955     OPENISIS_SC_DFLTDB, 0, buf, sizeof(buf));
1956     if (! dbn) {
1957     Tcl_AppendResult (ip, arg0,
1958     ": no db specified", 0);
1959     return TCL_ERROR;
1960     }
1961     }
1962     db = openIsisNDbByName (that->stb, dbn);
1963     if (! db) {
1964     Tcl_AppendResult (ip, arg0,
1965     ": no such db <", dbn, ">", 0);
1966     return TCL_ERROR;
1967     }
1968     fdt = db->fdt;
1969     }
1970     rt = NewRec (ois, db, fdt, 0);
1971     if (0 > rt) {
1972     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
1973     return TCL_ERROR;
1974     }
1975     rt = CrtRecCmd (ois, name, ois->recs[rt], !0);
1976     return rt;
1977    
1978     /* new stub */
1979     default:
1980     arg2 = Tcl_GetStringFromObj (argv[0], &len);
1981     if (2 > len) {
1982     return UsageStub (ip, arg0);
1983     }
1984     if (2 == argc && 0 == strncmp ("-db", arg2, len)) {
1985     dbn = Tcl_GetStringFromObj (argv[1], &dbl);
1986     goto newrec;
1987     }
1988     if (strncmp ("-schema", arg2, len) &&
1989     strncmp ("schema", arg2, len)) {
1990     return UsageStub (ip, arg0);
1991     }
1992     name = Tcl_GetStringFromObj (argv[1], 0);
1993     argc -= 2;
1994     argv += 2;
1995     if (0 < argc) {
1996     int j;
1997     argp = ToArgv (argv, argc, buf, sizeof (buf));
1998     if (! argp) {
1999     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
2000     return TCL_ERROR;
2001     }
2002     for (j = 0; argc > j; ++j) {
2003     if (0 == strcmp ("-async", argp[j]) &&
2004     argc > ++j) {
2005     proc = argp[j];
2006     }
2007     }
2008     }
2009     nstb = CtorStub (ip, name, argc, (const char**)argp, proc);
2010     if (argp && argp != (char**)buf) {
2011     openIsisMFree (argp);
2012     }
2013     if (! nstb) {
2014     Tcl_AppendResult (ip, arg0,
2015     ": deficient configuration for ", name,
2016     " or out of memory", 0);
2017     return TCL_ERROR;
2018     }
2019     return TCL_OK;
2020    
2021     } /* switch (argc) */
2022     } /* SC_NEW */
2023    
2024     case SC_RECV: {
2025     if (that->rsp && that->rsp->env.rec) {
2026     return TCL_OK;
2027     }
2028     Tcl_AppendResult (ip, arg0,
2029     ": waiting for response in async mode not implemented yet", 0);
2030     return TCL_ERROR;
2031     } /* SC_RECV */
2032    
2033     case SC_RQS: {
2034     OpenIsisRec *rqs;
2035     if (that->rsp) {
2036     DtorRec ((OITRec*) that->rsp, 0);
2037     }
2038     if (! BuildRqsCont (that, ip, arg0, ois, &argc, &argv)) {
2039     return TCL_ERROR;
2040     }
2041     if (0 < argc) {
2042     Tcl_Obj *setcmd = Tcl_NewStringObj ("set", 3);
2043     if (! setcmd) {
2044     Tcl_AppendResult (ip, arg0, ": out of memory", 0);
2045     return TCL_ERROR;
2046     }
2047     Tcl_IncrRefCount (setcmd);
2048     rt = OpPath (
2049     (OITRec*)that->rqs, ip, 0, setcmd, argc, argv);
2050     Tcl_DecrRefCount (setcmd);
2051     if (TCL_OK != rt) {
2052     return rt;
2053     }
2054     }
2055     rqs = that->rqs->env.rec;
2056     if (that->rqs->numr) {
2057     OpenIsisRec *rec;
2058     if ((rec = that->rqs->recs[0]->rec)) {
2059     rqs = luti_wrap (rqs, rec, OPENISIS_COM_REC);
2060     }
2061     if ((rec = that->rqs->recs[1]->rec)) {
2062     rqs = luti_wrap (rqs, rec, OPENISIS_RQS_IDX);
2063     }
2064     if ((rec = that->rqs->recs[2]->rec)) {
2065     rqs = luti_wrap (rqs, rec, OPENISIS_COM_CFG);
2066     }
2067     if ((rec = that->rqs->recs[3]->rec)) {
2068     rqs = luti_append (rqs, rec);
2069     }
2070     }
2071     if (! openIsisRGet (rqs, OPENISIS_COM_DBN, 0) && that->rqs->env.db) {
2072     OPENISIS_RADDS (rqs, OPENISIS_COM_DBN, that->rqs->env.db->name, !0);
2073     }
2074     rt = openIsisNSend (that->stb, that->rqs->env.rec = rqs, 0, 0, !0);
2075     that->rqs->env.db = 0; /* do never remember */
2076     if (0 != rt) {
2077     char buf[64];
2078     sprintf (buf, "%x", rt);
2079     Tcl_AppendResult (ip, arg0, ": error ", buf,
2080     " sending request", 0);
2081     return TCL_ERROR;
2082     }
2083     return TCL_OK;
2084     } /* SC_RQS */
2085    
2086     case SC_ARQS: {
2087     if (! BuildRqsCont (that, ip, arg0, ois, &argc, &argv)) {
2088     return TCL_ERROR;
2089     }
2090     if (1 > argc) {
2091     return UsageStub (ip, arg0);
2092     }
2093     rt = OpPath (
2094     (OITRec*)that->rqs, ip, 0, argv[0], argc - 1, argv + 1);
2095     return rt;
2096     } /* SC_ARQS */
2097    
2098     case SC_ARSP: {
2099     int hasrsp = that->rsp && that->rsp->env.rec;
2100     if (1 > argc) {
2101     Tcl_SetObjResult (ip, Tcl_NewBooleanObj (hasrsp));
2102     return TCL_OK;
2103     }
2104     if (! hasrsp) {
2105     Tcl_AppendResult (ip, arg0, ": no response available", 0);
2106     return TCL_ERROR;
2107     }
2108     rt = OpPath (
2109     (OITRec*)that->rsp, ip, 0, argv[0], argc - 1, argv + 1);
2110     return rt;
2111     } /* SC_ARSP */
2112    
2113     default: {
2114     /* record commands */
2115     OpenIsisSchema *sch;
2116     rt = OpRec (&that->cfg, ip, arg0, cmd, argc, argv);
2117     sch = openIsisNSchema (that->stb);
2118     /* sch->cfg is a reference to our cfg at every time,
2119     OpRec changes with RDIS, so we dont free the old rec here
2120     */
2121     sch->cfg = that->cfg.rec;
2122     return rt;
2123     } /* default */
2124    
2125     } /* switch cmd */
2126     }
2127    
2128     static int CmdInit (
2129     ClientData cld, Tcl_Interp *ip, int argc, const char *argv[]
2130     ) {
2131     OITStub *news;
2132     const char *proc = 0;
2133     int j, len;
2134    
2135     (void)cld;
2136    
2137     if (openisis_stub0) {
2138     Tcl_CmdInfo info;
2139     if (Tcl_GetCommandInfo (ip, OIT_STB0, &info)) {
2140     Tcl_SetResult (ip, OIT_STB0, TCL_STATIC);
2141     return TCL_OK;
2142     }
2143     }
2144    
2145     for (j = 1; argc > j; ++j) {
2146     if (! argv[j] || ! (len = strlen (argv[j]))) {
2147     goto usage;
2148     }
2149     if ('-' == *argv[j]) {
2150     if (! strncmp ("-async", argv[j], (unsigned) len)) {
2151     if (argc <= ++j) {
2152     goto usage;
2153     }
2154     proc = argv[j];
2155     continue;
2156     }
2157     }
2158     break;
2159     }
2160    
2161     /* openIsisNInit can be called multiple times */
2162     news = CtorStub (ip, 0, argc - j, argv + j, proc);
2163     if (! news) {
2164     Tcl_AppendResult (ip, OIT_STB0, ": out of memory", 0);
2165     return TCL_ERROR;
2166     }
2167     return TCL_OK;
2168    
2169     usage:
2170     Tcl_AppendResult (ip,
2171     "usage: ", argv[0], " ?-async <cb>? ?options?", 0);
2172     return TCL_ERROR;
2173     }
2174    
2175     static int CmdOIR (
2176     ClientData cld, Tcl_Interp *ip, int argc, Tcl_Obj* const argv[]
2177     ) {
2178     OITSess *ois;
2179     OITRec *rec, *rfdt;
2180     const OpenIsisFdt *fdt;
2181     char *fname;
2182     const char *rname;
2183     char buf[64];
2184     int j, rt, len, ownf;
2185    
2186     (void)cld;
2187     if (! NumSessions) {
2188     Tcl_AppendResult (ip, "session not initialized", 0);
2189     return TCL_ERROR;
2190     }
2191     ois = Sessions;
2192    
2193     rec = 0;
2194     rname = 0;
2195     fdt = 0;
2196     ownf = 0;
2197     for (j = 1; argc > j; ++j) {
2198     fname = Tcl_GetStringFromObj (argv[j], &len);
2199     if (! fdt && 2 <= len && 0 == strncmp ("-fdt", fname, len)) {
2200     if (argc <= ++j) {
2201     Tcl_AppendResult (ip,
2202     "usage: openIsisRec ?-fdt name? ?options...?", 0);
2203     return TCL_ERROR;
2204     }
2205     fname = Tcl_GetStringFromObj (argv[j], &len);
2206     if (len && '-' == *fname) {
2207     fdt = SysFdtFromName (fname, len);
2208     }
2209     if (! fdt) {
2210     rfdt = TclCmd2Rec (ip, fname, "openIsisRec");
2211     if (! rfdt) {
2212     return TCL_ERROR;
2213     }
2214     fdt = openIsisFRec2Fdt (rfdt->rec);
2215     if (! fdt) {
2216     Tcl_AppendResult (ip, fname, " is an illegal fdt", 0);
2217     return TCL_ERROR;
2218     }
2219     ownf = !0;
2220     }
2221     if (rname) {
2222     ++j;
2223     break;
2224     }
2225     continue;
2226     }
2227     if (rname) {
2228     break;
2229     }
2230     rname = fname;
2231     }
2232    
2233     if (! rname || ! *rname) {
2234     rname = NewRecId (buf);
2235     }
2236    
2237     rt = NewRec (ois, 0, fdt, ownf ? OIT_RS_OWNF : 0);
2238     if (0 > rt) {
2239     Tcl_AppendResult (ip, Tcl_GetStringFromObj (argv[0], 0),
2240     ": out of memory", 0);
2241     goto error;
2242     }
2243     rec = ois->recs[rt];
2244    
2245     if (j < argc - 1) {
2246     rt = OpPath (rec, ip, rname, argv[j], argc - (j+1), argv + (j+1));
2247     if (TCL_OK != rt) {
2248     goto error;
2249     }
2250     }
2251    
2252     rt = CrtRecCmd (ois, rname, rec, !0);
2253     if (TCL_OK == rt) {
2254     return TCL_OK;
2255     }
2256     error:
2257     if (rec) {
2258     DtorRec (rec, 0);
2259     }
2260     else if (ownf) {
2261     openIsisFFree ((OpenIsisFdt*)fdt);
2262     }
2263     return TCL_ERROR;
2264     }
2265    
2266     static void FreeEnc ();
2267     static void AtExit (ClientData cld) {
2268     (void)cld;
2269     openIsisNDeinit ();
2270     ExitSess ();
2271     FreeEnc ();
2272     }
2273    
2274     static void AddCmds (Tcl_Interp *ip, int root) {
2275     Tcl_CreateCommand (ip, "openIsis",
2276     (Tcl_CmdProc*)CmdInit, 0, root ? &AtExit : 0);
2277     Tcl_CreateObjCommand (ip, "openIsisRec", &CmdOIR, 0, 0);
2278     }
2279    
2280     /* ===================== command evaluation ============================
2281     */
2282    
2283     static int CmdEval (OpenIsisRec *cmd, OpenIsisRec **rsp) {
2284     Tcl_DString ds;
2285     OpenIsisField *F, *E;
2286     OpenIsisSession ois;
2287     OpenIsisRec *recs[1] = { 0 };
2288     int rid[1];
2289     int rt;
2290    
2291     ois = SESGET ();
2292     if (NumSessions <= ois->id) {
2293     return openIsisSMsg (OPENISIS_ERR_TRASH,
2294     "[openIsisTcl] CmdEval: no ip for ses %d[%d]",
2295     ois->id, NumSessions);
2296     }
2297    
2298     rid[0] = openIsisTclCreateRecCmd (ois->id, "result", 0, 0);
2299     if (0 > rid[0]) {
2300     return openIsisSMsg (OPENISIS_ERR_NOMEM,
2301     "[openIsisTcl] CmdEval: cannot allocate result cmd");
2302     }
2303    
2304     rt = 0;
2305     Tcl_DStringInit (&ds);
2306     for (E = (F = cmd->field) + cmd->len; E > F; ++F) {
2307     if (rt) {
2308     Tcl_DStringAppend (&ds, ";", 1);
2309     }
2310     rt = !0;
2311     Tcl_DStringAppend (&ds, F->val, F->len);
2312     }
2313     rt = openIsisTclEval (ois->id, 1, rid, recs, Tcl_DStringValue (&ds));
2314     Tcl_DStringFree (&ds);
2315    
2316     /* record freed in ldsp */
2317     Sessions[ois->id].recs[rid[0]]->rec = 0;
2318     *rsp = recs[0];
2319    
2320     return rt;
2321     }
2322    
2323     OpenIsisEvalFunc *openIsisEval = &CmdEval;
2324    
2325     /* =========================== encoding ================================
2326     */
2327    
2328     static Tcl_HashTable Encodings;
2329     static int InitEnc = 0;
2330    
2331     static Tcl_Encoding GetEnc (Tcl_Interp *ip, const char *name, int *frs) {
2332     Tcl_HashEntry *he;
2333     Tcl_Encoding enc;
2334     int nw;
2335     if (! InitEnc) {
2336     Tcl_InitHashTable (&Encodings, TCL_STRING_KEYS);
2337     InitEnc = !0;
2338     }
2339     he = Tcl_FindHashEntry (&Encodings, name);
2340     if (he) {
2341     return (Tcl_Encoding) Tcl_GetHashValue (he);
2342     }
2343     enc = Tcl_GetEncoding (ip, name);
2344     he = Tcl_CreateHashEntry (&Encodings, name, &nw);
2345     Tcl_SetHashValue (he, enc);
2346     if (frs && ! enc) {
2347     *frs = !0;
2348     }
2349     return enc;
2350     }
2351    
2352     static void FreeEnc () {
2353     if (InitEnc) {
2354     Tcl_Encoding enc;
2355     Tcl_HashSearch hs;
2356     Tcl_HashEntry *he;
2357     for (he = Tcl_FirstHashEntry (&Encodings, &hs);
2358     he;
2359     he = Tcl_NextHashEntry (&hs)
2360     ) {
2361     enc = (Tcl_Encoding) Tcl_GetHashValue (he);
2362     if (enc) {
2363     Tcl_FreeEncoding (enc);
2364     }
2365     }
2366     Tcl_DeleteHashTable (&Encodings);
2367     InitEnc = 0;
2368     }
2369     }
2370    
2371     static const char* TrfEnc (const char *ename,
2372     const char *src, int slen, char *dst, int dlen, int invert
2373     ) {
2374     Tcl_Encoding enc;
2375     Tcl_DString str;
2376     char *tgt;
2377     int tlen, frs;
2378    
2379     if (! ename) {
2380     if (src) {
2381     openIsisMFree ((void*)src);
2382     }
2383     return 0;
2384     }
2385    
2386     if (! src || 0 >= slen) {
2387     return src;
2388     }
2389     /* tclEncoding.c says that a null interp is ok */
2390     frs = 0;
2391     enc = GetEnc (0, ename, &frs);
2392     if (frs) {
2393     openIsisSMsg (OPENISIS_ERR_INVAL,
2394     "[openIsisTcl] TrfEnc: no such encoding <%s>", ename);
2395     return src;
2396     }
2397    
2398     Tcl_DStringInit (&str);
2399     if (invert) {
2400     tgt = Tcl_UtfToExternalDString (enc, src, slen, &str);
2401     }
2402     else {
2403     tgt = Tcl_ExternalToUtfDString (enc, src, slen, &str);
2404     }
2405     tlen = Tcl_DStringLength (&str);
2406     if (! dst || tlen >= dlen) {
2407     dst = (char*) openIsisMAlloc (1 + tlen);
2408     if (! dst) {
2409     return 0;
2410     }
2411     }
2412     memcpy (dst, tgt, tlen);
2413     dst[tlen] = 0;
2414     Tcl_DStringFree (&str);
2415     return dst;
2416     }
2417    
2418     OpenIsisEnc2Utf8Func *openIsisEnc2Utf8 = &TrfEnc;
2419    
2420     /* ************************************************************
2421     public functions
2422     */
2423    
2424     int openIsisTclNewSession (Tcl_Interp *ip) {
2425     int id;
2426     for (id = 0; NumSessions > id; ++id) {
2427     if (ip == Sessions[id].ip) {
2428     return id;
2429     }
2430     }
2431     id = CtorSess (ip);
2432     if (0 <= id) {
2433     AddCmds (ip, 0 == id);
2434     }
2435     return id;
2436     }
2437    
2438     int openIsisTclGetSession (int sid, Tcl_Interp **ip) {
2439     if (0 > sid || NumSessions <= sid) {
2440     return 0;
2441     }
2442     if (ip) {
2443     *ip = Sessions[sid].ip;
2444     }
2445     return !0;
2446     }
2447    
2448     /*
2449     void openIsisTclDelSession (int sid) {
2450     if (! sid) {
2451     ExitSess ();
2452     return;
2453     }
2454     if (0 < sid && NumSessions > sid) {
2455     DtorSess (Sessions + sid);
2456     }
2457     }
2458     */
2459    
2460    
2461     int openIsisTclCreateRecCmd (
2462     int sid, const char *nam, const char *fn, int flg
2463     ) {
2464     OITSess *ois = Sessions+sid;
2465     OpenIsisFdt *fdt = 0;
2466     int rid;
2467     (void)flg; /* TODO: set readonly */
2468     if (fn) {
2469     OITRec *oitf = TclCmd2Rec (ois->ip, fn, 0);
2470     if (! oitf) {
2471     openIsisSMsg (OPENISIS_ERR_INVAL,
2472     "[openIsisTcl] createRecCmd: no such fdt %s", fn);
2473     }
2474     fdt = openIsisFRec2Fdt (oitf->rec);
2475     if (! fdt) {
2476     openIsisSMsg (OPENISIS_ERR_INVAL,
2477     "[openIsisTcl] createRecCmd: illegal fdt %s", fn);
2478     }
2479     }
2480     rid = NewRec( ois, 0, fdt, fdt ? OIT_RS_OWNF : 0 );
2481     if ( 0 <= rid ) {
2482     CrtRecCmd( ois, nam, ois->recs[rid], 0 );
2483     }
2484     return rid;
2485     } /* openIsisTclCreateRecCmd */
2486    
2487    
2488     int openIsisTclEval ( int sid,
2489     int cnt, const int *ids, OpenIsisRec **recs, char *script )
2490     {
2491     OITSess *ois = Sessions+sid;
2492     int ret, i;
2493    
2494     if ( recs )
2495     for ( i=cnt; i--; )
2496     ois->recs[ ids[i] ]->rec = recs[i];
2497     ret = Tcl_Eval( ois->ip, script );
2498     if ( recs )
2499     for ( i=cnt; i--; )
2500     recs[i] = ois->recs[ ids[i] ]->rec;
2501     return ret;
2502     } /* openIsisTclEval */
2503    
2504    
2505     int openIsisTclInit (Tcl_Interp *ip) {
2506     if (! NumSessions) {
2507     CtorSess (ip);
2508     }
2509     AddCmds (ip, !0);
2510     Tcl_CreateExitHandler (&AtExit, 0);
2511     return TCL_OK;
2512     }
2513    
  ViewVC Help
Powered by ViewVC 1.1.26