www/z39util.tcl

   1 #
   2 # $Id: z39util.tcl,v 1.1 1995/11/06 17:44: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         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} {
 141     global setNo
 142
 143     while {$from <= $to} {
 144         eval "$dfunc z39.$setNo $from"
 145         incr from
 146     }
 147 }
 148
 149 proc build-query {} {
 150     global targets
 151     global t
 152
 153     set op {}
 154     set q {}
 155     for {set i 1} {$i < 4} {incr i} {
 156         set term1 [wform entry$i]
 157         regsub {\+} $term1 " " term
 158         if {$term != ""} {
 159             set field [wform menu$i]
 160             foreach x [lindex $targets($t) 2] {
 161                 if {[lindex $x 0] == $field} {
 162                     set attr [lindex $x 1]
 163                 }
 164             }
 165             switch $op {
 166             And
 167                 { set q "@and $q ${attr} \{${term}\}" }
 168             Or
 169                 { set q "@or $q ${attr} \{${term}\}" }
 170             {And not}
 171                 { set q "@not $q ${attr} \{${term}\}" }
 172             {}
 173                 { set q "${attr} \{${term}\}" }
 174             }
 175             set op [wform logic$i]
 176         }
 177     }
 178     return $q
 179 }
 180
 181 proc z39search {setNo piggy} {
 182     global hist
 183     global sessionWait
 184
 185     set host $hist($setNo,host)
 186     if {[catch {z39 failback fail-response}]} {
 187         ir z39
 188     }
 189     if {[catch {set oldHost [z39 connect]}]} {
 190         set oldHost ""
 191     }
 192     z39 callback ok-response
 193     z39 failback fail-response
 194     if {$oldHost != $host} {
 195         catch {z39 disconnect}
 196
 197         html "Connecting to target " $host " <br>\n"
 198         set sessionWait 0
 199         if {[catch {z39 connect $host}]} {
 200             html "Cannot connect to target ${host} <br>\n"
 201             return 0
 202         } elseif {$sessionWait == 0} {
 203             zwait sessionWait
 204             if {$sessionWait != 1} {
 205                 html "Cannot connect to target ${host} <br>\n"
 206                 return 0
 207             }
 208         }
 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 z39present {setNo setOffset setMax dfunc} {
 259     global hist
 260     global sessionWait
 261
 262     set toGet [expr 1 + $setMax - $setOffset]
 263     while {$setMax > 0 && $toGet > 0} {
 264         for {set got 0} {$got < $toGet} {incr got} {
 265             if {[z39.$setNo type [expr $setOffset + $got]] == ""} {
 266                 break
 267             }
 268         }
 269         if {$got < $toGet} {
 270             set sessionWait 0
 271             z39.$setNo present $setOffset $toGet
 272             zwait sessionWait
 273             if {$sessionWait != "1"} {
 274                 break
 275             }
 276             set got [z39.$setNo numberOfRecordsReturned]
 277         }
 278         display-rec $setOffset [expr $got + $setOffset - 1] $dfunc
 279         set setOffset [expr $got + $setOffset]
 280         set toGet [expr 1 + $setMax - $setOffset]
 281         wflush
 282     }
 283 }
 284
 285 proc z39history {} {
 286     global nextSetNo
 287     global hist
 288     global env
 289     global sessionId
 290
 291     if {![info exists nextSetNo]} {
 292         return
 293     }
 294     html "<hr><h3>History</h3><dl>\n"
 295     for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} {
 296         html {<dt> <a href="http://} $env(SERVER_NAME) $env(SCRIPT_NAME)
 297         html / $sessionId {/search.egw/} $setNo + 1
 298         html + [expr $hist($setNo,maxPresent) - 1]
 299         html {"> } $hist($setNo,host)
 300         if {[llength $hist($setNo,database)] > 1} {
 301             html ": "
 302             foreach b $hist($setNo,database) {
 303                 html " $b"
 304             }
 305         }
 306         html "</a>\n"
 307         html "<dd> "
 308         if {[info exists hist($setNo,hits)]} {
 309             html $hist($setNo,hits) " hits"
 310         } else {
 311             html failed
 312         }
 313         html "\n"
 314     }
 315     html "</dl>\n"
 316 }