www/z39util.tcl

   1 #
   2 # $Id: z39util.tcl,v 1.5 1995/11/08 18:07:23 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 {"> } $title {</a>}
  86         html " <i> ${year} </i>"
  87     }
  88     html "<br>\n"
  89 }
  90
  91 proc display-full {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     html "<h3>${no}</h3>\n"
 107     set rtype [$zset recordType $no]
 108     if {$rtype == "SUTRS"} {
 109         html [join [$zset getSutrs $no]] "<br>\n"
 110         return
 111     }
 112     if {[catch {set r [$zset getMarc $no line * * *]}]} {
 113         html "Unknown record type: $rtype <br>\n"
 114         return
 115     }
 116     foreach line $r {
 117         set tag [lindex $line 0]
 118         set indicator [lindex $line 1]
 119         set fields [lindex $line 2]
 120         set l [string length $indicator]
 121         html "$tag "
 122         if {$l > 0} {
 123             for {set i 0} {$i < $l} {incr i} {
 124                 if {[string index $indicator $i] == " "} {
 125                     html "-"
 126                 } else {
 127                     html [string index $tag $i]
 128                 }
 129             }
 130         }
 131         foreach field $fields {
 132             set id [lindex $field 0]
 133             set data [lindex $field 1]
 134             if {$id != ""} {
 135                 html " <b>\$$id</b> "
 136             }
 137             html $data
 138         }
 139         htmlr {<br>}
 140     }
 141 }
 142
 143 proc display-rec {from to dfunc zz} {
 144     global setNo
 145
 146     while {$from <= $to} {
 147         eval "$dfunc $zz.$setNo $from"
 148         incr from
 149     }
 150 }
 151
 152 proc build-query {t} {
 153     global targets
 154
 155     set op {}
 156     set q {}
 157     for {set i 1} {$i < 4} {incr i} {
 158         set term1 [wform entry$i]
 159         regsub {\+} $term1 " " term
 160         if {$term != ""} {
 161             set field [wform menu$i]
 162             foreach x [lindex $targets($t) 2] {
 163                 if {[lindex $x 0] == $field} {
 164                     set attr [lindex $x 1]
 165                 }
 166             }
 167             switch $op {
 168             And
 169                 { set q "@and $q ${attr} \{${term}\}" }
 170             Or
 171                 { set q "@or $q ${attr} \{${term}\}" }
 172             {And not}
 173                 { set q "@not $q ${attr} \{${term}\}" }
 174             {}
 175                 { set q "${attr} \{${term}\}" }
 176             }
 177             set op [wform logic$i]
 178         }
 179     }
 180     return $q
 181 }
 182
 183 proc z39search {setNo piggy} {
 184     global hist
 185     global sessionWait
 186
 187     set host $hist($setNo,host)
 188     if {[catch {z39 failback fail-response}]} {
 189         ir z39
 190     }
 191     if {[catch {set oldHost [z39 connect]}]} {
 192         set oldHost ""
 193     }
 194     z39 callback ok-response
 195     z39 failback fail-response
 196     if {$oldHost != $host} {
 197         catch {z39 disconnect}
 198
 199         html "Connecting to target " $host " <br>\n"
 200         set sessionWait 0
 201         if {[catch {z39 connect $host}]} {
 202             html "Cannot connect to target ${host} <br>\n"
 203             return 0
 204         } elseif {$sessionWait == 0} {
 205             zwait sessionWait
 206             if {$sessionWait != 1} {
 207                 html "Cannot connect to target ${host} <br>\n"
 208                 return 0
 209             }
 210         }
 211         z39 idAuthentication $hist($setNo,idAuthentication)
 212         set sessionWait 0
 213         if {[catch {z39 init}]} {
 214             html "Cannot initialize with target ${host} <br>\n"
 215             return 0
 216         }
 217         if {[catch {zwait sessionWait 60}]} {
 218             html "Cannot initialize with target ${host} <br>\n"
 219             z39 disconnect
 220             return 0
 221         }
 222         if {$sessionWait != "1"} {
 223             html "Cannot initialize with target ${host} <br>\n"
 224             z39 disconnect
 225             return 0
 226         }
 227     }
 228     if {![catch {z39.$setNo smallSetUpperBound 0}]} {
 229         return 1
 230     }
 231     ir-set z39.$setNo z39
 232     eval z39.$setNo databaseNames $hist($setNo,database)
 233
 234     z39.$setNo preferredRecordSyntax USMARC
 235
 236     z39 callback search-response $setNo
 237     if {$piggy} {
 238         z39.$setNo largeSetLowerBound 999999
 239         z39.$setNo smallSetUpperBound 0
 240         z39.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
 241     } else {
 242         z39.$setNo largeSetLowerBound 2
 243         z39.$setNo smallSetUpperBound 0
 244         z39.$setNo mediumSetPresentNumber 0
 245     }
 246     set sessionWait 0
 247     z39.$setNo search $hist($setNo,query)
 248
 249     if {[catch {zwait sessionWait 600}]} {
 250         html "</body></html>\n"
 251         z39 disconnect
 252         return 0
 253     }
 254
 255     if {$sessionWait != 1} {
 256         html "</body></html>\n"
 257         z39 disconnect
 258         return 0
 259     }
 260     set status [z39.$setNo responseStatus]
 261     if {[lindex $status 0] == "NSD"} {
 262         set code [lindex $status 1]
 263         set msg [lindex $status 2]
 264         set addinfo [lindex $status 3]
 265         html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
 266         return 0
 267     }
 268     set hist($setNo,hits) [z39.$setNo resultCount]
 269     return 1
 270 }
 271
 272 proc init-m-response {i} {
 273     global zstatus
 274     global zleft
 275
 276     wlog debug "init-m-response"
 277
 278     set zstatus($i) 1
 279     incr zleft -1
 280 }
 281
 282 proc connect-m-response {i} {
 283     global zstatus
 284     global zleft
 285
 286     wlog debug "connect-m-response"
 287     z39$i callback [list init-m-response $i]
 288     if {[catch {z39$i init}]} {
 289         set zstatus($i) -1
 290         incr zleft -1
 291     }
 292 }
 293
 294 proc fail-m-response {i} {
 295     global zstatus
 296     global zleft
 297
 298     wlog debug "fail-m-response"
 299     set zstatus($i) -1
 300     incr zleft -1
 301 }
 302
 303 proc search-m-response {setNo i} {
 304     global zleft
 305     global zstatus
 306
 307     incr zleft -1
 308     set zstatus($i) 2
 309 }
 310
 311 proc z39msearch {setNo piggy} {
 312     global zleft
 313     global zstatus
 314     global hist
 315
 316     set not $hist($setNo,0,host)
 317
 318     for {set i 1} {$i <= $not} {incr i} {
 319         set host $hist($setNo,$i,host)
 320         if {[catch {z39 failback fail-response}]} {
 321             ir z39$i
 322         }
 323         if {[catch {set oldHost [z39$i connect]}]} {
 324             set oldHost ""
 325         }
 326         if {$oldHost != $host} {
 327             catch {z39$i disconnect}
 328         }
 329         z39$i callback [list connect-m-response $i]
 330         z39$i failback [list fail-m-response $i]
 331     }
 332     set zleft 0
 333     for {set i 1} {$i <= $not} {incr i} {
 334         set oldHost [z39$i connect]
 335         set host $hist($setNo,$i,host)
 336         if {$oldHost == $host} {
 337             set zstatus($i) 1
 338             continue
 339         }
 340         html "Connecting to target " $host " <br>\n"
 341         set zstatus($i) -1
 342         if {![catch {z39$i connect $host}]} {
 343             incr zleft
 344         }
 345     }
 346     while {$zleft > 0} {
 347         wlog debug "Waiting for init response"
 348         if {[catch {zwait zleft 10}]} {
 349             break
 350         }
 351     }
 352     set zleft 0
 353     for {set i 1} {$i <= $not} {incr i} {
 354         html "host " $hist($setNo,$i,host) ": "
 355         if {$zstatus($i) >= 1} {
 356             html "ok <br>\n"
 357             ir-set z39$i.$setNo z39$i
 358             set hist($setNo,$i,offset) 0
 359             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
 360             z39$i.$setNo preferredRecordSyntax USMARC
 361             z39$i callback [list search-m-response $setNo $i]
 362
 363             if {$piggy} {
 364                 z39$i.$setNo largeSetLowerBound 999999
 365                 z39$i.$setNo smallSetUpperBound 0
 366                 z39$i.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
 367             } else {
 368                 z39$i.$setNo largeSetLowerBound 2
 369                 z39$i.$setNo smallSetUpperBound 0
 370                 z39$i.$setNo mediumSetPresentNumber 0
 371             }
 372             set zstatus($i) 1
 373             wlog debug "search " $hist($setNo,$i,query)
 374             z39$i.$setNo search $hist($setNo,$i,query)
 375             incr zleft
 376         } else {
 377             html "fail <br>\n"
 378         }
 379     }
 380     while {$zleft > 0} {
 381         wlog debug "Waiting for search response"
 382         if {[catch {zwait zleft 30}]} {
 383             break
 384         }
 385     }
 386     for {set i 1} {$i <= $not} {incr i} {
 387         if {$zstatus($i) != 2} continue
 388         set status [z39$i.$setNo responseStatus]
 389         if {[lindex $status 0] != "NSD"} {
 390             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
 391         }
 392     }
 393 }
 394
 395 proc z39present {setNo setOffset setMax dfunc} {
 396     global hist
 397     global sessionWait
 398
 399     set toGet [expr 1 + $setMax - $setOffset]
 400     while {$setMax > 0 && $toGet > 0} {
 401         for {set got 0} {$got < $toGet} {incr got} {
 402             if {[z39.$setNo type [expr $setOffset + $got]] == ""} {
 403                 break
 404             }
 405         }
 406         if {$got < $toGet} {
 407             set sessionWait 0
 408             z39.$setNo present $setOffset $toGet
 409             if {[catch {zwait sessionWait 300}]} {
 410                 z39 disconnect
 411                 break
 412             }
 413             if {$sessionWait != "1"} {
 414                 break
 415             }
 416             set got [z39.$setNo numberOfRecordsReturned]
 417         }
 418         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc z39
 419         set setOffset [expr $got + $setOffset]
 420         set toGet [expr 1 + $setMax - $setOffset]
 421         wflush
 422     }
 423 }
 424
 425 proc z39history {} {
 426     global nextSetNo
 427     global hist
 428     global env
 429     global sessionId
 430     global targets
 431
 432     if {![info exists nextSetNo]} {
 433         return
 434     }
 435     html "<hr><h3>History</h3><dl>\n"
 436     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
 437         html {<dt> <a href="http:} $env(SCRIPT_NAME)
 438         html / $sessionId {/search.egw/} $setNo + 1
 439         html + [expr $hist($setNo,maxPresent) - 1]
 440         html {"> } [lindex $targets($hist($setNo,host)) 0]
 441         if {[llength $hist($setNo,database)] > 1} {
 442             html ": "
 443             foreach b $hist($setNo,database) {
 444                 html " $b"
 445             }
 446         }
 447         html "</a>\n"
 448         html "<dd> "
 449         if {[info exists hist($setNo,hits)]} {
 450             html $hist($setNo,hits) " hits"
 451         } else {
 452             html failed
 453         }
 454         html "\n"
 455     }
 456     html "</dl>\n"
 457 }