From ed6b88adb8132f4668c60113532d5c2da34523e7 Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Mon, 29 May 1995 08:44:08 +0000 Subject: [PATCH] Work on delete of objects. --- LICENSE | 26 +++ ir-tcl.c | 596 ++++++++++++++++++++++++++++++++++++++++++++----------------- ir-tcl.h | 29 ++- ir-tclp.h | 10 +- marc.c | 10 +- mem.tcl | 64 +++++++ tclmain.c | 6 +- 7 files changed, 571 insertions(+), 170 deletions(-) create mode 100644 LICENSE create mode 100644 mem.tcl diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..aff9630 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +/* + * Copyright (c) 1995, Index Data. + * + * Permission to use, copy, modify, distribute, and sell this software and + * its documentation, in whole or in part, for any purpose, is hereby granted, + * provided that: + * + * 1. This copyright and permission notice appear in all copies of the + * software and its documentation. Notices of copyright or attribution + * which appear at the beginning of any file must remain unchanged. + * + * 2. The names of Index Data or the individual authors may not be used to + * endorse or promote products derived from this software without specific + * prior written permission. + * + * THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND, + * EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY + * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. + * IN NO EVENT SHALL INDEX DATA BE LIABLE FOR ANY SPECIAL, INCIDENTAL, + * INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY KIND, OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER OR + * NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND ON ANY THEORY OF + * LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE + * OF THIS SOFTWARE. + * + */ diff --git a/ir-tcl.c b/ir-tcl.c index 8ca0a36..aac5e4d 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -1,10 +1,14 @@ /* * IR toolkit for tcl/tk * (c) Index Data 1995 + * See the file LICENSE for details. * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.c,v $ - * Revision 1.31 1995-05-26 11:44:10 adam + * Revision 1.32 1995-05-29 08:44:16 adam + * Work on delete of objects. + * + * Revision 1.31 1995/05/26 11:44:10 adam * Bugs fixed. More work on MARC utilities and queries. Test * client is up-to-date again. * @@ -167,6 +171,27 @@ static IRRecordList *find_IR_record (IRSetObj *setobj, int no) return NULL; } +static void delete_IR_records (IRSetObj *setobj) +{ + IRRecordList *rl, *rl1; + + for (rl = setobj->record_list; rl; rl = rl1) + { + switch (rl->which) + { + case Z_NamePlusRecord_databaseRecord: + free (rl->u.dbrec.buf); + break; + case Z_NamePlusRecord_surrogateDiagnostic: + free (rl->u.diag.addinfo); + break; + } + rl1 = rl->next; + free (rl); + } + setobj->record_list = NULL; +} + /* * getsetint: Set/get integer value */ @@ -250,15 +275,22 @@ int ir_method (Tcl_Interp *interp, int argc, char **argv, IRMethods *tab) for (tab_i = tab; tab_i->tab; tab_i++) for (t = tab_i->tab; t->name; t++) - if (!strcmp (t->name, argv[1])) - return (*t->method)(tab_i->obj, interp, argc, argv); + if (argc <= 0) + { + if ((*t->method)(tab_i->obj, interp, argc, argv) == TCL_ERROR) + return TCL_ERROR; + } + else + if (!strcmp (t->name, argv[1])) + return (*t->method)(tab_i->obj, interp, argc, argv); + if (argc <= 0) + return TCL_OK; Tcl_AppendResult (interp, "Bad method. Possible methods:", NULL); for (tab_i = tab; tab_i->tab; tab_i++) for (t = tab_i->tab; t->name; t++) Tcl_AppendResult (interp, " ", t->name, NULL); return TCL_ERROR; - } /* @@ -284,29 +316,10 @@ int ir_method_r (void *obj, Tcl_Interp *interp, int argc, char **argv, } /* - * ir_asc2bitmask: Ascii to ODR bitmask conversion - */ -int ir_asc2bitmask (const char *asc, Odr_bitmask *ob) -{ - const char *cp = asc + strlen(asc); - int bitno = 0; - - ODR_MASK_ZERO (ob); - do - { - if (*--cp == '1') - ODR_MASK_SET (ob, bitno); - bitno++; - } while (cp != asc); - return bitno; -} - -/* * ir_named_bits: get/set named bits */ int ir_named_bits (struct ir_named_entry *tab, Odr_bitmask *ob, - Tcl_Interp *interp, - int argc, char **argv) + Tcl_Interp *interp, int argc, char **argv) { struct ir_named_entry *ti; if (argc > 0) @@ -351,6 +364,16 @@ int ir_strdup (Tcl_Interp *interp, char** p, const char *s) } /* + * ir_strdel: Delete string + */ +int ir_strdel (Tcl_Interp *interp, char **p) +{ + free (*p); + *p = NULL; + return TCL_OK; +} + +/* * ir_malloc: Malloc function */ void *ir_malloc (Tcl_Interp *interp, size_t size) @@ -380,6 +403,8 @@ static int do_init_request (void *obj, Tcl_Interp *interp, Z_InitRequest req; int r; + if (argc <= 0) + return TCL_OK; if (!p->cs_link) { interp->result = "not connected"; @@ -443,7 +468,7 @@ static int do_init_request (void *obj, Tcl_Interp *interp, if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0) { interp->result = "cs_put failed in init"; - do_disconnect (p, NULL, 0, NULL); + do_disconnect (p, NULL, 2, NULL); return TCL_ERROR; } else if (r == 1) @@ -471,6 +496,13 @@ static int do_protocolVersion (void *obj, Tcl_Interp *interp, }; IRObj *p = obj; + if (argc <= 0) + { + ODR_MASK_ZERO (&p->protocolVersion); + ODR_MASK_SET (&p->protocolVersion, 0); + ODR_MASK_SET (&p->protocolVersion, 1); + return TCL_OK; + } return ir_named_bits (version_tab, &p->protocolVersion, interp, argc-2, argv+2); } @@ -500,6 +532,15 @@ static int do_options (void *obj, Tcl_Interp *interp, }; IRObj *p = obj; + if (argc <= 0) + { + ODR_MASK_ZERO (&p->options); + ODR_MASK_SET (&p->options, 0); + ODR_MASK_SET (&p->options, 1); + ODR_MASK_SET (&p->options, 7); + ODR_MASK_SET (&p->options, 14); + return TCL_OK; + } return ir_named_bits (options_tab, &p->options, interp, argc-2, argv+2); } @@ -510,6 +551,12 @@ static int do_preferredMessageSize (void *obj, Tcl_Interp *interp, int argc, char **argv) { IRObj *p = obj; + + if (argc <= 0) + { + p->preferredMessageSize = 4096; + return TCL_OK; + } return get_set_int (&p->preferredMessageSize, interp, argc, argv); } @@ -520,6 +567,12 @@ static int do_maximumRecordSize (void *obj, Tcl_Interp *interp, int argc, char **argv) { IRObj *p = obj; + + if (argc <= 0) + { + p->maximumRecordSize = 32768; + return TCL_OK; + } return get_set_int (&p->maximumRecordSize, interp, argc, argv); } @@ -530,7 +583,9 @@ static int do_initResult (void *obj, Tcl_Interp *interp, int argc, char **argv) { IRObj *p = obj; - + + if (argc <= 0) + return TCL_OK; return get_set_int (&p->initResult, interp, argc, argv); } @@ -543,9 +598,13 @@ static int do_implementationName (void *obj, Tcl_Interp *interp, { IRObj *p = obj; + if (argc == 0) + return ir_strdup (interp, &p->implementationName, "TCL/TK on YAZ"); + else if (argc == -1) + return ir_strdel (interp, &p->implementationName); if (argc == 3) { - free (((IRObj*)obj)->implementationName); + free (p->implementationName); if (ir_strdup (interp, &p->implementationName, argv[2]) == TCL_ERROR) return TCL_ERROR; @@ -561,15 +620,19 @@ static int do_implementationName (void *obj, Tcl_Interp *interp, static int do_implementationId (void *obj, Tcl_Interp *interp, int argc, char **argv) { + IRObj *p = obj; + + if (argc == 0) + return ir_strdup (interp, &p->implementationId, "81"); + else if (argc == -1) + return ir_strdel (interp, &p->implementationId); if (argc == 3) { - free (((IRObj*)obj)->implementationId); - if (ir_strdup (interp, &((IRObj*) obj)->implementationId, argv[2]) - == TCL_ERROR) + free (p->implementationId); + if (ir_strdup (interp, &p->implementationId, argv[2]) == TCL_ERROR) return TCL_ERROR; } - Tcl_AppendResult (interp, ((IRObj*)obj)->implementationId, - (char*) NULL); + Tcl_AppendResult (interp, p->implementationId, (char*) NULL); return TCL_OK; } @@ -581,6 +644,13 @@ static int do_targetImplementationName (void *obj, Tcl_Interp *interp, { IRObj *p = obj; + if (argc == 0) + { + p->targetImplementationName = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->targetImplementationName); Tcl_AppendResult (interp, p->targetImplementationName, (char*) NULL); return TCL_OK; @@ -592,8 +662,16 @@ static int do_targetImplementationName (void *obj, Tcl_Interp *interp, static int do_targetImplementationId (void *obj, Tcl_Interp *interp, int argc, char **argv) { - Tcl_AppendResult (interp, ((IRObj*)obj)->targetImplementationId, - (char*) NULL); + IRObj *p = obj; + + if (argc == 0) + { + p->targetImplementationId = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->targetImplementationId); + Tcl_AppendResult (interp, p->targetImplementationId, (char*) NULL); return TCL_OK; } @@ -603,8 +681,16 @@ static int do_targetImplementationId (void *obj, Tcl_Interp *interp, static int do_targetImplementationVersion (void *obj, Tcl_Interp *interp, int argc, char **argv) { - Tcl_AppendResult (interp, ((IRObj*)obj)->targetImplementationVersion, - (char*) NULL); + IRObj *p = obj; + + if (argc == 0) + { + p->targetImplementationVersion = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->targetImplementationVersion); + Tcl_AppendResult (interp, p->targetImplementationVersion, (char*) NULL); return TCL_OK; } @@ -616,17 +702,24 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp, { IRObj *p = obj; - if (argc >= 3) + if (argc >= 3 || argc == -1) { free (p->idAuthenticationOpen); free (p->idAuthenticationGroupId); free (p->idAuthenticationUserId); free (p->idAuthenticationPassword); + } + if (argc >= 3 || argc <= 0) + { p->idAuthenticationOpen = NULL; p->idAuthenticationGroupId = NULL; p->idAuthenticationUserId = NULL; p->idAuthenticationPassword = NULL; - + } + if (argc <= 0) + return TCL_OK; + if (argc >= 3) + { if (argc == 3) { if (ir_strdup (interp, &p->idAuthenticationOpen, argv[2]) @@ -648,14 +741,11 @@ static int do_idAuthentication (void *obj, Tcl_Interp *interp, } if (p->idAuthenticationOpen) Tcl_AppendElement (interp, p->idAuthenticationOpen); - else + else if (p->idAuthenticationGroupId) { - Tcl_AppendElement (interp, p->idAuthenticationGroupId ? - p->idAuthenticationGroupId : ""); - Tcl_AppendElement (interp, p->idAuthenticationUserId ? - p->idAuthenticationUserId : ""); - Tcl_AppendElement (interp, p->idAuthenticationPassword ? - p->idAuthenticationPassword : ""); + Tcl_AppendElement (interp, p->idAuthenticationGroupId); + Tcl_AppendElement (interp, p->idAuthenticationUserId); + Tcl_AppendElement (interp, p->idAuthenticationPassword); } return TCL_OK; } @@ -671,6 +761,8 @@ static int do_connect (void *obj, Tcl_Interp *interp, int r; int protocol_type = CS_Z3950; + if (argc <= 0) + return TCL_OK; if (argc == 3) { if (p->hostname) @@ -721,7 +813,7 @@ static int do_connect (void *obj, Tcl_Interp *interp, if ((r=cs_connect (p->cs_link, addr)) < 0) { interp->result = "cs_connect fail"; - do_disconnect (p, NULL, 0, NULL); + do_disconnect (p, NULL, 2, NULL); return TCL_ERROR; } ir_select_add (cs_fileno (p->cs_link), p); @@ -750,6 +842,13 @@ static int do_disconnect (void *obj, Tcl_Interp *interp, { IRObj *p = obj; + if (argc == 0) + { + p->connectFlag = 0; + p->hostname = NULL; + p->cs_link = NULL; + return TCL_OK; + } if (p->hostname) { free (p->hostname); @@ -773,7 +872,11 @@ static int do_comstack (void *o, Tcl_Interp *interp, { IRObj *obj = o; - if (argc == 3) + if (argc == 0) + return ir_strdup (interp, &obj->cs_type, "tcpip"); + else if (argc == -1) + return ir_strdel (interp, &obj->cs_type); + else if (argc == 3) { free (obj->cs_type); if (ir_strdup (interp, &obj->cs_type, argv[2]) == TCL_ERROR) @@ -791,7 +894,11 @@ static int do_protocol (void *o, Tcl_Interp *interp, { IRObj *obj = o; - if (argc == 3) + if (argc == 0) + return ir_strdup (interp, &obj->protocol_type, "Z3950"); + else if (argc == -1) + return ir_strdel (interp, &obj->protocol_type); + else if (argc == 3) { free (obj->protocol_type); if (ir_strdup (interp, &obj->protocol_type, argv[2]) == TCL_ERROR) @@ -809,11 +916,23 @@ static int do_callback (void *obj, Tcl_Interp *interp, { IRObj *p = obj; + if (argc == 0) + { + p->callback = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->callback); if (argc == 3) { free (p->callback); - if (ir_strdup (interp, &p->callback, argv[2]) == TCL_ERROR) - return TCL_ERROR; + if (argv[2][0]) + { + if (ir_strdup (interp, &p->callback, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + else + p->callback = NULL; p->interp = interp; } return TCL_OK; @@ -827,11 +946,23 @@ static int do_failback (void *obj, Tcl_Interp *interp, { IRObj *p = obj; - if (argc == 3) + if (argc == 0) + { + p->failback = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->failback); + else if (argc == 3) { free (p->failback); - if (ir_strdup (interp, &p->failback, argv[2]) == TCL_ERROR) - return TCL_ERROR; + if (argv[2][0]) + { + if (ir_strdup (interp, &p->failback, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + else + p->failback = NULL; p->interp = interp; } return TCL_OK; @@ -846,6 +977,18 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp, int i; IRSetCObj *p = obj; + if (argc == -1) + { + for (i=0; inum_databaseNames; i++) + free (p->databaseNames[i]); + free (p->databaseNames); + } + if (argc <= 0) + { + p->num_databaseNames = 0; + p->databaseNames = NULL; + return TCL_OK; + } if (argc < 3) { for (i=0; inum_databaseNames; i++) @@ -879,6 +1022,11 @@ static int do_replaceIndicator (void *obj, Tcl_Interp *interp, { IRSetCObj *p = obj; + if (argc <= 0) + { + p->replaceIndicator = 1; + return TCL_OK; + } return get_set_int (&p->replaceIndicator, interp, argc, argv); } @@ -890,6 +1038,10 @@ static int do_queryType (void *obj, Tcl_Interp *interp, { IRSetCObj *p = obj; + if (argc == 0) + return ir_strdup (interp, &p->queryType, "rpn"); + else if (argc == -1) + return ir_strdel (interp, &p->queryType); if (argc == 3) { free (p->queryType); @@ -907,7 +1059,14 @@ static int do_userInformationField (void *obj, Tcl_Interp *interp, int argc, char **argv) { IRObj *p = obj; - + + if (argc == 0) + { + p->userInformationField = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &p->userInformationField); Tcl_AppendResult (interp, p->userInformationField, NULL); return TCL_OK; } @@ -918,9 +1077,14 @@ static int do_userInformationField (void *obj, Tcl_Interp *interp, static int do_smallSetUpperBound (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetCObj *obj = o; + IRSetCObj *p = o; - return get_set_int (&obj->smallSetUpperBound, interp, argc, argv); + if (argc <= 0) + { + p->smallSetUpperBound = 0; + return TCL_OK; + } + return get_set_int (&p->smallSetUpperBound, interp, argc, argv); } /* @@ -929,9 +1093,14 @@ static int do_smallSetUpperBound (void *o, Tcl_Interp *interp, static int do_largeSetLowerBound (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetCObj *obj = o; + IRSetCObj *p = o; - return get_set_int (&obj->largeSetLowerBound, interp, argc, argv); + if (argc <= 0) + { + p->largeSetLowerBound = 2; + return TCL_OK; + } + return get_set_int (&p->largeSetLowerBound, interp, argc, argv); } /* @@ -940,9 +1109,14 @@ static int do_largeSetLowerBound (void *o, Tcl_Interp *interp, static int do_mediumSetPresentNumber (void *o, Tcl_Interp *interp, int argc, char **argv) { - IRSetCObj *obj = o; - - return get_set_int (&obj->mediumSetPresentNumber, interp, argc, argv); + IRSetCObj *p = o; + + if (argc <= 0) + { + p->mediumSetPresentNumber = 0; + return TCL_OK; + } + return get_set_int (&p->mediumSetPresentNumber, interp, argc, argv); } @@ -1006,30 +1180,27 @@ int argc, char **argv) */ static void ir_obj_delete (ClientData clientData) { - free ( (void*) clientData); -} + IRObj *obj = clientData; + IRMethods tab[3]; -static int ir_reset_inher (Tcl_Interp *interp, IRSetCObj *o) -{ - o->smallSetUpperBound = 0; - o->largeSetLowerBound = 2; - o->mediumSetPresentNumber = 0; - o->replaceIndicator = 1; -#if 0 - obj->databaseNames = NULL; - obj->num_databaseNames = 0; -#else - o->num_databaseNames = 1; - if (!(o->databaseNames = - ir_malloc (interp, sizeof(*o->databaseNames)))) - return TCL_ERROR; - if (ir_strdup (interp, &o->databaseNames[0], "Default") - == TCL_ERROR) - return TCL_ERROR; -#endif - if (ir_strdup (interp, &o->queryType, "rpn") == TCL_ERROR) - return TCL_ERROR; - return TCL_OK; + --(obj->ref_count); + if (obj->ref_count > 0) + return; + assert (obj->ref_count == 0); + + tab[0].tab = ir_method_tab; + tab[0].obj = obj; + tab[1].tab = ir_set_c_method_tab; + tab[1].obj = &obj->set_inher; + tab[2].tab = NULL; + + ir_method (NULL, -1, NULL, tab); + odr_destroy (obj->odr_in); + odr_destroy (obj->odr_out); + odr_destroy (obj->odr_pr); + free (obj->buf_out); + free (obj->buf_in); + free (obj); } /* @@ -1038,6 +1209,7 @@ static int ir_reset_inher (Tcl_Interp *interp, IRSetCObj *o) static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { + IRMethods tab[3]; IRObj *obj; #if CCL2RPN FILE *inf; @@ -1050,39 +1222,8 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, } if (!(obj = ir_malloc (interp, sizeof(*obj)))) return TCL_ERROR; - if (ir_strdup (interp, &obj->cs_type, "tcpip") == TCL_ERROR) - return TCL_ERROR; - if (ir_strdup (interp, &obj->protocol_type, "Z3950") == TCL_ERROR) - return TCL_ERROR; - obj->cs_link = NULL; - obj->bib1.proto = PROTO_Z3950; - obj->bib1.class = CLASS_ATTSET; - obj->bib1.value = VAL_BIB1; - - obj->maximumRecordSize = 32768; - obj->preferredMessageSize = 4096; - obj->connectFlag = 0; - - obj->idAuthenticationOpen = NULL; - obj->idAuthenticationGroupId = NULL; - obj->idAuthenticationUserId = NULL; - obj->idAuthenticationPassword = NULL; - - if (ir_strdup (interp, &obj->implementationName, "TCL/TK on YAZ") - == TCL_ERROR) - return TCL_ERROR; - - if (ir_strdup (interp, &obj->implementationId, "TCL/TK/YAZ") - == TCL_ERROR) - return TCL_ERROR; - - obj->targetImplementationName = NULL; - obj->targetImplementationId = NULL; - obj->targetImplementationVersion = NULL; - obj->userInformationField = NULL; - - obj->hostname = NULL; + obj->ref_count = 1; #if CCL2RPN obj->bibset = ccl_qual_mk (); if ((inf = fopen ("default.bib", "r"))) @@ -1091,15 +1232,6 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, fclose (inf); } #endif - ODR_MASK_ZERO (&obj->protocolVersion); - ODR_MASK_SET (&obj->protocolVersion, 0); - ODR_MASK_SET (&obj->protocolVersion, 1); - - ODR_MASK_ZERO (&obj->options); - ODR_MASK_SET (&obj->options, 0); - ODR_MASK_SET (&obj->options, 1); - ODR_MASK_SET (&obj->options, 7); - ODR_MASK_SET (&obj->options, 14); obj->odr_in = odr_createmem (ODR_DECODE); obj->odr_out = odr_createmem (ODR_ENCODE); @@ -1113,10 +1245,13 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, obj->len_in = 0; obj->buf_in = NULL; - obj->callback = NULL; - obj->failback = NULL; + tab[0].tab = ir_method_tab; + tab[0].obj = obj; + tab[1].tab = ir_set_c_method_tab; + tab[1].obj = &obj->set_inher; + tab[2].tab = NULL; - if (ir_reset_inher (interp, &obj->set_inher) == TCL_ERROR) + if (ir_method (interp, 0, NULL, tab) == TCL_ERROR) return TCL_ERROR; Tcl_CreateCommand (interp, argv[1], ir_obj_method, (ClientData) obj, ir_obj_delete); @@ -1137,6 +1272,10 @@ static int do_search (void *o, Tcl_Interp *interp, IRSetObj *obj = o; IRObj *p = obj->parent; int r; + oident bib1; + + if (argc <= 0) + return TCL_OK; p->set_child = o; if (argc != 3) @@ -1157,6 +1296,10 @@ static int do_search (void *o, Tcl_Interp *interp, odr_reset (p->odr_out); apdu.which = Z_APDU_searchRequest; apdu.u.searchRequest = &req; + + bib1.proto = PROTO_Z3950; + bib1.class = CLASS_ATTSET; + bib1.value = VAL_BIB1; req.referenceId = 0; req.smallSetUpperBound = &p->set_inher.smallSetUpperBound; @@ -1184,7 +1327,7 @@ static int do_search (void *o, Tcl_Interp *interp, Tcl_AppendResult (interp, "Syntax error in query", NULL); return TCL_ERROR; } - RPNquery->attributeSetId = oid_getoidbyent (&p->bib1); + RPNquery->attributeSetId = oid_getoidbyent (&bib1); query.which = Z_Query_type_1; query.u.type_1 = RPNquery; logf (LOG_DEBUG, "RPN"); @@ -1206,7 +1349,7 @@ static int do_search (void *o, Tcl_Interp *interp, ccl_pr_tree (rpn, stderr); fprintf (stderr, "\n"); assert((RPNquery = ccl_rpn_query(rpn))); - RPNquery->attributeSetId = oid_getoidbyent (&p->bib1); + RPNquery->attributeSetId = oid_getoidbyent (&bib1); query.which = Z_Query_type_1; query.u.type_1 = RPNquery; logf (LOG_DEBUG, "CCLRPN"); @@ -1257,6 +1400,8 @@ static int do_resultCount (void *o, Tcl_Interp *interp, { IRSetObj *obj = o; + if (argc <= 0) + return TCL_OK; return get_set_int (&obj->resultCount, interp, argc, argv); } @@ -1268,6 +1413,8 @@ static int do_searchStatus (void *o, Tcl_Interp *interp, { IRSetObj *obj = o; + if (argc <= 0) + return TCL_OK; return get_set_int (&obj->searchStatus, interp, argc, argv); } @@ -1279,6 +1426,8 @@ static int do_presentStatus (void *o, Tcl_Interp *interp, { IRSetObj *obj = o; + if (argc <= 0) + return TCL_OK; return get_set_int (&obj->presentStatus, interp, argc, argv); } @@ -1291,6 +1440,8 @@ static int do_nextResultSetPosition (void *o, Tcl_Interp *interp, { IRSetObj *obj = o; + if (argc <= 0) + return TCL_OK; return get_set_int (&obj->nextResultSetPosition, interp, argc, argv); } @@ -1302,6 +1453,10 @@ static int do_setName (void *o, Tcl_Interp *interp, { IRSetObj *obj = o; + if (argc == 0) + return ir_strdup (interp, &obj->setName, "Default"); + else if (argc == -1) + return ir_strdel (interp, &obj->setName); if (argc == 3) { free (obj->setName); @@ -1321,6 +1476,8 @@ static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp, { IRSetObj *obj = o; + if (argc < 0) + return TCL_OK; return get_set_int (&obj->numberOfRecordsReturned, interp, argc, argv); } @@ -1333,6 +1490,16 @@ static int do_recordType (void *o, Tcl_Interp *interp, int argc, char **argv) int offset; IRRecordList *rl; + if (argc == 0) + { + obj->record_list = NULL; + return TCL_OK; + } + else if (argc == -1) + { + delete_IR_records (obj); + return TCL_OK; + } if (argc < 3) { sprintf (interp->result, "wrong # args"); @@ -1365,6 +1532,8 @@ static int do_recordDiag (void *o, Tcl_Interp *interp, int argc, char **argv) IRRecordList *rl; char buf[20]; + if (argc <= 0) + return TCL_OK; if (argc < 3) { sprintf (interp->result, "wrong # args"); @@ -1399,7 +1568,9 @@ static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv) int offset; IRRecordList *rl; - if (argc < 4) + if (argc <= 0) + return TCL_OK; + if (argc < 7) { sprintf (interp->result, "wrong # args"); return TCL_ERROR; @@ -1429,6 +1600,14 @@ static int do_responseStatus (void *o, Tcl_Interp *interp, { IRSetObj *obj = o; + if (argc == 0) + { + obj->recordFlag = 0; + obj->addinfo = NULL; + return TCL_OK; + } + else if (argc == -1) + return ir_strdel (interp, &obj->addinfo); if (!obj->recordFlag) { Tcl_AppendElement (interp, "OK"); @@ -1461,6 +1640,8 @@ static int do_present (void *o, Tcl_Interp *interp, int number; int r; + if (argc <= 0) + return TCL_OK; if (argc >= 3) { if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR) @@ -1535,6 +1716,8 @@ static int do_loadFile (void *o, Tcl_Interp *interp, int no = 1; char *buf; + if (argc <= 0) + return TCL_OK; if (argc < 3) { interp->result = "wrong # args"; @@ -1560,13 +1743,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp, return TCL_OK; } -/* - * ir_set_obj_method: IR Set Object methods - */ -static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) -{ - static IRMethod tab[] = { +static IRMethod ir_set_method_tab[] = { { 0, "search", do_search }, { 0, "searchStatus", do_searchStatus }, { 0, "presentStatus", do_presentStatus }, @@ -1581,7 +1758,14 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, { 0, "responseStatus", do_responseStatus }, { 0, "loadFile", do_loadFile }, { 0, NULL, NULL} - }; +}; + +/* + * ir_set_obj_method: IR Set Object methods + */ +static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ IRMethods tabs[3]; IRSetObj *p = clientData; @@ -1590,7 +1774,7 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, interp->result = "wrong # args"; return TCL_ERROR; } - tabs[0].tab = tab; + tabs[0].tab = ir_set_method_tab; tabs[0].obj = p; tabs[1].tab = ir_set_c_method_tab; tabs[1].obj = &p->set_inher; @@ -1604,7 +1788,18 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, */ static void ir_set_obj_delete (ClientData clientData) { - free ( (void*) clientData); + IRMethods tabs[3]; + IRSetObj *p = clientData; + + tabs[0].tab = ir_set_method_tab; + tabs[0].obj = p; + tabs[1].tab = ir_set_c_method_tab; + tabs[1].obj = &p->set_inher; + tabs[2].tab = NULL; + + ir_method (NULL, -1, NULL, tabs); + + free (p); } /* @@ -1613,6 +1808,7 @@ static void ir_set_obj_delete (ClientData clientData) static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { + IRMethods tabs[3]; IRSetObj *obj; if (argc < 2 || argc > 3) @@ -1660,10 +1856,14 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, } else obj->parent = NULL; - if (ir_strdup (interp, &obj->setName, argv[2]) == TCL_ERROR) + + tabs[0].tab = ir_set_method_tab; + tabs[0].obj = obj; + tabs[1].tab = NULL; + + if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR) return TCL_ERROR; - obj->record_list = NULL; - obj->addinfo = NULL; + Tcl_CreateCommand (interp, argv[1], ir_set_obj_method, (ClientData) obj, ir_set_obj_delete); return TCL_OK; @@ -1681,11 +1881,14 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) IRScanObj *obj = o; IRObj *p = obj->parent; int r; + oident bib1; #if CCL2RPN struct ccl_rpn_node *rpn; int pos; #endif + if (argc <= 0) + return TCL_OK; p->scan_child = o; if (argc != 3) { @@ -1703,12 +1906,17 @@ static int do_scan (void *o, Tcl_Interp *interp, int argc, char **argv) return TCL_ERROR; } odr_reset (p->odr_out); + + bib1.proto = PROTO_Z3950; + bib1.class = CLASS_ATTSET; + bib1.value = VAL_BIB1; + apdu.which = Z_APDU_scanRequest; apdu.u.scanRequest = &req; req.referenceId = NULL; req.num_databaseNames = p->set_inher.num_databaseNames; req.databaseNames = p->set_inher.databaseNames; - req.attributeSet = oid_getoidbyent (&p->bib1); + req.attributeSet = oid_getoidbyent (&bib1); #if !CCL2RPN if (!(req.termListAndStartPoint = p_query_scan (p->odr_out, argv[2]))) @@ -1768,6 +1976,11 @@ static int do_stepSize (void *obj, Tcl_Interp *interp, int argc, char **argv) { IRScanObj *p = obj; + if (argc <= 0) + { + p->stepSize = 0; + return TCL_OK; + } return get_set_int (&p->stepSize, interp, argc, argv); } @@ -1778,6 +1991,12 @@ static int do_numberOfTermsRequested (void *obj, Tcl_Interp *interp, int argc, char **argv) { IRScanObj *p = obj; + + if (argc <= 0) + { + p->numberOfTermsRequested = 20; + return TCL_OK; + } return get_set_int (&p->numberOfTermsRequested, interp, argc, argv); } @@ -1789,6 +2008,12 @@ static int do_preferredPositionInResponse (void *obj, Tcl_Interp *interp, int argc, char **argv) { IRScanObj *p = obj; + + if (argc <= 0) + { + p->preferredPositionInResponse = 1; + return TCL_OK; + } return get_set_int (&p->preferredPositionInResponse, interp, argc, argv); } @@ -1799,6 +2024,9 @@ static int do_scanStatus (void *obj, Tcl_Interp *interp, int argc, char **argv) { IRScanObj *p = obj; + + if (argc <= 0) + return TCL_OK; return get_set_int (&p->scanStatus, interp, argc, argv); } @@ -1809,6 +2037,9 @@ static int do_numberOfEntriesReturned (void *obj, Tcl_Interp *interp, int argc, char **argv) { IRScanObj *p = obj; + + if (argc <= 0) + return TCL_OK; return get_set_int (&p->numberOfEntriesReturned, interp, argc, argv); } @@ -1819,6 +2050,9 @@ static int do_positionOfTerm (void *obj, Tcl_Interp *interp, int argc, char **argv) { IRScanObj *p = obj; + + if (argc <= 0) + return TCL_OK; return get_set_int (&p->positionOfTerm, interp, argc, argv); } @@ -1831,6 +2065,22 @@ static int do_scanLine (void *obj, Tcl_Interp *interp, int argc, char **argv) int i; char numstr[20]; + if (argc == 0) + { + p->entries_flag = 0; + p->entries = NULL; + p->nonSurrogateDiagnostics = NULL; + return TCL_OK; + } + else if (argc == -1) + { + p->entries_flag = 0; + /* release entries */ + p->entries = NULL; + /* release non diagnostics */ + p->nonSurrogateDiagnostics = NULL; + return TCL_OK; + } if (argc != 3) { interp->result = "wrong # args"; @@ -1861,13 +2111,7 @@ static int do_scanLine (void *obj, Tcl_Interp *interp, int argc, char **argv) return TCL_OK; } -/* - * ir_scan_obj_method: IR Scan Object methods - */ -static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) -{ - static IRMethod tab[] = { +static IRMethod ir_scan_method_tab[] = { { 0, "scan", do_scan }, { 0, "stepSize", do_stepSize }, { 0, "numberOfTermsRequested", do_numberOfTermsRequested }, @@ -1877,7 +2121,14 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, { 0, "positionOfTerm", do_positionOfTerm }, { 0, "scanLine", do_scanLine }, { 0, NULL, NULL} - }; +}; + +/* + * ir_scan_obj_method: IR Scan Object methods + */ +static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, + int argc, char **argv) +{ IRMethods tabs[3]; if (argc < 2) @@ -1885,8 +2136,7 @@ static int ir_scan_obj_method (ClientData clientData, Tcl_Interp *interp, interp->result = "wrong # args"; return TCL_ERROR; } - - tabs[0].tab = tab; + tabs[0].tab = ir_scan_method_tab; tabs[0].obj = clientData; tabs[1].tab = NULL; @@ -1909,6 +2159,7 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, { Tcl_CmdInfo parent_info; IRScanObj *obj; + IRMethods tabs[3]; if (argc != 2) { @@ -1920,12 +2171,20 @@ static int ir_scan_obj_mk (ClientData clientData, Tcl_Interp *interp, if (!(obj = ir_malloc (interp, sizeof(*obj)))) return TCL_ERROR; + tabs[0].tab = ir_scan_method_tab; + tabs[0].obj = clientData; + tabs[1].tab = NULL; + + if (ir_method (interp, 0, NULL, tabs) == TCL_ERROR) + return TCL_ERROR; +#if 0 obj->stepSize = 0; obj->numberOfTermsRequested = 20; obj->preferredPositionInResponse = 1; obj->entries = NULL; obj->nonSurrogateDiagnostics = NULL; +#endif obj->parent = (IRObj *) parent_info.clientData; Tcl_CreateCommand (interp, argv[1], ir_scan_obj_method, @@ -2207,7 +2466,7 @@ void ir_select_read (ClientData clientData) logf (LOG_DEBUG, "cs_rcvconnect error"); if (p->failback) Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + do_disconnect (p, NULL, 2, NULL); return; } if (p->callback) @@ -2216,13 +2475,19 @@ void ir_select_read (ClientData clientData) } do { + /* signal one more use of ir object - callbacks must not + release the ir memory (p pointer) */ + ++(p->ref_count); if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) <= 0) { logf (LOG_DEBUG, "cs_get failed, code %d", r); ir_select_remove (cs_fileno (p->cs_link), p); if (p->failback) Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + do_disconnect (p, NULL, 2, NULL); + + /* relase ir object now if callback deleted it */ + ir_obj_delete (p); return; } if (r == 1) @@ -2234,7 +2499,10 @@ void ir_select_read (ClientData clientData) logf (LOG_DEBUG, "%s", odr_errlist [odr_geterror (p->odr_in)]); if (p->failback) Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + do_disconnect (p, NULL, 2, NULL); + + /* relase ir object now if callback deleted it */ + ir_obj_delete (p); return; } switch(apdu->which) @@ -2255,11 +2523,17 @@ void ir_select_read (ClientData clientData) logf (LOG_WARN, "Received unknown APDU type (%d)", apdu->which); if (p->failback) Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + do_disconnect (p, NULL, 2, NULL); } odr_reset (p->odr_in); if (p->callback) Tcl_Eval (p->interp, p->callback); + if (p->ref_count == 1) + { + ir_obj_delete (p); + return; + } + --(p->ref_count); } while (p->cs_link && cs_more (p->cs_link)); } @@ -2284,7 +2558,7 @@ void ir_select_write (ClientData clientData) ir_select_remove_write (cs_fileno (p->cs_link), p); if (p->failback) Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + do_disconnect (p, NULL, 2, NULL); return; } ir_select_remove_write (cs_fileno (p->cs_link), p); @@ -2297,7 +2571,7 @@ void ir_select_write (ClientData clientData) logf (LOG_DEBUG, "select write fail"); if (p->failback) Tcl_Eval (p->interp, p->failback); - do_disconnect (p, NULL, 0, NULL); + do_disconnect (p, NULL, 2, NULL); } else if (r == 0) /* remove select bit */ { diff --git a/ir-tcl.h b/ir-tcl.h index 1f75c51..b89a437 100644 --- a/ir-tcl.h +++ b/ir-tcl.h @@ -1,10 +1,37 @@ /* + * Copyright (c) 1995, Index Data. + * + * Permission to use, copy, modify, distribute, and sell this software and + * its documentation, in whole or in part, for any purpose, is hereby granted, + * provided that: + * + * 1. This copyright and permission notice appear in all copies of the + * software and its documentation. Notices of copyright or attribution + * which appear at the beginning of any file must remain unchanged. + * + * 2. The names of Index Data or the individual authors may not be used to + * endorse or promote products derived from this software without specific + * prior written permission. + * + * THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND, + * EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY + * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. + * IN NO EVENT SHALL INDEX DATA BE LIABLE FOR ANY SPECIAL, INCIDENTAL, + * INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY KIND, OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER OR + * NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND ON ANY THEORY OF + * LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE + * OF THIS SOFTWARE. + * * IR toolkit for tcl/tk * (c) Index Data 1995 * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tcl.h,v $ - * Revision 1.6 1995-05-23 15:34:49 adam + * Revision 1.7 1995-05-29 08:44:23 adam + * Work on delete of objects. + * + * Revision 1.6 1995/05/23 15:34:49 adam * Many new settings, userInformationField, smallSetUpperBound, etc. * A number of settings are inherited when ir-set is executed. * This version is incompatible with the graphical test client (client.tcl). diff --git a/ir-tclp.h b/ir-tclp.h index 1d7d6d9..31fe2c0 100644 --- a/ir-tclp.h +++ b/ir-tclp.h @@ -1,10 +1,14 @@ /* * IR toolkit for tcl/tk * (c) Index Data 1995 + * See the file LICENSE for details. * Sebastian Hammer, Adam Dickmeiss * * $Log: ir-tclp.h,v $ - * Revision 1.4 1995-05-26 11:44:10 adam + * Revision 1.5 1995-05-29 08:44:25 adam + * Work on delete of objects. + * + * Revision 1.4 1995/05/26 11:44:10 adam * Bugs fixed. More work on MARC utilities and queries. Test * client is up-to-date again. * @@ -62,6 +66,8 @@ typedef struct { } IRSetCObj; typedef struct { + int ref_count; + char *cs_type; char *protocol_type; int connectFlag; @@ -105,8 +111,6 @@ typedef struct { CCL_bibset bibset; #endif - oident bib1; - struct IRSetObj_ *set_child; struct IRScanObj_ *scan_child; diff --git a/marc.c b/marc.c index 36f2774..6322dc6 100644 --- a/marc.c +++ b/marc.c @@ -1,10 +1,14 @@ /* * IR toolkit for tcl/tk * (c) Index Data 1995 + * See the file LICENSE for details. * Sebastian Hammer, Adam Dickmeiss * * $Log: marc.c,v $ - * Revision 1.2 1995-05-26 11:44:11 adam + * Revision 1.3 1995-05-29 08:44:26 adam + * Work on delete of objects. + * + * Revision 1.2 1995/05/26 11:44:11 adam * Bugs fixed. More work on MARC utilities and queries. Test * client is up-to-date again. * @@ -24,7 +28,7 @@ #define ISO2709_FS 036 #define ISO2709_IDFS 037 -int atoi_n (const char *buf, int len) +static int atoi_n (const char *buf, int len) { int val = 0; @@ -53,8 +57,6 @@ static int marc_compare (const char *f, const char *p) return *f - *p; } -FILE *outf = stderr; - char *ir_tcl_fread_marc (FILE *inf, size_t *size) { char length[5]; diff --git a/mem.tcl b/mem.tcl new file mode 100644 index 0000000..49f2216 --- /dev/null +++ b/mem.tcl @@ -0,0 +1,64 @@ +set count 0 + +proc fail-response {} { + puts "Fail-response" +} + +proc present-response-a {} { + puts "present-response-a" + z disconnect + rename z.1 {} + rename z {} + start +} + +proc present-response-b {} { + puts "present-response-a" + z disconnect + rename z.1 {} + z callback {connect-response} + z connect localhost:9999 +} + +proc search-response {} { + puts "search-response" + set hits [z.1 resultCount] + if {$hits > 0} { + z callback {present-response-a} + z.1 present 1 $hits + return + } + z disconnect + rename z.1 {} + rename z {} + start +} + +proc init-response {} { + puts "init-reponse" + ir-set z.1 z + z callback {search-response} + z.1 search adam +} + +proc connect-response {} { + global count + + incr count + puts $count + puts "connect-response" + z callback {init-response} + z databaseNames A + z init +} + +proc start {} { + ir z + z comstack tcpip + z failback {fail-response} + z callback {connect-response} + z connect localhost:9999 +} + +start + diff --git a/tclmain.c b/tclmain.c index 7e5ae24..33a3407 100644 --- a/tclmain.c +++ b/tclmain.c @@ -1,10 +1,14 @@ /* * IR toolkit for tcl/tk * (c) Index Data 1995 + * See the file LICENSE for details. * Sebastian Hammer, Adam Dickmeiss * * $Log: tclmain.c,v $ - * Revision 1.5 1995-03-20 08:53:30 adam + * Revision 1.6 1995-05-29 08:44:28 adam + * Work on delete of objects. + * + * Revision 1.5 1995/03/20 08:53:30 adam * Event loop in tclmain.c rewritten. New method searchStatus. * * Revision 1.4 1995/03/17 07:50:31 adam -- 1.7.10.4