www/z39util.tcl

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