www/z39util.tcl

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