X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=www%2Fz39util.tcl;h=36a28a1588133b7fc54bf8ff06cc06e48cb382a5;hb=8bafbc608e1ffba9ee87f4856e586dffa57901b8;hp=9efda0b3fc2c7011e13cf6958e2bb39c291bd288;hpb=02d3e042a063e539acce998f74b00a09df000cd0;p=egate.git diff --git a/www/z39util.tcl b/www/z39util.tcl index 9efda0b..36a28a1 100644 --- a/www/z39util.tcl +++ b/www/z39util.tcl @@ -1,5 +1,5 @@ # -# $Id: z39util.tcl,v 1.38 1996/03/11 17:40:49 adam Exp $ +# $Id: z39util.tcl,v 1.41 1996/03/14 11:50:51 adam Exp $ # proc saveState {} { uplevel #0 { @@ -120,6 +120,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 +162,9 @@ proc display-medium {zset no setNo targetNo} { html "No Title" } html { } + if {[scan $score %d nscore]} { + html "; Score " $nscore + } } else { html { } @@ -175,6 +179,7 @@ proc display-brief {zset no setNo targetNo} { global env global sessionId + html {
  • } set type [$zset type $no] if {$type == "SD"} { set err [lindex [$zset diag $no] 1] @@ -520,6 +525,7 @@ 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" } @@ -581,41 +587,47 @@ proc display-full-wais {zset no setNo targetNo} { } else { set nwi 1 } + html "
    \n" + html {
    Title} if {$nwi} { - html {Title: } $data(title) "
    \n" - html {URL: } $data(linkage) "
    \n" + html {
    } $data(title) "" + html {
    URL} + html {
    } $data(linkage) "
    \n" } else { - html {Title: } [join [$zset getWAIS $no headline]] "
    \n" + html {
    } [join [$zset getWAIS $no headline]] } - html {Score: } [$zset getWAIS $no score] "
    \n" + html {
    Score
    } [$zset getWAIS $no score] set lines [$zset getWAIS $no lines] if {$lines > 0} { - html {Lines: } $lines "
    \n" + html {
    Lines
    } $lines "
    \n" } if {!$nwi} { - html "
    \n" [join [$zset getWAIS $no text]] "\n
    \n" + html "
    \n" [join [$zset getWAIS $no text]] "\n
    \n" return } if {[info exists data(bytes)]} { - html {Bytes: } $data(bytes) "
    \n" + html {
    Bytes
    } $data(bytes) } if {[info exists data(dateOfLastModification)]} { - html {Last modified: } $data(dateOfLastModification) "
    \n" + html {
    Last modified
    } $data(dateOfLastModification) } if {[info exists data(lastChecked)]} { - html {Last checked: } $data(lastChecked) "
    \n" + html {
    Last checked
    } $data(lastChecked) "
    \n" } if {[info exists data(ip)]} { - html {
    Initial text
    } $data(ip) "

    \n" + html {
    Initial text
    } $data(ip) "
    \n" + } + if {0} { + html {} + html {Similar WAIS record
    } + } + if {[info exists data($i,linkage)]} { + html "
    References\n" } - - html {} - html {Similar WAIS record
    } - html "
    References\n
    \n" for {set i 1} {[info exists data($i,linkage)]} {incr i} { - html {} + html {
    } if {[info exists data($i,title)]} { html $data($i,title) } else { @@ -694,16 +706,16 @@ proc build-query {t ilines} { set q {} 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 $op] == 0} { + if {[string length $q] == 0} { set q $term } else { set q "$term $q" } set op [egw_form logic$i] continue - } - if {[string length $term] > 0} { + } else { set field [join [egw_form menu$i]] catch {unset attr} foreach x [lindex $targets($t) 2] { @@ -716,13 +728,13 @@ proc build-query {t ilines} { set attr [lindex [lindex [lindex $targets($t) 2] 0] 1] } switch $op { - And + And { set q "@and $q ${attr} \"${term}\"" } - Or + Or { set q "@or $q ${attr} \"${term}\"" } - {And not} + {And not} { set q "@not $q ${attr} \"${term}\"" } - {} + {} { set q "${attr} \"${term}\"" } } set op [egw_form logic$i] @@ -833,6 +845,7 @@ proc display-scan {setNo scanNo tno} { global targets global env global sessionId + global scriptQuery set zz z39$tno set zs $zz.s$scanNo.$setNo @@ -862,7 +875,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 @@ -940,14 +953,8 @@ 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 } } @@ -1003,7 +1010,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 } @@ -1307,19 +1314,25 @@ proc buttons-result-set-s {setNo targetNo setMax startPos after} { set zz z39$targetNo html "

    \n" - button-europagate + button-main if {$setMax > 0 && $setMax < [$zz.$setNo resultCount]} { + if {!$useIcons} { + html "\n | " + } html {Next Records} + html {">} } else { - html {">Next Records} " | \n" + html {">Next Records} } } if {$setMax > 0 && $startPos != "" && $startPos != "1"} { + if {!$useIcons} { + html "\n | " + } html {} } else { - html {">Previous Records} " | \n" + 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" } @@ -1353,35 +1369,48 @@ 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] + } elseif {![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} { @@ -1389,20 +1418,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" @@ -1504,8 +1539,8 @@ proc z39history {} { global sessionId global targets global html3 + global scriptQuery - set targetNo 0 if {![info exists nextSetNo]} { return } @@ -1521,67 +1556,77 @@ 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 <= 3} {incr j} { + 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} { @@ -1596,27 +1641,30 @@ proc displayError {msga msgb} { html "

    \n" html {Error} html "

    " $msga "

    \n" - if {$msgb != ""} { + if {[string length $msgb] > 0} { html "

    " $msgb "

    \n" } html "

    \n" } -proc button-europagate {} { +proc button-main {} { global useIcons html {} if {$useIcons} { html {Europagate} } else { - html {Europagate | } + html {Europagate} } } -proc button-define-target {more} { +proc button-define-target {} { global useIcons global env global sessionId + if {!$useIcons} { + html "\n | " + } html {} } else { html {">Define Target} - if {$more} { - html " | \n" - } else { - html "\n" - } } } -proc button-new-target {more} { +proc button-new-target {} { global useIcons global env global sessionId - global mMode + global scriptTarget - html {} } else { html {">New Target} - if {$more} { - html " | \n" - } else { - html "\n" - } } } -proc button-view-history {more} { +proc button-view-history {} { global useIcons global env global sessionId global nextSetNo + if {!$useIcons} { + html "\n | " + } html {} } else { html {">View History} - if {$more} { - html " | \n" - } else { - html "\n" - } } } -proc button-new-query {more setNo} { +proc button-new-query {setNo} { global useIcons global env global sessionId global hist - global mMode + global scriptQuery - html {} + html {} + if {$useIcons} { html {} } else { html {New Query} - if {$more} { - html " | \n" - } else { - html "\n" - } } } -proc button-scan-window {more setNo} { +proc button-result-set {setNo tno} { + global useIcons + global env + global sessionId + global hist + + if {!$useIcons} { + html "\n | " + } + html {} + } else { + html {">Result Set} + } +} + +proc button-scan-window {setNo} { global useIcons global env global sessionId global hist + if {!$useIcons} { + html "\n | " + } set targetNo 0 html {} @@ -1722,11 +1778,6 @@ proc button-scan-window {more setNo} { html {alt="Scan" border=0>} } else { html {Scan} - if {$more} { - html " | \n" - } else { - html "\n" - } } } @@ -1759,7 +1810,7 @@ proc splitDatabaseSpec {host} { } proc mergeHostSpec {host databases} { - return ${host}.[join $databases -] + return ${host}/[join $databases -] } proc mkAssoc {assoc host} { @@ -1780,4 +1831,63 @@ proc mkAssoc {assoc host} { ir $assoc } } -} \ No newline at end of file +} + +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 { + 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 +} +