+++ /dev/null
-#!/opt/openisis/tcl/bin/isish
-#
-# openisis - an open implementation of the ISIS database
-# Version 0.8.x (microversion see file Version)
-# Copyright (C) 2003 by Erik Grziwotz, erik@openisis.org
-#
-# This library is free software; you can redistribute it and/or
-# modify it under the terms of the GNU Lesser General Public
-# License as published by the Free Software Foundation; either
-# version 2.1 of the License, or (at your option) any later version.
-#
-# This library is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# Lesser General Public License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public
-# License along with this library; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-#
-# This software is dedicated to the memory of Eckart Dietrich.
-#
-# This software is inspired by (but contains no code of) the iAPI
-# Copyright (C) 2000 by Robert Janusz, rj@jezuici.krakow.pl.
-# See iAPI.txt for what it contains.
-#
-# $Id: fdt21.tcl,v 1.3 2003/05/08 18:00:48 mawag Exp $
-# convert fdt21 to openIsis fdt
-
-package require mlcm::util
-
-set syspath ""
-
-# usage: fdt21.tcl ?fdt21path fdtpath? ?...?
-if !$argc {
- # test
- set syspath /opt/openisis/db/mlcm/ADB/ISISMARC
- set argv [list fdt21 fdttest]
- set argc 2
-}
-
-# comparisation of two fd recs
-proc cmpfd {f1 f2} {
- set res [expr [$f1 get 860] - [$f2 get 860]]
- if $res {
- return $res
- }
- string compare [$f1 get {861 ""}] [$f2 get {861 ""}]
-}
-
-# op on db and check response for error
-proc sendrqs {msg db type args} {
- global stb0
- if [catch {
- eval $stb0 req type $type db $db $args
- $stb0 .req delete
- }] {
- global errorInfo
- puts $errorInfo
- puts "$msg: $stb0 sendrqs $db $type $args"
- exit 1
- }
- set err 0
- set err2 0
- if [catch {
- set err [$stb0 .res get error]
- set err2 [$stb0 .res get error2]
- }] {
- global errorInfo
- puts $errorInfo
- puts "$msg: $stb0 checkerr $db $type $args"
- exit 1
- }
- if {$err || $err2} {
- puts "ERR = $err $err2"
- puts "$msg: $stb0 response $db $type $args"
- exit 1
- }
-}
-
-# set stb0 [openIsis syspath $syspath v 9]
-set stb0 [openIsis syspath $syspath]
-
-set ok 1
-
-# loop over db's
-foreach {db out} $argv {
- sendrqs openIn $db open
- sendrqs maxIn $db maxrow
- set maxin [$stb0 .res get rowid]
- sendrqs openOut $out open
- sendrqs maxOut $out maxrow
- set maxout [$stb0 .res get rowid]
- puts "db $db maxrow $maxin $maxout"
-
-# our fdt rec and list of fd's
- set fdt [openIsisRec]
- set fdlst [list]
-
-# read fdt21 db
- for {set r 1} {$maxin >= $r} {incr r} {
- set rlst ""
- if [catch {
- sendrqs "read($r)" $db read rowid $r
-
-# mainfield setup
- set rec [$stb0 .res .rec]
- set rlst [$rec get -tags]
- set fd [openIsisRec]
- set info [openIsisRec]
- set tag [$rec get 1]
- set len [$rec get {20 0}]
- $fd add \
- 862 0 \
- 860 $tag \
- 866 [lindex [$rec get 2] 0] \
- 863 [$rec get {5 0}]
- if $len {
- $fd add 865 -$len
- } {
- $fd add 865 0
- }
-
-# loop over subfields
- for {set pos 0} 1 {incr pos} {
- if [catch {
- set subrec [$rec get 100\[$pos\]]
- }] {
- break
- }
- set issub 1
- set sublst [mlcm::util::splitfld $subrec]
- foreach {c val} $sublst {
- if [string equal c $c] {
- set issub [string length $val]
- break
- }
- }
-# subfield entry
- if $issub {
- set fdsub [openIsisRec]
- set infosub [openIsisRec]
- foreach {c val} $sublst {
- switch $c {
- c {$fdsub add 861 $val}
- n {$fdsub add 866 $val}
- r {$fdsub add 863 $val}
- l {$fdsub add 865 [expr $val ? -$val : 0]}
- d {$fdsub add 869 $val}
- w {$infosub add 10 $val} # codes for data entry proc
- x {$infosub add 11 $val} # db with coded data
- k {$infosub add 12 $val} # prefix in coded data db
- a {$infosub add 20 $val} # edition attributes
- }
- }
- # MMM extract type from w field?
- $fdsub add 860 $tag 862 0
- if [llength [$infosub get]] {
- $fdsub wrap -done -tag 870 $infosub
- } {
- $infosub done
- }
- lappend fdlst $fdsub
-# additional mainfield attributes
- } {
- foreach {c val} $sublst {
- switch $c {
- d {$fd add 869 $val}
- w {$info add 10 $val}
- x {$info add 11 $val}
- k {$info add 12 $val}
- a {$info add 20 $val}
- }
- }
- }
- }
-# mainfield entry
- if [llength [$info get]] {
- $fd wrap -done -tag 870 $info
- } {
- $info done
- }
- lappend fdlst $fd
- }] {
- puts "ERR on rec $r@$db: $rlst: $errorInfo"
- set ok 0
- }
-
- };# for r
-
- set flen [llength $fdlst]
- if !$flen {
- puts "WARN empty fdt in $db"
- set ok 0
- } {
- set fdlst [lsort -command cmpfd $fdlst]
- $fdt add 880 $flen
- for {set f 0} {$flen > $f} {incr f} {
- $fdt wrap -done -tag 881 [lindex $fdlst $f]
- }
- # puts [$fdt get -tags]
- set orec [$stb0 .req .rec]
- foreach {t v} [$fdt get -tag] {
- $orec add $t $v
- }
- if $maxout {
- sendrqs update $out update rowid 1
- } {
- sendrqs insert $out insert
- }
- }
-
- $fdt done
- sendrqs closeIn $db close
- sendrqs closeOut $out close
-
-};# for db
-
-$stb0 done
-
-if !$ok {
- puts "terminated with warnings."
- exit 1
-}
-puts ok.
-
projects / webpac / blobdiff