www/z39util.tcl

   1 #
   2 # $Id: z39util.tcl,v 1.49 1997/11/19 13:29:13 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 $indicator $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         set zstatus($i) -1
 978         if {![catch {z39$i connect $thisHost}]} {
 979             incr zleft
 980         }
 981     }
 982     while {$zleft > 0} {
 983         egw_log debug "Waiting for init response"
 984         if {[catch {egw_wait zleft 20} reason]} {
 985             if {![string compare $reason cancel]} {
 986                 for {set i 1} {$i <= $not} {incr i} {
 987                     set zstatus($i) -1
 988                     catch {z39$i disconnect}
 989                 }
 990                 return
 991             } else {
 992                 for {set i 1} {$i <= $not} {incr i} {
 993                     if {$zstatus($i) == -1} {
 994                         catch {z39$i disconnect}
 995                     }
 996                 }
 997             }
 998             break
 999         }
1000     }
1001     set zleft 0
1002     for {set i 1} {$i <= $not} {incr i} {
1003         set host $hist($setNo,$i,host)
1004         if {$debug} {
1005             html "host " [splitHostSpec $host] ": "
1006         }
1007         egw_log debug "i=$i zstatus=$zstatus($i)"
1008         if {$zstatus($i) < 1} {
1009             if {$debug} {
1010                 html "fail<br>\n"
1011             }
1012             continue
1013         }
1014         if {[catch [list z39$i.$setNo preferredRecordSyntax]]} {
1015             if {$debug} {
1016                 html "ok<br>\n"
1017             }
1018
1019             ir-set z39$i.$setNo z39$i
1020             z39$i.$setNo preferredRecordSyntax [lindex $targets($host) 1]
1021             egw_log debug "set syntax to [lindex $targets($host) 1]"
1022             set hist($setNo,$i,offset) 0
1023             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
1024
1025             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
1026                 set thisElements {}
1027             } else {
1028                 set thisElements $elements
1029             }
1030             z39$i.$setNo smallSetElementSetNames $thisElements
1031             z39$i.$setNo mediumSetElementSetNames $thisElements
1032             z39$i.$setNo elementSetNames $thisElements
1033             z39$i.$setNo recordElements $thisElements
1034
1035             z39$i callback [list search-m-response $setNo $i $start $number]
1036
1037             if {$start == 1} {
1038                 z39$i.$setNo largeSetLowerBound 999999
1039                 z39$i.$setNo smallSetUpperBound 0
1040                 z39$i.$setNo mediumSetPresentNumber $number
1041             } else {
1042                 z39$i.$setNo largeSetLowerBound 2
1043                 z39$i.$setNo smallSetUpperBound 0
1044                 z39$i.$setNo mediumSetPresentNumber 0
1045             }
1046             set zstatus($i) 1
1047             incr zleft
1048             egw_log debug "msearch host=" $hist($setNo,$i,host)
1049             egw_log debug "setNo=$setNo query=" $hist($setNo,$i,query) "="
1050             if {[catch {z39$i.$setNo search $hist($setNo,$i,query)}]} {
1051                 set zstatus($i) -1
1052                 incr zleft -1
1053             }
1054         } elseif {[z39$i.$setNo resultCount] >= $start} {
1055             if {[expr $start + $number - 1] > [z39$i.$setNo resultCount]} {
1056                 set tnumber [expr [z39$i.$setNo resultCount] - $start + 1]
1057             } else {
1058                 set tnumber $number
1059             }
1060             if {![lindex $targets($hist($setNo,$i,host)) 5]} {
1061                 set thisElements {}
1062             } else {
1063                 set thisElements $elements
1064             }
1065             z39$i.$setNo smallSetElementSetNames $thisElements
1066             z39$i.$setNo mediumSetElementSetNames $thisElements
1067             z39$i.$setNo elementSetNames $thisElements
1068             z39$i.$setNo recordElements $thisElements
1069
1070             for {set n 0} {$n < $tnumber} {incr n} {
1071                 if {[z39$i.$setNo recordType [expr $start + $n]] == ""} {
1072                     if {$n > 0} {
1073                         egw_log debug "failed on $n"
1074                     }
1075                     if {$debug} {
1076                         html "no record at #" [expr $start + $n]
1077                         html " el=-" $thisElements "-"
1078                     }
1079                     break
1080                 }
1081             }
1082             if {$n == $tnumber} {
1083                 if {$debug} {
1084                     html "cached<br>\n"
1085                 }
1086                 continue
1087             }
1088
1089             html "present<br>\n"
1090             z39$i callback [list search-m-response $setNo $i $start $tnumber]
1091             incr zleft
1092             egw_log debug "mpresent start=$start number=$tnumber"
1093             z39$i.$setNo present $start $tnumber
1094         } else {
1095             if {$debug} {
1096                 html "ok<br>\n"
1097             }
1098         }
1099     }
1100
1101
1102     while {$zleft > 0} {
1103         egw_log debug "Waiting for search/present response"
1104         if {[catch {egw_wait zleft 60} reason]} {
1105             if {![string compare $reason cancel]} {
1106                 for {set i 1} {$i <= $not} {incr i} {
1107                     catch {z39$i disconnect}
1108                     set zstatus($i) -1
1109                 }
1110                 return
1111             } else {
1112                 for {set i 1} {$i <= $not} {incr i} {
1113                     if {$zstatus($i) != 2} {
1114                         catch {z39$i disconnect}
1115                     }
1116                 }
1117             }
1118             break
1119         }
1120     }
1121     for {set i 1} {$i <= $not} {incr i} {
1122         if {$zstatus($i) != 2} continue
1123         set status [z39$i.$setNo responseStatus]
1124         if {0 && [lindex $status 0] != "NSD"} {
1125             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
1126         }
1127     }
1128 }
1129
1130 proc z39present {setNo tno setOffset setMax dfunc elements} {
1131     global hist
1132     global sessionWait
1133     global targets
1134
1135     set zz z39$tno
1136     set host $hist($setNo,$tno,host)
1137
1138     if {![lindex $targets($host) 5]} {
1139         set elements {}
1140     }
1141
1142     $zz.$setNo elementSetNames $elements
1143     $zz.$setNo recordElements $elements
1144     set toGet [expr 1 + $setMax - $setOffset]
1145
1146     $zz callback [list search-response $zz.$setNo]
1147
1148     while {$setMax > 0 && $toGet > 0} {
1149         for {set got 0} {$got < $toGet} {incr got} {
1150             if {[$zz.$setNo recordType [expr $setOffset + $got]] == ""} {
1151                 break
1152             }
1153         }
1154         if {$got < $toGet} {
1155             set sessionWait 0
1156             $zz.$setNo present $setOffset $toGet
1157             if {[catch {egw_wait sessionWait 300}]} {
1158                 egw_log debug "timeout/cancel in present"
1159                 $zz disconnect
1160                 break
1161             }
1162             if {$sessionWait == "0"} {
1163                 $zz disconnect
1164             }
1165             if {$sessionWait != "1"} {
1166                 break
1167             }
1168             set got [$zz.$setNo numberOfRecordsReturned]
1169             if {$got <= 0} {
1170                 break
1171             }
1172         }
1173         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $setNo $tno
1174         set setOffset [expr $got + $setOffset]
1175         set toGet [expr 1 + $setMax - $setOffset]
1176         egw_flush
1177     }
1178 }
1179
1180 proc buttons-result-set-s {setNo targetNo setMax startPos after} {
1181     global sessionId
1182     global useIcons
1183     global env
1184     global hist
1185
1186     set zz z39$targetNo
1187     html "<p>\n"
1188     button-main
1189     if {$setMax > 0 && $setMax < [$zz.$setNo resultCount]} {
1190         if {!$useIcons} {
1191             html "\n | "
1192         }
1193         html {<a href="http:} $env(SCRIPT_NAME)
1194         html / $sessionId {/search.egw/} $setNo + $targetNo +
1195         html [expr $setMax + 1] + [expr $setMax + $hist($setNo,maxPresent)]
1196         if {$useIcons} {
1197             html {"><img src="/egwgif/button-next-records.gif" }
1198             html {alt="Next Records" border=0></a>}
1199         } else {
1200             html {">Next Records</a>}
1201         }
1202     }
1203     if {$setMax > 0 && $startPos != "" && $startPos != "1"} {
1204         if {!$useIcons} {
1205             html "\n | "
1206         }
1207         html {<a href="http:} $env(SCRIPT_NAME)
1208         html / $sessionId {/search.egw/} $setNo + $targetNo
1209         html + [expr $startPos - $hist($setNo,maxPresent)]
1210         html + [expr $startPos - 1]
1211         if {$useIcons} {
1212             html {"><img src="/egwgif/button-previous-records.gif" }
1213             html {alt="Previous Records" border=0></a>}
1214         } else {
1215             html {">Previous Records</a>}
1216         }
1217     }
1218     if {$targetNo > 0} {
1219         button-result-set $setNo $targetNo
1220     }
1221     button-new-query $setNo
1222     button-new-target
1223     button-view-history
1224
1225     html "<p>\n"
1226 }
1227
1228 proc score-sort {l r} {
1229     return [expr [lindex $r 0] - [lindex $l 0]]
1230 }
1231
1232 proc display-result-set-m-score {setNo} {
1233     global hist
1234     global useIcons
1235     global zstatus
1236     global targets
1237
1238     set not $hist($setNo,0,host)
1239     for {set i 1} {$i <= $not} {incr i} {
1240         if {$zstatus($i) != 2} continue
1241         set status [z39$i.$setNo responseStatus]
1242         if {[lindex $status 0] != "DBOSD"} continue
1243         set nor $hist($setNo,$i,offset)
1244         for {set j 1} {$j <= $nor} {incr j} {
1245             if {![string compare [z39$i.$setNo recordType $j] USmarc]} {
1246                 set score [z39$i.$setNo getMarc $j field 999 * r]
1247                 if {[scan $score %d score] != 1} {
1248                     set score 10
1249                 }
1250             } else {
1251                 set score 10
1252             }
1253             if {$score > 0} {
1254                 lappend scoreArray [list $score $i $j]
1255             }
1256         }
1257     }
1258     if {![info exists scoreArray]} {
1259         html "<br><h3>Search produced no result</h3><br>\n"
1260     } else {
1261         html "<ul>\n"
1262         set scoreSorted [lsort -command score-sort $scoreArray]
1263         foreach r $scoreSorted {
1264             set i [lindex $r 1]
1265             set j [lindex $r 2]
1266             display-$hist($setNo,format) z39$i.$setNo $j $setNo $i
1267         }
1268         html "<br></ul>\n"
1269     }
1270     for {set i 1} {$i <= $not} {incr i} {
1271         if {$zstatus($i) != 2} continue
1272         set status [z39$i.$setNo responseStatus]
1273         if {[lindex $status 0] == "NSD"} {
1274             z39$i.$setNo nextResultSetPosition 0
1275             set code [lindex $status 1]
1276             set msg [lindex $status 2]
1277             set addinfo [lindex $status 3]
1278             html {<dt>} [lindex $targets($hist($setNo,$i,host)) 0]
1279             html "<dd>Error: $msg: $addinfo (code $code)<br>\n"
1280         }
1281     }
1282     html "\n<br>"
1283 }
1284
1285 proc display-result-set-m-server {setNo} {
1286     global hist
1287     global useIcons
1288     global zstatus
1289     global targets
1290     global env
1291     global sessionId
1292
1293     set not $hist($setNo,0,host)
1294     html "<dl>\n"
1295     for {set i 1} {$i <= $not} {incr i} {
1296         if {$zstatus($i) != 2} continue
1297         set status [z39$i.$setNo responseStatus]
1298         if {[lindex $status 0] == "NSD"} {
1299             html "<dt><h3>" [lindex $targets($hist($setNo,$i,host)) 0] ": "
1300             z39$i.$setNo nextResultSetPosition 0
1301             set code [lindex $status 1]
1302             set msg [lindex $status 2]
1303             set addinfo [lindex $status 3]
1304             html "Error</h3>\n<dd>NSD$code: $msg: $addinfo"
1305         } else {
1306             html {<dt><a href="http:} $env(SCRIPT_NAME)
1307             html / $sessionId {/search.egw/} $setNo + $i + 1
1308             html + $hist($setNo,maxPresent) {">}
1309             html "<h3>" [lindex $targets($hist($setNo,$i,host)) 0] "</a>: "
1310             set r [z39$i.$setNo resultCount]
1311             html "$r hits</h3>\n<dd>\n"
1312
1313             if {$hist($setNo,$i,offset) > $hist($setNo,maxPresent)} {
1314                 set nor $hist($setNo,maxPresent)
1315             } else {
1316                 set nor $hist($setNo,$i,offset)
1317             }
1318             display-rec 1 $nor display-$hist($setNo,format) $setNo $i
1319         }
1320         html "\n"
1321     }
1322     html "</dl>\n"
1323 }
1324
1325 proc display-result-set-m {setNo} {
1326     global hist
1327     global useIcons
1328     global zstatus
1329     global targets
1330
1331     egw_log debug "sort=$hist($setNo,sort)"
1332     switch $hist($setNo,sort) {
1333         score {
1334             display-result-set-m-score $setNo
1335         }
1336         default {
1337             display-result-set-m-server $setNo
1338         }
1339     }
1340 }
1341
1342 proc display-result-set-s {setNo targetNo startPos endPos} {
1343     global hist
1344     global useIcons
1345
1346     set zz z39$targetNo
1347     set host $hist($setNo,$targetNo,host)
1348     set idAuth $hist($setNo,$targetNo,idAuthentication)
1349     set database $hist($setNo,$targetNo,database)
1350     set query $hist($setNo,$targetNo,query)
1351
1352     set useIcons 1
1353
1354     if {$startPos == ""} {
1355         if {[z39search $setNo 1 $targetNo B] != "1"} {
1356             return
1357         }
1358         set r [$zz.$setNo resultCount]
1359
1360         set setMax [$zz.$setNo resultCount]
1361         if {$setMax > $hist($setNo,maxPresent)} {
1362             set setMax $hist($setNo,maxPresent)
1363         }
1364         buttons-result-set-s $setNo $targetNo $setMax $startPos 0
1365
1366         set setOffset [$zz.$setNo numberOfRecordsReturned]
1367         if {$setMax > 0} {
1368             html {<h3> Records 1-} $setMax " out of $r</h3>\n"
1369         } else {
1370             html "<h3> No hits</h3>\n"
1371         }
1372         egw_flush
1373         html "<ul>\n"
1374         display-rec 1 $setMax display-brief $setNo $targetNo
1375         incr setOffset
1376
1377     } else {
1378         if {[z39search $setNo 0 $targetNo B] != "1"} {
1379             return
1380         }
1381         set r [$zz.$setNo resultCount]
1382         set setOffset $startPos
1383         set setMax [$zz.$setNo resultCount]
1384         if {$setMax > $endPos} {
1385             set setMax $endPos
1386         }
1387         buttons-result-set-s $setNo $targetNo $setMax $startPos 0
1388         if {$setMax > 0} {
1389             html {<h3> Records } $startPos {-} $setMax " out of $r</h3>\n"
1390         } else {
1391             html "<h3> No hits</h3>\n"
1392         }
1393         egw_flush
1394         html "<ul>\n"
1395     }
1396     if {$setMax > 0} {
1397         z39present $setNo $targetNo $setOffset $setMax display-brief B
1398     }
1399     html "</ul>\n"
1400     set useIcons 0
1401     buttons-result-set-s $setNo $targetNo $setMax $startPos 1
1402 }
1403
1404 proc z39history {} {
1405     global nextSetNo
1406     global hist
1407     global env
1408     global sessionId
1409     global targets
1410     global html3
1411     global scriptQuery
1412
1413     if {![info exists nextSetNo]} {
1414         return
1415     }
1416     html "<h2>History</h2><br>\n"
1417     if {$html3} {
1418         html {<table width=500 border=1><tr>}
1419         html {<td align=center><b>Target</b>}
1420         html {<td align=center><b>Database</b>}
1421         html {<td align=center><b>Hits</b>}
1422         html {<td align=center><b>Query</b>}
1423         html {<tr>} "\n"
1424     } else {
1425         html {<dl>} "\n"
1426     }
1427     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
1428         if {[info exists hist($setNo,scan)]} {
1429             if {$hist($setNo,scan) > 0} continue
1430         }
1431         if {[info exists hist($setNo,1,host)]} {
1432             set start 1
1433             set end $hist($setNo,0,host)
1434         } else {
1435             set start 0
1436             set end 0
1437         }
1438         for {set i $start} {$i <= $end} {incr i} {
1439             if {$html3} {
1440                 html {<td align=left>}
1441             } else {
1442                 html {<dt> }
1443             }
1444             set host $hist($setNo,$i,host)
1445             html [lindex $targets($host) 0]
1446             if {$html3} {
1447                 html {<td align=left>} [join $hist($setNo,$i,database)]
1448             } else {
1449                 if {[llength [lindex $targets($host) 1]] > 1} {
1450                     html ": "
1451                     foreach b $hist($setNo,$i,database) {
1452                         html " $b"
1453                     }
1454                 }
1455                 html {. }
1456             }
1457             if {$html3} {
1458                 html {<td align=right>}
1459             }
1460             if {[info exists hist($setNo,$i,hits)]} {
1461                 html { <a href="http:} $env(SCRIPT_NAME)
1462                 html / $sessionId {/search.egw/} $setNo + $i + 1
1463                 html + $hist($setNo,maxPresent)
1464                 html {">} $hist($setNo,$i,hits) {</a>}
1465             } else {
1466                 if {$html3} {
1467                     html {Failed}
1468                 } else {
1469                     html {Search failed.}
1470                 }
1471             }
1472             if {$html3} {
1473                 html {<td align=left>}
1474             } else {
1475                 html "<dd>\n"
1476             }
1477             html { <a href="http:} $env(SCRIPT_NAME)
1478             html / $sessionId / $scriptQuery {;/} $setNo + $host
1479             if {$html3} {
1480                 html {">}
1481             } else {
1482                 html {">Query</a>: }
1483             }
1484             set op {}
1485             for {set j 1} {$j <= 10} {incr j} {
1486                 if {![info exists hist($setNo,form,entry$j)]} {
1487                     break
1488                 }
1489                 if {[string length $hist($setNo,form,entry$j)] > 0} {
1490                     html " <b>" [join $op " "] "</b> "
1491                 set pre [join $hist($setNo,form,menu$j)]
1492                     if {[string length $pre] > 0} {
1493                         html $pre "="
1494                     }
1495                     html $hist($setNo,form,entry$j)
1496                     set op $hist($setNo,form,logic$j)
1497                 }
1498             }
1499             if {$html3} {
1500                 html {</a><tr>} "\n"
1501             }
1502         }
1503     }
1504     if {$html3} {
1505         html {</table><p>}
1506     } else {
1507         html {</dl>}
1508     }
1509     html "\n"
1510 }
1511
1512 proc displayError {msga msgb} {
1513     html "<p><center>\n"
1514     html {<img src="/egwgif/noway.gif" alt="Error">}
1515     html "<h2>" $msga "</h2>\n"
1516     if {[string length $msgb] > 0} {
1517         html "<h3>" $msgb "</h3>\n"
1518     }
1519     html "</center><p>\n"
1520 }
1521
1522 proc button-main {} {
1523     global useIcons
1524     html {<a href="http://europagate.dtv.dk/">}
1525     if {$useIcons} {
1526         html {<img src="/egwgif/button-egw.gif" alt="Europagate" border=0></a>}
1527     } else {
1528         html {Europagate</a>}
1529     }
1530 }
1531
1532 proc button-feedback {} {
1533     global useIcons
1534
1535     html {<a href="http://europagate.dtv.dk/wwwquest.html">}
1536     if {$useIcons} {
1537         html {<img src="/egwgif/button-user-feedback.gif" alt="User Feedback"
1538         border=0></a>}
1539     } else {
1540         html "\n | "
1541         html {User Feedback</a>}
1542     }
1543 }
1544
1545 proc button-define-target {} {
1546     global useIcons
1547     global env
1548     global sessionId
1549
1550     if {!$useIcons} {
1551         html "\n | "
1552     }
1553     html {<a href="http:} $env(SCRIPT_NAME)
1554     html / $sessionId {/tform.egw}
1555     if {$useIcons} {
1556         html {"><img src="/egwgif/button-define-target.gif" }
1557         html {alt="Define Target" border=0></a>}
1558     } else {
1559         html {">Define Target</a>}
1560     }
1561 }
1562
1563 proc button-new-target {} {
1564     global useIcons
1565     global env
1566     global sessionId
1567     global scriptTarget
1568
1569     if {[string length $scriptTarget] == 0} return
1570
1571     if {!$useIcons} {
1572         html "\n | "
1573     }
1574     html {<a href="http:} $env(SCRIPT_NAME)
1575     html / $sessionId / $scriptTarget
1576     if {$useIcons} {
1577         html {"><img src="/egwgif/button-new-target.gif" }
1578         html {alt="New Target" border=0></a>}
1579     } else {
1580         html {">New Target</a>}
1581     }
1582 }
1583
1584 proc button-view-history {} {
1585     global useIcons
1586     global env
1587     global sessionId
1588     global nextSetNo
1589
1590     if {!$useIcons} {
1591         html "\n | "
1592     }
1593     html {<a href="http:} $env(SCRIPT_NAME)
1594     html / $sessionId {/history.egw;}
1595     catch { html "/" $nextSetNo}
1596     if {$useIcons} {
1597         html {"><img src="/egwgif/button-view-history.gif" alt="View History" }
1598         html {border=0></a>}
1599     } else {
1600         html {">View History</a>}
1601     }
1602 }
1603
1604 proc button-new-query {setNo} {
1605     global useIcons
1606     global env
1607     global sessionId
1608     global hist
1609     global scriptQuery
1610
1611     if {!$useIcons} {
1612         html "\n | "
1613     }
1614     html {<a href="http:} $env(SCRIPT_NAME)
1615     html / $sessionId / $scriptQuery {;/} $setNo + $hist($setNo,0,host) {">}
1616
1617     if {$useIcons} {
1618         html {<img src="/egwgif/button-new-query.gif" }
1619         html {alt="New Query" border=0></a>}
1620     } else {
1621         html {New Query</a>}
1622     }
1623 }
1624
1625 proc button-result-set {setNo tno} {
1626     global useIcons
1627     global env
1628     global sessionId
1629     global hist
1630
1631     if {!$useIcons} {
1632         html "\n | "
1633     }
1634     html {<a href="http:} $env(SCRIPT_NAME) / $sessionId
1635     if {$tno > 0} {
1636         html {/msearch.egw/} $setNo
1637     } else {
1638         html {/search.egw/} $setNo + $tno
1639     }
1640     html + 1 + $hist($setNo,maxPresent)
1641     if {$useIcons} {
1642         html {"><img src="/egwgif/button-result-set.gif" }
1643         html {alt="Result Set" border=0></a>}
1644     } else {
1645         html {">Result Set</a>}
1646     }
1647 }
1648
1649 proc button-scan-window {setNo} {
1650     global useIcons
1651     global env
1652     global sessionId
1653     global hist
1654
1655     if {!$useIcons} {
1656         html "\n | "
1657     }
1658     set targetNo 0
1659     html {<a href="http:} $env(SCRIPT_NAME)
1660     html / $sessionId {/search.egw/} $setNo + $targetNo + {scan} {">}
1661     if {$useIcons} {
1662         html {<img src="/egwgif/button-scan-window.gif" }
1663         html {alt="Scan" border=0></a>}
1664     } else {
1665         html {Scan</a>}
1666     }
1667 }
1668
1669 proc maintenance {} {
1670     html {<hr>This page is maintained by }
1671     html {<a href="mailto:nobody"> Nobody </a>.}
1672     html {Last modified x x x. <br>}
1673 }
1674
1675 proc splitHostSpec {host} {
1676     set i [string first / $host]
1677     if {$i > 1} {
1678         incr i -1
1679         return [string range $host 0 $i]
1680     }
1681     return $host
1682 }
1683
1684 proc splitDatabaseSpec {host} {
1685     set i [string first / $host]
1686     if {$i > 1} {
1687         incr i
1688         regsub -all -- - [string range $host $i end] { } res
1689         return $res
1690     }
1691     regsub -all -- - $host {} res
1692     return $res
1693 }
1694
1695 proc mergeHostSpec {host databases} {
1696     return ${host}/[join $databases -]
1697 }
1698
1699 proc mkAssoc {assoc host} {
1700     global targets
1701
1702     if {[catch {$assoc failback fail-response}]} {
1703         ir $assoc
1704         $assoc maximumRecordSize 1000000
1705     } else {
1706         if {[$assoc comstack] == "tcpip"} return
1707         ir $assoc
1708         $assoc maximumRecordSize 1000000
1709     }
1710 }
1711
1712 proc serverList {headlineProc targetProc} {
1713     global targets
1714     global groupsDescription
1715
1716     proc targetsCmp {l r} {
1717         global targets
1718         return [string compare [string tolower [lindex $targets($l) 0]] \
1719                                [string tolower [lindex $targets($r) 0]]]
1720     }
1721     proc groupCmp {l r} {
1722         global groupsOrder
1723         if {[catch {set lo $groupsOrder($l)}]} {
1724             set lo 10
1725         }
1726         if {[catch {set ro $groupsOrder($r)}]} {
1727             set ro 10
1728         }
1729         return [expr $lo - $ro]
1730     }
1731
1732     foreach tt [array names targets] {
1733         lappend groupsTmp([lindex $targets($tt) 6]) $tt
1734     }
1735     set gts [lsort -command groupCmp [array names groupsTmp]]
1736     foreach gt $gts {
1737         if {[info exists groupsDescription($gt)]} {
1738             eval $headlineProc [list $groupsDescription($gt)]
1739         } else {
1740             eval $headlineProc $gt
1741         }
1742         set tn [lsort -command targetsCmp $groupsTmp($gt)]
1743         foreach t $tn {
1744             eval $targetProc $t
1745         }
1746     }
1747
1748     rename targetsCmp {}
1749 }
1750
1751 proc session-lost {} {
1752     global useIcons
1753
1754     html {<head><title>WWW/Z39.50 Gateway: Session Expired</title></head>}
1755     html \n {<body>}
1756     set useIcons 1
1757     button-main
1758     html {<h1>Session Expired</h1>}
1759     html {Your session has expired. Please reload the gateways' }
1760     html {front page.<br><br>} \n
1761     set useIcons 0
1762     button-main
1763     html {</body></html>}
1764 }
1765
1766 if {[info exists utilExtension]} {
1767     source $utilExtension
1768 }
1769