From 3954f0a5830c668503a8d382de3599e9cdd88ea9 Mon Sep 17 00:00:00 2001
From: Adam Dickmeiss <adam@indexdata.dk>
Date: Wed, 9 Jun 2004 08:29:36 +0000
Subject: [PATCH] Utility that converts from danbib rules to Zebra .abs

---
 tab/rules2abs.tcl |   64 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 64 insertions(+)
 create mode 100755 tab/rules2abs.tcl

diff --git a/tab/rules2abs.tcl b/tab/rules2abs.tcl
new file mode 100755
index 0000000..b86bd03
--- /dev/null
+++ b/tab/rules2abs.tcl
@@ -0,0 +1,64 @@
+#!/usr/bin/tclsh
+
+set prevtag {}
+
+proc flushfields {f tag} {
+    global specs absfile
+    
+    if {[string compare $tag {}] == 0} {
+	return
+    }
+    puts $f "elm $tag		$tag     -"
+    foreach sub [array names specs] {
+	puts -nonewline $f "elm $tag/$sub	${tag}_${sub}	"
+	set sep ""
+	foreach spec [lsort -unique $specs($sub)] {
+	    puts -nonewline $f "$sep[lindex $spec 0]:[lindex $spec 1]"
+	    set sep ","
+	}
+	puts $f ""
+	unset specs($sub)
+    }
+}
+
+set absfile [open danbib.abs w]
+set attrseq 1
+
+puts $absfile "name danbib"
+puts $absfile ""
+puts $absfile "attset danbib.att"
+puts $absfile ""
+while {[gets stdin line] >= 0} {
+    set ch [string index $line 0]
+    if {[string compare $ch \#] && [scan $line "%s %s %s %s %s %s %s %s %s" tag class fieldid marcid prefixid subfields str cats format] > 6} {
+
+	if {[string compare $prevtag $tag]} {
+	    flushfields $absfile $prevtag
+	    set prevtag $tag
+	}
+	for {set i 0} {$i < [string length $subfields]} {incr i} {
+	    set subchar [string index $subfields $i]
+	    if {[string compare $fieldid {-}] != 0} {
+		set prefixid any
+	    }
+	    if {![info exists attr($prefixid)]} {
+		set attr($prefixid) $attrseq
+		incr attrseq
+	    }
+	    lappend specs($subchar) [list $prefixid [string tolower $class]]
+	}
+    }
+}
+if {[string compare $prevtag $tag]} {
+    flushfields $absfile $prevtag
+}
+close $absfile
+set attfile [open danbib.att w]
+puts $attfile "name danbib"
+puts $attfile "reference Bib-1"
+puts $attfile ""
+foreach a [array names attr] {
+    puts $a
+    puts $attfile "att $attr($a)   $a"
+}
+close $attfile
\ No newline at end of file
-- 
1.7.10.4