X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=www%2Fz39util.tcl;h=3a2c69482c9a0e243bb1443fa1c46631f31072e6;hb=df7b985601de6c729147a6fd6588adba6f905480;hp=20fcec2a99befb5a2a9015fc8bb65c14f4372ac4;hpb=6315a552d51ac08b60d25d8500da5574a83ba530;p=egate.git diff --git a/www/z39util.tcl b/www/z39util.tcl index 20fcec2..3a2c694 100644 --- a/www/z39util.tcl +++ b/www/z39util.tcl @@ -1,5 +1,5 @@ # -# $Id: z39util.tcl,v 1.3 1995/11/08 12:42:18 adam Exp $ +# $Id: z39util.tcl,v 1.15 1996/01/02 10:52:32 adam Exp $ # proc saveState {} { uplevel #0 { @@ -8,31 +8,47 @@ proc saveState {} { if {$var == "f"} continue if {$var == "sessionId"} continue if {$var == "errorInfo"} continue - set names [array names $var] - if {$names != ""} { + if {[catch {set names [array names $var]}]} { + eval "set v \$${var}" + puts $f "set ${var} \{$v\}" + } else { foreach n $names { eval "set v \$${var}(\$n)" puts $f "set ${var}($n) \{$v\}" } - } else { - eval "set v \$${var}" - puts $f "set ${var} \{$v\}" + catch { + eval "set v \$${var}" + puts $f "set ${var} \{$v\}" + } } } close $f } } -proc search-response {sno} { +proc search-response {zz} { global sessionWait - set status [z39.$sno responseStatus] + set status [$zz responseStatus] if {[lindex $status 0] == "NSD"} { - z39.$sno nextResultSetPosition 0 + $zz nextResultSetPosition 0 set code [lindex $status 1] set msg [lindex $status 2] set addinfo [lindex $status 3] - html "

Error NSD$code: $msg: $addinfo


\n" + displayError "Diagnostic message" \ + "$msg: $addinfo
\n(error code $code)" + set sessionWait -2 + } else { + set sessionWait 1 + } +} + +proc scan-response {zz} { + global sessionWait + + set status [$zz scanStatus] + if {$status == 6} { + displayError "Scan fail" "" set sessionWait -2 } else { set sessionWait 1 @@ -49,7 +65,7 @@ proc fail-response {} { set sessionWait -1 } -proc display-brief {zset no} { +proc display-brief {zset no tno} { global env global setNo global sessionId @@ -67,7 +83,7 @@ proc display-brief {zset no} { if {$type != "DB"} { return } - html "${no} " + html "${no}" set rtype [$zset recordType $no] if {$rtype == "SUTRS"} { html [join [$zset getSutrs $no]] @@ -78,14 +94,14 @@ proc display-brief {zset no} { set title [lindex [$zset getMarc $no field 245 * a] 0] set year [lindex [$zset getMarc $no field 260 * c] 0] } ] } { - html { } $title {} - html " ${year} " + html { } $title {} " ${year} " } html "
\n" } -proc display-full {zset no} { +proc display-raw {zset no tno} { set type [$zset type $no] if {$type == "SD"} { set err [lindex [$zset diag $no] 1] @@ -100,7 +116,6 @@ proc display-full {zset no} { if {$type != "DB"} { return } - html "

${no}

\n" set rtype [$zset recordType $no] if {$rtype == "SUTRS"} { html [join [$zset getSutrs $no]] "
\n" @@ -115,7 +130,7 @@ proc display-full {zset no} { set indicator [lindex $line 1] set fields [lindex $line 2] set l [string length $indicator] - html "$tag " + html "$tag " if {$l > 0} { for {set i 0} {$i < $l} {incr i} { if {[string index $indicator $i] == " "} { @@ -125,6 +140,7 @@ proc display-full {zset no} { } } } + html "" foreach field $fields { set id [lindex $field 0] set data [lindex $field 1] @@ -137,23 +153,239 @@ proc display-full {zset no} { } } -proc display-rec {from to dfunc zz} { +proc put-marc-contents {cc} { + set ref "" + if {[string first :// $cc] > 0} { + foreach urltype {gopher http ftp mailto} { + if {[string first ${urltype}:// $cc] == 0} { + set ref $urltype + break + } + } + } + if {$ref != ""} { + html {} $cc {} + } +} + +proc dl-marc-field {zset no tag id la lb sep} { + set n 0 + set c [$zset getMarc $no field $tag * $id] + set len [llength $c] + if {$len == 0} { + return 0 + } + if {$len > 1 && "x$lb" != "x"} { + html "
$lb\n
" + } else { + html "
$la\n
" + } + foreach cc $c { + if {$n > 0} { + html $sep + } + put-marc-contents $cc + incr n + } + return $n +} + +proc dd-marc-field {zset no tag id start stop} { + set n 0 + set c [$zset getMarc $no field $tag * $id] + set len [llength $c] + if {$len == 0} { + return 0 + } + foreach cc $c { + html $start + put-marc-contents $cc + html $stop + incr n + } + return $n +} + +proc dl-marc-field-rec {zset no tag lead start stop startid sep} { + set n 0 + set lines [$zset getMarc $no line $tag * *] + foreach line $lines { + foreach field [lindex $line 2] { + if {$n == 0} { + html "
$lead" + html "\n
" + } + set id [lindex $field 0] + if {$id == $startid} { + if {$n > 0} { + html $stop + } + html $start + incr n + html [lindex $field 1] + } else { + html $sep + html [lindex $field 1] + } + } + } + if {$n > 0} { + html $stop + } +} + +proc display-full {zset no tno} { + set type [$zset type $no] + if {$type == "SD"} { + set err [lindex [$zset diag $no] 1] + set add [lindex [$zset diag $no] 2] + if {$add != {}} { + set add " :${add}" + } + html "Error ${err}${add}
\n" + return + } + if {$type != "DB"} { + return + } + set rtype [$zset recordType $no] + if {$rtype == "SUTRS"} { + html [join [$zset getSutrs $no]] "
\n" + return + } + if {[catch {set r [$zset getMarc $no line * * *]}]} { + html "Unknown record type: $rtype
\n" + return + } + html "
\n" + set n [dl-marc-field $zset $no 700 a "Author" "Authors" "
\n"] + if {$n == 0} { + set n [dl-marc-field $zset $no 100 a "Author" "Authors" "
\n"] + } + 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 245 {a} "Title" {} " "] + if {$n > 0} { + dd-marc-field $zset $no 245 b "" "" + dd-marc-field $zset $no 245 c " " "" + } else { + dl-marc-field $zset $no 245 {[ab]} "Title" {} " " + } + dl-marc-field $zset $no 520 a "Abstract" {} ", " + dl-marc-field $zset $no 072 * "Subject code" "Subject codes" ", " + dl-marc-field $zset $no 650 * "Subject" {} ", " + dl-marc-field $zset $no 260 * "Publisher" {} " " + dl-marc-field $zset $no 300 * "Physical Description" {} " " + + dl-marc-field-rec $zset $no 500 "Notes" "" "
\n" "a" ", " + + dl-marc-field-rec $zset $no 510 "References" "" "
\n" "a" ", " + + dl-marc-field-rec $zset $no 511 "Participant note" "" "
\n" "a" ", " + + dl-marc-field $zset $no 513 a "Report type" {} ", " + dl-marc-field $zset $no 513 b "Period covered" {} ", " + dl-marc-field-rec $zset $no 515 "Numbering notes" "" "
\n" "a" ", " + dl-marc-field-rec $zset $no 516 "Data notes" "" "
\n" "a" ", " + dl-marc-field-rec $zset $no 518 "Date/time notes" "" "
\n" "a" ", " + + dl-marc-field $zset $no 350 a "Price" {} ", " + dl-marc-field $zset $no 362 a "Dates of publication" {} ", " + dl-marc-field $zset $no 850 a "Holdings" {} ", " + + dl-marc-field-rec $zset $no 270 "Contact name" "" "
\n" p ", " + if {0} { + set n [dl-marc-field $zset $no 270 p "Contact name" {} ", "] + if {$n > 0} { + html "\n
\n" + + if {0} { + dl-marc-field $zset $no 270 a "Street" {} ", " + dl-marc-field $zset $no 270 b "City" {} ", " + dl-marc-field $zset $no 270 c "State" {} ", " + dl-marc-field $zset $no 270 e "Zip code" {} ", " + dl-marc-field $zset $no 270 d "Country" {} ", " + dl-marc-field $zset $no 270 m "Network address" {} ", " + dl-marc-field $zset $no 301 a "Service hours" {} ", " + dl-marc-field $zset $no 270 k "Phone" {} ", " + dl-marc-field $zset $no 270 l "Fax" {} ", " + } else { + dl-marc-field $zset $no 270 {[abcedmakl]} "Address" {} "
\n" + } + + html "\n
\n" + } + } + dl-marc-field $zset $no 010 a "LC control number" {} ", " + dl-marc-field $zset $no 010 b "NUCMC control number" {} ", " + dl-marc-field $zset $no 020 a "ISBN" {} ", " + dl-marc-field $zset $no 022 a "ISSN" {} ", " + set url [$zset getMarc $no field 856 * u] + set sp [$zset getMarc $no field 856 * 3] + if {"x$url" != "x"} { + html "
URL\n" + if {"x$sp" == "x"} { + set sp $url + } + html {
} [join $sp] "\n" + } + dl-marc-field $zset $no 037 {[abc]} "Acquisition" {} "
\n" + dl-marc-field $zset $no 037 {[f6]} "Form of issue" {} "
\n" + 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 001 * "Local control number" {} ", " + html "
\n" +} + + +proc display-rec {from to dfunc tno} { global setNo - while {$from <= $to} { - eval "$dfunc $zz.$setNo $from" - incr from + if {$tno > 0} { + while {$from <= $to} { + eval "$dfunc z39${tno}.${setNo} $from $tno" + incr from + } + } else { + while {$from <= $to} { + eval "$dfunc z39.${setNo} $from 0" + incr from + } } } -proc build-query {t} { +proc build-scan {t ilines} { + global targets + + for {set i 1} {$i <= $ilines} {incr i} { + set term [wform entry$i] + if {$term != ""} { + set field [wform menu$i] + foreach x [lindex $targets($t) 2] { + if {[lindex $x 0] == $field} { + set attr [lindex $x 1] + } + } + return [list $term $attr] + } + } + return "" +} + +proc build-query {t ilines} { global targets set op {} set q {} - for {set i 1} {$i < 4} {incr i} { - set term1 [wform entry$i] - regsub {\+} $term1 " " term + for {set i 1} {$i <= $ilines} {incr i} { + set term [wform entry$i] if {$term != ""} { set field [wform menu$i] foreach x [lindex $targets($t) 2] { @@ -163,13 +395,13 @@ proc build-query {t} { } 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] } @@ -177,81 +409,252 @@ proc build-query {t} { return $q } -proc z39search {setNo piggy} { +proc z39scan {setNo scanNo tno scanLines scanPos} { global hist global sessionWait + global targets - set host $hist($setNo,host) - if {[catch {z39 failback fail-response}]} { - ir z39 + if {$tno > 0} { + set zz z39$tno + set host $hist($setNo,$tno,host) + set idAuth $hist($setNo,$tno,idAuthentication) + set database $hist($setNo,$tno,database) + set scanAttr $hist($setNo,$tno,scanAttr) + set scanTerm $hist($setNo,$tno,$scanNo,scanTerm) + } else { + set zz z39 + set host $hist($setNo,host) + set idAuth $hist($setNo,idAuthentication) + set database $hist($setNo,database) + set scanAttr $hist($setNo,scanAttr) + set scanTerm $hist($setNo,$scanNo,scanTerm) + } + if {[catch [list $zz failback fail-response]]} { + ir $zz } - if {[catch {set oldHost [z39 connect]}]} { + if {[catch [list set oldHost [$zz connect]]]} { set oldHost "" } - z39 callback ok-response - z39 failback fail-response + set zs $zz.s$scanNo.$setNo + $zz callback ok-response + $zz failback fail-response if {$oldHost != $host} { - catch {z39 disconnect} + catch [list $zz disconnect] - html "Connecting to target " $host "
\n" set sessionWait 0 - if {[catch {z39 connect $host}]} { - html "Cannot connect to target ${host}
\n" + if {[catch [list $zz connect $host]]} { + displayError "Cannot connect to target" $host return 0 } elseif {$sessionWait == 0} { - zwait sessionWait + if {[catch {zwait sessionWait 300}]} { + $zz disconnect + displayError "Cannot connect to target" $host + return 0 + } if {$sessionWait != 1} { - html "Cannot connect to target ${host}
\n" + displayError "Cannot connect to target" $host return 0 } } - z39 idAuthentication $hist($setNo,idAuthentication) + $zz idAuthentication $idAuth set sessionWait 0 - if {[catch {z39 init}]} { - html "Cannot initialize with target ${host}
\n" + if {[catch {$zz init}]} { + displayError "Cannot initialize target" $host + $zz disconnect + return 0 + } + if {[catch {zwait sessionWait 60}]} { + displayError "Cannot initialize target" $host + $zz disconnect return 0 } - zwait sessionWait if {$sessionWait != "1"} { - html "Cannot initialize with target ${host}
\n" + displayError "Cannot initialize target" $host + $zz disconnect return 0 } + if {![$zz initResult]} { + set u [$zz userInformationField] + $zz disconnect + displayError "Cannot initialize target $host" $u + return 0 + } + } else { + if {![catch [list $zs numberOfTermsRequested 5]]} { + return 1 + } + } + eval $zz databaseNames $database + + ir-scan $zs $zz + + $zs numberOfTermsRequested $scanLines + $zs preferredPositionInResponse $scanPos + + $zz callback [list scan-response $zs] + + set sessionWait 0 + $zs scan "${scanAttr} ${scanTerm}" + + if {[catch {zwait sessionWait 600}]} { + wlog debug "timeout/cancel in scan" + displayError "Timeout in scan" {} + html "\n" + $zz disconnect + return 0 } - if {![catch {z39.$setNo smallSetUpperBound 0}]} { - return 1 + if {$sessionWait == -1} { + displayError "Scan fail" "Connection closed" + html "\n" + $zz disconnect + } + if {$sessionWait != 1} { + return 0 } - ir-set z39.$setNo z39 - eval z39.$setNo databaseNames $hist($setNo,database) + return 1 +} - z39.$setNo preferredRecordSyntax USMARC +proc display-scan {setNo scanNo tno} { + global hist + global targets - z39 callback search-response $setNo + if {$tno > 0} { + set zz z39$tno + } else { + set zz z39 + } + set zs $zz.s$scanNo.$setNo + set m [$zs numberOfEntriesReturned] + + html "
\n" + for {set i 0} {$i < $m} {incr i} { + html "
" + html [lindex [$zs scanLine $i] 1] + html ": " + html [lindex [$zs scanLine $i] 2] + html "\n" + } + html "
\n" +} + +proc z39search {setNo piggy tno elements} { + global hist + global sessionWait + global targets + + if {$tno > 0} { + set zz z39$tno + set host $hist($setNo,$tno,host) + set idAuth $hist($setNo,$tno,idAuthentication) + set database $hist($setNo,$tno,database) + set query $hist($setNo,$tno,query) + } else { + set zz z39 + set host $hist($setNo,host) + set idAuth $hist($setNo,idAuthentication) + set database $hist($setNo,database) + set query $hist($setNo,query) + } + if {[catch [list $zz failback fail-response]]} { + ir $zz + } + if {[catch [list set oldHost [$zz connect]]]} { + set oldHost "" + } + $zz callback ok-response + $zz failback fail-response + if {$oldHost != $host} { + catch [list $zz disconnect] + + set sessionWait 0 + if {[catch [list $zz connect $host]]} { + displayError "Cannot connect to target" $host + return 0 + } elseif {$sessionWait == 0} { + if {[catch {zwait sessionWait 300}]} { + $zz disconnect + displayError "Cannot connect to target" $host + return 0 + } + if {$sessionWait != 1} { + displayError "Cannot connect to target" $host + return 0 + } + } + $zz idAuthentication $idAuth + set sessionWait 0 + if {[catch {$zz init}]} { + displayError "Cannot initialize target" $host + $zz disconnect + return 0 + } + if {[catch {zwait sessionWait 60}]} { + displayError "Cannot initialize target" $host + $zz disconnect + return 0 + } + if {$sessionWait != "1"} { + displayError "Cannot initialize target" $host + $zz disconnect + return 0 + } + if {![$zz initResult]} { + set u [$zz userInformationField] + $zz disconnect + displayError "Cannot initialize target $host" $u + return 0 + } + } else { + if {[info exists hist($setNo,hits)] && \ + ![catch [list $zz.$setNo smallSetUpperBound 0]]} { + return 1 + } + + } + ir-set $zz.$setNo $zz + + if {![lindex $targets($host) 5]} { + set elements {} + } + $zz.$setNo smallSetElementSetNames $elements + $zz.$setNo mediumSetElementSetNames $elements + $zz.$setNo recordElements $elements + + wlog debug "database=$database" + eval $zz.$setNo databaseNames $database + + $zz.$setNo preferredRecordSyntax USMARC + + $zz callback [list search-response $zz.$setNo] if {$piggy} { - z39.$setNo largeSetLowerBound 999999 - z39.$setNo smallSetUpperBound 0 - z39.$setNo mediumSetPresentNumber $hist($setNo,maxPresent) + $zz.$setNo largeSetLowerBound 999999 + $zz.$setNo smallSetUpperBound 0 + $zz.$setNo mediumSetPresentNumber $hist($setNo,maxPresent) } else { - z39.$setNo largeSetLowerBound 2 - z39.$setNo smallSetUpperBound 0 - z39.$setNo mediumSetPresentNumber 0 + $zz.$setNo largeSetLowerBound 2 + $zz.$setNo smallSetUpperBound 0 + $zz.$setNo mediumSetPresentNumber 0 } set sessionWait 0 - z39.$setNo search $hist($setNo,query) + $zz.$setNo search $query - zwait sessionWait - if {$sessionWait != 1} { + if {[catch {zwait sessionWait 600}]} { + wlog debug "timeout/cancel in search" + displayError "Timeout in search" {} html "\n" + $zz disconnect return 0 } - set status [z39.$setNo responseStatus] - if {[lindex $status 0] == "NSD"} { - set code [lindex $status 1] - set msg [lindex $status 2] - set addinfo [lindex $status 3] - html "

Error NSD$code: $msg: $addinfo


\n" - return 0 + + if {$sessionWait == -1} { + displayError "Search fail" "Connection closed" + html "\n" + $zz disconnect } - set hist($setNo,hits) [z39.$setNo resultCount] + if {$sessionWait != 1} { + return 0 + } + set hist($setNo,hits) [$zz.$setNo resultCount] return 1 } @@ -294,10 +697,11 @@ proc search-m-response {setNo i} { set zstatus($i) 2 } -proc z39msearch {setNo piggy} { +proc z39msearch {setNo piggy elements} { global zleft global zstatus global hist + global targets set not $hist($setNo,0,host) @@ -323,6 +727,7 @@ proc z39msearch {setNo piggy} { set zstatus($i) 1 continue } + z39$i idAuthentication $hist($setNo,$i,idAuthentication) html "Connecting to target " $host "
\n" set zstatus($i) -1 if {![catch {z39$i connect $host}]} { @@ -343,6 +748,16 @@ proc z39msearch {setNo piggy} { ir-set z39$i.$setNo z39$i set hist($setNo,$i,offset) 0 eval z39$i.$setNo databaseNames $hist($setNo,$i,database) + + if {![lindex $targets($hist($setNo,$i,host)) 5]} { + set thisElements {} + } else { + set thisElements $elements + } + z39$i.$setNo smallSetElementSetNames $thisElements + z39$i.$setNo mediumSetElementSetNames $thisElements + z39$i.$setNo recordElements $thisElements + z39$i.$setNo preferredRecordSyntax USMARC z39$i callback [list search-m-response $setNo $i] @@ -378,27 +793,55 @@ proc z39msearch {setNo piggy} { } } -proc z39present {setNo setOffset setMax dfunc} { +proc z39present {setNo tno setOffset setMax dfunc elements} { global hist global sessionWait + global targets + + if {$tno > 0} { + set zz z39$tno + set host $hist($setNo,$tno,host) + } else { + set zz z39 + set host $hist($setNo,host) + } + + if {![lindex $targets($host) 5]} { + set elements {} + } + $zz.$setNo elementSetNames $elements + $zz.$setNo recordElements $elements set toGet [expr 1 + $setMax - $setOffset] + + $zz callback [list search-response $zz.$setNo] + while {$setMax > 0 && $toGet > 0} { for {set got 0} {$got < $toGet} {incr got} { - if {[z39.$setNo type [expr $setOffset + $got]] == ""} { + if {[$zz.$setNo type [expr $setOffset + $got]] == ""} { break } } if {$got < $toGet} { set sessionWait 0 - z39.$setNo present $setOffset $toGet - zwait sessionWait + $zz.$setNo present $setOffset $toGet + if {[catch {zwait sessionWait 300}]} { + wlog debug "timeout/cancel in present" + $zz disconnect + break + } + if {$sessionWait == "0"} { + $zz disconnect + } if {$sessionWait != "1"} { break } - set got [z39.$setNo numberOfRecordsReturned] + set got [$zz.$setNo numberOfRecordsReturned] + if {$got <= 0} { + break + } } - display-rec $setOffset [expr $got + $setOffset - 1] $dfunc z39 + display-rec $setOffset [expr $got + $setOffset - 1] $dfunc $tno set setOffset [expr $got + $setOffset] set toGet [expr 1 + $setMax - $setOffset] wflush @@ -415,11 +858,11 @@ proc z39history {} { if {![info exists nextSetNo]} { return } - html "

History

\n" + html "

History


\n" for {set setNo 1} {$setNo < $nextSetNo} {incr setNo} { - html {
} [lindex $targets($hist($setNo,host)) 0] if {[llength $hist($setNo,database)] > 1} { html ": " @@ -437,4 +880,16 @@ proc z39history {} { html "\n" } html "
\n" -} \ No newline at end of file +} + +proc displayError {msga msgb} { + html "

\n" + html {Error} + html "

" $msga "

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

" $msgb "

\n" + } + html "

\n" +} + +set useIcons 1