www/z39util.tcl

   1 #
   2 # $Id: z39util.tcl,v 1.47 1996/09/03 14:06:43 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-medium {zset no setNo targetNo} {
  69     global env
  70     global sessionId
  71
  72     set type [$zset type $no]
  73     if {$type == "SD"} {
  74         html {<li>}
  75         set err [lindex [$zset diag $no] 1]
  76         set add [lindex [$zset diag $no] 2]
  77         if {$add != {}} {
  78             set add " :${add}"
  79         }
  80         html "${no} Error ${err}${add} <br>\n"
  81         return
  82     }
  83     if {$type != "DB"} {
  84         return
  85     }
  86     html {<li>}
  87     set rtype [$zset recordType $no]
  88     switch $rtype {
  89         SUTRS {
  90             html { <a href="http:} $env(SCRIPT_NAME) / $sessionId
  91             html {/showfull.egw/} $setNo + $targetNo + $no + full {">}
  92             html [join [$zset getSutrs $no]]
  93             html "</a><br>\n"
  94             return
  95         }
  96     }
  97     if {![catch {
  98         set author [$zset getMarc $no field 100 * a]
  99         set corp [$zset getMarc $no field 110 * a]
 100         set meet [$zset getMarc $no field 111 * a]
 101         set title [$zset getMarc $no field 245 * a]
 102         if {[llength $author] == 0} {
 103             set cover [$zset getMarc $no field 245 * {[bc]}]
 104         } else {
 105             set cover [$zset getMarc $no field 245 * b]
 106         }
 107         set location [$zset getMarc $no field 260 * a]
 108         set publisher [$zset getMarc $no field 260 * b]
 109         set year [$zset getMarc $no field 260 * c]
 110         set score [$zset getMarc $no field 999 * r]
 111     } dispError ] } {
 112         html { <a href="http:} $env(SCRIPT_NAME) /
 113         html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 114         set p 0
 115         foreach a $author {
 116             if {$p} {
 117                 html ", "
 118             }
 119             html $a
 120             set p 1
 121         }
 122         foreach a $corp {
 123             if {$p} {
 124                 html ", "
 125             }
 126             html $a
 127             set p 1
 128         }
 129         foreach a $meet {
 130             if {$p} {
 131                 html ", "
 132             }
 133             html $a
 134             set p 1
 135         }
 136         if {$p} {
 137             html ": "
 138         }
 139         set nope 1
 140         foreach v $title {
 141             html $v
 142             set nope 0
 143         }
 144         set v [join $cover ""]
 145         if {[string length $v] > 0} {
 146             set nope 0
 147             html $v
 148         } elseif {$nope} {
 149             html "No Title"
 150         }
 151         html {</a> }
 152         if {[scan $score %d nscore] == 1} {
 153             html "; Score " $nscore
 154         }
 155     } else {
 156         html { <a href="http:} $env(SCRIPT_NAME) /
 157         html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 158         html {No Title}
 159         html {</a> }
 160         html "Error: " $dispError "\n"
 161     }
 162     html "<br>\n"
 163 }
 164
 165 proc display-brief {zset no setNo targetNo} {
 166     global env
 167     global sessionId
 168
 169     set type [$zset type $no]
 170     if {$type == "SD"} {
 171         html {<li>}
 172         set err [lindex [$zset diag $no] 1]
 173         set add [lindex [$zset diag $no] 2]
 174         if {$add != {}} {
 175             set add " :${add}"
 176         }
 177         html "${no} Error ${err}${add} <br>\n"
 178         return
 179     }
 180     if {$type != "DB"} {
 181         return
 182     }
 183     html {<li>}
 184     set rtype [$zset recordType $no]
 185     switch $rtype {
 186         SUTRS {
 187             html { <a href="http:} $env(SCRIPT_NAME) / $sessionId
 188             html {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 189             html [string range [join [$zset getSutrs $no]] 0 70]
 190             html "</a><br>\n"
 191             return
 192         }
 193     }
 194     if {![catch {
 195         set author [$zset getMarc $no field 100 * a]
 196         set corp [$zset getMarc $no field 110 * a]
 197         set meet [$zset getMarc $no field 111 * a]
 198         set title [$zset getMarc $no field 245 * a]
 199         if {[llength $author] == 0} {
 200             set cover [$zset getMarc $no field 245 * {[bc]}]
 201         } else {
 202             set cover [$zset getMarc $no field 245 * b]
 203         }
 204         set location [$zset getMarc $no field 260 * a]
 205         set publisher [$zset getMarc $no field 260 * b]
 206         set year [$zset getMarc $no field 260 * c]
 207     } dispError ] } {
 208         html { <a href="http:} $env(SCRIPT_NAME) /
 209         html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 210         set p 0
 211         foreach a $author {
 212             if {$p} {
 213                 html ", "
 214             }
 215             html $a
 216             set p 1
 217         }
 218         foreach a $corp {
 219             if {$p} {
 220                 html ", "
 221             }
 222             html $a
 223             set p 1
 224         }
 225         foreach a $meet {
 226             if {$p} {
 227                 html ", "
 228             }
 229             html $a
 230             set p 1
 231         }
 232         if {$p} {
 233             html ": "
 234         }
 235         html {<it>}
 236         set nope 1
 237         foreach v $title {
 238             html $v
 239             set nope 0
 240         }
 241         html {</it>}
 242         if {$nope} {
 243             set v [join $cover ""]
 244             if {[string length $v] > 40} {
 245                 set nope 0
 246                 html [string range $v 0 38] "..."
 247             } elseif {[string length $v] > 0} {
 248                 set nope 0
 249                 html $v
 250             } else {
 251                 html "No Title"
 252             }
 253         }
 254         html {</a> }
 255     } else {
 256         html { <a href="http:} $env(SCRIPT_NAME) /
 257         html $sessionId {/showfull.egw/} $setNo + $targetNo + $no + full {">}
 258         html {No Title}
 259         html {</a> }
 260         html "Error: " $dispError "\n"
 261     }
 262     html "<br>\n"
 263 }
 264
 265 proc display-raw {zset no setNo targetNo} {
 266     set type [$zset type $no]
 267     switch $type {
 268         SD {
 269             set err [lindex [$zset diag $no] 1]
 270             set add [lindex [$zset diag $no] 2]
 271             if {$add != {}} {
 272                 set add " :${add}"
 273             }
 274             html "<h3>${no}</h3>\n"
 275             html "Error ${err}${add} <br>\n"
 276             return
 277         }
 278         DB {
 279         }
 280         default {
 281             return
 282         }
 283     }
 284     set rtype [$zset recordType $no]
 285     switch $rtype {
 286         SUTRS {
 287             html "<xmp>\n" [join [$zset getSutrs $no]] "\n</xmp>\n"
 288             return
 289         }
 290     }
 291     if {[catch {set r [$zset getMarc $no line * * *]}]} {
 292         html "Unknown record type: $rtype <br>\n"
 293         return
 294     }
 295     foreach line $r {
 296         set tag [lindex $line 0]
 297         set indicator [lindex $line 1]
 298         set fields [lindex $line 2]
 299         set l [string length $indicator]
 300         html "<tt>$tag "
 301         if {$l > 0} {
 302             for {set i 0} {$i < $l} {incr i} {
 303                 if {[string index $indicator $i] == " "} {
 304                     html "-"
 305                 } else {
 306                     html [string index $tag $i]
 307                 }
 308             }
 309         }
 310         html "</tt>"
 311         foreach field $fields {
 312             set id [lindex $field 0]
 313             set data [lindex $field 1]
 314             if {$id != ""} {
 315                 html " <b>\$$id</b> "
 316             }
 317             html $data
 318         }
 319         html "<br>\n"
 320     }
 321 }
 322
 323 proc put-marc-contents {cc} {
 324     set ref ""
 325     if {[string first :// $cc] > 0} {
 326         foreach urltype {gopher http ftp mailto} {
 327             if {[string first ${urltype}:// $cc] == 0} {
 328                 set ref $urltype
 329                 break
 330             }
 331         }
 332     }
 333     if {$ref != ""} {
 334         html {<a href="}
 335     }
 336     html $cc
 337     if {$ref != ""} {
 338         html {">} $cc {</a>}
 339     }
 340 }
 341
 342 proc dl-marc-field {zset no tag id la lb sep} {
 343     set n 0
 344     set c [$zset getMarc $no field $tag * $id]
 345     set len [llength $c]
 346     if {$len == 0} {
 347         return 0
 348     }
 349     if {$len > 1 && "x$lb" != "x"} {
 350         html "<dt><b>$lb</b>\n<dd>"
 351     } else {
 352         html "<dt><b>$la</b>\n<dd>"
 353     }
 354     foreach cc $c {
 355         if {$n > 0} {
 356             html $sep
 357         }
 358         put-marc-contents $cc
 359         incr n
 360     }
 361     return $n
 362 }
 363
 364 proc dd-marc-field {zset no tag id start stop} {
 365     set n 0
 366     set c [$zset getMarc $no field $tag * $id]
 367     set len [llength $c]
 368     if {$len == 0} {
 369         return 0
 370     }
 371     foreach cc $c {
 372         html $start
 373         put-marc-contents $cc
 374         html $stop
 375         incr n
 376     }
 377     return $n
 378 }
 379
 380 proc dl-marc-field-rec {zset no tag lead start stop startid sep} {
 381     set n 0
 382     set lines [$zset getMarc $no line $tag * *]
 383     foreach line $lines {
 384         foreach field [lindex $line 2] {
 385             if {$n == 0} {
 386                 html "<dt><b>$lead</b>"
 387                 html "\n<dd>"
 388             }
 389             set id [lindex $field 0]
 390             if {$id == $startid} {
 391                 if {$n > 0} {
 392                     html $stop
 393                 }
 394                 html $start
 395                 incr n
 396                 html [lindex $field 1]
 397             } else {
 398                 html $sep
 399                 html [lindex $field 1]
 400             }
 401         }
 402     }
 403     if {$n > 0} {
 404         html $stop
 405     }
 406 }
 407
 408 proc display-full-marc {zset no setNo targetNo} {
 409     global env
 410     global hist
 411     global sessionId
 412
 413     html "<dl>\n"
 414     set n [dl-marc-field $zset $no 700 a "Author" "Authors" "<br>\n"]
 415     if {$n == 0} {
 416         set n [dl-marc-field $zset $no 100 a "Author" "Authors" "<br>\n"]
 417     }
 418     set n [dl-marc-field $zset $no 710 a "Corporate Name" {} ", "]
 419     if {$n == 0} {
 420         set n [dl-marc-field $zset $no 110 a "Corporate Name" {} ", "]
 421     }
 422     set n [dl-marc-field $zset $no 711 a "Meeting Name" {} ", "]
 423     if {$n > 0} {
 424         dd-marc-field $zset $no 711 {[bndc]} " " ""
 425     } else {
 426         set n [dl-marc-field $zset $no 111 a "Meeting Name" {} ", "]
 427         if {$n > 0} {
 428             dd-marc-field $zset $no 111 {[bndc]} " " " "
 429         }
 430     }
 431     set n [dl-marc-field $zset $no 245 {a} "Title" {} " "]
 432     if {$n > 0} {
 433         dd-marc-field $zset $no 245 b "<em>" "</em>"
 434         dd-marc-field $zset $no 245 c " " ""
 435     } else {
 436         dl-marc-field $zset $no 245 {[ab]} "Title" {} " "
 437     }
 438     dl-marc-field $zset $no 520 a "Abstract" {} ", "
 439     dl-marc-field $zset $no 072 * "Subject code" "Subject codes" ", "
 440     dl-marc-field $zset $no 650 * "Subject" {} ", "
 441     dl-marc-field $zset $no 260 * "Publisher" {} " "
 442     dl-marc-field $zset $no 300 * "Physical Description" {} " "
 443
 444     dl-marc-field-rec $zset $no 500 "Notes" "" "<br>\n" "a" ", "
 445
 446     dl-marc-field-rec $zset $no 510 "References" "" "<br>\n" "a" ", "
 447
 448     dl-marc-field-rec $zset $no 511 "Participant note" "" "<br>\n" "a" ", "
 449
 450     dl-marc-field $zset $no 513 a "Report type" {} ", "
 451     dl-marc-field $zset $no 513 b "Period covered" {} ", "
 452     dl-marc-field-rec $zset $no 515 "Numbering notes" "" "<br>\n" "a" ", "
 453     dl-marc-field-rec $zset $no 516 "Data notes" "" "<br>\n" "a" ", "
 454     dl-marc-field-rec $zset $no 518 "Date/time notes" "" "<br>\n" "a" ", "
 455
 456     dl-marc-field $zset $no 350 a "Price" {} ", "
 457     dl-marc-field $zset $no 362 a "Dates of publication" {} ", "
 458     dl-marc-field $zset $no 850 a "Holdings" {} ", "
 459
 460     dl-marc-field-rec $zset $no 270 "Contact name" "" "<br>\n" p ", "
 461     if {0} {
 462         set n [dl-marc-field $zset $no 270 p "Contact name" {} ", "]
 463         if {$n > 0} {
 464             html "\n<dl>\n"
 465
 466             if {0} {
 467                 dl-marc-field $zset $no 270 a "Street" {} ", "
 468                 dl-marc-field $zset $no 270 b "City" {} ", "
 469                 dl-marc-field $zset $no 270 c "State" {} ", "
 470                 dl-marc-field $zset $no 270 e "Zip code" {} ", "
 471                 dl-marc-field $zset $no 270 d "Country" {} ", "
 472                 dl-marc-field $zset $no 270 m "Network address" {} ", "
 473                 dl-marc-field $zset $no 301 a "Service hours" {} ", "
 474                 dl-marc-field $zset $no 270 k "Phone" {} ", "
 475                 dl-marc-field $zset $no 270 l "Fax" {} ", "
 476             } else {
 477                 dl-marc-field $zset $no 270 {[abcedmakl]} "Address" {} "<br>\n"
 478             }
 479
 480             html "\n</dl>\n"
 481         }
 482     }
 483     dl-marc-field $zset $no 010 a "LC control number" {} ", "
 484     dl-marc-field $zset $no 010 b "NUCMC control number" {} ", "
 485     dl-marc-field $zset $no 020 a "ISBN" {} ", "
 486     dl-marc-field $zset $no 022 a "ISSN" {} ", "
 487     set url [$zset getMarc $no field 856 * u]
 488     set sp [$zset getMarc $no field 856 * 3]
 489     if {"x$url" != "x"} {
 490         html "<dt><b>URL</b>\n"
 491         if {"x$sp" == "x"} {
 492             set sp $url
 493         }
 494         html {<dd><a href="} [join $url] {">} [join $sp] "</a>\n"
 495     }
 496     dl-marc-field $zset $no 037 {[abc]} "Acquisition" {} "<br>\n"
 497     dl-marc-field $zset $no 037 {[f6]} "Form of issue" {} "<br>\n"
 498     dl-marc-field $zset $no 537 * "Source of data" {} "<br>\n"
 499     dl-marc-field $zset $no 538 * "System details" {} "<br>\n"
 500     dl-marc-field $zset $no 787 {[rstw6]} "Related information" {} "<br>\n"
 501     dl-marc-field $zset $no 999 r "Score" {} ", "
 502     dl-marc-field $zset $no 001 * "Local control number" {} ", "
 503     html "</dl>\n"
 504 }
 505
 506 proc display-full {zset no setNo targetNo} {
 507     set type [$zset type $no]
 508     switch $type {
 509         SD {
 510             set err [lindex [$zset diag $no] 1]
 511             set add [lindex [$zset diag $no] 2]
 512             if {$add != {}} {
 513                 set add " :${add}"
 514             }
 515             html "Error ${err}${add} <br>\n"
 516             return
 517         }
 518         DB {
 519         }
 520         default {
 521             return
 522         }
 523     }
 524     set rtype [$zset recordType $no]
 525     switch $rtype {
 526         SUTRS {
 527             html "<pre>" [join [$zset getSutrs $no]] "</pre><br>\n"
 528             return
 529         }
 530     }
 531     if {[catch {set r [$zset getMarc $no line * * *]}]} {
 532         html "Unknown record type: $rtype <br>\n"
 533         return
 534     }
 535     display-full-marc $zset $no $setNo $targetNo
 536 }
 537
 538
 539 proc display-rec {from to dfunc setNo targetNo} {
 540     while {$from <= $to} {
 541         eval "$dfunc z39${targetNo}.${setNo} $from $setNo $targetNo"
 542         incr from
 543     }
 544 }
 545
 546 proc build-scan {t i} {
 547     global targets
 548
 549     set term [egw_form entry$i]
 550     if {$term != ""} {
 551         set field [join [egw_form menu$i]]
 552         set attr {Title}
 553         foreach x [lindex $targets($t) 2] {
 554             if {[lindex $x 0] == $field} {
 555                 set attr [lindex $x 1]
 556             }
 557         }
 558         return [list $term $attr]
 559     }
 560     return ""
 561 }
 562
 563 proc build-query {t ilines} {
 564     global targets
 565
 566     set op {}
 567     set q {}
 568     for {set i 1} {$i <= $ilines} {incr i} {
 569         set term [join [egw_form entry$i]]
 570         if {[string length $term] == 0} continue
 571         set field [join [egw_form menu$i]]
 572         catch {unset attr}
 573         foreach x [lindex $targets($t) 2] {
 574             if {![string compare [lindex $x 0] $field]} {
 575                 set attr [lindex $x 1]
 576             }
 577         }
 578         if {![info exists attr]} {
 579             egw_log debug "attr failed for $t"
 580             set attr [lindex [lindex [lindex $targets($t) 2] 0] 1]
 581         }
 582         egw_log debug "op=${op}"
 583         switch $op {
 584             And
 585             { set q "@and $q ${attr} \"${term}\""; egw_log debug AND }
 586             Or
 587             { set q "@or $q ${attr} \"${term}\""; egw_log debug OR }
 588             {}
 589             { set q "${attr} \"${term}\""; egw_log debug NOPE }
 590             default
 591            { set q "@not $q ${attr} \"${term}\""; egw_log debug ANDNOT }
 592         }
 593         set op [egw_form logic$i]
 594     }
 595     return $q
 596 }
 597
 598 proc z39scan {setNo scanNo tno scanLines scanPos cache} {
 599     global hist
 600     global sessionWait
 601     global targets
 602
 603     set zz z39$tno
 604     set host $hist($setNo,$tno,host)
 605     set idAuth $hist($setNo,$tno,idAuthentication)
 606     set database $hist($setNo,$tno,database)
 607     set scanAttr $hist($setNo,scanAttr)
 608     set scanTerm $hist($setNo,$scanNo,scanTerm)
 609
 610     mkAssoc $zz $host
 611     if {[catch [list set oldHost [$zz connect]]]} {
 612         set oldHost ""
 613     }
 614     set zs $zz.s$scanNo.$setNo
 615     $zz callback ok-response
 616     $zz failback fail-response
 617     set thisHost [splitHostSpec $host]
 618     if {[string compare $oldHost $thisHost]} {
 619         catch [list $zz disconnect]
 620
 621         set sessionWait 0
 622         if {[catch [list $zz connect $thisHost]]} {
 623             displayError "Cannot connect to target" $thisHost
 624             return 0
 625         } elseif {$sessionWait == 0} {
 626             if {[catch {egw_wait sessionWait 300}]} {
 627                 $zz disconnect
 628                 displayError "Cannot connect to target" $thisHost
 629                 return 0
 630             }
 631             if {$sessionWait != 1} {
 632                 displayError "Cannot connect to target" $thisHost
 633                 return 0
 634             }
 635         }
 636         $zz idAuthentication $idAuth
 637         set sessionWait 0
 638         if {[catch {$zz init}]} {
 639             displayError "Cannot initialize target" $thisHost
 640             $zz disconnect
 641             return 0
 642         }
 643         if {[catch {egw_wait sessionWait 60}]} {
 644             displayError "Cannot initialize target" $thisHost
 645             $zz disconnect
 646             return 0
 647         }
 648         if {$sessionWait != "1"} {
 649             displayError "Cannot initialize target" $thisHost
 650             $zz disconnect
 651             return 0
 652         }
 653         if {![$zz initResult]} {
 654             set u [$zz userInformationField]
 655             $zz disconnect
 656             displayError "Cannot initialize target $thisHost" $u
 657             return 0
 658         }
 659     } else {
 660         if {$cache && ![catch [list $zs numberOfTermsRequested 5]]} {
 661             return 1
 662         }
 663     }
 664     eval $zz databaseNames $database
 665
 666     ir-scan $zs $zz
 667
 668     $zs numberOfTermsRequested $scanLines
 669     $zs preferredPositionInResponse $scanPos
 670
 671     $zz callback [list scan-response $zs]
 672
 673     egw_log debug "scan: ${scanAttr} ${scanTerm}"
 674     set sessionWait 0
 675     $zs scan "${scanAttr} ${scanTerm}"
 676
 677     if {[catch {egw_wait sessionWait 60}]} {
 678         egw_log debug "timeout/cancel in scan"
 679         displayError "Timeout in scan" {}
 680         html "</body></html>\n"
 681         $zz disconnect
 682         return 0
 683     }
 684     if {$sessionWait == -1} {
 685         displayError "Scan fail" "Connection closed"
 686         html "</body></html>\n"
 687         $zz disconnect
 688     }
 689     if {$sessionWait != 1} {
 690         return 0
 691     }
 692     return 1
 693 }
 694
 695 proc display-scan {setNo scanNo tno} {
 696     global hist
 697     global targets
 698     global env
 699     global sessionId
 700     global scriptQuery
 701
 702     set zz z39$tno
 703     set zs $zz.s$scanNo.$setNo
 704     set m [$zs numberOfEntriesReturned]
 705
 706     if {$m > 0} {
 707         set t [lindex [$zs scanLine 0] 1]
 708         if {$tno > 0} {
 709             set hist($setNo,$tno,[expr $scanNo - 1],scanTerm) $t
 710         } else {
 711             set hist($setNo,[expr $scanNo - 1],scanTerm) $t
 712         }
 713         set t [lindex [$zs scanLine [expr $m - 1]] 1]
 714         if {$tno > 0} {
 715             set hist($setNo,$tno,[expr $scanNo + 1],scanTerm) $t
 716         } else {
 717             set hist($setNo,[expr $scanNo + 1],scanTerm) $t
 718         }
 719     }
 720     html {<table width=500 border=0><tr>}
 721     html {<td align=left><b>Scan term</b>}
 722     html {<td align=right><b>Hits</b>}
 723     html {<tr>} \n
 724
 725     for {set i 0} {$i < $m} {incr i} {
 726         html {<td align=left>}
 727         if {0} {
 728             regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
 729             html {<a href="http:} $env(SCRIPT_NAME)
 730             html / $sessionId / $scriptQuery {;/} $setNo + $hist($setNo,host) +
 731             html $hist($setNo,scan) +  $tterm {">}
 732         } else {
 733             regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
 734             html {<a href="http:} $env(SCRIPT_NAME)
 735             html / $sessionId {/search.egw/} $setNo + $tno +
 736             html hyper + $tterm {">}
 737         }
 738         html [lindex [$zs scanLine $i] 1]
 739         html {</a>}
 740         html {<td align=right>}
 741         html [lindex [$zs scanLine $i] 2]
 742         html {<tr>} \n
 743     }
 744     html {</table} \n
 745 }
 746
 747 proc z39search {setNo piggy tno elements} {
 748     global hist
 749     global sessionWait
 750     global targets
 751
 752     set zz z39$tno
 753     set host $hist($setNo,$tno,host)
 754     set idAuth $hist($setNo,$tno,idAuthentication)
 755     set database $hist($setNo,$tno,database)
 756     set query $hist($setNo,$tno,query)
 757     catch {set docId $hist($setNo,$tno,queryId)}
 758
 759     mkAssoc $zz $host
 760     if {[catch [list set oldHost [$zz connect]]]} {
 761         set oldHost ""
 762     }
 763     $zz callback ok-response
 764     $zz failback fail-response
 765     set thisHost [splitHostSpec $host]
 766     if {[string compare $oldHost $thisHost]} {
 767         catch [list $zz disconnect]
 768
 769         set sessionWait 0
 770         if {[catch [list $zz connect $thisHost]]} {
 771             displayError "Cannot connect to target" $thisHost
 772             return 0
 773         } elseif {$sessionWait == 0} {
 774             if {[catch {egw_wait sessionWait 300}]} {
 775                 $zz disconnect
 776                 displayError "Cannot connect to target" $thisHost
 777                 return 0
 778             }
 779             if {$sessionWait != 1} {
 780                 displayError "Cannot connect to target" $thisHost
 781                 return 0
 782             }
 783         }
 784         $zz idAuthentication $idAuth
 785         set sessionWait 0
 786         if {[catch {$zz init}]} {
 787             displayError "Cannot initialize target" $thisHost
 788             $zz disconnect
 789             return 0
 790         }
 791         if {$sessionWait == 0 && [catch {egw_wait sessionWait 60}]} {
 792             displayError "Cannot initialize target" $thisHost
 793             $zz disconnect
 794             return 0
 795         }
 796         if {$sessionWait != "1"} {
 797             displayError "Cannot initialize target" $thisHost
 798             $zz disconnect
 799             return 0
 800         }
 801         if {![$zz initResult]} {
 802             set u [$zz userInformationField]
 803             $zz disconnect
 804             displayError "Cannot initialize target $thisHost" $u
 805             return 0
 806         }
 807     } elseif {![catch  [list $zz.$setNo smallSetUpperBound 0]]} {
 808         if {[info exists hist($setNo,$tno,hits)]} {
 809             return 1
 810         }
 811     }
 812
 813     ir-set $zz.$setNo $zz
 814     $zz.$setNo preferredRecordSyntax [lindex $targets($host) 1]
 815     egw_log debug "set syntax to [lindex $targets($host) 1]"
 816     if {![lindex $targets($host) 5]} {
 817         set elements {}
 818     }
 819     $zz.$setNo smallSetElementSetNames $elements
 820     $zz.$setNo mediumSetElementSetNames $elements
 821     $zz.$setNo recordElements $elements
 822
 823     egw_log debug "database=$database"
 824     eval $zz.$setNo databaseNames $database
 825
 826     $zz callback [list search-response $zz.$setNo]
 827     if {$piggy} {
 828         $zz.$setNo largeSetLowerBound 999999
 829         $zz.$setNo smallSetUpperBound 0
 830         $zz.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
 831     } else {
 832         $zz.$setNo largeSetLowerBound 2
 833         $zz.$setNo smallSetUpperBound 0
 834         $zz.$setNo mediumSetPresentNumber 0
 835     }
 836     set sessionWait 0
 837     egw_log debug "search: $query"
 838
 839     if {[info exists docId]} {
 840         $zz.$setNo search $query $docId
 841     } else {
 842         $zz.$setNo search $query
 843     }
 844
 845     if {!$sessionWait && [catch {egw_wait sessionWait 60}]} {
 846         egw_log debug "timeout/cancel in search"
 847         displayError "Timeout in search" {}
 848         html "</body></html>\n"
 849         $zz disconnect
 850         return 0
 851     }
 852
 853     if {$sessionWait == -1} {
 854         displayError "Search fail" "Connection closed"
 855         html "</body></html>\n"
 856         $zz disconnect
 857     }
 858     if {$sessionWait != 1} {
 859         return 0
 860     }
 861     set hist($setNo,$tno,hits) [$zz.$setNo resultCount]
 862     return 1
 863 }
 864
 865 proc init-m-response {i} {
 866     global zstatus
 867     global zleft
 868
 869     egw_log debug "init-m-response"
 870
 871     incr zleft -1
 872     if {![z39$i initResult]} {
 873         set zstatus($i) -1
 874         z39$i disconnect
 875         return
 876     }
 877     set zstatus($i) 1
 878 }
 879
 880 proc connect-m-response {i} {
 881     global zstatus
 882     global zleft
 883
 884     egw_log debug "connect-m-response"
 885     z39$i callback [list init-m-response $i]
 886     if {[catch {z39$i init}]} {
 887         set zstatus($i) -1
 888         incr zleft -1
 889     }
 890 }
 891
 892 proc fail-m-response {i} {
 893     global zstatus
 894     global zleft
 895
 896     egw_log debug "fail-m-response"
 897     set zstatus($i) -1
 898     incr zleft -1
 899 }
 900
 901 proc search-m-response {setNo i start number} {
 902     global zleft
 903     global zstatus
 904     global hist
 905
 906     egw_log debug "search-m-response"
 907     set status [z39$i.$setNo responseStatus]
 908     egw_log debug "search-m-response1"
 909     if {[lindex $status 0] == "OK"} {
 910         set nor 0
 911     } elseif {[lindex $status 0] == "DBOSD"} {
 912         set nor [z39$i.$setNo numberOfRecordsReturned]
 913     } else {
 914         egw_log debug "search-m-response2"
 915         incr zleft -1
 916         set zstatus($i) 2
 917         return
 918     }
 919     set hist($setNo,$i,hits) [z39$i.$setNo resultCount]
 920     egw_log debug "search-m-response3"
 921     set hist($setNo,$i,offset) [expr $start + $nor -1]
 922     if {[expr $nor + $start] > [z39$i.$setNo resultCount]} {
 923         egw_log debug "search-m-response4"
 924         incr zleft -1
 925         set zstatus($i) 2
 926         return
 927     }
 928     egw_log debug "search-m-response5"
 929     if {$nor >= $number} {
 930         egw_log debug "search-m-response6 nor=$nor number=$number"
 931         incr zleft -1
 932         set zstatus($i) 2
 933         return
 934     }
 935     egw_log debug "search-m-response7"
 936     set start [expr $start + $nor]
 937     set number [expr $number - $nor]
 938     if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
 939         set number [expr [z39$i.$setNo resultCount] - $start + 1]
 940     }
 941     z39$i callback [list search-m-response $setNo $i $start $number]
 942     egw_log debug "mpresent start=$number number=$number"
 943     z39$i.$setNo present $start $number
 944 }
 945
 946 proc z39msearch {setNo elements start number cache} {
 947     global zleft
 948     global zstatus
 949     global hist
 950     global targets
 951     global debug
 952
 953     set not $hist($setNo,0,host)
 954
 955     egw_log debug "z39msearch start=$start number=$number elements=$elements"
 956     for {set i 1} {$i <= $not} {incr i} {
 957         set host $hist($setNo,$i,host)
 958         mkAssoc z39$i $host
 959         set oldHost [z39$i connect]
 960         set thisHost [splitHostSpec $host]
 961         if {[string compare $oldHost $thisHost]} {
 962             catch {z39$i disconnect}
 963         }
 964         z39$i callback [list connect-m-response $i]
 965         z39$i failback [list fail-m-response $i]
 966     }
 967     set zleft 0
 968     for {set i 1} {$i <= $not} {incr i} {
 969         set oldHost [z39$i connect]
 970         set host $hist($setNo,$i,host)
 971         set thisHost [splitHostSpec $host]
 972         if {![string compare $oldHost $thisHost]} {
 973             continue
 974         }
 975         egw_log debug "old=$oldHost this=$thisHost"
 976         z39$i idAuthentication $hist($setNo,$i,idAuthentication)
 977         html "Connecting to target " $thisHost " <br>\n"
 978         set zstatus($i) -1
 979         if {![catch {z39$i connect $thisHost}]} {
 980             incr zleft
 981         }
 982     }
 983     while {$zleft > 0} {
 984         egw_log debug "Waiting for init response"
 985         if {[catch {egw_wait zleft 20} reason]} {
 986             if {![string compare $reason cancel]} {
 987                 for {set i 1} {$i <= $not} {incr i} {
 988                     set zstatus($i) -1
 989                     catch {z39$i disconnect}
 990                 }
 991                 return
 992             } else {
 993                 for {set i 1} {$i <= $not} {incr i} {
 994                     if {$zstatus($i) == -1} {
 995                         catch {z39$i disconnect}
 996                     }
 997                 }
 998             }
 999             break
1000         }
1001     }
1002     set zleft 0
1003     for {set i 1} {$i <= $not} {incr i} {
1004         set host $hist($setNo,$i,host)
1005         if {$debug} {
1006             html "host " [splitHostSpec $host] ": "
1007         }
1008         egw_log debug "i=$i zstatus=$zstatus($i)"
1009         if {$zstatus($i) < 1} {
1010             if {$debug} {
1011                 html "fail<br>\n"
1012             }
1013             continue
1014         }
1015         if {[catch [list z39$i.$setNo preferredRecordSyntax]]} {
1016             if {$debug} {
1017                 html "ok<br>\n"
1018             }
1019
1020             ir-set z39$i.$setNo z39$i
1021             z39$i.$setNo preferredRecordSyntax [lindex $targets($host) 1]
1022             egw_log debug "set syntax to [lindex $targets($host) 1]"
1023             set hist($setNo,$i,offset) 0
1024             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
1025
1026             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
1027                 set thisElements {}
1028             } else {
1029                 set thisElements $elements
1030             }
1031             z39$i.$setNo smallSetElementSetNames $thisElements
1032             z39$i.$setNo mediumSetElementSetNames $thisElements
1033             z39$i.$setNo elementSetNames $thisElements
1034             z39$i.$setNo recordElements $thisElements
1035
1036             z39$i callback [list search-m-response $setNo $i $start $number]
1037
1038             if {$start == 1} {
1039                 z39$i.$setNo largeSetLowerBound 999999
1040                 z39$i.$setNo smallSetUpperBound 0
1041                 z39$i.$setNo mediumSetPresentNumber $number
1042             } else {
1043                 z39$i.$setNo largeSetLowerBound 2
1044                 z39$i.$setNo smallSetUpperBound 0
1045                 z39$i.$setNo mediumSetPresentNumber 0
1046             }
1047             set zstatus($i) 1
1048             incr zleft
1049             egw_log debug "msearch host=" $hist($setNo,$i,host)
1050             egw_log debug "setNo=$setNo query=" $hist($setNo,$i,query) "="
1051             if {[catch {z39$i.$setNo search $hist($setNo,$i,query)}]} {
1052                 set zstatus($i) -1
1053                 incr zleft -1
1054             }
1055         } elseif {[z39$i.$setNo resultCount] >= $start} {
1056             if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
1057                 set tnumber [expr [z39$i.$setNo resultCount] - $start + 1]
1058             } else {
1059                 set tnumber $number
1060             }
1061             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
1062                 set thisElements {}
1063             } else {
1064                 set thisElements $elements
1065             }
1066             z39$i.$setNo smallSetElementSetNames $thisElements
1067             z39$i.$setNo mediumSetElementSetNames $thisElements
1068             z39$i.$setNo elementSetNames $thisElements
1069             z39$i.$setNo recordElements $thisElements
1070
1071             for {set n 0} {$n < $tnumber} {incr n} {
1072                 if {[z39$i.$setNo recordType [expr $start + $n]] == ""} {
1073                     if {$n > 0} {
1074                         egw_log debug "failed on $n"
1075                     }
1076                     if {$debug} {
1077                         html "no record at #" [expr $start + $n]
1078                         html " el=-" $thisElements "-"
1079                     }
1080                     break
1081                 }
1082             }
1083             if {$n == $tnumber} {
1084                 if {$debug} {
1085                     html "cached<br>\n"
1086                 }
1087                 continue
1088             }
1089
1090             html "present<br>\n"
1091             z39$i callback [list search-m-response $setNo $i $start $tnumber]
1092             incr zleft
1093             egw_log debug "mpresent start=$start number=$tnumber"
1094             z39$i.$setNo present $start $tnumber
1095         } else {
1096             if {$debug} {
1097                 html "ok<br>\n"
1098             }
1099         }
1100     }
1101
1102
1103     while {$zleft > 0} {
1104         egw_log debug "Waiting for search/present response"
1105         if {[catch {egw_wait zleft 60} reason]} {
1106             if {![string compare $reason cancel]} {
1107                 for {set i 1} {$i <= $not} {incr i} {
1108                     catch {z39$i disconnect}
1109                     set zstatus($i) -1
1110                 }
1111                 return
1112             } else {
1113                 for {set i 1} {$i <= $not} {incr i} {
1114                     if {$zstatus($i) != 2} {
1115                         catch {z39$i disconnect}
1116                     }
1117                 }
1118             }
1119             break
1120         }
1121     }
1122     for {set i 1} {$i <= $not} {incr i} {
1123         if {$zstatus($i) != 2} continue
1124         set status [z39$i.$setNo responseStatus]
1125         if {0 && [lindex $status 0] != "NSD"} {
1126             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
1127         }
1128     }
1129 }
1130
1131 proc z39present {setNo tno setOffset setMax dfunc elements} {
1132     global hist
1133     global sessionWait
1134     global targets
1135
1136     set zz z39$tno
1137     set host $hist($setNo,$tno,host)
1138
1139     if {![lindex $targets($host) 5]} {
1140         set elements {}
1141     }
1142
1143     $zz.$setNo elementSetNames $elements
1144     $zz.$setNo recordElements $elements
1145     set toGet [expr 1 + $setMax - $setOffset]
1146
1147     $zz callback [list search-response $zz.$setNo]
1148
1149     while {$setMax > 0 && $toGet > 0} {
1150         for {set got 0} {$got < $toGet} {incr got} {
1151             if {[$zz.$setNo recordType [expr $setOffset + $got]] == ""} {
1152                 break
1153             }
1154         }
1155         if {$got < $toGet} {
1156             set sessionWait 0
1157             $zz.$setNo present $setOffset $toGet
1158             if {[catch {egw_wait sessionWait 300}]} {
1159                 egw_log debug "timeout/cancel in present"
1160                 $zz disconnect
1161                 break
1162             }
1163             if {$sessionWait == "0"} {
1164                 $zz disconnect
1165             }
1166             if {$sessionWait != "1"} {
1167                 break
1168             }
1169             set got [$zz.$setNo numberOfRecordsReturned]
1170             if {$got <= 0} {
1171                 break
1172             }
1173         }
1174         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $setNo $tno
1175         set setOffset [expr $got + $setOffset]
1176         set toGet [expr 1 + $setMax - $setOffset]
1177         egw_flush
1178     }
1179 }
1180
1181 proc buttons-result-set-s {setNo targetNo setMax startPos after} {
1182     global sessionId
1183     global useIcons
1184     global env
1185     global hist
1186
1187     set zz z39$targetNo
1188     html "<p>\n"
1189     button-main
1190     if {$setMax > 0 && $setMax < [$zz.$setNo resultCount]} {
1191         if {!$useIcons} {
1192             html "\n | "
1193         }
1194         html {<a href="http:} $env(SCRIPT_NAME)
1195         html / $sessionId {/search.egw/} $setNo + $targetNo +
1196         html [expr $setMax + 1] + [expr $setMax + $hist($setNo,maxPresent)]
1197         if {$useIcons} {
1198             html {"><img src="/egwgif/button-next-records.gif" }
1199             html {alt="Next Records" border=0></a>}
1200         } else {
1201             html {">Next Records</a>}
1202         }
1203     }
1204     if {$setMax > 0 && $startPos != "" && $startPos != "1"} {
1205         if {!$useIcons} {
1206             html "\n | "
1207         }
1208         html {<a href="http:} $env(SCRIPT_NAME)
1209         html / $sessionId {/search.egw/} $setNo + $targetNo
1210         html + [expr $startPos - $hist($setNo,maxPresent)]
1211         html + [expr $startPos - 1]
1212         if {$useIcons} {
1213             html {"><img src="/egwgif/button-previous-records.gif" }
1214             html {alt="Previous Records" border=0></a>}
1215         } else {
1216             html {">Previous Records</a>}
1217         }
1218     }
1219     if {$targetNo > 0} {
1220         button-result-set $setNo $targetNo
1221     }
1222     button-new-query $setNo
1223     button-new-target
1224     button-view-history
1225
1226     html "<p>\n"
1227 }
1228
1229 proc score-sort {l r} {
1230     return [expr [lindex $r 0] - [lindex $l 0]]
1231 }
1232
1233 proc display-result-set-m-score {setNo} {
1234     global hist
1235     global useIcons
1236     global zstatus
1237     global targets
1238
1239     set not $hist($setNo,0,host)
1240     for {set i 1} {$i <= $not} {incr i} {
1241         if {$zstatus($i) != 2} continue
1242         set status [z39$i.$setNo responseStatus]
1243         if {[lindex $status 0] != "DBOSD"} continue
1244         set nor $hist($setNo,$i,offset)
1245         for {set j 1} {$j <= $nor} {incr j} {
1246             if {![string compare [z39$i.$setNo recordType $j] USmarc]} {
1247                 set score [z39$i.$setNo getMarc $j field 999 * r]
1248                 if {[scan $score %d score] != 1} {
1249                     set score 10
1250                 }
1251             } else {
1252                 set score 10
1253             }
1254             if {$score > 0} {
1255                 lappend scoreArray [list $score $i $j]
1256             }
1257         }
1258     }
1259     if {![info exists scoreArray]} {
1260         html "<br><h3>Search produced no result</h3><br>\n"
1261     } else {
1262         html "<ul>\n"
1263         set scoreSorted [lsort -command score-sort $scoreArray]
1264         foreach r $scoreSorted {
1265             set i [lindex $r 1]
1266             set j [lindex $r 2]
1267             display-$hist($setNo,format) z39$i.$setNo $j $setNo $i
1268         }
1269         html "<br></ul>\n"
1270     }
1271     for {set i 1} {$i <= $not} {incr i} {
1272         if {$zstatus($i) != 2} continue
1273         set status [z39$i.$setNo responseStatus]
1274         if {[lindex $status 0] == "NSD"} {
1275             z39$i.$setNo nextResultSetPosition 0
1276             set code [lindex $status 1]
1277             set msg [lindex $status 2]
1278             set addinfo [lindex $status 3]
1279             html {<dt>} [lindex $targets($hist($setNo,$i,host)) 0]
1280             html "<dd>Error: $msg: $addinfo (code $code)<br>\n"
1281         }
1282     }
1283     html "\n<br>"
1284 }
1285
1286 proc display-result-set-m-server {setNo} {
1287     global hist
1288     global useIcons
1289     global zstatus
1290     global targets
1291     global env
1292     global sessionId
1293
1294     set not $hist($setNo,0,host)
1295     html "<dl>\n"
1296     for {set i 1} {$i <= $not} {incr i} {
1297         if {$zstatus($i) != 2} continue
1298         set status [z39$i.$setNo responseStatus]
1299         if {[lindex $status 0] == "NSD"} {
1300             html "<dt><h3>" [lindex $targets($hist($setNo,$i,host)) 0] ": "
1301             z39$i.$setNo nextResultSetPosition 0
1302             set code [lindex $status 1]
1303             set msg [lindex $status 2]
1304             set addinfo [lindex $status 3]
1305             html "Error</h3>\n<dd>NSD$code: $msg: $addinfo"
1306         } else {
1307             html {<dt><a href="http:} $env(SCRIPT_NAME)
1308             html / $sessionId {/search.egw/} $setNo + $i + 1
1309             html + $hist($setNo,maxPresent) {">}
1310             html "<h3>" [lindex $targets($hist($setNo,$i,host)) 0] "</a>: "
1311             set r [z39$i.$setNo resultCount]
1312             html "$r hits</h3>\n<dd>\n"
1313
1314             if {$hist($setNo,$i,offset) > $hist($setNo,maxPresent)} {
1315                 set nor $hist($setNo,maxPresent)
1316             } else {
1317                 set nor $hist($setNo,$i,offset)
1318             }
1319             display-rec 1 $nor display-$hist($setNo,format) $setNo $i
1320         }
1321         html "\n"
1322     }
1323     html "</dl>\n"
1324 }
1325
1326 proc display-result-set-m {setNo} {
1327     global hist
1328     global useIcons
1329     global zstatus
1330     global targets
1331
1332     egw_log debug "sort=$hist($setNo,sort)"
1333     switch $hist($setNo,sort) {
1334         score {
1335             display-result-set-m-score $setNo
1336         }
1337         default {
1338             display-result-set-m-server $setNo
1339         }
1340     }
1341 }
1342
1343 proc display-result-set-s {setNo targetNo startPos endPos} {
1344     global hist
1345     global useIcons
1346
1347     set zz z39$targetNo
1348     set host $hist($setNo,$targetNo,host)
1349     set idAuth $hist($setNo,$targetNo,idAuthentication)
1350     set database $hist($setNo,$targetNo,database)
1351     set query $hist($setNo,$targetNo,query)
1352
1353     set useIcons 1
1354
1355     if {$startPos == ""} {
1356         if {[z39search $setNo 1 $targetNo B] != "1"} {
1357             return
1358         }
1359         set r [$zz.$setNo resultCount]
1360
1361         set setMax [$zz.$setNo resultCount]
1362         if {$setMax > $hist($setNo,maxPresent)} {
1363             set setMax $hist($setNo,maxPresent)
1364         }
1365         buttons-result-set-s $setNo $targetNo $setMax $startPos 0
1366
1367         set setOffset [$zz.$setNo numberOfRecordsReturned]
1368         if {$setMax > 0} {
1369             html {<h3> Records 1-} $setMax " out of $r</h3>\n"
1370         } else {
1371             html "<h3> No hits</h3>\n"
1372         }
1373         egw_flush
1374         html "<ul>\n"
1375         display-rec 1 $setMax display-brief $setNo $targetNo
1376         incr setOffset
1377
1378     } else {
1379         if {[z39search $setNo 0 $targetNo B] != "1"} {
1380             return
1381         }
1382         set r [$zz.$setNo resultCount]
1383         set setOffset $startPos
1384         set setMax [$zz.$setNo resultCount]
1385         if {$setMax > $endPos} {
1386             set setMax $endPos
1387         }
1388         buttons-result-set-s $setNo $targetNo $setMax $startPos 0
1389         if {$setMax > 0} {
1390             html {<h3> Records } $startPos {-} $setMax " out of $r</h3>\n"
1391         } else {
1392             html "<h3> No hits</h3>\n"
1393         }
1394         egw_flush
1395         html "<ul>\n"
1396     }
1397     if {$setMax > 0} {
1398         z39present $setNo $targetNo $setOffset $setMax display-brief B
1399     }
1400     html "</ul>\n"
1401     set useIcons 0
1402     buttons-result-set-s $setNo $targetNo $setMax $startPos 1
1403 }
1404
1405 proc z39history {} {
1406     global nextSetNo
1407     global hist
1408     global env
1409     global sessionId
1410     global targets
1411     global html3
1412     global scriptQuery
1413
1414     if {![info exists nextSetNo]} {
1415         return
1416     }
1417     html "<h2>History</h2><br>\n"
1418     if {$html3} {
1419         html {<table width=500 border=1><tr>}
1420         html {<td align=center><b>Target</b>}
1421         html {<td align=center><b>Database</b>}
1422         html {<td align=center><b>Hits</b>}
1423         html {<td align=center><b>Query</b>}
1424         html {<tr>} "\n"
1425     } else {
1426         html {<dl>} "\n"
1427     }
1428     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
1429         if {[info exists hist($setNo,scan)]} {
1430             if {$hist($setNo,scan) > 0} continue
1431         }
1432         if {[info exists hist($setNo,1,host)]} {
1433             set start 1
1434             set end $hist($setNo,0,host)
1435         } else {
1436             set start 0
1437             set end 0
1438         }
1439         for {set i $start} {$i <= $end} {incr i} {
1440             if {$html3} {
1441                 html {<td align=left>}
1442             } else {
1443                 html {<dt> }
1444             }
1445             set host $hist($setNo,$i,host)
1446             html [lindex $targets($host) 0]
1447             if {$html3} {
1448                 html {<td align=left>} [join $hist($setNo,$i,database)]
1449             } else {
1450                 if {[llength [lindex $targets($host) 1]] > 1} {
1451                     html ": "
1452                     foreach b $hist($setNo,$i,database) {
1453                         html " $b"
1454                     }
1455                 }
1456                 html {. }
1457             }
1458             if {$html3} {
1459                 html {<td align=right>}
1460             }
1461             if {[info exists hist($setNo,$i,hits)]} {
1462                 html { <a href="http:} $env(SCRIPT_NAME)
1463                 html / $sessionId {/search.egw/} $setNo + $i + 1
1464                 html + $hist($setNo,maxPresent)
1465                 html {">} $hist($setNo,$i,hits) {</a>}
1466             } else {
1467                 if {$html3} {
1468                     html {Failed}
1469                 } else {
1470                     html {Search failed.}
1471                 }
1472             }
1473             if {$html3} {
1474                 html {<td align=left>}
1475             } else {
1476                 html "<dd>\n"
1477             }
1478             html { <a href="http:} $env(SCRIPT_NAME)
1479             html / $sessionId / $scriptQuery {;/} $setNo + $host
1480             if {$html3} {
1481                 html {">}
1482             } else {
1483                 html {">Query</a>: }
1484             }
1485             set op {}
1486             for {set j 1} {$j <= 10} {incr j} {
1487                 if {![info exists hist($setNo,form,entry$j)]} {
1488                     break
1489                 }
1490                 if {[string length $hist($setNo,form,entry$j)] > 0} {
1491                     html " <b>" [join $op " "] "</b> "
1492                 set pre [join $hist($setNo,form,menu$j)]
1493                     if {[string length $pre] > 0} {
1494                         html $pre "="
1495                     }
1496                     html $hist($setNo,form,entry$j)
1497                     set op $hist($setNo,form,logic$j)
1498                 }
1499             }
1500             if {$html3} {
1501                 html {</a><tr>} "\n"
1502             }
1503         }
1504     }
1505     if {$html3} {
1506         html {</table><p>}
1507     } else {
1508         html {</dl>}
1509     }
1510     html "\n"
1511 }
1512
1513 proc displayError {msga msgb} {
1514     html "<p><center>\n"
1515     html {<img src="/egwgif/noway.gif" alt="Error">}
1516     html "<h2>" $msga "</h2>\n"
1517     if {[string length $msgb] > 0} {
1518         html "<h3>" $msgb "</h3>\n"
1519     }
1520     html "</center><p>\n"
1521 }
1522
1523 proc button-main {} {
1524     global useIcons
1525     html {<a href="http://europagate.dtv.dk/">}
1526     if {$useIcons} {
1527         html {<img src="/egwgif/button-egw.gif" alt="Europagate" border=0></a>}
1528     } else {
1529         html {Europagate</a>}
1530     }
1531 }
1532
1533 proc button-feedback {} {
1534     global useIcons
1535
1536     html {<a href="http://europagate.dtv.dk/wwwquest.html">}
1537     if {$useIcons} {
1538         html {<img src="/egwgif/button-user-feedback.gif" alt="User Feedback"
1539         border=0></a>}
1540     } else {
1541         html "\n | "
1542         html {User Feedback</a>}
1543     }
1544 }
1545
1546 proc button-define-target {} {
1547     global useIcons
1548     global env
1549     global sessionId
1550
1551     if {!$useIcons} {
1552         html "\n | "
1553     }
1554     html {<a href="http:} $env(SCRIPT_NAME)
1555     html / $sessionId {/tform.egw}
1556     if {$useIcons} {
1557         html {"><img src="/egwgif/button-define-target.gif" }
1558         html {alt="Define Target" border=0></a>}
1559     } else {
1560         html {">Define Target</a>}
1561     }
1562 }
1563
1564 proc button-new-target {} {
1565     global useIcons
1566     global env
1567     global sessionId
1568     global scriptTarget
1569
1570     if {[string length $scriptTarget] == 0} return
1571
1572     if {!$useIcons} {
1573         html "\n | "
1574     }
1575     html {<a href="http:} $env(SCRIPT_NAME)
1576     html / $sessionId / $scriptTarget
1577     if {$useIcons} {
1578         html {"><img src="/egwgif/button-new-target.gif" }
1579         html {alt="New Target" border=0></a>}
1580     } else {
1581         html {">New Target</a>}
1582     }
1583 }
1584
1585 proc button-view-history {} {
1586     global useIcons
1587     global env
1588     global sessionId
1589     global nextSetNo
1590
1591     if {!$useIcons} {
1592         html "\n | "
1593     }
1594     html {<a href="http:} $env(SCRIPT_NAME)
1595     html / $sessionId {/history.egw;}
1596     catch { html "/" $nextSetNo}
1597     if {$useIcons} {
1598         html {"><img src="/egwgif/button-view-history.gif" alt="View History" }
1599         html {border=0></a>}
1600     } else {
1601         html {">View History</a>}
1602     }
1603 }
1604
1605 proc button-new-query {setNo} {
1606     global useIcons
1607     global env
1608     global sessionId
1609     global hist
1610     global scriptQuery
1611
1612     if {!$useIcons} {
1613         html "\n | "
1614     }
1615     html {<a href="http:} $env(SCRIPT_NAME)
1616     html / $sessionId / $scriptQuery {;/} $setNo + $hist($setNo,0,host) {">}
1617
1618     if {$useIcons} {
1619         html {<img src="/egwgif/button-new-query.gif" }
1620         html {alt="New Query" border=0></a>}
1621     } else {
1622         html {New Query</a>}
1623     }
1624 }
1625
1626 proc button-result-set {setNo tno} {
1627     global useIcons
1628     global env
1629     global sessionId
1630     global hist
1631
1632     if {!$useIcons} {
1633         html "\n | "
1634     }
1635     html {<a href="http:} $env(SCRIPT_NAME) / $sessionId
1636     if {$tno > 0} {
1637         html {/msearch.egw/} $setNo
1638     } else {
1639         html {/search.egw/} $setNo + $tno
1640     }
1641     html + 1 + $hist($setNo,maxPresent)
1642     if {$useIcons} {
1643         html {"><img src="/egwgif/button-result-set.gif" }
1644         html {alt="Result Set" border=0></a>}
1645     } else {
1646         html {">Result Set</a>}
1647     }
1648 }
1649
1650 proc button-scan-window {setNo} {
1651     global useIcons
1652     global env
1653     global sessionId
1654     global hist
1655
1656     if {!$useIcons} {
1657         html "\n | "
1658     }
1659     set targetNo 0
1660     html {<a href="http:} $env(SCRIPT_NAME)
1661     html / $sessionId {/search.egw/} $setNo + $targetNo + {scan} {">}
1662     if {$useIcons} {
1663         html {<img src="/egwgif/button-scan-window.gif" }
1664         html {alt="Scan" border=0></a>}
1665     } else {
1666         html {Scan</a>}
1667     }
1668 }
1669
1670 proc maintenance {} {
1671     html {<hr>This page is maintained by }
1672     html {<a href="mailto:nobody"> Nobody </a>.}
1673     html {Last modified x x x. <br>}
1674 }
1675
1676 proc splitHostSpec {host} {
1677     set i [string first / $host]
1678     if {$i > 1} {
1679         incr i -1
1680         return [string range $host 0 $i]
1681     }
1682     return $host
1683 }
1684
1685 proc splitDatabaseSpec {host} {
1686     set i [string first / $host]
1687     if {$i > 1} {
1688         incr i
1689         regsub -all -- - [string range $host $i end] { } res
1690         return $res
1691     }
1692     regsub -all -- - $host {} res
1693     return $res
1694 }
1695
1696 proc mergeHostSpec {host databases} {
1697     return ${host}/[join $databases -]
1698 }
1699
1700 proc mkAssoc {assoc host} {
1701     global targets
1702
1703     if {[catch {$assoc failback fail-response}]} {
1704         ir $assoc
1705         $assoc maximumRecordSize 1000000
1706     } else {
1707         if {[$assoc comstack] == "tcpip"} return
1708         ir $assoc
1709         $assoc maximumRecordSize 1000000
1710     }
1711 }
1712
1713 proc serverList {headlineProc targetProc} {
1714     global targets
1715     global groupsDescription
1716
1717     proc targetsCmp {l r} {
1718         global targets
1719         return [string compare [string tolower [lindex $targets($l) 0]] \
1720                                [string tolower [lindex $targets($r) 0]]]
1721     }
1722     proc groupCmp {l r} {
1723         global groupsOrder
1724         if {[catch {set lo $groupsOrder($l)}]} {
1725             set lo 10
1726         }
1727         if {[catch {set ro $groupsOrder($r)}]} {
1728             set ro 10
1729         }
1730         return [expr $lo - $ro]
1731     }
1732
1733     foreach tt [array names targets] {
1734         lappend groupsTmp([lindex $targets($tt) 6]) $tt
1735     }
1736     set gts [lsort -command groupCmp [array names groupsTmp]]
1737     foreach gt $gts {
1738         if {[info exists groupsDescription($gt)]} {
1739             eval $headlineProc [list $groupsDescription($gt)]
1740         } else {
1741             eval $headlineProc $gt
1742         }
1743         set tn [lsort -command targetsCmp $groupsTmp($gt)]
1744         foreach t $tn {
1745             eval $targetProc $t
1746         }
1747     }
1748
1749     rename targetsCmp {}
1750 }
1751
1752 proc session-lost {} {
1753     global useIcons
1754
1755     html {<head><title>WWW/Z39.50 Gateway: Session Expired</title></head>}
1756     html \n {<body>}
1757     set useIcons 1
1758     button-main
1759     html {<h1>Session Expired</h1>}
1760     html {Your session has expired. Please reload the gateways' }
1761     html {front page.<br><br>} \n
1762     set useIcons 0
1763     button-main
1764     html {</body></html>}
1765 }
1766
1767 if {[info exists utilExtension]} {
1768     source $utilExtension
1769 }
1770