/[webpac]/openisis/current/tcl/fdt21.tcl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /openisis/current/tcl/fdt21.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 237 - (show annotations)
Mon Mar 8 17:43:12 2004 UTC (20 years, 1 month ago) by dpavlin
File MIME type: application/x-tcl
File size: 5252 byte(s)
initial import of openisis 0.9.0 vendor drop

1 #!/opt/openisis/tcl/bin/isish
2 #
3 # openisis - an open implementation of the ISIS database
4 # Version 0.8.x (microversion see file Version)
5 # Copyright (C) 2003 by Erik Grziwotz, erik@openisis.org
6 #
7 # This library is free software; you can redistribute it and/or
8 # modify it under the terms of the GNU Lesser General Public
9 # License as published by the Free Software Foundation; either
10 # version 2.1 of the License, or (at your option) any later version.
11 #
12 # This library is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # Lesser General Public License for more details.
16 #
17 # You should have received a copy of the GNU Lesser General Public
18 # License along with this library; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20 #
21 # This software is dedicated to the memory of Eckart Dietrich.
22 #
23 # This software is inspired by (but contains no code of) the iAPI
24 # Copyright (C) 2000 by Robert Janusz, rj@jezuici.krakow.pl.
25 # See iAPI.txt for what it contains.
26 #
27 # $Id: fdt21.tcl,v 1.3 2003/05/08 18:00:48 mawag Exp $
28 # convert fdt21 to openIsis fdt
29
30 package require mlcm::util
31
32 set syspath ""
33
34 # usage: fdt21.tcl ?fdt21path fdtpath? ?...?
35 if !$argc {
36 # test
37 set syspath /opt/openisis/db/mlcm/ADB/ISISMARC
38 set argv [list fdt21 fdttest]
39 set argc 2
40 }
41
42 # comparisation of two fd recs
43 proc cmpfd {f1 f2} {
44 set res [expr [$f1 get 860] - [$f2 get 860]]
45 if $res {
46 return $res
47 }
48 string compare [$f1 get {861 ""}] [$f2 get {861 ""}]
49 }
50
51 # op on db and check response for error
52 proc sendrqs {msg db type args} {
53 global stb0
54 if [catch {
55 eval $stb0 req type $type db $db $args
56 $stb0 .req delete
57 }] {
58 global errorInfo
59 puts $errorInfo
60 puts "$msg: $stb0 sendrqs $db $type $args"
61 exit 1
62 }
63 set err 0
64 set err2 0
65 if [catch {
66 set err [$stb0 .res get error]
67 set err2 [$stb0 .res get error2]
68 }] {
69 global errorInfo
70 puts $errorInfo
71 puts "$msg: $stb0 checkerr $db $type $args"
72 exit 1
73 }
74 if {$err || $err2} {
75 puts "ERR = $err $err2"
76 puts "$msg: $stb0 response $db $type $args"
77 exit 1
78 }
79 }
80
81 # set stb0 [openIsis syspath $syspath v 9]
82 set stb0 [openIsis syspath $syspath]
83
84 set ok 1
85
86 # loop over db's
87 foreach {db out} $argv {
88 sendrqs openIn $db open
89 sendrqs maxIn $db maxrow
90 set maxin [$stb0 .res get rowid]
91 sendrqs openOut $out open
92 sendrqs maxOut $out maxrow
93 set maxout [$stb0 .res get rowid]
94 puts "db $db maxrow $maxin $maxout"
95
96 # our fdt rec and list of fd's
97 set fdt [openIsisRec]
98 set fdlst [list]
99
100 # read fdt21 db
101 for {set r 1} {$maxin >= $r} {incr r} {
102 set rlst ""
103 if [catch {
104 sendrqs "read($r)" $db read rowid $r
105
106 # mainfield setup
107 set rec [$stb0 .res .rec]
108 set rlst [$rec get -tags]
109 set fd [openIsisRec]
110 set info [openIsisRec]
111 set tag [$rec get 1]
112 set len [$rec get {20 0}]
113 $fd add \
114 862 0 \
115 860 $tag \
116 866 [lindex [$rec get 2] 0] \
117 863 [$rec get {5 0}]
118 if $len {
119 $fd add 865 -$len
120 } {
121 $fd add 865 0
122 }
123
124 # loop over subfields
125 for {set pos 0} 1 {incr pos} {
126 if [catch {
127 set subrec [$rec get 100\[$pos\]]
128 }] {
129 break
130 }
131 set issub 1
132 set sublst [mlcm::util::splitfld $subrec]
133 foreach {c val} $sublst {
134 if [string equal c $c] {
135 set issub [string length $val]
136 break
137 }
138 }
139 # subfield entry
140 if $issub {
141 set fdsub [openIsisRec]
142 set infosub [openIsisRec]
143 foreach {c val} $sublst {
144 switch $c {
145 c {$fdsub add 861 $val}
146 n {$fdsub add 866 $val}
147 r {$fdsub add 863 $val}
148 l {$fdsub add 865 [expr $val ? -$val : 0]}
149 d {$fdsub add 869 $val}
150 w {$infosub add 10 $val} # codes for data entry proc
151 x {$infosub add 11 $val} # db with coded data
152 k {$infosub add 12 $val} # prefix in coded data db
153 a {$infosub add 20 $val} # edition attributes
154 }
155 }
156 # MMM extract type from w field?
157 $fdsub add 860 $tag 862 0
158 if [llength [$infosub get]] {
159 $fdsub wrap -done -tag 870 $infosub
160 } {
161 $infosub done
162 }
163 lappend fdlst $fdsub
164 # additional mainfield attributes
165 } {
166 foreach {c val} $sublst {
167 switch $c {
168 d {$fd add 869 $val}
169 w {$info add 10 $val}
170 x {$info add 11 $val}
171 k {$info add 12 $val}
172 a {$info add 20 $val}
173 }
174 }
175 }
176 }
177 # mainfield entry
178 if [llength [$info get]] {
179 $fd wrap -done -tag 870 $info
180 } {
181 $info done
182 }
183 lappend fdlst $fd
184 }] {
185 puts "ERR on rec $r@$db: $rlst: $errorInfo"
186 set ok 0
187 }
188
189 };# for r
190
191 set flen [llength $fdlst]
192 if !$flen {
193 puts "WARN empty fdt in $db"
194 set ok 0
195 } {
196 set fdlst [lsort -command cmpfd $fdlst]
197 $fdt add 880 $flen
198 for {set f 0} {$flen > $f} {incr f} {
199 $fdt wrap -done -tag 881 [lindex $fdlst $f]
200 }
201 # puts [$fdt get -tags]
202 set orec [$stb0 .req .rec]
203 foreach {t v} [$fdt get -tag] {
204 $orec add $t $v
205 }
206 if $maxout {
207 sendrqs update $out update rowid 1
208 } {
209 sendrqs insert $out insert
210 }
211 }
212
213 $fdt done
214 sendrqs closeIn $db close
215 sendrqs closeOut $out close
216
217 };# for db
218
219 $stb0 done
220
221 if !$ok {
222 puts "terminated with warnings."
223 exit 1
224 }
225 puts ok.
226

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26