www/z39util.tcl

   1 #
   2 # $Id: z39util.tcl,v 1.6 1995/11/09 15:24:37 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 {sno} {
  30     global sessionWait
  31
  32     set status [z39.$sno responseStatus]
  33     if {[lindex $status 0] == "NSD"} {
  34         z39.$sno nextResultSetPosition 0
  35         set code [lindex $status 1]
  36         set msg [lindex $status 2]
  37         set addinfo [lindex $status 3]
  38         html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
  39         set sessionWait -2
  40     } else {
  41         set sessionWait 1
  42     }
  43 }
  44
  45 proc ok-response {} {
  46     global sessionWait
  47     set sessionWait 1
  48 }
  49
  50 proc fail-response {} {
  51     global sessionWait
  52     set sessionWait -1
  53 }
  54
  55 proc display-brief {zset no} {
  56     global env
  57     global setNo
  58     global sessionId
  59
  60     set type [$zset type $no]
  61     if {$type == "SD"} {
  62         set err [lindex [$zset diag $no] 1]
  63         set add [lindex [$zset diag $no] 2]
  64         if {$add != {}} {
  65             set add " :${add}"
  66         }
  67         html "${no} Error ${err}${add} <br>\n"
  68         return
  69     }
  70     if {$type != "DB"} {
  71         return
  72     }
  73     html "${no} "
  74     set rtype [$zset recordType $no]
  75     if {$rtype == "SUTRS"} {
  76         html [join [$zset getSutrs $no]]
  77         html "<br>\n"
  78         return
  79     }
  80     if {![catch {
  81         set title [lindex [$zset getMarc $no field 245 * a] 0]
  82         set year [lindex [$zset getMarc $no field 260 * c] 0]
  83     } ] } {
  84         html {<a href="http:} $env(SCRIPT_NAME) /
  85         html $sessionId {/showfull.egw/} $setNo + $no + full
  86         html {"> } $title {</a>} " <i> ${year} </i>"
  87     }
  88     html "<br>\n"
  89 }
  90
  91 proc display-raw {zset no} {
  92     set type [$zset type $no]
  93     if {$type == "SD"} {
  94         set err [lindex [$zset diag $no] 1]
  95         set add [lindex [$zset diag $no] 2]
  96         if {$add != {}} {
  97             set add " :${add}"
  98         }
  99         html "<h3>${no}</h3>\n"
 100         html "Error ${err}${add} <br>\n"
 101         return
 102     }
 103     if {$type != "DB"} {
 104         return
 105     }
 106     set rtype [$zset recordType $no]
 107     if {$rtype == "SUTRS"} {
 108         html [join [$zset getSutrs $no]] "<br>\n"
 109         return
 110     }
 111     if {[catch {set r [$zset getMarc $no line * * *]}]} {
 112         html "Unknown record type: $rtype <br>\n"
 113         return
 114     }
 115     foreach line $r {
 116         set tag [lindex $line 0]
 117         set indicator [lindex $line 1]
 118         set fields [lindex $line 2]
 119         set l [string length $indicator]
 120         html "$tag "
 121         if {$l > 0} {
 122             for {set i 0} {$i < $l} {incr i} {
 123                 if {[string index $indicator $i] == " "} {
 124                     html "-"
 125                 } else {
 126                     html [string index $tag $i]
 127                 }
 128             }
 129         }
 130         foreach field $fields {
 131             set id [lindex $field 0]
 132             set data [lindex $field 1]
 133             if {$id != ""} {
 134                 html " <b>\$$id</b> "
 135             }
 136             html $data
 137         }
 138         htmlr {<br>}
 139     }
 140 }
 141
 142 proc put-marc-contents {cc} {
 143     set ref ""
 144     if {[string first :// $cc] > 0} {
 145         foreach urltype {gopher http ftp mailto} {
 146             if {[string first ${urltype}:// $cc] == 0} {
 147                 set ref $urltype
 148                 break
 149             }
 150         }
 151     }
 152     if {$ref != ""} {
 153         html {<a href="}
 154     }
 155     html $cc
 156     if {$ref != ""} {
 157         html {">} $urltype { reference</a>}
 158     }
 159 }
 160
 161 proc dl-marc-field {zset no tag id la lb sep} {
 162     set n 0
 163     set c [$zset getMarc $no field $tag * $id]
 164     set len [llength $c]
 165     if {$len == 0} {
 166         return 0
 167     }
 168     if {$len > 1 && "x$lb" != "x"} {
 169         html "<dt><b>$lb</b>\n<dd>"
 170     } else {
 171         html "<dt><b>$la</b>\n<dd>"
 172     }
 173     foreach cc $c {
 174         if {$n > 0} {
 175             html $sep
 176         }
 177         put-marc-contents $cc
 178         incr n
 179     }
 180     return $n
 181 }
 182
 183 proc dd-marc-field {zset no tag id start stop} {
 184     set n 0
 185     set c [$zset getMarc $no field $tag * $id]
 186     set len [llength $c]
 187     if {$len == 0} {
 188         return 0
 189     }
 190     foreach cc $c {
 191         html $start
 192         put-marc-contents $cc
 193         html $stop
 194         incr n
 195     }
 196     return $n
 197 }
 198
 199 proc dl-marc-field-rec {zset no tag lead start stop startid sep} {
 200     set n 0
 201     set lines [$zset getMarc $no line $tag * *]
 202     foreach line $lines {
 203         foreach field [lindex $line 2] {
 204             if {$n == 0} {
 205                 html "<dt><b>$lead</b>"
 206                 html "\n<dd>"
 207             }
 208             set id [lindex $field 0]
 209             if {$id == $startid} {
 210                 if {$n > 0} {
 211                     html $stop
 212                 }
 213                 html $start
 214                 incr n
 215                 html [lindex $field 1]
 216             } else {
 217                 html $sep
 218                 html [lindex $field 1]
 219             }
 220         }
 221     }
 222     if {$n > 0} {
 223         html $stop
 224     }
 225 }
 226
 227 proc display-full {zset no} {
 228     set type [$zset type $no]
 229     if {$type == "SD"} {
 230         set err [lindex [$zset diag $no] 1]
 231         set add [lindex [$zset diag $no] 2]
 232         if {$add != {}} {
 233             set add " :${add}"
 234         }
 235         html "Error ${err}${add} <br>\n"
 236         return
 237     }
 238     if {$type != "DB"} {
 239         return
 240     }
 241     set rtype [$zset recordType $no]
 242     if {$rtype == "SUTRS"} {
 243         html [join [$zset getSutrs $no]] "<br>\n"
 244         return
 245     }
 246     if {[catch {set r [$zset getMarc $no line * * *]}]} {
 247         html "Unknown record type: $rtype <br>\n"
 248         return
 249     }
 250     html "<dl>\n"
 251     set n [dl-marc-field $zset $no 700 a "Author" "Authors" "<br>\n"]
 252     if {$n == 0} {
 253         set n [dl-marc-field $zset $no 100 a "Author" "Authors" "<br>\n"]
 254     }
 255     set n [dl-marc-field $zset $no 710 a "Corporate Name" {} ", "]
 256     if {$n == 0} {
 257         set n [dl-marc-field $zset $no 710 a "Corporate Name" {} ", "]
 258     }
 259     set n [dl-marc-field $zset $no 245 {a} "Title" {} " "]
 260     if {$n > 0} {
 261         dd-marc-field $zset $no 245 b "<em>" "</em>"
 262         dd-marc-field $zset $no 245 c " " ""
 263     } else {
 264         dl-marc-field $zset $no 245 {[ab]} "Title" {} " "
 265     }
 266     dl-marc-field $zset $no 520 a "Abstract" {} ", "
 267     dl-marc-field $zset $no 072 * "Subject code" "Subject codes" ", "
 268     dl-marc-field $zset $no 650 * "Subject" {} ", "
 269     dl-marc-field $zset $no 260 * "Publisher" {} " "
 270     dl-marc-field $zset $no 300 * "Physical Description" {} " "
 271
 272     dl-marc-field $zset $no 500 a "Notes" {} ", "
 273
 274     dl-marc-field-rec $zset $no 510 "References" "" "<br>\n" "a" ", "
 275
 276     dl-marc-field $zset $no 350 a "Price" {} ", "
 277     dl-marc-field $zset $no 362 a "Dates of publication" {} ", "
 278     dl-marc-field $zset $no 850 a "Holdings" {} ", "
 279
 280     dl-marc-field $zset $no 010 a "LC control number" {} ", "
 281     dl-marc-field $zset $no 010 b "NUCMC control number" {} ", "
 282     dl-marc-field $zset $no 020 a "ISBN" {} ", "
 283     dl-marc-field $zset $no 022 a "ISSN" {} ", "
 284     set url [$zset getMarc $no field 856 * u]
 285     set sp [$zset getMarc $no field 856 * 3]
 286     if {"x$url" != "x"} {
 287         html "<dt><b>URL</b>\n"
 288         if {"x$sp" == "x"} {
 289             set sp reference
 290         }
 291         html {<dd><a href="} $url {">} [join $sp] "</a>\n"
 292     }
 293     dl-marc-field $zset $no 037 * "Acquisition" {} "<br>\n"
 294     dl-marc-field $zset $no 787 {[rstw6]} "Related information" {} "<br>\n"
 295     dl-marc-field $zset $no 001 * "Local control number" {} ", "
 296     html "</dl>\n"
 297 }
 298
 299
 300 proc display-rec {from to dfunc zz} {
 301     global setNo
 302
 303     while {$from <= $to} {
 304         eval "$dfunc $zz.$setNo $from"
 305         incr from
 306     }
 307 }
 308
 309 proc build-query {t} {
 310     global targets
 311
 312     set op {}
 313     set q {}
 314     for {set i 1} {$i < 4} {incr i} {
 315         set term1 [wform entry$i]
 316         regsub {\+} $term1 " " term
 317         if {$term != ""} {
 318             set field [wform menu$i]
 319             foreach x [lindex $targets($t) 2] {
 320                 if {[lindex $x 0] == $field} {
 321                     set attr [lindex $x 1]
 322                 }
 323             }
 324             switch $op {
 325             And
 326                 { set q "@and $q ${attr} \{${term}\}" }
 327             Or
 328                 { set q "@or $q ${attr} \{${term}\}" }
 329             {And not}
 330                 { set q "@not $q ${attr} \{${term}\}" }
 331             {}
 332                 { set q "${attr} \{${term}\}" }
 333             }
 334             set op [wform logic$i]
 335         }
 336     }
 337     return $q
 338 }
 339
 340 proc z39search {setNo piggy} {
 341     global hist
 342     global sessionWait
 343
 344     set host $hist($setNo,host)
 345     if {[catch {z39 failback fail-response}]} {
 346         ir z39
 347     }
 348     if {[catch {set oldHost [z39 connect]}]} {
 349         set oldHost ""
 350     }
 351     z39 callback ok-response
 352     z39 failback fail-response
 353     if {$oldHost != $host} {
 354         catch {z39 disconnect}
 355
 356         html "Connecting to target " $host " <br>\n"
 357         set sessionWait 0
 358         if {[catch {z39 connect $host}]} {
 359             html "Cannot connect to target ${host} <br>\n"
 360             return 0
 361         } elseif {$sessionWait == 0} {
 362             zwait sessionWait
 363             if {$sessionWait != 1} {
 364                 html "Cannot connect to target ${host} <br>\n"
 365                 return 0
 366             }
 367         }
 368         z39 idAuthentication $hist($setNo,idAuthentication)
 369         set sessionWait 0
 370         if {[catch {z39 init}]} {
 371             html "Cannot initialize with target ${host} <br>\n"
 372             return 0
 373         }
 374         if {[catch {zwait sessionWait 60}]} {
 375             html "Cannot initialize with target ${host} <br>\n"
 376             z39 disconnect
 377             return 0
 378         }
 379         if {$sessionWait != "1"} {
 380             html "Cannot initialize with target ${host} <br>\n"
 381             z39 disconnect
 382             return 0
 383         }
 384     }
 385     if {![catch {z39.$setNo smallSetUpperBound 0}]} {
 386         return 1
 387     }
 388     ir-set z39.$setNo z39
 389     eval z39.$setNo databaseNames $hist($setNo,database)
 390
 391     z39.$setNo preferredRecordSyntax USMARC
 392
 393     z39 callback search-response $setNo
 394     if {$piggy} {
 395         z39.$setNo largeSetLowerBound 999999
 396         z39.$setNo smallSetUpperBound 0
 397         z39.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
 398     } else {
 399         z39.$setNo largeSetLowerBound 2
 400         z39.$setNo smallSetUpperBound 0
 401         z39.$setNo mediumSetPresentNumber 0
 402     }
 403     set sessionWait 0
 404     z39.$setNo search $hist($setNo,query)
 405
 406     if {[catch {zwait sessionWait 600}]} {
 407         html "</body></html>\n"
 408         z39 disconnect
 409         return 0
 410     }
 411
 412     if {$sessionWait != 1} {
 413         html "</body></html>\n"
 414         z39 disconnect
 415         return 0
 416     }
 417     set status [z39.$setNo responseStatus]
 418     if {[lindex $status 0] == "NSD"} {
 419         set code [lindex $status 1]
 420         set msg [lindex $status 2]
 421         set addinfo [lindex $status 3]
 422         html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
 423         return 0
 424     }
 425     set hist($setNo,hits) [z39.$setNo resultCount]
 426     return 1
 427 }
 428
 429 proc init-m-response {i} {
 430     global zstatus
 431     global zleft
 432
 433     wlog debug "init-m-response"
 434
 435     set zstatus($i) 1
 436     incr zleft -1
 437 }
 438
 439 proc connect-m-response {i} {
 440     global zstatus
 441     global zleft
 442
 443     wlog debug "connect-m-response"
 444     z39$i callback [list init-m-response $i]
 445     if {[catch {z39$i init}]} {
 446         set zstatus($i) -1
 447         incr zleft -1
 448     }
 449 }
 450
 451 proc fail-m-response {i} {
 452     global zstatus
 453     global zleft
 454
 455     wlog debug "fail-m-response"
 456     set zstatus($i) -1
 457     incr zleft -1
 458 }
 459
 460 proc search-m-response {setNo i} {
 461     global zleft
 462     global zstatus
 463
 464     incr zleft -1
 465     set zstatus($i) 2
 466 }
 467
 468 proc z39msearch {setNo piggy} {
 469     global zleft
 470     global zstatus
 471     global hist
 472
 473     set not $hist($setNo,0,host)
 474
 475     for {set i 1} {$i <= $not} {incr i} {
 476         set host $hist($setNo,$i,host)
 477         if {[catch {z39 failback fail-response}]} {
 478             ir z39$i
 479         }
 480         if {[catch {set oldHost [z39$i connect]}]} {
 481             set oldHost ""
 482         }
 483         if {$oldHost != $host} {
 484             catch {z39$i disconnect}
 485         }
 486         z39$i callback [list connect-m-response $i]
 487         z39$i failback [list fail-m-response $i]
 488     }
 489     set zleft 0
 490     for {set i 1} {$i <= $not} {incr i} {
 491         set oldHost [z39$i connect]
 492         set host $hist($setNo,$i,host)
 493         if {$oldHost == $host} {
 494             set zstatus($i) 1
 495             continue
 496         }
 497         html "Connecting to target " $host " <br>\n"
 498         set zstatus($i) -1
 499         if {![catch {z39$i connect $host}]} {
 500             incr zleft
 501         }
 502     }
 503     while {$zleft > 0} {
 504         wlog debug "Waiting for init response"
 505         if {[catch {zwait zleft 10}]} {
 506             break
 507         }
 508     }
 509     set zleft 0
 510     for {set i 1} {$i <= $not} {incr i} {
 511         html "host " $hist($setNo,$i,host) ": "
 512         if {$zstatus($i) >= 1} {
 513             html "ok <br>\n"
 514             ir-set z39$i.$setNo z39$i
 515             set hist($setNo,$i,offset) 0
 516             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
 517             z39$i.$setNo preferredRecordSyntax USMARC
 518             z39$i callback [list search-m-response $setNo $i]
 519
 520             if {$piggy} {
 521                 z39$i.$setNo largeSetLowerBound 999999
 522                 z39$i.$setNo smallSetUpperBound 0
 523                 z39$i.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
 524             } else {
 525                 z39$i.$setNo largeSetLowerBound 2
 526                 z39$i.$setNo smallSetUpperBound 0
 527                 z39$i.$setNo mediumSetPresentNumber 0
 528             }
 529             set zstatus($i) 1
 530             wlog debug "search " $hist($setNo,$i,query)
 531             z39$i.$setNo search $hist($setNo,$i,query)
 532             incr zleft
 533         } else {
 534             html "fail <br>\n"
 535         }
 536     }
 537     while {$zleft > 0} {
 538         wlog debug "Waiting for search response"
 539         if {[catch {zwait zleft 30}]} {
 540             break
 541         }
 542     }
 543     for {set i 1} {$i <= $not} {incr i} {
 544         if {$zstatus($i) != 2} continue
 545         set status [z39$i.$setNo responseStatus]
 546         if {[lindex $status 0] != "NSD"} {
 547             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
 548         }
 549     }
 550 }
 551
 552 proc z39present {setNo setOffset setMax dfunc} {
 553     global hist
 554     global sessionWait
 555
 556     set toGet [expr 1 + $setMax - $setOffset]
 557     while {$setMax > 0 && $toGet > 0} {
 558         for {set got 0} {$got < $toGet} {incr got} {
 559             if {[z39.$setNo type [expr $setOffset + $got]] == ""} {
 560                 break
 561             }
 562         }
 563         if {$got < $toGet} {
 564             set sessionWait 0
 565             z39.$setNo present $setOffset $toGet
 566             if {[catch {zwait sessionWait 300}]} {
 567                 z39 disconnect
 568                 break
 569             }
 570             if {$sessionWait != "1"} {
 571                 break
 572             }
 573             set got [z39.$setNo numberOfRecordsReturned]
 574             if {$got <= 0} {
 575                 break
 576             }
 577         }
 578         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc z39
 579         set setOffset [expr $got + $setOffset]
 580         set toGet [expr 1 + $setMax - $setOffset]
 581         wflush
 582     }
 583 }
 584
 585 proc z39history {} {
 586     global nextSetNo
 587     global hist
 588     global env
 589     global sessionId
 590     global targets
 591
 592     if {![info exists nextSetNo]} {
 593         return
 594     }
 595     html "<hr><h3>History</h3><dl>\n"
 596     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
 597         html {<dt> <a href="http:} $env(SCRIPT_NAME)
 598         html / $sessionId {/search.egw/} $setNo + 1
 599         html + [expr $hist($setNo,maxPresent) - 1]
 600         html {"> } [lindex $targets($hist($setNo,host)) 0]
 601         if {[llength $hist($setNo,database)] > 1} {
 602             html ": "
 603             foreach b $hist($setNo,database) {
 604                 html " $b"
 605             }
 606         }
 607         html "</a>\n"
 608         html "<dd> "
 609         if {[info exists hist($setNo,hits)]} {
 610             html $hist($setNo,hits) " hits"
 611         } else {
 612             html failed
 613         }
 614         html "\n"
 615     }
 616     html "</dl>\n"
 617 }