From 85098ebfc222fe65073732978d8c5132ee52e08c Mon Sep 17 00:00:00 2001 From: Adam Dickmeiss Date: Thu, 9 Mar 1995 16:15:07 +0000 Subject: [PATCH] First presentRequest attempts. Hot-target list. --- client.tcl | 394 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ir-tcl.c | 121 ++++++++++++++++--- 2 files changed, 497 insertions(+), 18 deletions(-) create mode 100644 client.tcl diff --git a/client.tcl b/client.tcl new file mode 100644 index 0000000..4282b6a --- /dev/null +++ b/client.tcl @@ -0,0 +1,394 @@ +# +# $Log: client.tcl,v $ +# Revision 1.1 1995-03-09 16:15:07 adam +# First presentRequest attempts. Hot-target list. +# +# +set hotTargets {} +set hotInfo {} +if {[file readable "~/.tk-c"]} { + source "~/.tk-c" +} + +proc show-target {target} { + .bot.target configure -text "$target" +} + +proc show-status {status} { + .bot.status configure -text "$status" +} + +proc show-message {msg} { + .bot.message configure -text "$msg" +} + +proc update-target-hotlist {target} { + global hotTargets + + set len [llength $hotTargets] + if {$len > 0} { + .top.target.m delete 5 [expr 5+[llength $hotTargets]] + } + set indx [lsearch $hotTargets $target] + if {$indx >= 0} { + set hotTargets [lreplace $hotTargets $indx $indx] + } + set hotTargets [linsert $hotTargets 0 $target] + set-target-hotlist +} + +proc set-target-hotlist {} { + global hotTargets + + set i 1 + foreach target $hotTargets { + .top.target.m add command -label $target -command \ + "menu-open-target $target" + incr i + if {$i > 8} { + break + } + } +} + +proc menu-open-target {target} { + open-target $target + update-target-hotlist $target +} + +proc open-target-action {} { + set host [.target-connect.top.host.entry get] + set port [.target-connect.top.port.entry get] + + if {$host == ""} { + return + } + if {$port == ""} { + set port 210 + } + open-target "${host}:${port}" + update-target-hotlist ${host}:${port} + destroy .target-connect +} + +proc open-target {target} { + z39 disconnect + global csRadioType + z39 comstack ${csRadioType} + show-target $target + z39 connect $target + + init-request +} + +proc init-request {} { + global set-no + + z39 callback {init-response} + z39 init + show-status {Initializing} + set set-no 0 +} + +proc init-response {} { + show-status {Ready} + pack .mid.searchlabel .mid.searchentry -side left + bind .mid.searchentry search-request + focus .mid.searchentry +} + +proc search-request {} { + global set-no + + incr set-no + ir-set z39.${set-no} + + z39 callback {search-response} + z39.${set-no} search [.mid.searchentry get] + show-status {Search} +} + +proc search-response {} { + global set-no + + show-status {Ready} + show-message "[z39.${set-no} resultCount] hits" + z39 callback {present-response} + z39.${set-no} present + show-status {Retrieve} +} + +proc present-response {} { + show-status {Finished} +} + +proc bind-fields {list returnAction escapeAction} { + set i 0 + set max [expr [llength $list]-1] + while {$i < $max} { + 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 + bind [lindex $list $i] [list focus [lindex $list 0]] + focus [lindex $list 0] +} + +proc entry-fields {parent list tlist returnAction escapeAction} { + set alist {} + set i 0 + foreach field $list { + set label ${parent}.${field}.label + set entry ${parent}.${field}.entry + label $label -text [lindex $tlist $i] -anchor e + entry $entry -width 30 -relief sunken + pack $label -side left + pack $entry -side right + lappend alist $entry + incr i + } + bind-fields $alist $returnAction $escapeAction +} + +proc open-target-dialog {} { + set w .target-connect + + toplevel $w + + place-force $w . + + frame $w.top -relief sunken -border 1 + frame $w.bot -relief sunken -border 1 + + pack $w.top $w.bot -side top -fill both -expand yes + + frame $w.top.host + frame $w.top.port + + pack $w.top.host $w.top.port \ + -side top -anchor e -pady 2 + + entry-fields $w.top {host port } \ + {{Hostname:} {Port number:}} \ + {open-target-action} {destroy .target-connect} + + frame $w.bot.left -relief sunken -border 1 + pack $w.bot.left -side left -expand yes -padx 5 -pady 5 + button $w.bot.left.ok -width 6 -text {Ok} \ + -command {open-target-action} + pack $w.bot.left.ok -expand yes -padx 3 -pady 3 + button $w.bot.cancel -width 6 -text {Cancel} \ + -command {destroy .target-connect} + pack $w.bot.cancel -side left -expand yes + + grab $w + + tkwait window $w +} + +proc close-target {} { + pack forget .mid.searchlabel .mid.searchentry + z39 disconnect + show-target {None} + show-status {Not connected} + show-message {} +} + +proc protocol-setup-action {} { + destroy .protocol-setup +} + + +proc place-force {window parent} { + set g [wm geometry $parent] + + set p1 [string first + $g] + set p2 [string last + $g] + + set x [expr 40+[string range $g [expr $p1 +1] [expr $p2 -1]]] + set y [expr 60+[string range $g [expr $p2 +1] end]] + wm geometry $window +${x}+${y} +} + +proc protocol-setup {} { + set w .protocol-setup + + toplevel $w + + place-force $w . + + frame $w.top -relief sunken -border 1 + frame $w.bot -relief sunken -border 1 + + pack $w.top $w.bot -side top -fill both -expand yes + + frame $w.top.description + frame $w.top.idAuthentification + frame $w.top.maximumMessageSize + frame $w.top.preferredMessageSize + frame $w.top.cs-type -relief ridge -border 2 + frame $w.top.query -relief ridge -border 2 + +# Maximum/preferred/idAuth ... + pack $w.top.description \ + $w.top.idAuthentification $w.top.maximumMessageSize \ + $w.top.preferredMessageSize -side top -anchor e -pady 2 + + entry-fields $w.top {description idAuthentification maximumMessageSize \ + preferredMessageSize} \ + {{Description:} {Id Authentification:} {Maximum Message Size:} + {Preferred Message Size:}} \ + {protocol-setup-action} {destroy .protocol-setup} + +# Transport ... + pack $w.top.cs-type -side left -pady 2 -padx 2 + + global csRadioType + + label $w.top.cs-type.label -text "Transport" -anchor e + radiobutton $w.top.cs-type.tcpip -text "TCP/IP" \ + -command {puts tcp/ip} -variable csRadioType -value tcpip + radiobutton $w.top.cs-type.mosi -text "MOSI" \ + -command {puts mosi} -variable csRadioType -value mosi + + pack $w.top.cs-type.label $w.top.cs-type.tcpip $w.top.cs-type.mosi \ + -padx 4 -side top -fill x + +# Query ... + pack $w.top.query -side right -pady 2 -padx 2 -expand yes + + label $w.top.query.label -text "Query support" -anchor e + checkbutton $w.top.query.c1 -text "CCL query" + checkbutton $w.top.query.c2 -text "RPN query" + checkbutton $w.top.query.c3 -text "Result sets" + + pack $w.top.query.label -side top -anchor w + pack $w.top.query.c1 $w.top.query.c2 $w.top.query.c3 \ + -padx 4 -side left -fill x + +# Buttons ... + frame $w.bot.left -relief sunken -border 1 + pack $w.bot.left -side left -expand yes -padx 5 -pady 5 + button $w.bot.left.ok -width 6 -text {Ok} \ + -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" + pack $w.bot.cancel -side left -expand yes + +# Grab ... + grab $w + + tkwait window $w + +} + +proc database-select-action {} { + z39 databaseNames [.database-select.top.database.entry get] + destroy .database-select +} + +proc database-select {} { + set w .database-select + + toplevel $w + + place-force $w . + + frame $w.top -relief sunken -border 1 + frame $w.bot -relief sunken -border 1 + + pack $w.top $w.bot -side top -fill both -expand yes + + frame $w.top.database + +# Database select + pack $w.top.database -side top -anchor e -pady 2 + + entry-fields $w.top {database} \ + {{Database:}} \ + {database-select-action} {destroy .database-select} + +# Buttons ... + frame $w.bot.left -relief sunken -border 1 + pack $w.bot.left -side left -expand yes -padx 5 -pady 5 + button $w.bot.left.ok -width 6 -text {Ok} \ + -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" + pack $w.bot.cancel -side left -expand yes + +# Grab ... + grab $w + + tkwait window $w +} + +proc save-settings {} { + global hotTargets + + set f [open "~/.tk-c" w] + puts $f "# Setup file" + puts $f "set hotTargets \{ $hotTargets \}" + close $f +} + +frame .top -border 1 -relief raised +frame .mid -border 1 -relief raised +frame .data -border 1 -relief raised +frame .bot -border 1 -relief raised +pack .top .mid -side top -fill x +pack .data -side top -fill both -expand yes +pack .bot -fill x + +menubutton .top.file -text "File" -menu .top.file.m +menu .top.file.m +.top.file.m add command -label "Save settings" -command {save-settings} +.top.file.m add command -label "Exit" -command {destroy .} + +menubutton .top.target -text "Target" -menu .top.target.m +menu .top.target.m +.top.target.m add command -label "Connect" -command {open-target-dialog} +.top.target.m add command -label "Disconnect" -command {close-target} +.top.target.m add command -label "Initialize" -command {init-request} +.top.target.m add command -label "Setup" -command {protocol-setup} +.top.target.m add separator +set-target-hotlist + +menubutton .top.database -text "Database" -menu .top.database.m +menu .top.database.m +.top.database.m add command -label "Select ..." -command {database-select} +.top.database.m add command -label "Add ..." -command {puts "Add"} + +menubutton .top.help -text "Help" -menu .top.help.m +menu .top.help.m +.top.help.m add command -label "Help on help" -command {puts "Help on help"} +.top.help.m add command -label "About" -command {puts "About"} + +pack .top.file .top.target .top.database -side left +pack .top.help -side right + +label .mid.searchlabel -text {Search:} +entry .mid.searchentry -width 50 -relief sunken + +listbox .data.list -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 + +message .bot.target -text "None" -aspect 1000 -relief sunken -border 1 +label .bot.status -text "Not connected" -width 12 -relief \ + sunken -anchor w -border 1 +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 + +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 7376e04..9746fe9 100644 --- a/ir-tcl.c +++ b/ir-tcl.c @@ -2,7 +2,10 @@ * IR toolkit for tcl/tk * (c) Index Data 1995 * - * $Id: ir-tcl.c,v 1.3 1995-03-09 08:35:53 adam Exp $ + * $Log: ir-tcl.c,v $ + * Revision 1.4 1995-03-09 16:15:08 adam + * First presentRequest attempts. Hot-target list. + * */ #include @@ -51,10 +54,13 @@ typedef struct { int replaceIndicator; char **databaseNames; int num_databaseNames; + + struct IRSetObj_ *child; } IRObj; -typedef struct { +typedef struct IRSetObj_ { IRObj *parent; + int resultCount; } IRSetObj; typedef struct { @@ -85,7 +91,10 @@ static int get_parent_info (Tcl_Interp *interp, const char *name, memcpy (parent_name, name, pos); parent_name[pos] = '\0'; if (!Tcl_GetCommandInfo (interp, parent_name, parent_info)) + { + interp->result = "No parent"; return TCL_ERROR; + } return TCL_OK; } @@ -502,7 +511,7 @@ static int ir_obj_mk (ClientData clientData, Tcl_Interp *interp, } obj->cs_link = cs_create (tcpip_type); - obj->maximumMessageSize = 10000; + obj->maximumMessageSize = 9000; obj->preferredMessageSize = 4096; obj->idAuthentication = NULL; @@ -569,6 +578,7 @@ static int do_search (void *o, Tcl_Interp *interp, char *sbuf; int slen; + p->child = o; if (argc != 3) { interp->result = "wrong # args"; @@ -625,6 +635,75 @@ static int do_query (void *obj, Tcl_Interp *interp, return TCL_OK; } +/* + * do_resultCount: Get number of hits + */ +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_present: Perform present Request + */ + +static int do_present (void *o, Tcl_Interp *interp, + int argc, char **argv) +{ + IRSetObj *obj = o; + IRObj *p = obj->parent; + Z_APDU apdu, *apdup; + Z_PresentRequest req; + int start; + int number; + char *sbuf; + int slen; + + if (argc >= 3) + { + if (Tcl_GetInt (interp, argv[2], &start) == TCL_ERROR) + return TCL_ERROR; + } + else + start = 1; + if (argc >= 4) + { + if (Tcl_GetInt (interp, argv[3], &number) == TCL_ERROR) + return TCL_ERROR; + } + else + number = 10; + apdup = &apdu; + apdu.which = Z_APDU_presentRequest; + apdu.u.presentRequest = &req; + req.referenceId = 0; + /* sprintf(setstring, "%d", setnumber); */ + req.resultSetId = "Default"; + req.resultSetStartPoint = &start; + req.numberOfRecordsRequested = &number; + req.elementSetNames = 0; + req.preferredRecordSyntax = 0; + + if (!z_APDU (p->odr_out, &apdup, 0)) + { + interp->result = odr_errlist [odr_geterror (p->odr_out)]; + odr_reset (p->odr_out); + return TCL_ERROR; + } + sbuf = odr_getbuf (p->odr_out, &slen); + if (cs_put (p->cs_link, sbuf, slen) < 0) + { + interp->result = "cs_put failed in init"; + return TCL_ERROR; + } + printf ("Present request\n"); + return TCL_OK; +} /* * ir_set_obj_method: IR Set Object methods @@ -635,6 +714,8 @@ static int ir_set_obj_method (ClientData clientData, Tcl_Interp *interp, static IRMethod tab[] = { { "query", do_query }, { "search", do_search }, + { "resultCount", do_resultCount }, + { "present", do_present }, { NULL, NULL} }; @@ -669,10 +750,7 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, return TCL_ERROR; } if (get_parent_info (interp, argv[1], &parent_info) == TCL_ERROR) - { - interp->result = "No parent"; return TCL_ERROR; - } obj = malloc (sizeof(*obj)); if (!obj) { @@ -687,13 +765,18 @@ static int ir_set_obj_mk (ClientData clientData, Tcl_Interp *interp, /* ------------------------------------------------------- */ -static void ir_searchResponse (void *obj, Z_SearchResponse *searchrs) +static void ir_searchResponse (void *o, Z_SearchResponse *searchrs) { + IRObj *p = o; + IRSetObj *obj = p->child; + + if (obj) + obj->resultCount = *searchrs->resultCount; if (searchrs->searchStatus) printf("Search was a success.\n"); else printf("Search was a bloomin' failure.\n"); - printf("Number of hits: %d, setno %d\n", *searchrs->resultCount, 1); + printf("Number of hits: %d\n", *searchrs->resultCount); #if 0 if (searchrs->records) display_records(searchrs->records); @@ -702,6 +785,8 @@ static void ir_searchResponse (void *obj, Z_SearchResponse *searchrs) static void ir_initResponse (void *obj, Z_InitResponse *initrs) { + IRObj *p = obj; + if (!*initrs->result) printf("Connection rejected by target.\n"); else @@ -722,8 +807,11 @@ static void ir_initResponse (void *obj, Z_InitResponse *initrs) #endif } -static void ir_presentResponse (void *obj, Z_PresentResponse *presrs) +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"); @@ -742,6 +830,7 @@ void ir_select_proc (ClientData clientData) if ((r=cs_get (p->cs_link, &p->buf_in, &p->len_in)) < 0) { printf ("cs_get failed\n"); + ir_select_remove (cs_fileno (p->cs_link), p); return; } odr_setbuf (p->odr_in, p->buf_in, r); @@ -751,25 +840,23 @@ void ir_select_proc (ClientData clientData) printf ("%s\n", odr_errlist [odr_geterror (p->odr_in)]); return; } - if (p->callback) - { - Tcl_Eval (p->interp, p->callback); - } switch(apdu->which) { case Z_APDU_initResponse: - ir_initResponse (NULL, apdu->u.initResponse); + ir_initResponse (p, apdu->u.initResponse); break; case Z_APDU_searchResponse: - ir_searchResponse (NULL, apdu->u.searchResponse); + ir_searchResponse (p, apdu->u.searchResponse); break; case Z_APDU_presentResponse: - ir_presentResponse (NULL, apdu->u.presentResponse); + ir_presentResponse (p, apdu->u.presentResponse); break; default: printf("Received unknown APDU type (%d).\n", apdu->which); } + if (p->callback) + Tcl_Eval (p->interp, p->callback); } while (cs_more (p->cs_link)); } @@ -786,5 +873,3 @@ int ir_tcl_init (Tcl_Interp *interp) (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; } - - -- 1.7.10.4