X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=www%2Fz39util.tcl;h=7903fd4773e40b20457945f2129371a2cdc866e1;hb=84081f9782ee28f9236b0974891f1d6b865992be;hp=4853f0adbb72f4881b6bd74c3864b599ee2f647d;hpb=15bfeea050c1282aa6d53ad8bea324369832e40e;p=egate.git diff --git a/www/z39util.tcl b/www/z39util.tcl index 4853f0a..7903fd4 100644 --- a/www/z39util.tcl +++ b/www/z39util.tcl @@ -1,5 +1,5 @@ # -# $Id: z39util.tcl,v 1.18 1996/01/04 13:30:33 adam Exp $ +# $Id: z39util.tcl,v 1.25 1996/01/24 16:59:29 adam Exp $ # proc saveState {} { uplevel #0 { @@ -93,8 +93,17 @@ proc display-brief {zset no tno} { } if {![catch { set author [$zset getMarc $no field 100 * a] - set title [lindex [$zset getMarc $no field 245 * a] 0] - set year [lindex [$zset getMarc $no field 260 * c] 0] + set corp [$zset getMarc $no field 110 * a] + set meet [$zset getMarc $no field 111 * a] + set title [$zset getMarc $no field 245 * a] + if {[llength $author] == 0} { + set cover [$zset getMarc $no field 245 * {[bc]}] + } else { + set cover [$zset getMarc $no field 245 * b] + } + 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 p 0 foreach a $author { @@ -104,17 +113,49 @@ proc display-brief {zset no tno} { html $a set p 1 } + foreach a $corp { + if {$p} { + html ", " + } + html $a + set p 1 + } + foreach a $meet { + if {$p} { + html ", " + } + html $a + set p 1 + } if {$p} { html ": " } - html {} - if {[string length $title] == 0} { - html {No title} - } else { - html $title + set nope 1 + foreach v $title { + html $v + set nope 0 + } + if {$nope} { + html {No title} + } + html { } + foreach v $cover { + html $v + } + if {0} { + html {
} + foreach v $location { + html " $v" + } + foreach v $publisher { + html " $v" + } + foreach v $year { + html " $v" + } } - html {} " ${year} " } html "
\n" } @@ -167,7 +208,7 @@ proc display-raw {zset no tno} { } html $data } - htmlr {
} + html "
\n" } } @@ -286,8 +327,17 @@ proc display-full {zset no tno} { } set n [dl-marc-field $zset $no 710 a "Corporate Name" {} ", "] if {$n == 0} { - set n [dl-marc-field $zset $no 710 a "Corporate Name" {} ", "] + set n [dl-marc-field $zset $no 110 a "Corporate Name" {} ", "] } + set n [dl-marc-field $zset $no 711 a "Meeting Name" {} ", "] + if {$n > 0} { + dd-marc-field $zset $no 711 {[bndc]} " " "" + } else { + set n [dl-marc-field $zset $no 111 a "Meeting Name" {} ", "] + if {$n > 0} { + dd-marc-field $zset $no 111 {[bndc]} " " " " + } + } set n [dl-marc-field $zset $no 245 {a} "Title" {} " "] if {$n > 0} { dd-marc-field $zset $no 245 b "" "" @@ -382,9 +432,10 @@ proc display-rec {from to dfunc tno} { proc build-scan {t i} { global targets - set term [wform entry$i] + set term [egw_form entry$i] if {$term != ""} { - set field [wform menu$i] + set field [join [egw_form menu$i]] + set attr {Title} foreach x [lindex $targets($t) 2] { if {[lindex $x 0] == $field} { set attr [lindex $x 1] @@ -401,9 +452,9 @@ proc build-query {t ilines} { set op {} set q {} for {set i 1} {$i <= $ilines} {incr i} { - set term [wform entry$i] + set term [join [egw_form entry$i]] if {[string length $term] > 0} { - set field [wform menu$i] + set field [join [egw_form menu$i]] foreach x [lindex $targets($t) 2] { if {[lindex $x 0] == $field} { set attr [lindex $x 1] @@ -411,15 +462,15 @@ proc build-query {t ilines} { } switch $op { And - { set q "@and $q ${attr} ${term}" } + { set q "@and $q ${attr} \"${term}\"" } Or - { set q "@or $q ${attr} ${term}" } + { set q "@or $q ${attr} \"${term}\"" } {And not} - { set q "@not $q ${attr} ${term}" } + { set q "@not $q ${attr} \"${term}\"" } {} - { set q "${attr} ${term}" } + { set q "${attr} \"${term}\"" } } - set op [wform logic$i] + set op [egw_form logic$i] } } return $q @@ -454,45 +505,46 @@ proc z39scan {setNo scanNo tno scanLines scanPos cache} { set zs $zz.s$scanNo.$setNo $zz callback ok-response $zz failback fail-response - if {$oldHost != $host} { + set thisHost [splitHostSpec $host] + if {$oldHost != $thisHost} { catch [list $zz disconnect] set sessionWait 0 - if {[catch [list $zz connect $host]]} { - displayError "Cannot connect to target" $host + if {[catch [list $zz connect $thisHost]]} { + displayError "Cannot connect to target" $thisHost return 0 } elseif {$sessionWait == 0} { - if {[catch {zwait sessionWait 300}]} { + if {[catch {egw_wait sessionWait 300}]} { $zz disconnect - displayError "Cannot connect to target" $host + displayError "Cannot connect to target" $thisHost return 0 } if {$sessionWait != 1} { - displayError "Cannot connect to target" $host + displayError "Cannot connect to target" $thisHost return 0 } } $zz idAuthentication $idAuth set sessionWait 0 if {[catch {$zz init}]} { - displayError "Cannot initialize target" $host + displayError "Cannot initialize target" $thisHost $zz disconnect return 0 } - if {[catch {zwait sessionWait 60}]} { - displayError "Cannot initialize target" $host + if {[catch {egw_wait sessionWait 60}]} { + displayError "Cannot initialize target" $thisHost $zz disconnect return 0 } if {$sessionWait != "1"} { - displayError "Cannot initialize target" $host + displayError "Cannot initialize target" $thisHost $zz disconnect return 0 } if {![$zz initResult]} { set u [$zz userInformationField] $zz disconnect - displayError "Cannot initialize target $host" $u + displayError "Cannot initialize target $thisHost" $u return 0 } } else { @@ -512,8 +564,8 @@ proc z39scan {setNo scanNo tno scanLines scanPos cache} { set sessionWait 0 $zs scan "${scanAttr} ${scanTerm}" - if {[catch {zwait sessionWait 600}]} { - wlog debug "timeout/cancel in scan" + if {[catch {egw_wait sessionWait 60}]} { + egw_log debug "timeout/cancel in scan" displayError "Timeout in scan" {} html "\n" $zz disconnect @@ -596,45 +648,46 @@ proc z39search {setNo piggy tno elements} { } $zz callback ok-response $zz failback fail-response - if {$oldHost != $host} { + set thisHost [splitHostSpec $host] + if {$oldHost != $thisHost} { catch [list $zz disconnect] set sessionWait 0 - if {[catch [list $zz connect $host]]} { - displayError "Cannot connect to target" $host + if {[catch [list $zz connect $thisHost]]} { + displayError "Cannot connect to target" $thisHost return 0 } elseif {$sessionWait == 0} { - if {[catch {zwait sessionWait 300}]} { + if {[catch {egw_wait sessionWait 300}]} { $zz disconnect - displayError "Cannot connect to target" $host + displayError "Cannot connect to target" $thisHost return 0 } if {$sessionWait != 1} { - displayError "Cannot connect to target" $host + displayError "Cannot connect to target" $thisHost return 0 } } $zz idAuthentication $idAuth set sessionWait 0 if {[catch {$zz init}]} { - displayError "Cannot initialize target" $host + displayError "Cannot initialize target" $thisHost $zz disconnect return 0 } - if {[catch {zwait sessionWait 60}]} { - displayError "Cannot initialize target" $host + if {[catch {egw_wait sessionWait 60}]} { + displayError "Cannot initialize target" $thisHost $zz disconnect return 0 } if {$sessionWait != "1"} { - displayError "Cannot initialize target" $host + displayError "Cannot initialize target" $thisHost $zz disconnect return 0 } if {![$zz initResult]} { set u [$zz userInformationField] $zz disconnect - displayError "Cannot initialize target $host" $u + displayError "Cannot initialize target $thisHost" $u return 0 } } else { @@ -653,7 +706,7 @@ proc z39search {setNo piggy tno elements} { $zz.$setNo mediumSetElementSetNames $elements $zz.$setNo recordElements $elements - wlog debug "database=$database" + egw_log debug "database=$database" eval $zz.$setNo databaseNames $database $zz.$setNo preferredRecordSyntax USMARC @@ -669,10 +722,11 @@ proc z39search {setNo piggy tno elements} { $zz.$setNo mediumSetPresentNumber 0 } set sessionWait 0 + egw_log debug "search: $query" $zz.$setNo search $query - if {[catch {zwait sessionWait 600}]} { - wlog debug "timeout/cancel in search" + if {[catch {egw_wait sessionWait 600}]} { + egw_log debug "timeout/cancel in search" displayError "Timeout in search" {} html "\n" $zz disconnect @@ -695,7 +749,7 @@ proc init-m-response {i} { global zstatus global zleft - wlog debug "init-m-response" + egw_log debug "init-m-response" set zstatus($i) 1 incr zleft -1 @@ -705,7 +759,7 @@ proc connect-m-response {i} { global zstatus global zleft - wlog debug "connect-m-response" + egw_log debug "connect-m-response" z39$i callback [list init-m-response $i] if {[catch {z39$i init}]} { set zstatus($i) -1 @@ -717,7 +771,7 @@ proc fail-m-response {i} { global zstatus global zleft - wlog debug "fail-m-response" + egw_log debug "fail-m-response" set zstatus($i) -1 incr zleft -1 } @@ -746,7 +800,8 @@ proc z39msearch {setNo piggy elements} { if {[catch {set oldHost [z39$i connect]}]} { set oldHost "" } - if {$oldHost != $host} { + set thisHost [splitHostSpec $host] + if {$oldHost != $thisHost} { catch {z39$i disconnect} } z39$i callback [list connect-m-response $i] @@ -756,26 +811,27 @@ proc z39msearch {setNo piggy elements} { for {set i 1} {$i <= $not} {incr i} { set oldHost [z39$i connect] set host $hist($setNo,$i,host) - if {$oldHost == $host} { + set thisHost [splitHostSpec $host] + if {$oldHost == $thisHost} { set zstatus($i) 1 continue } z39$i idAuthentication $hist($setNo,$i,idAuthentication) - html "Connecting to target " $host "
\n" + html "Connecting to target " $thisHost "
\n" set zstatus($i) -1 - if {![catch {z39$i connect $host}]} { + if {![catch {z39$i connect $thisHost}]} { incr zleft } } while {$zleft > 0} { - wlog debug "Waiting for init response" - if {[catch {zwait zleft 10}]} { + egw_log debug "Waiting for init response" + if {[catch {egw_wait zleft 10}]} { break } } set zleft 0 for {set i 1} {$i <= $not} {incr i} { - html "host " $hist($setNo,$i,host) ": " + html "host " [splitHostSpec $hist($setNo,$i,host)] ": " if {$zstatus($i) >= 1} { html "ok
\n" ir-set z39$i.$setNo z39$i @@ -804,7 +860,7 @@ proc z39msearch {setNo piggy elements} { z39$i.$setNo mediumSetPresentNumber 0 } set zstatus($i) 1 - wlog debug "search " $hist($setNo,$i,query) + egw_log debug "search " $hist($setNo,$i,query) z39$i.$setNo search $hist($setNo,$i,query) incr zleft } else { @@ -812,8 +868,8 @@ proc z39msearch {setNo piggy elements} { } } while {$zleft > 0} { - wlog debug "Waiting for search response" - if {[catch {zwait zleft 30}]} { + egw_log debug "Waiting for search response" + if {[catch {egw_wait zleft 30}]} { break } } @@ -858,8 +914,8 @@ proc z39present {setNo tno setOffset setMax dfunc elements} { if {$got < $toGet} { set sessionWait 0 $zz.$setNo present $setOffset $toGet - if {[catch {zwait sessionWait 300}]} { - wlog debug "timeout/cancel in present" + if {[catch {egw_wait sessionWait 300}]} { + egw_log debug "timeout/cancel in present" $zz disconnect break } @@ -877,7 +933,7 @@ proc z39present {setNo tno setOffset setMax dfunc elements} { display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $tno set setOffset [expr $got + $setOffset] set toGet [expr 1 + $setMax - $setOffset] - wflush + egw_flush } } @@ -930,7 +986,7 @@ proc z39history {} { proc displayError {msga msgb} { html "

\n" - html {Error} + html {Error} html "

" $msga "

\n" if {$msgb != ""} { html "

" $msgb "

\n" @@ -941,12 +997,32 @@ proc displayError {msga msgb} { proc button-europagate {} { global useIcons if {$useIcons} { - html {Europagate} + html {Europagate} } else { html {Europagate | } } } +proc button-define-target {more} { + global useIcons + global env + global sessionId + + html {} + } else { + html {">New Target} + if {$more} { + html " | \n" + } else { + html "\n" + } + } +} + proc button-new-target {more} { global useIcons global env @@ -955,7 +1031,7 @@ proc button-new-target {more} { html {} } else { html {">New Target} @@ -971,11 +1047,13 @@ proc button-view-history {more} { global useIcons global env global sessionId + global nextSetNo html {View HistoryView History} } else { html {">View History} @@ -996,7 +1074,7 @@ proc button-new-query {more setNo} { html {} if {$useIcons} { - html {} } else { html {New Query} @@ -1008,10 +1086,44 @@ proc button-new-query {more setNo} { } } +proc button-scan-window {more setNo} { + global useIcons + global env + global sessionId + global hist + + html {} + if {$useIcons} { + html {} + } else { + html {Scan} + if {$more} { + html " | \n" + } else { + html "\n" + } + } +} + proc maintenance {} { html {
This page is maintained by } html { Peter Wad Hansen .} - html {Last modified 3. january 1996.
} + html {Last modified 24. january 1996.
} html { This and the following pages are under construction and } html {will continue to be so until the end of January 1996.} } + +proc splitHostSpec {host} { + set i [string last . $host] + if {$i > 1} { + incr i -1 + return [string range $host 0 $i] + } + return $host +} + +proc mergeHostSpec {host databases} { + return ${host}.[join $databases -] +}