www/z39util.tcl

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