A lot of work on scan. Tables used to display scan terms and hits.
[egate.git] / www / z39util.tcl
index a7d06d4..6860b16 100644 (file)
@@ -1,5 +1,5 @@
 #
-# $Id: z39util.tcl,v 1.20 1996/01/12 10:05:42 adam Exp $
+# $Id: z39util.tcl,v 1.26 1996/01/26 15:50:11 adam Exp $
 #
 proc saveState {} {
     uplevel #0 {
@@ -93,9 +93,20 @@ 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]
     } ] } {
+        html { <a href="http:} $env(SCRIPT_NAME) /
+        html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
         set p 0
         foreach a $author {
             if {$p} {
@@ -104,17 +115,37 @@ 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 {<a href="http:} $env(SCRIPT_NAME) /
-        html $sessionId {/showfull.egw/} $setNo + $tno + $no + full {">}
-        if {[string length $title] == 0} {
-            html {No title}
-        } else {
-            html $title
+       set nope 1
+        foreach v $title {
+            html $v
+            set nope 0
         }
-        html {</a>} " <i> ${year} </i>"
+        if {$nope} {
+            set v [join $cover ""]
+            if {[string length $v] > 40} {
+                html [string range $v 0 38] "..."
+            } else {
+                html $v
+            }
+       }
+        html {</a> }
     }
     html "<br>\n"
 }
@@ -167,7 +198,7 @@ proc display-raw {zset no tno} {
             }
             html $data
         }
-        htmlr {<br>}
+        html "<br>\n"
     }
 }
 
@@ -286,8 +317,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 "<em>" "</em>"
@@ -382,9 +422,9 @@ 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 [join [wform menu$i]]
+        set field [join [egw_form menu$i]]
         set attr {Title}
         foreach x [lindex $targets($t) 2] {
             if {[lindex $x 0] == $field} {
@@ -402,9 +442,9 @@ proc build-query {t ilines} {
     set op {}
     set q {}
     for {set i 1} {$i <= $ilines} {incr i} {
-        set term [join [wform entry$i]]
+        set term [join [egw_form entry$i]]
         if {[string length $term] > 0} {
-            set field [join [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]
@@ -412,15 +452,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
@@ -455,45 +495,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 {
@@ -510,11 +551,12 @@ proc z39scan {setNo scanNo tno scanLines scanPos cache} {
 
     $zz callback [list scan-response $zs]
 
+    egw_log debug "scan: ${scanAttr} ${scanTerm}"
     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 "</body></html>\n"
         $zz disconnect
@@ -559,16 +601,31 @@ proc display-scan {setNo scanNo tno} {
             set hist($setNo,[expr $scanNo + 1],scanTerm) $t
         }
     }
+    html {<table border=0><tr>}
+    html {<td align=left><b>Scan term</b>}
+    html {<td align=right><b>Hits</b>}
+    html {<tr>} \n
+
     for {set i 0} {$i < $m} {incr i} {
-        regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
-        html {<a href="http:} $env(SCRIPT_NAME)
-        html / $sessionId {/query.egw/} $hist($setNo,host) + $setNo +
-        html $hist($setNo,scan) +  $tterm {">}
+        html {<td align=left>}
+        if {0} {
+            regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
+            html {<a href="http:} $env(SCRIPT_NAME)
+            html / $sessionId {/query.egw/} $hist($setNo,host) + $setNo +
+            html $hist($setNo,scan) +  $tterm {">}
+        } else {
+            regsub -all {\ } [lindex [$zs scanLine $i] 1] + tterm
+            html {<a href="http:} $env(SCRIPT_NAME)
+            html / $sessionId {/search.egw/} $setNo +
+            html hyper + $tterm {">}
+        }
         html [lindex [$zs scanLine $i] 1]
-        html {</a>: <em>}
+        html {</a>} 
+        html {<td align=right>}
         html [lindex [$zs scanLine $i] 2]
-        html "</em><br>\n"
+        html {<tr>} \n
     }
+    html {</table} \n
 }
 
 proc z39search {setNo piggy tno elements} {
@@ -597,45 +654,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 {
@@ -654,7 +712,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
@@ -670,10 +728,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 "</body></html>\n"
         $zz disconnect
@@ -696,7 +755,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
@@ -706,7 +765,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
@@ -718,7 +777,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
 }
@@ -747,7 +806,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]
@@ -757,26 +817,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 " <br>\n"
+        html "Connecting to target " $thisHost " <br>\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 <br>\n"
             ir-set z39$i.$setNo z39$i
@@ -805,7 +866,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 {
@@ -813,8 +874,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
         }
     }
@@ -859,8 +920,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
            }
@@ -878,7 +939,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
     }
 }
 
@@ -921,7 +982,8 @@ proc z39history {} {
         for {set i 1} {$i <= 3} {incr i} {
             if {[string length $hist($setNo,form,entry$i)] > 0} {
                 html " <b>" [join $op " "] "</b> "
-                html $hist($setNo,form,menu$i) "=" $hist($setNo,form,entry$i)
+                html [join $hist($setNo,form,menu$i)] "=" 
+                html $hist($setNo,form,entry$i)
                 set op $hist($setNo,form,logic$i)
             }
         }
@@ -948,13 +1010,39 @@ proc button-europagate {} {
     }
 }
 
+proc button-define-target {more} {
+    global useIcons
+    global env
+    global sessionId
+
+    html {<a href="http:} $env(SCRIPT_NAME)
+    html / $sessionId {/tform.egw}
+    if {$useIcons} {
+        html {"><img src="/egwgif/button-define-target.gif" }
+       html {alt="Define Target" border=0></a>}
+    } else {
+        html {">Define Target</a>}
+        if {$more} {
+            html " | \n"
+        } else {
+            html "\n"
+        }
+    }
+}
+
 proc button-new-target {more} {
     global useIcons
     global env
     global sessionId
+    global mMode
 
     html {<a href="http:} $env(SCRIPT_NAME)
-    html / $sessionId {/targets.egw}
+    html / $sessionId 
+    if {$mMode} {
+        html {/mtargets.egw}
+    } else {
+        html {/targets.egw}
+    }
     if {$useIcons} {
         html {"><img src="/egwgif/button-new-target.gif" }
        html {alt="New Target" border=0></a>}
@@ -995,9 +1083,16 @@ proc button-new-query {more setNo} {
     global env
     global sessionId
     global hist
+    global mMode
 
     html {<a href="http:} $env(SCRIPT_NAME)
-    html / $sessionId {/query.egw/} $hist($setNo,host) + $setNo {">}
+    html / $sessionId 
+    if {$mMode} {
+        html {/mquery.egw/} $setNo
+    } else {
+        html {/query.egw/} $hist($setNo,host) + $setNo
+    }
+    html {">}
     if {$useIcons} {
         html {<img src="/egwgif/button-new-query.gif" }
        html {alt="New Query" border=0></a>}
@@ -1011,10 +1106,44 @@ proc button-new-query {more setNo} {
     }
 }
 
+proc button-scan-window {more setNo} {
+    global useIcons
+    global env
+    global sessionId
+    global hist
+
+    html {<a href="http:} $env(SCRIPT_NAME)
+    html / $sessionId {/search.egw/} $setNo + {scan} {">}
+    if {$useIcons} {
+        html {<img src="/egwgif/button-scan-window.gif" }
+       html {alt="Scan" border=0></a>}
+    } else {
+        html {Scan</a>}
+        if {$more} {
+            html " | \n"
+        } else {
+            html "\n"
+        }
+    }
+}
+
 proc maintenance {} {
     html {<hr>This page is maintained by }
     html {<a href="mailto:pwh@dtv.dk"> Peter Wad Hansen </a>.}
-    html {Last modified 9. january 1996. <br>}
+    html {Last modified 26. january 1996. <br>}
     html {<em> This and the following pages are under construction and }
     html {will continue to be so until the end of January 1996.</em>}
 }
+
+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 -]
+}