X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=www%2Fz39util.tcl;h=19c75f3e4681c26f36fb594a98940d88b1009d53;hb=8475d385a59bc414a07804de7de9692edc022364;hp=e50db2ba3809ed080d704b73c4af72579eee1701;hpb=a4571caef991e968e3c20b515490b7923306a1cf;p=egate.git diff --git a/www/z39util.tcl b/www/z39util.tcl index e50db2b..19c75f3 100644 --- a/www/z39util.tcl +++ b/www/z39util.tcl @@ -1,5 +1,5 @@ # -# $Id: z39util.tcl,v 1.39 1996/03/12 16:30:30 adam Exp $ +# $Id: z39util.tcl,v 1.46 1996/08/28 09:36:03 adam Exp $ # proc saveState {} { uplevel #0 { @@ -92,20 +92,6 @@ proc display-medium {zset no setNo targetNo} { html "
\n" return } - WAIS { - html { } - html [join [$zset getWAIS $no headline]] - html {} - html "
\n" - html {Score: } [$zset getWAIS $no score] - set lines [$zset getWAIS $no lines] - if {$lines > 0} { - html {, } $lines { lines} - } - html "
\n" - return - } } if {![catch { set author [$zset getMarc $no field 100 * a] @@ -120,6 +106,7 @@ proc display-medium {zset no setNo targetNo} { set location [$zset getMarc $no field 260 * a] set publisher [$zset getMarc $no field 260 * b] set year [$zset getMarc $no field 260 * c] + set score [$zset getMarc $no field 999 * r] } dispError ] } { html { } @@ -161,6 +148,9 @@ proc display-medium {zset no setNo targetNo} { html "No Title" } html { } + if {[scan $score %d nscore] == 1} { + html "; Score " $nscore + } } else { html { } @@ -198,17 +188,6 @@ proc display-brief {zset no setNo targetNo} { html "
\n" return } - WAIS { - html { } - html [string range [join [$zset getWAIS $no headline]] 0 70] - - html {} - set score [$zset getWAIS $no score] - html { Score } $score - html "
\n" - return - } } if {![catch { set author [$zset getMarc $no field 100 * a] @@ -306,10 +285,6 @@ proc display-raw {zset no setNo targetNo} { html "\n" [join [$zset getSutrs $no]] "\n\n" return } - WAIS { - html "\n" [join [$zset getWAIS $no text]] "\n\n" - return - } } if {[catch {set r [$zset getMarc $no line * * *]}]} { html "Unknown record type: $rtype
\n" @@ -521,116 +496,11 @@ proc display-full-marc {zset no setNo targetNo} { dl-marc-field $zset $no 537 * "Source of data" {} "
\n" dl-marc-field $zset $no 538 * "System details" {} "
\n" dl-marc-field $zset $no 787 {[rstw6]} "Related information" {} "
\n" + dl-marc-field $zset $no 999 r "Score" {} ", " dl-marc-field $zset $no 001 * "Local control number" {} ", " html "\n" } -proc display-full-wais {zset no setNo targetNo} { - global env - global hist - global sessionId - - set i 0 - set element junk - htmlToken l [join [$zset getWAIS $no text]] { - if {[string compare [string index $l 0] {<}]} { - if {[info exist data($element)]} { - set data($element) $data($element)$l - } else { - set data($element) $l - } - continue - } - switch -- $l { - { - set element title - } - { - set element dateOfLastModification - } - { - set element controlIdentifier - } - { - set element lastChecked - } - { - set element bytes - } - { - set element linkage - } - { - incr i - } -
  • { - set element "$i,linkage" - } - { - set element "$i,title" - } - { - set element ip - } - default { - set element junk - } - } - } - if {![info exists data(title)] || ![info exists data(linkage)]} { - set nwi 0 - } else { - set nwi 1 - } - html "
    \n" - html {
    Title} - if {$nwi} { - html {
    } $data(title) "" - html {
    URL} - html {
    } $data(linkage) "
    \n" - } else { - html {
    } [join [$zset getWAIS $no headline]] - } - html {
    Score
    } [$zset getWAIS $no score] - set lines [$zset getWAIS $no lines] - if {$lines > 0} { - html {
    Lines
    } $lines "
    \n" - } - if {!$nwi} { - html "
    \n" [join [$zset getWAIS $no text]] "\n
    \n" - return - } - if {[info exists data(bytes)]} { - html {
    Bytes
    } $data(bytes) - } - if {[info exists data(dateOfLastModification)]} { - html {
    Last modified
    } $data(dateOfLastModification) - } - if {[info exists data(lastChecked)]} { - html {
    Last checked
    } $data(lastChecked) "
    \n" - } - if {[info exists data(ip)]} { - html {
    Initial text
    } $data(ip) "
    \n" - } - if {0} { - html {} - html {Similar WAIS record
    } - } - html "
    References\n" - for {set i 1} {[info exists data($i,linkage)]} {incr i} { - html {
    } - if {[info exists data($i,title)]} { - html $data($i,title) - } else { - html Untitled - } - html "
    \n" - } - html "\n" -} - proc display-full {zset no setNo targetNo} { set type [$zset type $no] switch $type { @@ -655,10 +525,6 @@ proc display-full {zset no setNo targetNo} { html "
    " [join [$zset getSutrs $no]] "

    \n" return } - WAIS { - display-full-wais $zset $no $setNo $targetNo - return - } } if {[catch {set r [$zset getMarc $no line * * *]}]} { html "Unknown record type: $rtype
    \n" @@ -700,38 +566,29 @@ proc build-query {t ilines} { for {set i 1} {$i <= $ilines} {incr i} { set term [join [egw_form entry$i]] if {[string length $term] == 0} continue - if {![string compare [lindex $targets($t) 1] WAIS]} { - if {[string length $q] == 0} { - set q $term - } else { - set q "$term $q" - } - set op [egw_form logic$i] - continue - } else { - set field [join [egw_form menu$i]] - catch {unset attr} - foreach x [lindex $targets($t) 2] { - if {![string compare [lindex $x 0] $field]} { - set attr [lindex $x 1] - } - } - if {![info exists attr]} { - egw_log debug "attr failed for $t" - set attr [lindex [lindex [lindex $targets($t) 2] 0] 1] - } - switch $op { - And - { set q "@and $q ${attr} \"${term}\"" } - Or - { set q "@or $q ${attr} \"${term}\"" } - {And not} - { set q "@not $q ${attr} \"${term}\"" } - {} - { set q "${attr} \"${term}\"" } + set field [join [egw_form menu$i]] + catch {unset attr} + foreach x [lindex $targets($t) 2] { + if {![string compare [lindex $x 0] $field]} { + set attr [lindex $x 1] } - set op [egw_form logic$i] } + if {![info exists attr]} { + egw_log debug "attr failed for $t" + set attr [lindex [lindex [lindex $targets($t) 2] 0] 1] + } + egw_log debug "op=${op}" + switch $op { + And + { set q "@and $q ${attr} \"${term}\""; egw_log debug AND } + Or + { set q "@or $q ${attr} \"${term}\""; egw_log debug OR } + {} + { set q "${attr} \"${term}\""; egw_log debug NOPE } + default + { set q "@not $q ${attr} \"${term}\""; egw_log debug ANDNOT } + } + set op [egw_form logic$i] } return $q } @@ -868,7 +725,7 @@ proc display-scan {setNo scanNo tno} { if {0} { regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm html {} } else { regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm @@ -946,24 +803,14 @@ proc z39search {setNo piggy tno elements} { return 0 } } elseif {![catch [list $zz.$setNo smallSetUpperBound 0]]} { - if {$tno > 0} { - if {[info exists hist($setNo,$tno,hits)]} { - return 1 - } - } else { - if {[info exists hist($setNo,hits)]} { - return 1 - } + if {[info exists hist($setNo,$tno,hits)]} { + return 1 } } - if {![string compare [lindex $targets($host) 1] WAIS]} { - wais-set $zz.$setNo $zz - } else { - ir-set $zz.$setNo $zz - $zz.$setNo preferredRecordSyntax [lindex $targets($host) 1] - egw_log debug "set syntax to [lindex $targets($host) 1]" - } + ir-set $zz.$setNo $zz + $zz.$setNo preferredRecordSyntax [lindex $targets($host) 1] + egw_log debug "set syntax to [lindex $targets($host) 1]" if {![lindex $targets($host) 5]} { set elements {} } @@ -1009,7 +856,7 @@ proc z39search {setNo piggy tno elements} { if {$sessionWait != 1} { return 0 } - set hist($setNo,hits) [$zz.$setNo resultCount] + set hist($setNo,$tno,hits) [$zz.$setNo resultCount] return 1 } @@ -1133,7 +980,20 @@ proc z39msearch {setNo elements start number cache} { } while {$zleft > 0} { egw_log debug "Waiting for init response" - if {[catch {egw_wait zleft 20}]} { + if {[catch {egw_wait zleft 20} reason]} { + if {![string compare $reason cancel]} { + for {set i 1} {$i <= $not} {incr i} { + set zstatus($i) -1 + catch {z39$i disconnect} + } + return + } else { + for {set i 1} {$i <= $not} {incr i} { + if {$zstatus($i) == -1} { + catch {z39$i disconnect} + } + } + } break } } @@ -1155,13 +1015,9 @@ proc z39msearch {setNo elements start number cache} { html "ok
    \n" } - if {![string compare [lindex $targets($host) 1] WAIS]} { - wais-set z39$i.$setNo z39$i - } else { - ir-set z39$i.$setNo z39$i - z39$i.$setNo preferredRecordSyntax [lindex $targets($host) 1] - egw_log debug "set syntax to [lindex $targets($host) 1]" - } + ir-set z39$i.$setNo z39$i + z39$i.$setNo preferredRecordSyntax [lindex $targets($host) 1] + egw_log debug "set syntax to [lindex $targets($host) 1]" set hist($setNo,$i,offset) 0 eval z39$i.$setNo databaseNames $hist($setNo,$i,database) @@ -1240,9 +1096,24 @@ proc z39msearch {setNo elements start number cache} { } } } + + while {$zleft > 0} { egw_log debug "Waiting for search/present response" - if {[catch {egw_wait zleft 60}]} { + if {[catch {egw_wait zleft 60} reason]} { + if {![string compare $reason cancel]} { + for {set i 1} {$i <= $not} {incr i} { + catch {z39$i disconnect} + set zstatus($i) -1 + } + return + } else { + for {set i 1} {$i <= $not} {incr i} { + if {$zstatus($i) != 2} { + catch {z39$i disconnect} + } + } + } break } } @@ -1343,9 +1214,12 @@ proc buttons-result-set-s {setNo targetNo setMax startPos after} { html {">Previous Records
    } } } - button-new-query 1 $setNo - button-new-target 1 - button-view-history 0 + if {$targetNo > 0} { + button-result-set $setNo $targetNo + } + button-new-query $setNo + button-new-target + button-view-history html "

    \n" } @@ -1365,35 +1239,46 @@ proc display-result-set-m-score {setNo} { if {$zstatus($i) != 2} continue set status [z39$i.$setNo responseStatus] if {[lindex $status 0] != "DBOSD"} continue - if {$hist($setNo,$i,offset) > $hist($setNo,maxPresent)} { - set nor $hist($setNo,maxPresent) - } else { - set nor $hist($setNo,$i,offset) - } + set nor $hist($setNo,$i,offset) for {set j 1} {$j <= $nor} {incr j} { - if {![string compare [z39$i.$setNo recordType $j] WAIS]} { - set score [z39$i.$setNo getWAIS $j score] - if {$score > 0} { - lappend scoreArray [list $score $i $j] + if {![string compare [z39$i.$setNo recordType $j] USmarc]} { + set score [z39$i.$setNo getMarc $j field 999 * r] + if {[scan $score %d score] != 1} { + set score 10 } } else { - lappend scoreArray [list 10 $i $j] + set score 10 + } + if {$score > 0} { + lappend scoreArray [list $score $i $j] } } } if {![info exists scoreArray]} { html "

    Search produced no result


    \n" - return + } else { + html "
      \n" + set scoreSorted [lsort -command score-sort $scoreArray] + foreach r $scoreSorted { + set i [lindex $r 1] + set j [lindex $r 2] + display-$hist($setNo,format) z39$i.$setNo $j $setNo $i + } + html "
    \n" } - set scoreSorted [lsort -command score-sort $scoreArray] - - html "
      \n" - foreach r $scoreSorted { - set i [lindex $r 1] - set j [lindex $r 2] - display-$hist($setNo,format) z39$i.$setNo $j $setNo $i + for {set i 1} {$i <= $not} {incr i} { + if {$zstatus($i) != 2} continue + set status [z39$i.$setNo responseStatus] + if {[lindex $status 0] == "NSD"} { + z39$i.$setNo nextResultSetPosition 0 + set code [lindex $status 1] + set msg [lindex $status 2] + set addinfo [lindex $status 3] + html {
      } [lindex $targets($hist($setNo,$i,host)) 0] + html "
      Error: $msg: $addinfo (code $code)
      \n" + } } - html "

    \n" + html "\n
    " } proc display-result-set-m-server {setNo} { @@ -1401,20 +1286,26 @@ proc display-result-set-m-server {setNo} { global useIcons global zstatus global targets + global env + global sessionId set not $hist($setNo,0,host) html "
    \n" for {set i 1} {$i <= $not} {incr i} { if {$zstatus($i) != 2} continue - html "

    " [lindex $targets($hist($setNo,$i,host)) 0] ": " set status [z39$i.$setNo responseStatus] if {[lindex $status 0] == "NSD"} { + html "

    " [lindex $targets($hist($setNo,$i,host)) 0] ": " z39$i.$setNo nextResultSetPosition 0 set code [lindex $status 1] set msg [lindex $status 2] set addinfo [lindex $status 3] html "Error

    \n
    NSD$code: $msg: $addinfo" } else { + html {
    } + html "

    " [lindex $targets($hist($setNo,$i,host)) 0] ": " set r [z39$i.$setNo resultCount] html "$r hits

    \n
    \n" @@ -1518,7 +1409,6 @@ proc z39history {} { global html3 global scriptQuery - set targetNo 0 if {![info exists nextSetNo]} { return } @@ -1534,67 +1424,80 @@ proc z39history {} { html {
    } "\n" } for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} { - if {$hist($setNo,scan) > 0} continue - set host $hist($setNo,0,host) - if {$html3} { - html {} - } else { - html {
    } + if {[info exists hist($setNo,scan)]} { + if {$hist($setNo,scan) > 0} continue } - html [lindex $targets($host) 0] - if {$html3} { - html {} [join $hist($setNo,0,database)] + if {[info exists hist($setNo,1,host)]} { + set start 1 + set end $hist($setNo,0,host) } else { - if {[llength [lindex $targets($host) 1]] > 1} { - html ": " - foreach b $hist($setNo,0,database) { - html " $b" + set start 0 + set end 0 + } + for {set i $start} {$i <= $end} {incr i} { + if {$html3} { + html {} + } else { + html {
    } + } + set host $hist($setNo,$i,host) + html [lindex $targets($host) 0] + if {$html3} { + html {} [join $hist($setNo,$i,database)] + } else { + if {[llength [lindex $targets($host) 1]] > 1} { + html ": " + foreach b $hist($setNo,$i,database) { + html " $b" + } } + html {. } } - html {. } - } - if {$html3} { - html {} - } - if {[info exists hist($setNo,hits)]} { - html { } $hist($setNo,hits) {} + if {$html3} { + html {} + } + if {[info exists hist($setNo,$i,hits)]} { + html { } $hist($setNo,$i,hits) {} } else { - html {">Result: } $hist($setNo,hits) { hits.} + if {$html3} { + html {Failed} + } else { + html {Search failed.} + } } - } else { if {$html3} { - html {Failed} + html {} } else { - html {Search failed.} + html "
    \n" } - } - if {$html3} { - html {} - } else { - html "
    \n" - } - html { } - } else { - html {">Query: } - } - set op {} - for {set i 1} {$i <= 3} {incr i} { - if {[string length $hist($setNo,form,entry$i)] > 0} { - html " " [join $op " "] " " - html [join $hist($setNo,form,menu$i)] "=" - html $hist($setNo,form,entry$i) - set op $hist($setNo,form,logic$i) + html { } + } else { + html {">Query: } + } + set op {} + for {set j 1} {$j <= 10} {incr j} { + if {![info exists hist($setNo,form,entry$j)]} { + break + } + if {[string length $hist($setNo,form,entry$j)] > 0} { + html " " [join $op " "] " " + set pre [join $hist($setNo,form,menu$j)] + if {[string length $pre] > 0} { + html $pre "=" + } + html $hist($setNo,form,entry$j) + set op $hist($setNo,form,logic$j) + } + } + if {$html3} { + html {} "\n" } - } - if {$html3} { - html {} "\n" } } if {$html3} { @@ -1625,7 +1528,19 @@ proc button-main {} { } } -proc button-define-target {more} { +proc button-feedback {} { + global useIcons + + html {} + if {$useIcons} { + html {User Feedback} + } else { + html {User Feedback} + } +} + +proc button-define-target {} { global useIcons global env global sessionId @@ -1643,11 +1558,10 @@ proc button-define-target {more} { } } -proc button-new-target {more} { +proc button-new-target {} { global useIcons global env global sessionId - global mMode global scriptTarget if {[string length $scriptTarget] == 0} return @@ -1665,7 +1579,7 @@ proc button-new-target {more} { } } -proc button-view-history {more} { +proc button-view-history {} { global useIcons global env global sessionId @@ -1685,19 +1599,18 @@ proc button-view-history {more} { } } -proc button-new-query {more setNo} { +proc button-new-query {setNo} { global useIcons global env global sessionId global hist - global mMode global scriptQuery if {!$useIcons} { html "\n | " } html {} + html / $sessionId / $scriptQuery {;/} $setNo + $hist($setNo,0,host) {">} if {$useIcons} { html {} + } else { + html {">Result Set} + } +} + +proc button-scan-window {setNo} { global useIcons global env global sessionId @@ -1729,10 +1666,8 @@ proc button-scan-window {more setNo} { proc maintenance {} { html {
    This page is maintained by } - html { Peter Wad Hansen .} - html {Last modified 29. january 1996.
    } - html { This and the following pages are under construction and } - html {will continue to be so until the end of January 1996.} + html { Nobody .} + html {Last modified x x x.
    } } proc splitHostSpec {host} { @@ -1763,22 +1698,70 @@ proc mkAssoc {assoc host} { global targets if {[catch {$assoc failback fail-response}]} { - if {![string compare [lindex $targets($host) 1] WAIS]} { - wais $assoc - } else { - ir $assoc - } + ir $assoc + $assoc maximumRecordSize 1000000 } else { - if {![string compare [lindex $targets($host) 1] WAIS]} { - if {[$assoc comstack] == "wais"} return - wais $assoc + if {[$assoc comstack] == "tcpip"} return + ir $assoc + $assoc maximumRecordSize 1000000 + } +} + +proc serverList {headlineProc targetProc} { + global targets + global groupsDescription + + proc targetsCmp {l r} { + global targets + return [string compare [string tolower [lindex $targets($l) 0]] \ + [string tolower [lindex $targets($r) 0]]] + } + proc groupCmp {l r} { + global groupsOrder + if {[catch {set lo $groupsOrder($l)}]} { + set lo 10 + } + if {[catch {set ro $groupsOrder($r)}]} { + set ro 10 + } + return [expr $lo - $ro] + } + + foreach tt [array names targets] { + lappend groupsTmp([lindex $targets($tt) 6]) $tt + } + set gts [lsort -command groupCmp [array names groupsTmp]] + foreach gt $gts { + if {[info exists groupsDescription($gt)]} { + eval $headlineProc [list $groupsDescription($gt)] } else { - if {[$assoc comstack] == "tcpip"} return - ir $assoc + eval $headlineProc $gt + } + set tn [lsort -command targetsCmp $groupsTmp($gt)] + foreach t $tn { + eval $targetProc $t } } + + rename targetsCmp {} +} + +proc session-lost {} { + global useIcons + + html {WWW/Z39.50 Gateway: Session Expired} + html \n {} + set useIcons 1 + button-main + html {

    Session Expired

    } + html {Your session has expired. Please reload the gateways' } + html {front page.

    } \n + set useIcons 0 + button-main + html {} } if {[info exists utilExtension]} { source $utilExtension -} \ No newline at end of file +} +