From 91dd1bab3cf3797e165813afe42ac8c29c69bf0e Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Fri, 10 Mar 1995 18:00:15 +0000 Subject: [PATCH] Actual presentation in line-by-line format. RPN query support. --- client.tcl | 116 +++++++++++++++++++------ ir-tcl.c | 283 ++++++++++++++++++++++++++++++++++++++++++++++++++++-------- 2 files changed, 334 insertions(+), 65 deletions(-) diff --git a/client.tcl b/client.tcl index 4282b6a..a2be810 100644 --- a/client.tcl +++ b/client.tcl @@ -1,11 +1,19 @@ # # $Log: client.tcl,v $ -# Revision 1.1 1995-03-09 16:15:07 adam +# Revision 1.2 1995-03-10 18:00:15 adam +# Actual presentation in line-by-line format. RPN query support. +# +# Revision 1.1 1995/03/09 16:15:07 adam # First presentRequest attempts. Hot-target list. # # set hotTargets {} set hotInfo {} +set busy 0 + +wm minsize . 360 200 +wm maxsize . 800 800 + if {[file readable "~/.tk-c"]} { source "~/.tk-c" } @@ -14,8 +22,30 @@ proc show-target {target} { .bot.target configure -text "$target" } -proc show-status {status} { +proc show-busy {v1 v2} { + global busy + if {$busy != 0} { + .bot.status configure -fg $v1 + after 200 [list show-busy $v2 $v1] + } +} + +proc show-status {status b} { + global busy + global statusbg .bot.status configure -text "$status" + .bot.status configure -fg black + if {$b != 0} { + if {$busy == 0} { + set busy $b + show-busy red blue + } + # . config -cursor {watch black white} + } else { + # . config -cursor {top_left_arrow black white} + puts "Normal" + } + set busy $b } proc show-message {msg} { @@ -82,54 +112,79 @@ proc open-target {target} { } proc init-request {} { - global set-no + global SetNo z39 callback {init-response} z39 init - show-status {Initializing} - set set-no 0 + show-status {Initializing} 1 + set SetNo 0 } proc init-response {} { - show-status {Ready} + show-status {Ready} 0 pack .mid.searchlabel .mid.searchentry -side left bind .mid.searchentry search-request focus .mid.searchentry } proc search-request {} { - global set-no + global SetNo - incr set-no - ir-set z39.${set-no} + incr SetNo + ir-set z39.$SetNo z39 callback {search-response} - z39.${set-no} search [.mid.searchentry get] - show-status {Search} + z39.$SetNo search [.mid.searchentry get] + show-status {Search} 1 } proc search-response {} { - global set-no - - show-status {Ready} - show-message "[z39.${set-no} resultCount] hits" + global SetNo + global setOffset + global setMax + + .data.list delete 0 end + show-status {Ready} 0 + show-message "[z39.$SetNo resultCount] hits" + set setMax [z39.$SetNo resultCount] + puts $setMax + if {$setMax > 16} { + set setMax 16 + } z39 callback {present-response} - z39.${set-no} present - show-status {Retrieve} + set setOffset 1 + z39.$SetNo present 1 $setMax + show-status {Retrieve} 1 } proc present-response {} { - show-status {Finished} + global SetNo + global setOffset + global setMax + + puts "In present-response" + set no [z39.$SetNo numberOfRecordsReturned] + puts "Returned $no records, setOffset $setOffset" + for {set i 0} {$i < $no} {incr i} { + set o [expr $i + $setOffset] + set title [lindex [z39.$SetNo getRecord $o 245 a] 0] + set year [lindex [z39.$SetNo getRecord $o 260 c] 0] + .data.list insert end "$title - $year" + } + set setOffset [expr $setOffset + $no] + if { $setOffset <= $setMax} { + z39.$SetNo present $setOffset [expr $setMax - $setOffset + 1] + } else { + show-status {Finished} 0 + } } - + proc bind-fields {list returnAction escapeAction} { - set i 0 set max [expr [llength $list]-1] - while {$i < $max} { + for {set i 0} {$i < $max} {incr i} { bind [lindex $list $i] $returnAction bind [lindex $list $i] $escapeAction bind [lindex $list $i] [list focus [lindex $list [expr $i+1]]] - incr i } bind [lindex $list $i] $returnAction bind [lindex $list $i] $escapeAction @@ -193,7 +248,7 @@ proc close-target {} { pack forget .mid.searchlabel .mid.searchentry z39 disconnect show-target {None} - show-status {Not connected} + show-status {Not connected} 0 show-message {} } @@ -319,7 +374,7 @@ proc database-select {} { -command {protocol-setup-action} pack $w.bot.left.ok -expand yes -padx 3 -pady 3 button $w.bot.cancel -width 6 -text {Cancel} \ - -command "destroy $w" + -command "destroy .database-select" pack $w.bot.cancel -side left -expand yes # Grab ... @@ -375,10 +430,12 @@ pack .top.help -side right label .mid.searchlabel -text {Search:} entry .mid.searchentry -width 50 -relief sunken -listbox .data.list -geometry 50x10 +listbox .data.list -yscrollcommand {.data.scroll set} +#-geometry 50x10 scrollbar .data.scroll -orient vertical -border 1 pack .data.list -side left -fill both -expand yes pack .data.scroll -side right -fill y +.data.scroll config -command {.data.list yview} message .bot.target -text "None" -aspect 1000 -relief sunken -border 1 label .bot.status -text "Not connected" -width 12 -relief \ @@ -387,8 +444,13 @@ label .bot.message -text "" -width 20 -relief \ sunken -anchor w -border 1 pack .bot.target .bot.status .bot.message -anchor nw -side left -padx 2 -pady 2 +for {set i 0} {$i < 30} {incr i} { + .data.list insert end "Record $i" +} + +bind .data.list {set indx [.data.list nearest %y] +puts "y=%y index $indx" } + ir z39 z39 comstack tcpip set csRadioType [z39 comstack] -wm minsize . 360 200 -wm maxsize . 800 800 diff --git a/ir-tcl.c b/ir-tcl.c index 9746fe9..e17320a 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -3,7 +3,10 @@ * (c) Index Data 1995 * * $Log: ir-tcl.c,v $ - * Revision 1.4 1995-03-09 16:15:08 adam + * Revision 1.5 1995-03-10 18:00:15 adam + * Actual presentation in line-by-line format. RPN query support. + * + * Revision 1.4 1995/03/09 16:15:08 adam * First presentRequest attempts. Hot-target list. * */ @@ -13,6 +16,8 @@ #include #include +#include +#include #include #include #include @@ -54,13 +59,28 @@ typedef struct { int replaceIndicator; char **databaseNames; int num_databaseNames; + char *query_method; + + CCL_bibset bibset; struct IRSetObj_ *child; } IRObj; +typedef struct IRRecordList_ { + int status; + Iso2709Rec rec; + int no; + struct IRRecordList_ *next; +} IRRecordList; + typedef struct IRSetObj_ { IRObj *parent; int resultCount; + int start; + int number; + int numberOfRecordsReturned; + Z_Records *z_records; + IRRecordList *record_list; } IRSetObj; typedef struct { @@ -452,6 +472,23 @@ static int do_databaseNames (void *obj, Tcl_Interp *interp, return TCL_OK; } +/* + * do_query: Set/Get query mothod + */ +static int do_query (void *obj, Tcl_Interp *interp, + int argc, char **argv) +{ + IRObj *p = obj; + if (argc == 3) + { + free (p->query_method); + if (ir_strdup (interp, &p->query_method, argv[2]) == TCL_ERROR) + return TCL_ERROR; + } + Tcl_AppendResult (interp, p->query_method, NULL); + return TCL_OK; +} + /* * ir_obj_method: IR Object methods */ @@ -459,19 +496,20 @@ static int ir_obj_method (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { static IRMethod tab[] = { - { "comstack", do_comstack }, - { "connect", do_connect }, - { "protocolVersion", do_protocolVersion }, - { "options", do_options }, - { "preferredMessageSize", do_preferredMessageSize }, - { "maximumMessageSize", do_maximumMessageSize }, - { "implementationName", do_implementationName }, - { "implementationId", do_implementationId }, - { "idAuthentication", do_idAuthentication }, - { "init", do_init_request }, - { "disconnect", do_disconnect }, - { "callback", do_callback }, - { "databaseNames", do_databaseNames}, + { "comstack", do_comstack }, + { "connect", do_connect }, + { "protocolVersion", do_protocolVersion }, + { "options", do_options }, + { "preferredMessageSize", do_preferredMessageSize }, + { "maximumMessageSize", do_maximumMessageSize }, + { "implementationName", do_implementationName }, + { "implementationId", do_implementationId }, + { "idAuthentication", do_idAuthentication }, + { "init", do_init_request }, + { "disconnect", do_disconnect }, + { "callback", do_callback }, + { "databaseNames", do_databaseNames}, + { "query", do_query }, { NULL, NULL} }; if (argc < 2) @@ -497,6 +535,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { IRObj *obj; + FILE *inf; if (argc != 2) { @@ -511,7 +550,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, } obj->cs_link = cs_create (tcpip_type); - obj->maximumMessageSize = 9000; + obj->maximumMessageSize = 32768; obj->preferredMessageSize = 4096; obj->idAuthentication = NULL; @@ -530,7 +569,14 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, obj->replaceIndicator = 1; obj->databaseNames = NULL; obj->num_databaseNames = 0; - + if (ir_strdup (interp, &obj->query_method, "rpn") == TCL_ERROR) + return TCL_ERROR; + obj->bibset = ccl_qual_mk (); + if ((inf = fopen ("default.bib", "r"))) + { + ccl_qual_file (obj->bibset, inf); + fclose (inf); + } ODR_MASK_ZERO (&obj->protocolVersion); ODR_MASK_SET (&obj->protocolVersion, 0); ODR_MASK_SET (&obj->protocolVersion, 1); @@ -555,7 +601,6 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, obj->buf_in = NULL; obj->callback = NULL; - Tcl_CreateCommand (interp, argv[1], ir_obj_method, (ClientData) obj, ir_obj_delete); return TCL_OK; @@ -606,11 +651,36 @@ static int do_search (void *o, Tcl_Interp *interp, req.preferredRecordSyntax = 0; req.query = &query; - query.which = Z_Query_type_2; - query.u.type_2 = &ccl_query; - ccl_query.buf = argv[2]; - ccl_query.len = strlen (argv[2]); + if (!strcmp (p->query_method, "rpn")) + { + int error; + int pos; + struct ccl_rpn_node *rpn; + Z_RPNQuery *RPNquery; + rpn = ccl_find_str(p->bibset, argv[2], &error, &pos); + if (error) + { + Tcl_AppendResult (interp, "CCL error: ", ccl_err_msg(error),NULL); + return TCL_ERROR; + } + query.which = Z_Query_type_1; + assert((RPNquery = ccl_rpn_query(rpn))); + RPNquery->attributeSetId = bib1; + query.u.type_1 = RPNquery; + } + else if (!strcmp (p->query_method, "ccl")) + { + query.which = Z_Query_type_2; + query.u.type_2 = &ccl_query; + ccl_query.buf = argv[2]; + ccl_query.len = strlen (argv[2]); + } + else + { + interp->result = "unknown query method"; + return TCL_ERROR; + } if (!z_APDU (p->odr_out, &apdup, 0)) { interp->result = odr_errlist [odr_geterror (p->odr_out)]; @@ -623,33 +693,91 @@ static int do_search (void *o, Tcl_Interp *interp, interp->result = "cs_put failed in init"; return TCL_ERROR; } + printf ("Search request\n"); return TCL_OK; } /* - * do_query: Set query for a Set Object + * do_resultCount: Get number of hits */ -static int do_query (void *obj, Tcl_Interp *interp, +static int do_resultCount (void *o, Tcl_Interp *interp, int argc, char **argv) { + IRSetObj *obj = o; + + sprintf (interp->result, "%d", obj->resultCount); return TCL_OK; } /* - * do_resultCount: Get number of hits + * do_numberOfRecordsReturned: Get number of records returned */ -static int do_resultCount (void *o, Tcl_Interp *interp, +static int do_numberOfRecordsReturned (void *o, Tcl_Interp *interp, int argc, char **argv) { IRSetObj *obj = o; - sprintf (interp->result, "%d", obj->resultCount); + sprintf (interp->result, "%d", obj->numberOfRecordsReturned); return TCL_OK; } +static int get_marc_record(Tcl_Interp *interp, Iso2709Rec rec, + int argc, char **argv) +{ + struct iso2709_dir *dir; + struct iso2709_field *field; + + for (dir = rec->directory; dir; dir = dir->next) + { + if (strcmp (dir->tag, argv[3])) + continue; + for (field = dir->fields; field; field = field->next) + { + if (argc > 4 && strcmp (field->identifier, argv[4])) + continue; + Tcl_AppendElement (interp, field->data); + } + } + return TCL_OK; +} /* - * do_present: Perform present Request + * do_getRecord: Get an ISO2709 Record + */ +static int do_getRecord (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IRSetObj *obj = o; + int offset; + IRRecordList *rl; + + if (argc < 3) + { + sprintf (interp->result, "wrong # args"); + return TCL_ERROR; + } + if (Tcl_GetInt (interp, argv[2], &offset)==TCL_ERROR) + return TCL_ERROR; + for (rl = obj->record_list; rl; rl = rl->next) + { + if (rl->no == offset) + break; + } + if (!rl) + { + Tcl_AppendResult (interp, "No record at #", argv[2], NULL); + return TCL_ERROR; + } + if (!rl->rec) + { + Tcl_AppendResult (interp, "Not a MARC record at #", argv[2], NULL); + return TCL_ERROR; + } + return get_marc_record (interp, rl->rec, argc, argv); +} + +/* + * do_present: Perform Present Request */ static int do_present (void *o, Tcl_Interp *interp, @@ -678,6 +806,9 @@ static int do_present (void *o, Tcl_Interp *interp, } else number = 10; + obj->start = start; + obj->number = number; + apdup = &apdu; apdu.which = Z_APDU_presentRequest; apdu.u.presentRequest = &req; @@ -701,7 +832,7 @@ static int do_present (void *o, Tcl_Interp *interp, interp->result = "cs_put failed in init"; return TCL_ERROR; } - printf ("Present request\n"); + printf ("Present request, start=%d, num=%d\n", start, number); return TCL_OK; } @@ -712,10 +843,11 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, int argc, char **argv) { static IRMethod tab[] = { - { "query", do_query }, - { "search", do_search }, - { "resultCount", do_resultCount }, - { "present", do_present }, + { "search", do_search }, + { "resultCount", do_resultCount }, + { "numberOfRecordsReturned", do_numberOfRecordsReturned }, + { "present", do_present }, + { "getRecord", do_getRecord }, { NULL, NULL} }; @@ -757,6 +889,8 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, interp->result = "malloc fail"; return TCL_ERROR; } + obj->z_records = NULL; + obj->record_list = NULL; obj->parent = (IRObj *) parent_info.clientData; Tcl_CreateCommand (interp, argv[1], ir_set_obj_method, (ClientData) obj, ir_set_obj_delete); @@ -810,13 +944,86 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs) static void ir_presentResponse (void *o, Z_PresentResponse *presrs) { IRObj *p = o; - IRSetObj *obj = p->child; - - printf("Received presentResponse.\n"); - if (presrs->records) - printf ("Got records\n"); + IRSetObj *setobj = p->child; + Z_Records *zrs = presrs->records; + setobj->z_records = presrs->records; + + printf ("Received presentResponse\n"); + if (zrs) + { + if (zrs->which == Z_Records_NSD) + { + setobj->numberOfRecordsReturned = 0; + printf ("They are diagnostic!!!\n"); + /* + char buf[16]; + sprintf (buf, "%d", *zrs->u.nonSurrogateDiagnostic->condition); + Tcl_AppendResult (interp, "Diagnostic message: ", buf, + " : ", + zrs->u.nonSurrogateDiagnostic->addinfo, NULL); + return TCL_ERROR; + */ + return; + } + else + { + int offset; + IRRecordList *rl; + + setobj->numberOfRecordsReturned = + zrs->u.databaseOrSurDiagnostics->num_records; + printf ("Got %d records\n", setobj->numberOfRecordsReturned); + for (offset = 0; offsetnumberOfRecordsReturned; offset++) + { + int no = setobj->start + offset; + + for (rl = setobj->record_list; rl; rl = rl->next) + { + if (no == rl->no) + { + if (rl->rec) + iso2709_rm (rl->rec); + break; + } + } + if (!rl) + { + rl = malloc (sizeof(*rl)); + assert (rl); + rl->next = setobj->record_list; + rl->no = no; + rl->status = 0; + setobj->record_list = rl; + } + if (zrs->u.databaseOrSurDiagnostics->records[offset]->which == + Z_NamePlusRecord_surrogateDiagnostic) + { + rl->status = -1; + rl->rec = NULL; + } + else + { + Z_DatabaseRecord *zr; + Odr_external *oe; + + rl->status = 0; + zr = zrs->u.databaseOrSurDiagnostics->records[offset] + ->u.databaseRecord; + oe = (Odr_external*) zr; + if (oe->which == ODR_EXTERNAL_octet + && zr->u.octet_aligned->len) + { + const char *buf = (char*) zr->u.octet_aligned->buf; + rl->rec = iso2709_cvt (buf); + } + } + } + } + } else - printf("No records\n"); + { + printf ("No records!\n"); + } } void ir_select_proc (ClientData clientData) -- 1.7.10.4