www/z39util.tcl

   1 #
   2 # $Id: z39util.tcl,v 1.35 1996/03/05 18:50:26 adam Exp $
   3 #
   4 proc saveState {} {
   5     uplevel #0 {
   6     set f [open "tcl.state.${sessionId}" w]
   7     foreach var [info globals] {
   8         if {$var == "f"} continue
   9         if {$var == "sessionId"} continue
  10         if {$var == "errorInfo"} continue
  11         if {[catch {set names [array names $var]}]} {
  12             eval "set v \$${var}"
  13             puts $f "set ${var} \{$v\}"
  14         } else {
  15             foreach n $names {
  16                 eval "set v \$${var}(\$n)"
  17                 puts $f "set ${var}($n) \{$v\}"
  18             }
  19             catch {
  20                 eval "set v \$${var}"
  21                 puts $f "set ${var} \{$v\}"
  22             }
  23         }
  24     }
  25     close $f
  26     }
  27 }
  28
  29 proc search-response {zz} {
  30     global sessionWait
  31
  32     set status [$zz responseStatus]
  33     if {[lindex $status 0] == "NSD"} {
  34         $zz nextResultSetPosition 0
  35         set code [lindex $status 1]
  36         set msg [lindex $status 2]
  37         set addinfo [lindex $status 3]
  38         displayError "Diagnostic message" \
  39                 "$msg: $addinfo<br>\n(error code $code)"
  40         set sessionWait -2
  41     } else {
  42         set sessionWait 1
  43     }
  44 }
  45
  46 proc scan-response {zz} {
  47     global sessionWait
  48
  49     set status [$zz scanStatus]
  50     if {$status == 6} {
  51         displayError "Scan fail" ""
  52         set sessionWait -2
  53     } else {
  54         set sessionWait 1
  55     }
  56 }
  57
  58 proc ok-response {} {
  59     global sessionWait
  60     set sessionWait 1
  61 }
  62
  63 proc fail-response {} {
  64     global sessionWait
  65     set sessionWait -1
  66 }
  67
  68 proc display-brief {zset no tno} {
  69     global env
  70     global setNo
  71     global sessionId
  72
  73     html {<li>}
  74     set type [$zset type $no]
  75     if {$type == "SD"} {
  76         set err [lindex [$zset diag $no] 1]
  77         set add [lindex [$zset diag $no] 2]
  78         if {$add != {}} {
  79             set add " :${add}"
  80         }
  81         html "${no} Error ${err}${add} <br>\n"
  82         return
  83     }
  84     if {$type != "DB"} {
  85         return
  86     }
  87     set rtype [$zset recordType $no]
  88     if {$rtype == "SUTRS"} {
  89         html [join [$zset getSutrs $no]]
  90         html "<br>\n"
  91         return
  92     }
  93     if {$rtype == "WAIS"} {
  94         html { <a href="http:} $env(SCRIPT_NAME) /
  95         html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
  96         html [join [$zset getWAIS $no headline]]
  97         html {</a>}
  98         html "<br>\n"
  99         return
 100     }
 101     if {![catch {
 102         set author [$zset getMarc $no field 100 * a]
 103         set corp [$zset getMarc $no field 110 * a]
 104         set meet [$zset getMarc $no field 111 * a]
 105         set title [$zset getMarc $no field 245 * a]
 106         if {[llength $author] == 0} {
 107             set cover [$zset getMarc $no field 245 * {[bc]}]
 108         } else {
 109             set cover [$zset getMarc $no field 245 * b]
 110         }
 111         set location [$zset getMarc $no field 260 * a]
 112         set publisher [$zset getMarc $no field 260 * b]
 113         set year [$zset getMarc $no field 260 * c]
 114     } dispError ] } {
 115         html { <a href="http:} $env(SCRIPT_NAME) /
 116         html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
 117         set p 0
 118         foreach a $author {
 119             if {$p} {
 120                 html ", "
 121             }
 122             html $a
 123             set p 1
 124         }
 125         foreach a $corp {
 126             if {$p} {
 127                 html ", "
 128             }
 129             html $a
 130             set p 1
 131         }
 132         foreach a $meet {
 133             if {$p} {
 134                 html ", "
 135             }
 136             html $a
 137             set p 1
 138         }
 139         if {$p} {
 140             html ": "
 141         }
 142         set nope 1
 143         foreach v $title {
 144             html $v
 145             set nope 0
 146         }
 147         if {$nope} {
 148             set v [join $cover ""]
 149             if {[string length $v] > 40} {
 150                 set nope 0
 151                 html [string range $v 0 38] "..."
 152             } elseif {[string length $v] > 0} {
 153                 set nope 0
 154                 html $v
 155             } else {
 156                 html "No Title"
 157             }
 158         }
 159         html {</a> }
 160     } else {
 161         html { <a href="http:} $env(SCRIPT_NAME) /
 162         html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
 163         html {No Title}
 164         html {</a> }
 165         html "Error: " $dispError "\n"
 166     }
 167     html "<br>\n"
 168 }
 169
 170 proc display-raw {zset no tno} {
 171     set type [$zset type $no]
 172     if {$type == "SD"} {
 173         set err [lindex [$zset diag $no] 1]
 174         set add [lindex [$zset diag $no] 2]
 175         if {$add != {}} {
 176             set add " :${add}"
 177         }
 178         html "<h3>${no}</h3>\n"
 179         html "Error ${err}${add} <br>\n"
 180         return
 181     }
 182     if {$type != "DB"} {
 183         return
 184     }
 185     set rtype [$zset recordType $no]
 186     if {$rtype == "SUTRS"} {
 187         html [join [$zset getSutrs $no]] "<br>\n"
 188         return
 189     }
 190     if {[catch {set r [$zset getMarc $no line * * *]}]} {
 191         html "Unknown record type: $rtype <br>\n"
 192         return
 193     }
 194     foreach line $r {
 195         set tag [lindex $line 0]
 196         set indicator [lindex $line 1]
 197         set fields [lindex $line 2]
 198         set l [string length $indicator]
 199         html "<tt>$tag "
 200         if {$l > 0} {
 201             for {set i 0} {$i < $l} {incr i} {
 202                 if {[string index $indicator $i] == " "} {
 203                     html "-"
 204                 } else {
 205                     html [string index $tag $i]
 206                 }
 207             }
 208         }
 209         html "</tt>"
 210         foreach field $fields {
 211             set id [lindex $field 0]
 212             set data [lindex $field 1]
 213             if {$id != ""} {
 214                 html " <b>\$$id</b> "
 215             }
 216             html $data
 217         }
 218         html "<br>\n"
 219     }
 220 }
 221
 222 proc put-marc-contents {cc} {
 223     set ref ""
 224     if {[string first :// $cc] > 0} {
 225         foreach urltype {gopher http ftp mailto} {
 226             if {[string first ${urltype}:// $cc] == 0} {
 227                 set ref $urltype
 228                 break
 229             }
 230         }
 231     }
 232     if {$ref != ""} {
 233         html {<a href="}
 234     }
 235     html $cc
 236     if {$ref != ""} {
 237         html {">} $cc {</a>}
 238     }
 239 }
 240
 241 proc dl-marc-field {zset no tag id la lb sep} {
 242     set n 0
 243     set c [$zset getMarc $no field $tag * $id]
 244     set len [llength $c]
 245     if {$len == 0} {
 246         return 0
 247     }
 248     if {$len > 1 && "x$lb" != "x"} {
 249         html "<dt><b>$lb</b>\n<dd>"
 250     } else {
 251         html "<dt><b>$la</b>\n<dd>"
 252     }
 253     foreach cc $c {
 254         if {$n > 0} {
 255             html $sep
 256         }
 257         put-marc-contents $cc
 258         incr n
 259     }
 260     return $n
 261 }
 262
 263 proc dd-marc-field {zset no tag id start stop} {
 264     set n 0
 265     set c [$zset getMarc $no field $tag * $id]
 266     set len [llength $c]
 267     if {$len == 0} {
 268         return 0
 269     }
 270     foreach cc $c {
 271         html $start
 272         put-marc-contents $cc
 273         html $stop
 274         incr n
 275     }
 276     return $n
 277 }
 278
 279 proc dl-marc-field-rec {zset no tag lead start stop startid sep} {
 280     set n 0
 281     set lines [$zset getMarc $no line $tag * *]
 282     foreach line $lines {
 283         foreach field [lindex $line 2] {
 284             if {$n == 0} {
 285                 html "<dt><b>$lead</b>"
 286                 html "\n<dd>"
 287             }
 288             set id [lindex $field 0]
 289             if {$id == $startid} {
 290                 if {$n > 0} {
 291                     html $stop
 292                 }
 293                 html $start
 294                 incr n
 295                 html [lindex $field 1]
 296             } else {
 297                 html $sep
 298                 html [lindex $field 1]
 299             }
 300         }
 301     }
 302     if {$n > 0} {
 303         html $stop
 304     }
 305 }
 306
 307 proc display-full-wais {zset no} {
 308     set i 0
 309     set element junk
 310     htmlToken l [join [$zset getWAIS $no text]] {
 311         if {[string compare [string index $l 0] {<}]} {
 312             set data($element) $l
 313             continue
 314         }
 315         switch -exact $l {
 316             <ti> {
 317                 set element title
 318             }
 319             <dm> {
 320                 set element dateOfLastModification
 321             }
 322             <ci> {
 323                 set element controlIdentifier
 324             }
 325             <lc> {
 326                 set element lastChecked
 327             }
 328             <by> {
 329                 set element bytes
 330             }
 331             <avli> {
 332                 set element linkage
 333             }
 334             <cr> {
 335                 incr i
 336             }
 337             <li> {
 338                 set element "$i,linkage"
 339             }
 340             <cp> {
 341                 set element "$i,title"
 342             }
 343             default {
 344                 set element junk
 345             }
 346         }
 347     }
 348     html {Title: } {<a href="} $data(linkage) {">} $data(title) "</a><br>\n"
 349     html {URL: } $data(linkage) "<br>\n"
 350     html {Score: } [$zset getWAIS $no score] "<br>\n"
 351     html {Lines: } [$zset getWAIS $no lines] "<br>\n"
 352     if {[info exists data(bytes)]} {
 353         html {Bytes: } $data(bytes) "<br>\n"
 354     }
 355     if {[info exists data(dateOfLastModification)]} {
 356         html {Last modified: } $data(dateOfLastModification) "<br>\n"
 357     }
 358     if {[info exists data(lastChecked)]} {
 359         html {Last checked: } $data(lastChecked) "<br>\n"
 360     }
 361     html "<ul>\n"
 362     for {set i 1} {[info exists data($i,linkage)]} {incr i} {
 363         html {<li><a href="} $data($i,linkage) {">}
 364         html $data($i,title) "</a><br>\n"
 365         html "URL: " $data($i,linkage)
 366     }
 367     html "</ul>\n"
 368 }
 369
 370 proc display-full {zset no tno} {
 371     set type [$zset type $no]
 372     if {$type == "SD"} {
 373         set err [lindex [$zset diag $no] 1]
 374         set add [lindex [$zset diag $no] 2]
 375         if {$add != {}} {
 376             set add " :${add}"
 377         }
 378         html "Error ${err}${add} <br>\n"
 379         return
 380     }
 381     if {$type != "DB"} {
 382         return
 383     }
 384     set rtype [$zset recordType $no]
 385     if {$rtype == "SUTRS"} {
 386         html [join [$zset getSutrs $no]] "<br>\n"
 387         return
 388     }
 389     if {$rtype == "WAIS"} {
 390         display-full-wais $zset $no
 391         return
 392     }
 393     if {[catch {set r [$zset getMarc $no line * * *]}]} {
 394         html "Unknown record type: $rtype <br>\n"
 395         return
 396     }
 397     html "<dl>\n"
 398     set n [dl-marc-field $zset $no 700 a "Author" "Authors" "<br>\n"]
 399     if {$n == 0} {
 400         set n [dl-marc-field $zset $no 100 a "Author" "Authors" "<br>\n"]
 401     }
 402     set n [dl-marc-field $zset $no 710 a "Corporate Name" {} ", "]
 403     if {$n == 0} {
 404         set n [dl-marc-field $zset $no 110 a "Corporate Name" {} ", "]
 405     }
 406     set n [dl-marc-field $zset $no 711 a "Meeting Name" {} ", "]
 407     if {$n > 0} {
 408         dd-marc-field $zset $no 711 {[bndc]} " " ""
 409     } else {
 410         set n [dl-marc-field $zset $no 111 a "Meeting Name" {} ", "]
 411         if {$n > 0} {
 412             dd-marc-field $zset $no 111 {[bndc]} " " " "
 413         }
 414     }
 415     set n [dl-marc-field $zset $no 245 {a} "Title" {} " "]
 416     if {$n > 0} {
 417         dd-marc-field $zset $no 245 b "<em>" "</em>"
 418         dd-marc-field $zset $no 245 c " " ""
 419     } else {
 420         dl-marc-field $zset $no 245 {[ab]} "Title" {} " "
 421     }
 422     dl-marc-field $zset $no 520 a "Abstract" {} ", "
 423     dl-marc-field $zset $no 072 * "Subject code" "Subject codes" ", "
 424     dl-marc-field $zset $no 650 * "Subject" {} ", "
 425     dl-marc-field $zset $no 260 * "Publisher" {} " "
 426     dl-marc-field $zset $no 300 * "Physical Description" {} " "
 427
 428     dl-marc-field-rec $zset $no 500 "Notes" "" "<br>\n" "a" ", "
 429
 430     dl-marc-field-rec $zset $no 510 "References" "" "<br>\n" "a" ", "
 431
 432     dl-marc-field-rec $zset $no 511 "Participant note" "" "<br>\n" "a" ", "
 433
 434     dl-marc-field $zset $no 513 a "Report type" {} ", "
 435     dl-marc-field $zset $no 513 b "Period covered" {} ", "
 436     dl-marc-field-rec $zset $no 515 "Numbering notes" "" "<br>\n" "a" ", "
 437     dl-marc-field-rec $zset $no 516 "Data notes" "" "<br>\n" "a" ", "
 438     dl-marc-field-rec $zset $no 518 "Date/time notes" "" "<br>\n" "a" ", "
 439
 440     dl-marc-field $zset $no 350 a "Price" {} ", "
 441     dl-marc-field $zset $no 362 a "Dates of publication" {} ", "
 442     dl-marc-field $zset $no 850 a "Holdings" {} ", "
 443
 444     dl-marc-field-rec $zset $no 270 "Contact name" "" "<br>\n" p ", "
 445     if {0} {
 446         set n [dl-marc-field $zset $no 270 p "Contact name" {} ", "]
 447         if {$n > 0} {
 448             html "\n<dl>\n"
 449
 450             if {0} {
 451                 dl-marc-field $zset $no 270 a "Street" {} ", "
 452                 dl-marc-field $zset $no 270 b "City" {} ", "
 453                 dl-marc-field $zset $no 270 c "State" {} ", "
 454                 dl-marc-field $zset $no 270 e "Zip code" {} ", "
 455                 dl-marc-field $zset $no 270 d "Country" {} ", "
 456                 dl-marc-field $zset $no 270 m "Network address" {} ", "
 457                 dl-marc-field $zset $no 301 a "Service hours" {} ", "
 458                 dl-marc-field $zset $no 270 k "Phone" {} ", "
 459                 dl-marc-field $zset $no 270 l "Fax" {} ", "
 460             } else {
 461                 dl-marc-field $zset $no 270 {[abcedmakl]} "Address" {} "<br>\n"
 462             }
 463
 464             html "\n</dl>\n"
 465         }
 466     }
 467     dl-marc-field $zset $no 010 a "LC control number" {} ", "
 468     dl-marc-field $zset $no 010 b "NUCMC control number" {} ", "
 469     dl-marc-field $zset $no 020 a "ISBN" {} ", "
 470     dl-marc-field $zset $no 022 a "ISSN" {} ", "
 471     set url [$zset getMarc $no field 856 * u]
 472     set sp [$zset getMarc $no field 856 * 3]
 473     if {"x$url" != "x"} {
 474         html "<dt><b>URL</b>\n"
 475         if {"x$sp" == "x"} {
 476             set sp $url
 477         }
 478         html {<dd><a href="} [join $url] {">} [join $sp] "</a>\n"
 479     }
 480     dl-marc-field $zset $no 037 {[abc]} "Acquisition" {} "<br>\n"
 481     dl-marc-field $zset $no 037 {[f6]} "Form of issue" {} "<br>\n"
 482     dl-marc-field $zset $no 537 * "Source of data" {} "<br>\n"
 483     dl-marc-field $zset $no 538 * "System details" {} "<br>\n"
 484     dl-marc-field $zset $no 787 {[rstw6]} "Related information" {} "<br>\n"
 485     dl-marc-field $zset $no 001 * "Local control number" {} ", "
 486     html "</dl>\n"
 487 }
 488
 489
 490 proc display-rec {from to dfunc tno} {
 491     global setNo
 492
 493     if {$tno > 0} {
 494         while {$from <= $to} {
 495             eval "$dfunc z39${tno}.${setNo} $from $tno"
 496             incr from
 497         }
 498     } else {
 499         while {$from <= $to} {
 500             eval "$dfunc z39.${setNo} $from 0"
 501             incr from
 502         }
 503     }
 504 }
 505
 506 proc build-scan {t i} {
 507     global targets
 508
 509     set term [egw_form entry$i]
 510     if {$term != ""} {
 511         set field [join [egw_form menu$i]]
 512         set attr {Title}
 513         foreach x [lindex $targets($t) 2] {
 514             if {[lindex $x 0] == $field} {
 515                 set attr [lindex $x 1]
 516             }
 517         }
 518         return [list $term $attr]
 519     }
 520     return ""
 521 }
 522
 523 proc build-query {t ilines} {
 524     global targets
 525
 526     set op {}
 527     set q {}
 528     for {set i 1} {$i <= $ilines} {incr i} {
 529         set term [join [egw_form entry$i]]
 530         if {[lindex $targets($t) 6] == "1"} {
 531             if {[string length $op] == 0} {
 532                 set q $term
 533             } else {
 534                 set q "$term $q"
 535             }
 536             set op [egw_form logic$i]
 537             continue
 538         }
 539         if {[string length $term] > 0} {
 540             set field [join [egw_form menu$i]]
 541             foreach x [lindex $targets($t) 2] {
 542                 if {[lindex $x 0] == $field} {
 543                     set attr [lindex $x 1]
 544                 }
 545             }
 546             switch $op {
 547             And
 548                 { set q "@and $q ${attr} \"${term}\"" }
 549             Or
 550                 { set q "@or $q ${attr} \"${term}\"" }
 551             {And not}
 552                 { set q "@not $q ${attr} \"${term}\"" }
 553             {}
 554                 { set q "${attr} \"${term}\"" }
 555             }
 556             set op [egw_form logic$i]
 557         }
 558     }
 559     return $q
 560 }
 561
 562 proc z39scan {setNo scanNo tno scanLines scanPos cache} {
 563     global hist
 564     global sessionWait
 565     global targets
 566
 567     if {$tno > 0} {
 568         set zz z39$tno
 569         set host $hist($setNo,$tno,host)
 570         set idAuth $hist($setNo,$tno,idAuthentication)
 571         set database $hist($setNo,$tno,database)
 572         set scanAttr $hist($setNo,$tno,scanAttr)
 573         set scanTerm $hist($setNo,$tno,$scanNo,scanTerm)
 574     } else {
 575         set zz z39
 576         set host $hist($setNo,host)
 577         set idAuth $hist($setNo,idAuthentication)
 578         set database $hist($setNo,database)
 579         set scanAttr $hist($setNo,scanAttr)
 580         set scanTerm $hist($setNo,$scanNo,scanTerm)
 581     }
 582     mkAssoc $zz $host
 583     if {[catch [list set oldHost [$zz connect]]]} {
 584         set oldHost ""
 585     }
 586     set zs $zz.s$scanNo.$setNo
 587     $zz callback ok-response
 588     $zz failback fail-response
 589     set thisHost [splitHostSpec $host]
 590     if {[string compare $oldHost $thisHost]} {
 591         catch [list $zz disconnect]
 592
 593         set sessionWait 0
 594         if {[catch [list $zz connect $thisHost]]} {
 595             displayError "Cannot connect to target" $thisHost
 596             return 0
 597         } elseif {$sessionWait == 0} {
 598             if {[catch {egw_wait sessionWait 300}]} {
 599                 $zz disconnect
 600                 displayError "Cannot connect to target" $thisHost
 601                 return 0
 602             }
 603             if {$sessionWait != 1} {
 604                 displayError "Cannot connect to target" $thisHost
 605                 return 0
 606             }
 607         }
 608         $zz idAuthentication $idAuth
 609         set sessionWait 0
 610         if {[catch {$zz init}]} {
 611             displayError "Cannot initialize target" $thisHost
 612             $zz disconnect
 613             return 0
 614         }
 615         if {[catch {egw_wait sessionWait 60}]} {
 616             displayError "Cannot initialize target" $thisHost
 617             $zz disconnect
 618             return 0
 619         }
 620         if {$sessionWait != "1"} {
 621             displayError "Cannot initialize target" $thisHost
 622             $zz disconnect
 623             return 0
 624         }
 625         if {![$zz initResult]} {
 626             set u [$zz userInformationField]
 627             $zz disconnect
 628             displayError "Cannot initialize target $thisHost" $u
 629             return 0
 630         }
 631     } else {
 632         if {$cache && ![catch [list $zs numberOfTermsRequested 5]]} {
 633             return 1
 634         }
 635     }
 636     eval $zz databaseNames $database
 637
 638     ir-scan $zs $zz
 639
 640     $zs numberOfTermsRequested $scanLines
 641     $zs preferredPositionInResponse $scanPos
 642
 643     $zz callback [list scan-response $zs]
 644
 645     egw_log debug "scan: ${scanAttr} ${scanTerm}"
 646     set sessionWait 0
 647     $zs scan "${scanAttr} ${scanTerm}"
 648
 649     if {[catch {egw_wait sessionWait 60}]} {
 650         egw_log debug "timeout/cancel in scan"
 651         displayError "Timeout in scan" {}
 652         html "</body></html>\n"
 653         $zz disconnect
 654         return 0
 655     }
 656     if {$sessionWait == -1} {
 657         displayError "Scan fail" "Connection closed"
 658         html "</body></html>\n"
 659         $zz disconnect
 660     }
 661     if {$sessionWait != 1} {
 662         return 0
 663     }
 664     return 1
 665 }
 666
 667 proc display-scan {setNo scanNo tno} {
 668     global hist
 669     global targets
 670     global env
 671     global sessionId
 672
 673     if {$tno > 0} {
 674         set zz z39$tno
 675     } else {
 676         set zz z39
 677     }
 678     set zs $zz.s$scanNo.$setNo
 679     set m [$zs numberOfEntriesReturned]
 680
 681     if {$m > 0} {
 682         set t [lindex [$zs scanLine 0] 1]
 683         if {$tno > 0} {
 684             set hist($setNo,$tno,[expr $scanNo - 1],scanTerm) $t
 685         } else {
 686             set hist($setNo,[expr $scanNo - 1],scanTerm) $t
 687         }
 688         set t [lindex [$zs scanLine [expr $m - 1]] 1]
 689         if {$tno > 0} {
 690             set hist($setNo,$tno,[expr $scanNo + 1],scanTerm) $t
 691         } else {
 692             set hist($setNo,[expr $scanNo + 1],scanTerm) $t
 693         }
 694     }
 695     html {<table width=500 border=0><tr>}
 696     html {<td align=left><b>Scan term</b>}
 697     html {<td align=right><b>Hits</b>}
 698     html {<tr>} \n
 699
 700     for {set i 0} {$i < $m} {incr i} {
 701         html {<td align=left>}
 702         if {0} {
 703             regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
 704             html {<a href="http:} $env(SCRIPT_NAME)
 705             html / $sessionId {/query.egw/} $hist($setNo,host) + $setNo +
 706             html $hist($setNo,scan) +  $tterm {">}
 707         } else {
 708             regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
 709             html {<a href="http:} $env(SCRIPT_NAME)
 710             html / $sessionId {/search.egw/} $setNo +
 711             html hyper + $tterm {">}
 712         }
 713         html [lindex [$zs scanLine $i] 1]
 714         html {</a>}
 715         html {<td align=right>}
 716         html [lindex [$zs scanLine $i] 2]
 717         html {<tr>} \n
 718     }
 719     html {</table} \n
 720 }
 721
 722 proc z39search {setNo piggy tno elements} {
 723     global hist
 724     global sessionWait
 725     global targets
 726
 727     if {$tno > 0} {
 728         set zz z39$tno
 729         set host $hist($setNo,$tno,host)
 730         set idAuth $hist($setNo,$tno,idAuthentication)
 731         set database $hist($setNo,$tno,database)
 732         set query $hist($setNo,$tno,query)
 733     } else {
 734         set zz z39
 735         set host $hist($setNo,host)
 736         set idAuth $hist($setNo,idAuthentication)
 737         set database $hist($setNo,database)
 738         set query $hist($setNo,query)
 739     }
 740     mkAssoc $zz $host
 741     if {[catch [list set oldHost [$zz connect]]]} {
 742         set oldHost ""
 743     }
 744     $zz callback ok-response
 745     $zz failback fail-response
 746     set thisHost [splitHostSpec $host]
 747     if {[string compare $oldHost $thisHost]} {
 748         catch [list $zz disconnect]
 749
 750         set sessionWait 0
 751         if {[catch [list $zz connect $thisHost]]} {
 752             displayError "Cannot connect to target" $thisHost
 753             return 0
 754         } elseif {$sessionWait == 0} {
 755             if {[catch {egw_wait sessionWait 300}]} {
 756                 $zz disconnect
 757                 displayError "Cannot connect to target" $thisHost
 758                 return 0
 759             }
 760             if {$sessionWait != 1} {
 761                 displayError "Cannot connect to target" $thisHost
 762                 return 0
 763             }
 764         }
 765         $zz idAuthentication $idAuth
 766         set sessionWait 0
 767         if {[catch {$zz init}]} {
 768             displayError "Cannot initialize target" $thisHost
 769             $zz disconnect
 770             return 0
 771         }
 772         if {$sessionWait == 0 && [catch {egw_wait sessionWait 60}]} {
 773             displayError "Cannot initialize target" $thisHost
 774             $zz disconnect
 775             return 0
 776         }
 777         if {$sessionWait != "1"} {
 778             displayError "Cannot initialize target" $thisHost
 779             $zz disconnect
 780             return 0
 781         }
 782         if {![$zz initResult]} {
 783             set u [$zz userInformationField]
 784             $zz disconnect
 785             displayError "Cannot initialize target $thisHost" $u
 786             return 0
 787         }
 788     } elseif {![catch  [list $zz.$setNo smallSetUpperBound 0]]} {
 789         if {$tno > 0} {
 790             if {[info exists hist($setNo,$tno,hits)]} {
 791                 return 1
 792             }
 793         } else {
 794             if {[info exists hist($setNo,hits)]} {
 795                 return 1
 796             }
 797         }
 798     }
 799
 800     if {[lindex $targets($host) 6] == "1"} {
 801         wais-set $zz.$setNo $zz
 802     } else {
 803         ir-set $zz.$setNo $zz
 804     }
 805     if {![lindex $targets($host) 5]} {
 806         set elements {}
 807     }
 808     $zz.$setNo smallSetElementSetNames $elements
 809     $zz.$setNo mediumSetElementSetNames $elements
 810     $zz.$setNo recordElements $elements
 811
 812     egw_log debug "database=$database"
 813     eval $zz.$setNo databaseNames $database
 814
 815     $zz.$setNo preferredRecordSyntax USMARC
 816
 817     $zz callback [list search-response $zz.$setNo]
 818     if {$piggy} {
 819         $zz.$setNo largeSetLowerBound 999999
 820         $zz.$setNo smallSetUpperBound 0
 821         $zz.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
 822     } else {
 823         $zz.$setNo largeSetLowerBound 2
 824         $zz.$setNo smallSetUpperBound 0
 825         $zz.$setNo mediumSetPresentNumber 0
 826     }
 827     set sessionWait 0
 828     egw_log debug "search: $query"
 829     if {[catch {$zz.$setNo search $query}]} {
 830         displayError "Search fail" "Connection closed"
 831         html "</body></html>\n"
 832         $zz disconnect
 833         return 0
 834     }
 835
 836     if {[catch {egw_wait sessionWait 60}]} {
 837         egw_log debug "timeout/cancel in search"
 838         displayError "Timeout in search" {}
 839         html "</body></html>\n"
 840         $zz disconnect
 841         return 0
 842     }
 843
 844     if {$sessionWait == -1} {
 845         displayError "Search fail" "Connection closed"
 846         html "</body></html>\n"
 847         $zz disconnect
 848     }
 849     if {$sessionWait != 1} {
 850         return 0
 851     }
 852     set hist($setNo,hits) [$zz.$setNo resultCount]
 853     return 1
 854 }
 855
 856 proc init-m-response {i} {
 857     global zstatus
 858     global zleft
 859
 860     egw_log debug "init-m-response"
 861
 862     incr zleft -1
 863     if {![z39$i initResult]} {
 864         set zstatus($i) -1
 865         z39$i disconnect
 866         return
 867     }
 868     set zstatus($i) 1
 869 }
 870
 871 proc connect-m-response {i} {
 872     global zstatus
 873     global zleft
 874
 875     egw_log debug "connect-m-response"
 876     z39$i callback [list init-m-response $i]
 877     if {[catch {z39$i init}]} {
 878         set zstatus($i) -1
 879         incr zleft -1
 880     }
 881 }
 882
 883 proc fail-m-response {i} {
 884     global zstatus
 885     global zleft
 886
 887     egw_log debug "fail-m-response"
 888     set zstatus($i) -1
 889     incr zleft -1
 890 }
 891
 892 proc search-m-response {setNo i start number} {
 893     global zleft
 894     global zstatus
 895     global hist
 896
 897     egw_log debug "search-m-response"
 898     set status [z39$i.$setNo responseStatus]
 899     egw_log debug "search-m-response1"
 900     if {[lindex $status 0] == "OK"} {
 901         set nor 0
 902     } elseif {[lindex $status 0] == "DBOSD"} {
 903         set nor [z39$i.$setNo numberOfRecordsReturned]
 904     } else {
 905         egw_log debug "search-m-response2"
 906         incr zleft -1
 907         set zstatus($i) 2
 908         return
 909     }
 910     set hist($setNo,$i,hits) [z39$i.$setNo resultCount]
 911     egw_log debug "search-m-response3"
 912     set hist($setNo,$i,offset) [expr $start + $nor -1]
 913     if {[expr $nor + $start] > [z39$i.$setNo resultCount]} {
 914         egw_log debug "search-m-response4"
 915         incr zleft -1
 916         set zstatus($i) 2
 917         return
 918     }
 919     egw_log debug "search-m-response5"
 920     if {$nor >= $number} {
 921         egw_log debug "search-m-response6 nor=$nor number=$number"
 922         incr zleft -1
 923         set zstatus($i) 2
 924         return
 925     }
 926     egw_log debug "search-m-response7"
 927     set start [expr $start + $nor]
 928     set number [expr $number - $nor]
 929     if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
 930         set number [expr [z39$i.$setNo resultCount] - $start + 1]
 931     }
 932     z39$i callback [list search-m-response $setNo $i $start $number]
 933     egw_log debug "mpresent start=$number number=$number"
 934     z39$i.$setNo present $start $number
 935 }
 936
 937 proc z39msearch {setNo elements start number cache} {
 938     global zleft
 939     global zstatus
 940     global hist
 941     global targets
 942     global debug
 943
 944     set not $hist($setNo,0,host)
 945
 946     egw_log debug "z39msearch start=$start number=$number elements=$elements"
 947     for {set i 1} {$i <= $not} {incr i} {
 948         set host $hist($setNo,$i,host)
 949         mkAssoc z39$i $host
 950         set oldHost [z39$i connect]
 951         set thisHost [splitHostSpec $host]
 952         if {[string compare $oldHost $thisHost]} {
 953             catch {z39$i disconnect}
 954         }
 955         z39$i callback [list connect-m-response $i]
 956         z39$i failback [list fail-m-response $i]
 957     }
 958     set zleft 0
 959     for {set i 1} {$i <= $not} {incr i} {
 960         set oldHost [z39$i connect]
 961         set host $hist($setNo,$i,host)
 962         set thisHost [splitHostSpec $host]
 963         if {![string compare $oldHost $thisHost]} {
 964             continue
 965         }
 966         egw_log debug "old=$oldHost this=$thisHost"
 967         z39$i idAuthentication $hist($setNo,$i,idAuthentication)
 968         html "Connecting to target " $thisHost " <br>\n"
 969         set zstatus($i) -1
 970         if {![catch {z39$i connect $thisHost}]} {
 971             incr zleft
 972         }
 973     }
 974     while {$zleft > 0} {
 975         egw_log debug "Waiting for init response"
 976         if {[catch {egw_wait zleft 20}]} {
 977             break
 978         }
 979     }
 980     set zleft 0
 981     for {set i 1} {$i <= $not} {incr i} {
 982         set host $hist($setNo,$i,host)
 983         if {$debug} {
 984             html "host " [splitHostSpec $host] ": "
 985         }
 986         egw_log debug "i=$i zstatus=$zstatus($i)"
 987         if {$zstatus($i) < 1} {
 988             if {$debug} {
 989                 html "fail<br>\n"
 990             }
 991             continue
 992         }
 993         if {[catch [list z39$i.$setNo preferredRecordSyntax USMARC]]} {
 994             if {$debug} {
 995                 html "ok<br>\n"
 996             }
 997
 998             if {[lindex $targets($host) 6] == "1"} {
 999                 wais-set z39$i.$setNo z39$i
1000             } else {
1001                 ir-set z39$i.$setNo z39$i
1002             }
1003             set hist($setNo,$i,offset) 0
1004             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
1005
1006             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
1007                 set thisElements {}
1008             } else {
1009                 set thisElements $elements
1010             }
1011             z39$i.$setNo smallSetElementSetNames $thisElements
1012             z39$i.$setNo mediumSetElementSetNames $thisElements
1013             z39$i.$setNo elementSetNames $thisElements
1014             z39$i.$setNo recordElements $thisElements
1015
1016             z39$i.$setNo preferredRecordSyntax USMARC
1017             z39$i callback [list search-m-response $setNo $i $start $number]
1018
1019             if {$start == 1} {
1020                 z39$i.$setNo largeSetLowerBound 999999
1021                 z39$i.$setNo smallSetUpperBound 0
1022                 z39$i.$setNo mediumSetPresentNumber $number
1023             } else {
1024                 z39$i.$setNo largeSetLowerBound 2
1025                 z39$i.$setNo smallSetUpperBound 0
1026                 z39$i.$setNo mediumSetPresentNumber 0
1027             }
1028             set zstatus($i) 1
1029             incr zleft
1030             egw_log debug "setNo=$setNo msearch " $hist($setNo,$i,query)
1031             z39$i.$setNo search $hist($setNo,$i,query)
1032         } elseif {[z39$i.$setNo resultCount] >= $start} {
1033             if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
1034                 set tnumber [expr [z39$i.$setNo resultCount] - $start + 1]
1035             } else {
1036                 set tnumber $number
1037             }
1038             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
1039                 set thisElements {}
1040             } else {
1041                 set thisElements $elements
1042             }
1043             z39$i.$setNo smallSetElementSetNames $thisElements
1044             z39$i.$setNo mediumSetElementSetNames $thisElements
1045             z39$i.$setNo elementSetNames $thisElements
1046             z39$i.$setNo recordElements $thisElements
1047
1048             for {set n 0} {$n < $tnumber} {incr n} {
1049                 if {[z39$i.$setNo recordType [expr $start + $n]] == ""} {
1050                     if {$n > 0} {
1051                         egw_log debug "failed on $n"
1052                     }
1053                     if {$debug} {
1054                         html "no record at #" [expr $start + $n]
1055                         html " el=-" $thisElements "-"
1056                     }
1057                     break
1058                 }
1059             }
1060             if {$n == $tnumber} {
1061                 if {$debug} {
1062                     html "cached<br>\n"
1063                 }
1064                 continue
1065             }
1066
1067             html "present<br>\n"
1068             z39$i.$setNo preferredRecordSyntax USMARC
1069             z39$i callback [list search-m-response $setNo $i $start $tnumber]
1070             incr zleft
1071             egw_log debug "mpresent start=$start number=$tnumber"
1072             z39$i.$setNo present $start $tnumber
1073         } else {
1074             if {$debug} {
1075                 html "ok<br>\n"
1076             }
1077         }
1078     }
1079     while {$zleft > 0} {
1080         egw_log debug "Waiting for search/present response"
1081         if {[catch {egw_wait zleft 60}]} {
1082             break
1083         }
1084     }
1085     for {set i 1} {$i <= $not} {incr i} {
1086         if {$zstatus($i) != 2} continue
1087         set status [z39$i.$setNo responseStatus]
1088         if {0 && [lindex $status 0] != "NSD"} {
1089             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
1090         }
1091     }
1092 }
1093
1094 proc z39present {setNo tno setOffset setMax dfunc elements} {
1095     global hist
1096     global sessionWait
1097     global targets
1098
1099     if {$tno > 0} {
1100         set zz z39$tno
1101         set host $hist($setNo,$tno,host)
1102     } else {
1103         set zz z39
1104         set host $hist($setNo,host)
1105     }
1106
1107     if {![lindex $targets($host) 5]} {
1108         set elements {}
1109     }
1110
1111     $zz.$setNo elementSetNames $elements
1112     $zz.$setNo recordElements $elements
1113     set toGet [expr 1 + $setMax - $setOffset]
1114
1115     $zz callback [list search-response $zz.$setNo]
1116
1117     while {$setMax > 0 && $toGet > 0} {
1118         for {set got 0} {$got < $toGet} {incr got} {
1119             if {[$zz.$setNo recordType [expr $setOffset + $got]] == ""} {
1120                 break
1121             }
1122         }
1123         if {$got < $toGet} {
1124             set sessionWait 0
1125             $zz.$setNo present $setOffset $toGet
1126             if {[catch {egw_wait sessionWait 300}]} {
1127                 egw_log debug "timeout/cancel in present"
1128                 $zz disconnect
1129                 break
1130             }
1131             if {$sessionWait == "0"} {
1132                 $zz disconnect
1133             }
1134             if {$sessionWait != "1"} {
1135                 break
1136             }
1137             set got [$zz.$setNo numberOfRecordsReturned]
1138             if {$got <= 0} {
1139                 break
1140             }
1141         }
1142         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $tno
1143         set setOffset [expr $got + $setOffset]
1144         set toGet [expr 1 + $setMax - $setOffset]
1145         egw_flush
1146     }
1147 }
1148
1149 proc z39history {} {
1150     global nextSetNo
1151     global hist
1152     global env
1153     global sessionId
1154     global targets
1155     global html3
1156
1157     if {![info exists nextSetNo]} {
1158         return
1159     }
1160     html "<h2>History</h2><br>\n"
1161     if {$html3} {
1162         html {<table width=500 border=1><tr>}
1163         html {<td align=center><b>Target</b>}
1164         html {<td align=center><b>Database</b>}
1165         html {<td align=center><b>Hits</b>}
1166         html {<td align=center><b>Query</b>}
1167         html {<tr>} "\n"
1168     } else {
1169         html {<dl>} "\n"
1170     }
1171     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
1172         if {$hist($setNo,scan) > 0} continue
1173         set host $hist($setNo,host)
1174         if {$html3} {
1175             html {<td align=left>}
1176         } else {
1177             html {<dt> }
1178         }
1179         html [lindex $targets($host) 0]
1180         if {$html3} {
1181             html {<td align=left>} [join $hist($setNo,database)]
1182         } else {
1183             if {[llength [lindex $targets($host) 1]] > 1} {
1184                 html ": "
1185                 foreach b $hist($setNo,database) {
1186                     html " $b"
1187                 }
1188             }
1189             html {. }
1190         }
1191         if {$html3} {
1192             html {<td align=right>}
1193         }
1194         if {[info exists hist($setNo,hits)]} {
1195             html { <a href="http:} $env(SCRIPT_NAME)
1196             html / $sessionId {/search.egw/} $setNo + 1
1197             html + $hist($setNo,maxPresent)
1198             if {1} {
1199                 html {">} $hist($setNo,hits) {</a>}
1200             } else {
1201                 html {">Result</a>: } $hist($setNo,hits) { hits.}
1202             }
1203         } else {
1204             if {$html3} {
1205                 html {Failed}
1206             } else {
1207                 html {Search failed.}
1208             }
1209         }
1210         if {$html3} {
1211             html {<td align=left>}
1212         } else {
1213             html "<dd>\n"
1214         }
1215         html { <a href="http:} $env(SCRIPT_NAME)
1216         html / $sessionId {/query.egw/} $host + $setNo
1217         if {$html3} {
1218             html {">}
1219         } else {
1220             html {">Query</a>: }
1221         }
1222         set op {}
1223         for {set i 1} {$i <= 3} {incr i} {
1224             if {[string length $hist($setNo,form,entry$i)] > 0} {
1225                 html " <b>" [join $op " "] "</b> "
1226                 html [join $hist($setNo,form,menu$i)] "="
1227                 html $hist($setNo,form,entry$i)
1228                 set op $hist($setNo,form,logic$i)
1229             }
1230         }
1231         if {$html3} {
1232             html {</a><tr>} "\n"
1233         }
1234     }
1235     if {$html3} {
1236         html {</table><p>}
1237     } else {
1238         html {</dl>}
1239     }
1240     html "\n"
1241 }
1242
1243 proc displayError {msga msgb} {
1244     html "<p><center>\n"
1245     html {<img src="/egwgif/noway.gif" alt="Error">}
1246     html "<h2>" $msga "</h2>\n"
1247     if {$msgb != ""} {
1248         html "<h3>" $msgb "</h3>\n"
1249     }
1250     html "</center><p>\n"
1251 }
1252
1253 proc button-europagate {} {
1254     global useIcons
1255     html {<a href="http://europagate.dtv.dk/">}
1256     if {$useIcons} {
1257         html {<img src="/egwgif/button-egw.gif" alt="Europagate" border=0></a>}
1258     } else {
1259         html {Europagate</a> | }
1260     }
1261 }
1262
1263 proc button-define-target {more} {
1264     global useIcons
1265     global env
1266     global sessionId
1267
1268     html {<a href="http:} $env(SCRIPT_NAME)
1269     html / $sessionId {/tform.egw}
1270     if {$useIcons} {
1271         html {"><img src="/egwgif/button-define-target.gif" }
1272         html {alt="Define Target" border=0></a>}
1273     } else {
1274         html {">Define Target</a>}
1275         if {$more} {
1276             html " | \n"
1277         } else {
1278             html "\n"
1279         }
1280     }
1281 }
1282
1283 proc button-new-target {more} {
1284     global useIcons
1285     global env
1286     global sessionId
1287     global mMode
1288
1289     html {<a href="http:} $env(SCRIPT_NAME)
1290     html / $sessionId
1291     if {$mMode} {
1292         html {/mtargets.egw}
1293     } else {
1294         html {/targets.egw}
1295     }
1296     if {$useIcons} {
1297         html {"><img src="/egwgif/button-new-target.gif" }
1298         html {alt="New Target" border=0></a>}
1299     } else {
1300         html {">New Target</a>}
1301         if {$more} {
1302             html " | \n"
1303         } else {
1304             html "\n"
1305         }
1306     }
1307 }
1308
1309 proc button-view-history {more} {
1310     global useIcons
1311     global env
1312     global sessionId
1313     global nextSetNo
1314
1315     html {<a href="http:} $env(SCRIPT_NAME)
1316     html / $sessionId {/history.egw;}
1317     catch { html "/" $nextSetNo}
1318     if {$useIcons} {
1319         html {"><img src="/egwgif/button-view-history.gif" alt="View History" }
1320         html {border=0></a>}
1321     } else {
1322         html {">View History</a>}
1323         if {$more} {
1324             html " | \n"
1325         } else {
1326             html "\n"
1327         }
1328     }
1329 }
1330
1331 proc button-new-query {more setNo} {
1332     global useIcons
1333     global env
1334     global sessionId
1335     global hist
1336     global mMode
1337
1338     html {<a href="http:} $env(SCRIPT_NAME)
1339     html / $sessionId
1340     if {$mMode} {
1341         html {/mquery.egw/} $setNo
1342     } else {
1343         html {/query.egw/} $hist($setNo,host) + $setNo
1344     }
1345     html {">}
1346     if {$useIcons} {
1347         html {<img src="/egwgif/button-new-query.gif" }
1348         html {alt="New Query" border=0></a>}
1349     } else {
1350         html {New Query</a>}
1351         if {$more} {
1352             html " | \n"
1353         } else {
1354             html "\n"
1355         }
1356     }
1357 }
1358
1359 proc button-scan-window {more setNo} {
1360     global useIcons
1361     global env
1362     global sessionId
1363     global hist
1364
1365     html {<a href="http:} $env(SCRIPT_NAME)
1366     html / $sessionId {/search.egw/} $setNo + {scan} {">}
1367     if {$useIcons} {
1368         html {<img src="/egwgif/button-scan-window.gif" }
1369         html {alt="Scan" border=0></a>}
1370     } else {
1371         html {Scan</a>}
1372         if {$more} {
1373             html " | \n"
1374         } else {
1375             html "\n"
1376         }
1377     }
1378 }
1379
1380 proc maintenance {} {
1381     html {<hr>This page is maintained by }
1382     html {<a href="mailto:pwh@dtv.dk"> Peter Wad Hansen </a>.}
1383     html {Last modified 29. january 1996. <br>}
1384     html {<em> This and the following pages are under construction and }
1385     html {will continue to be so until the end of January 1996.</em>}
1386 }
1387
1388 proc splitHostSpec {host} {
1389     set i [string last . $host]
1390     if {$i > 1} {
1391         incr i -1
1392         return [string range $host 0 $i]
1393     }
1394     return $host
1395 }
1396
1397 proc mergeHostSpec {host databases} {
1398     return ${host}.[join $databases -]
1399 }
1400
1401 proc mkAssoc {assoc host} {
1402     global targets
1403
1404     if {[catch {$assoc failback fail-response}]} {
1405         if {[lindex $targets($host) 6] == "1"} {
1406             wais $assoc
1407         } else {
1408             ir $assoc
1409         }
1410     } else {
1411         if {[lindex $targets($host) 6] == "1"} {
1412             if {[$assoc comstack] == "wais"} return
1413             wais $assoc
1414         } else {
1415             if {[$assoc comstack] == "tcpip"} return
1416             ir $assoc
1417         }
1418     }
1419 }