www/z39util.tcl

   1 #
   2 # $Id: z39util.tcl,v 1.3 1995/11/08 12:42:18 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         html "<br>\n"
  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     html "<br>\n"
  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         html "<h3>${no}</h3>\n"
  97         html "Error ${err}${add} <br>\n"
  98         return
  99     }
 100     if {$type != "DB"} {
 101         return
 102     }
 103     html "<h3>${no}</h3>\n"
 104     set rtype [$zset recordType $no]
 105     if {$rtype == "SUTRS"} {
 106         html [join [$zset getSutrs $no]] "<br>\n"
 107         return
 108     }
 109     if {[catch {set r [$zset getMarc $no line * * *]}]} {
 110         html "Unknown record type: $rtype <br>\n"
 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 $indicator $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         z39 idAuthentication $hist($setNo,idAuthentication)
 209         set sessionWait 0
 210         if {[catch {z39 init}]} {
 211             html "Cannot initialize with target ${host} <br>\n"
 212             return 0
 213         }
 214         zwait sessionWait
 215         if {$sessionWait != "1"} {
 216             html "Cannot initialize with target ${host} <br>\n"
 217             return 0
 218         }
 219     }
 220     if {![catch {z39.$setNo smallSetUpperBound 0}]} {
 221         return 1
 222     }
 223     ir-set z39.$setNo z39
 224     eval z39.$setNo databaseNames $hist($setNo,database)
 225
 226     z39.$setNo preferredRecordSyntax USMARC
 227
 228     z39 callback search-response $setNo
 229     if {$piggy} {
 230         z39.$setNo largeSetLowerBound 999999
 231         z39.$setNo smallSetUpperBound 0
 232         z39.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
 233     } else {
 234         z39.$setNo largeSetLowerBound 2
 235         z39.$setNo smallSetUpperBound 0
 236         z39.$setNo mediumSetPresentNumber 0
 237     }
 238     set sessionWait 0
 239     z39.$setNo search $hist($setNo,query)
 240
 241     zwait sessionWait
 242     if {$sessionWait != 1} {
 243         html "</body></html>\n"
 244         return 0
 245     }
 246     set status [z39.$setNo responseStatus]
 247     if {[lindex $status 0] == "NSD"} {
 248         set code [lindex $status 1]
 249         set msg [lindex $status 2]
 250         set addinfo [lindex $status 3]
 251         html "<h2>Error NSD$code: $msg: $addinfo </h2><br>\n"
 252         return 0
 253     }
 254     set hist($setNo,hits) [z39.$setNo resultCount]
 255     return 1
 256 }
 257
 258 proc init-m-response {i} {
 259     global zstatus
 260     global zleft
 261
 262     wlog debug "init-m-response"
 263
 264     set zstatus($i) 1
 265     incr zleft -1
 266 }
 267
 268 proc connect-m-response {i} {
 269     global zstatus
 270     global zleft
 271
 272     wlog debug "connect-m-response"
 273     z39$i callback [list init-m-response $i]
 274     if {[catch {z39$i init}]} {
 275         set zstatus($i) -1
 276         incr zleft -1
 277     }
 278 }
 279
 280 proc fail-m-response {i} {
 281     global zstatus
 282     global zleft
 283
 284     wlog debug "fail-m-response"
 285     set zstatus($i) -1
 286     incr zleft -1
 287 }
 288
 289 proc search-m-response {setNo i} {
 290     global zleft
 291     global zstatus
 292
 293     incr zleft -1
 294     set zstatus($i) 2
 295 }
 296
 297 proc z39msearch {setNo piggy} {
 298     global zleft
 299     global zstatus
 300     global hist
 301
 302     set not $hist($setNo,0,host)
 303
 304     for {set i 1} {$i <= $not} {incr i} {
 305         set host $hist($setNo,$i,host)
 306         if {[catch {z39 failback fail-response}]} {
 307             ir z39$i
 308         }
 309         if {[catch {set oldHost [z39$i connect]}]} {
 310             set oldHost ""
 311         }
 312         if {$oldHost != $host} {
 313             catch {z39$i disconnect}
 314         }
 315         z39$i callback [list connect-m-response $i]
 316         z39$i failback [list fail-m-response $i]
 317     }
 318     set zleft 0
 319     for {set i 1} {$i <= $not} {incr i} {
 320         set oldHost [z39$i connect]
 321         set host $hist($setNo,$i,host)
 322         if {$oldHost == $host} {
 323             set zstatus($i) 1
 324             continue
 325         }
 326         html "Connecting to target " $host " <br>\n"
 327         set zstatus($i) -1
 328         if {![catch {z39$i connect $host}]} {
 329             incr zleft
 330         }
 331     }
 332     while {$zleft > 0} {
 333         wlog debug "Waiting for init response"
 334         if {[catch {zwait zleft 10}]} {
 335             break
 336         }
 337     }
 338     set zleft 0
 339     for {set i 1} {$i <= $not} {incr i} {
 340         html "host " $hist($setNo,$i,host) ": "
 341         if {$zstatus($i) >= 1} {
 342             html "ok <br>\n"
 343             ir-set z39$i.$setNo z39$i
 344             set hist($setNo,$i,offset) 0
 345             eval z39$i.$setNo databaseNames $hist($setNo,$i,database)
 346             z39$i.$setNo preferredRecordSyntax USMARC
 347             z39$i callback [list search-m-response $setNo $i]
 348
 349             if {$piggy} {
 350                 z39$i.$setNo largeSetLowerBound 999999
 351                 z39$i.$setNo smallSetUpperBound 0
 352                 z39$i.$setNo mediumSetPresentNumber $hist($setNo,maxPresent)
 353             } else {
 354                 z39$i.$setNo largeSetLowerBound 2
 355                 z39$i.$setNo smallSetUpperBound 0
 356                 z39$i.$setNo mediumSetPresentNumber 0
 357             }
 358             set zstatus($i) 1
 359             wlog debug "search " $hist($setNo,$i,query)
 360             z39$i.$setNo search $hist($setNo,$i,query)
 361             incr zleft
 362         } else {
 363             html "fail <br>\n"
 364         }
 365     }
 366     while {$zleft > 0} {
 367         wlog debug "Waiting for search response"
 368         if {[catch {zwait zleft 30}]} {
 369             break
 370         }
 371     }
 372     for {set i 1} {$i <= $not} {incr i} {
 373         if {$zstatus($i) != 2} continue
 374         set status [z39$i.$setNo responseStatus]
 375         if {[lindex $status 0] != "NSD"} {
 376             set hist($setNo,$i,offset) [z39$i.$setNo numberOfRecordsReturned]
 377         }
 378     }
 379 }
 380
 381 proc z39present {setNo setOffset setMax dfunc} {
 382     global hist
 383     global sessionWait
 384
 385     set toGet [expr 1 + $setMax - $setOffset]
 386     while {$setMax > 0 && $toGet > 0} {
 387         for {set got 0} {$got < $toGet} {incr got} {
 388             if {[z39.$setNo type [expr $setOffset + $got]] == ""} {
 389                 break
 390             }
 391         }
 392         if {$got < $toGet} {
 393             set sessionWait 0
 394             z39.$setNo present $setOffset $toGet
 395             zwait sessionWait
 396             if {$sessionWait != "1"} {
 397                 break
 398             }
 399             set got [z39.$setNo numberOfRecordsReturned]
 400         }
 401         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc z39
 402         set setOffset [expr $got + $setOffset]
 403         set toGet [expr 1 + $setMax - $setOffset]
 404         wflush
 405     }
 406 }
 407
 408 proc z39history {} {
 409     global nextSetNo
 410     global hist
 411     global env
 412     global sessionId
 413     global targets
 414
 415     if {![info exists nextSetNo]} {
 416         return
 417     }
 418     html "<hr><h3>History</h3><dl>\n"
 419     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
 420         html {<dt> <a href="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
 421         html / $sessionId {/search.egw/} $setNo + 1
 422         html + [expr $hist($setNo,maxPresent) - 1]
 423         html {"> } [lindex $targets($hist($setNo,host)) 0]
 424         if {[llength $hist($setNo,database)] > 1} {
 425             html ": "
 426             foreach b $hist($setNo,database) {
 427                 html " $b"
 428             }
 429         }
 430         html "</a>\n"
 431         html "<dd> "
 432         if {[info exists hist($setNo,hits)]} {
 433             html $hist($setNo,hits) " hits"
 434         } else {
 435             html failed
 436         }
 437         html "\n"
 438     }
 439     html "</dl>\n"
 440 }