X-Git-Url: http://lists.indexdata.com/cgi-bin?a=blobdiff_plain;f=ir-tcl.c;h=37386aefc10d4468ea26cff7c86d54bc926c30f8;hb=9bf072f0eae8b863614a64b3181f7f38b164d882;hp=d2c1881247c0fd702c18d10c16c37fc82e2fb3b0;hpb=6b7704f0e063b05c5817dd4dd8d3d4dedea22499;p=ir-tcl-moved-to-github.git

diff --git a/ir-tcl.c b/ir-tcl.c
index d2c1881..37386ae 100644
--- a/ir-tcl.c
+++ b/ir-tcl.c
@@ -5,7 +5,26 @@
  * Sebastian Hammer, Adam Dickmeiss
  *
  * $Log: ir-tcl.c,v $
- * Revision 1.45  1995-06-20 08:07:30  adam
+ * Revision 1.49  1995-06-30 12:39:21  adam
+ * Bug fix: loadFile didn't set record type.
+ * The MARC routines are a little less strict in the interpretation.
+ * Script display.tcl replaces the old marc.tcl.
+ * New interactive script: shell.tcl.
+ *
+ * Revision 1.48  1995/06/27  19:03:50  adam
+ * Bug fix in do_present in ir-tcl.c: p->set_child member weren't set.
+ * nextResultSetPosition used instead of setOffset.
+ *
+ * Revision 1.47  1995/06/25  10:25:04  adam
+ * Working on triggerResourceControl. Description of compile/install
+ * procedure moved to ir-tcl.sgml.
+ *
+ * Revision 1.46  1995/06/22  13:15:06  adam
+ * Feature: SUTRS. Setting getSutrs implemented.
+ * Work on display formats.
+ * Preferred record syntax can be set by the user.
+ *
+ * Revision 1.45  1995/06/20  08:07:30  adam
  * New setting: failInfo.
  * Working on better cancel mechanism.
  *
@@ -354,7 +373,8 @@ int ir_method (Tcl_Interp *interp, int argc, char **argv, IrTcl_Methods *tab)
 
     if (argc <= 0)
         return TCL_OK;
-    Tcl_AppendResult (interp, "Bad method. Possible methods:", NULL);
+    Tcl_AppendResult (interp, "Bad method: ", argv[1], 
+                      ". 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);
@@ -980,8 +1000,6 @@ static int do_connect (void *obj, Tcl_Interp *interp,
                 IrTcl_eval (p->interp, p->callback);
         }
     }
-    if (p->hostname)
-        Tcl_AppendElement (interp, p->hostname);
     return TCL_OK;
 }
 
@@ -1146,6 +1164,53 @@ static int do_protocol (void *o, Tcl_Interp *interp, int argc, char **argv)
 }
 
 /*
+ * do_triggerResourceControl:
+ */
+static int do_triggerResourceControl (void *obj, Tcl_Interp *interp,
+                                      int argc, char **argv)
+{
+    IrTcl_Obj *p = obj;
+    Z_APDU *apdu;
+    Z_TriggerResourceControlRequest *req;
+    int r;
+
+    if (argc <= 0)
+        return TCL_OK;
+    if (!p->cs_link)
+    {
+        interp->result = "not connected";
+        return TCL_ERROR;
+    }
+    apdu = zget_APDU (p->odr_out, Z_APDU_triggerResourceControlRequest);
+    req = apdu->u.triggerResourceControlRequest;
+    
+    if (!z_APDU (p->odr_out, &apdu, 0))
+    {
+        Tcl_AppendResult (interp, odr_errlist [odr_geterror (p->odr_out)],
+                          NULL);
+        odr_reset (p->odr_out);
+        return TCL_ERROR;
+    }
+    p->sbuf = odr_getbuf (p->odr_out, &p->slen, NULL);
+    if ((r=cs_put (p->cs_link, p->sbuf, p->slen)) < 0)
+    {     
+        interp->result = "cs_put failed in triggerResourceControl";
+        do_disconnect (p, NULL, 2, NULL);
+        return TCL_ERROR;
+    }
+    else if (r == 1)
+    {
+        ir_select_add_write (cs_fileno(p->cs_link), p);
+        logf (LOG_DEBUG, "Sent part of triggerResourceControl (%d bytes)", 
+            p->slen);
+    }
+    else
+        logf (LOG_DEBUG, "Sent whole of triggerResourceControl (%d bytes)", 
+            p->slen);
+    return TCL_OK;
+}
+
+/*
  * do_databaseNames: specify database names
  */
 static int do_databaseNames (void *obj, Tcl_Interp *interp,
@@ -1374,6 +1439,7 @@ static IrTcl_Method ir_method_tab[] = {
 { 0, "initResult",                  do_initResult },
 { 0, "disconnect",                  do_disconnect },
 { 0, "callback",                    do_callback },
+{ 0, "triggerResourceControl",      do_triggerResourceControl },
 { 0, NULL, NULL}
 };
 
@@ -1504,13 +1570,14 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
     Z_APDU *apdu;
     Odr_oct ccl_query;
     IrTcl_SetObj *obj = o;
-    IrTcl_Obj *p = obj->parent;
+    IrTcl_Obj *p;
     int r;
     oident bib1;
 
     if (argc <= 0)
         return TCL_OK;
 
+    p = obj->parent;
     p->set_child = o;
     if (argc != 3)
     {
@@ -1557,6 +1624,7 @@ static int do_search (void *o, Tcl_Interp *interp, int argc, char **argv)
         ident.proto = p->protocol_type;
         ident.class = CLASS_RECSYN;
         ident.value = *obj->set_inher.preferredRecordSyntax;
+        logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value);
         req->preferredRecordSyntax = odr_oiddup (p->odr_out, 
                                                  oid_getoidbyent (&ident));
     }
@@ -1689,7 +1757,10 @@ static int do_nextResultSetPosition (void *o, Tcl_Interp *interp,
     IrTcl_SetObj *obj = o;
 
     if (argc <= 0)
+    {
+        obj->nextResultSetPosition = 0;
         return TCL_OK;
+    }
     return get_set_int (&obj->nextResultSetPosition, interp, argc, argv);
 }
 
@@ -1903,6 +1974,41 @@ static int do_getMarc (void *o, Tcl_Interp *interp, int argc, char **argv)
     return ir_tcl_get_marc (interp, rl->u.dbrec.buf, argc, argv);
 }
 
+/*
+ * do_getSutrs: Get SUTRS Record
+ */
+static int do_getSutrs (void *o, Tcl_Interp *interp, int argc, char **argv)
+{
+    IrTcl_SetObj *obj = o;
+    int offset;
+    IrTcl_RecordList *rl;
+
+    if (argc <= 0)
+        return TCL_OK;
+    if (argc < 3)
+    {
+        sprintf (interp->result, "wrong # args");
+        return TCL_ERROR;
+    }
+    if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR)
+        return TCL_ERROR;
+    rl = find_IR_record (obj, offset);
+    if (!rl)
+    {
+        Tcl_AppendResult (interp, "No record at #", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    if (rl->which != Z_NamePlusRecord_databaseRecord)
+    {
+        Tcl_AppendResult (interp, "No DB record at #", argv[2], NULL);
+        return TCL_ERROR;
+    }
+    if (rl->u.dbrec.type != VAL_SUTRS)
+        return TCL_OK;
+    Tcl_AppendElement (interp, rl->u.dbrec.buf);
+    return TCL_OK;
+}
+
 
 /*
  * do_responseStatus: Return response status (present or search)
@@ -1951,7 +2057,7 @@ static int do_present (void *o, Tcl_Interp *interp,
                        int argc, char **argv)
 {
     IrTcl_SetObj *obj = o;
-    IrTcl_Obj *p = obj->parent;
+    IrTcl_Obj *p;
     Z_APDU *apdu;
     Z_PresentRequest *req;
     int start;
@@ -1979,6 +2085,9 @@ static int do_present (void *o, Tcl_Interp *interp,
         interp->result = "not connected";
         return TCL_ERROR;
     }
+    p = obj->parent;
+    p->set_child = obj;
+
     odr_reset (p->odr_out);
     obj->start = start;
     obj->number = number;
@@ -1993,7 +2102,19 @@ static int do_present (void *o, Tcl_Interp *interp,
     
     req->resultSetStartPoint = &start;
     req->numberOfRecordsRequested = &number;
-    req->preferredRecordSyntax = 0;
+    if (obj->set_inher.preferredRecordSyntax)
+    {
+        struct oident ident;
+
+        ident.proto = p->protocol_type;
+        ident.class = CLASS_RECSYN;
+        ident.value = *obj->set_inher.preferredRecordSyntax;
+        logf (LOG_DEBUG, "Preferred record syntax is %d", ident.value);
+        req->preferredRecordSyntax = odr_oiddup (p->odr_out, 
+                                                 oid_getoidbyent (&ident));
+    }
+    else
+        req->preferredRecordSyntax = 0;
 
     if (!z_APDU (p->odr_out, &apdu, 0))
     {
@@ -2052,6 +2173,7 @@ static int do_loadFile (void *o, Tcl_Interp *interp,
         IrTcl_RecordList *rl;
 
         rl = new_IR_record (setobj, no, Z_NamePlusRecord_databaseRecord);
+        rl->u.dbrec.type = VAL_USMARC;
         rl->u.dbrec.buf = buf;
 	rl->u.dbrec.size = size;
         no++;
@@ -2072,6 +2194,7 @@ static IrTcl_Method ir_set_method_tab[] = {
     { 0, "present",                 do_present },
     { 0, "type",                    do_type },
     { 0, "getMarc",                 do_getMarc },
+    { 0, "getSutrs",                do_getSutrs },
     { 0, "recordType",              do_recordType },
     { 0, "diag",                    do_diag },
     { 0, "responseStatus",          do_responseStatus },
@@ -2654,22 +2777,43 @@ static void ir_handleRecords (void *o, Z_Records *zrs)
             {
                 Z_DatabaseRecord *zr; 
                 Odr_external *oe;
+                struct oident *ident;
                 
                 zr = zrs->u.databaseOrSurDiagnostics->records[offset]
                     ->u.databaseRecord;
                 oe = (Odr_external*) zr;
 		rl->u.dbrec.size = zr->u.octet_aligned->len;
+
                 rl->u.dbrec.type = VAL_USMARC;
+                if ((ident = oid_getentbyoid (oe->direct_reference)))
+                    rl->u.dbrec.type = ident->value;
                 if (oe->which == ODR_EXTERNAL_octet && rl->u.dbrec.size > 0)
                 {
-                    const char *buf = (char*) zr->u.octet_aligned->buf;
+                    char *buf = (char*) zr->u.octet_aligned->buf;
                     if ((rl->u.dbrec.buf = malloc (rl->u.dbrec.size)))
 		        memcpy (rl->u.dbrec.buf, buf, rl->u.dbrec.size);
-                    if (oe->direct_reference)
+                }
+                else if (rl->u.dbrec.type == VAL_SUTRS && 
+                         oe->which == ODR_EXTERNAL_single)
+                {
+                    Odr_oct *rc;
+                    
+                    logf (LOG_DEBUG, "Decoding SUTRS");
+                    odr_setbuf (p->odr_in, (char*) oe->u.single_ASN1_type->buf,
+                                oe->u.single_ASN1_type->len, 0);
+                    if (!z_SUTRS(p->odr_in, &rc, 0))
+                    {
+                        logf (LOG_WARN, "Cannot decode SUTRS");
+                        rl->u.dbrec.buf = NULL;
+                    }
+                    else 
                     {
-                        struct oident *ident = 
-                            oid_getentbyoid (oe->direct_reference);
-                        rl->u.dbrec.type = ident->value;
+                        if ((rl->u.dbrec.buf = malloc (rc->len+1)))
+                        {
+                            memcpy (rl->u.dbrec.buf, rc->buf, rc->len);
+                            rl->u.dbrec.buf[rc->len] = '\0';
+                        }
+                        rl->u.dbrec.size = rc->len;
                     }
                 }
                 else