
#@package: stanza read_stanza_header read_stanza_body read_stanza_file load_stanza_file write_stanza save_stanza_file

#
# Copyright (C) 1992-1997 NeoSoft.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  NeoSoft makes no 
# representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.

# $Id: stanza.tcl,v 1.1.1.1 1999/03/31 20:34:40 damon Exp $

#
# we really need to rewrite this in C and be truly stanza compliant,
# it's kind of a pig.
#
# stanza noncompliance issues: lots
#
# seems to work, though.
#


# read_stanza_header
#
# given a filehandle and an array name, read the file, pulling key-value
# pairs and putting them into the named array, returning when an empty
# line or EOF is found
#
#
proc read_stanza_header {fp headerVarName} {
    upvar $headerVarName headerVar
    
    if {[gets $fp line] <= 0} {return 0}
    if {[string index $line 0] != "\["} {
        error "malformed stanza file - no '[' in header"
    }
    if {[cindex $line [clength $line]-1] != "]"} {
        error "malformed stanza file - no ']' in header"
    }
    set headerVar [crange $line 1 [clength $line]-2]
    return 1
}

# parse_stanza_line
#
# given a line and the names of key and value variables, put
# the key and value in variables and return 1, else 0 or error
#
proc parse_stanza_line {line keyVarName dataVarName} {
    upvar $keyVarName key
    upvar $dataVarName value
    
    if {[string trim $line] == ""} {return 0}
    if {[cindex $line 0] == "\["} {
        error "called parse_stanza_line with a header line '$line'"
    }

    set separator [string first "=" $line]
    if {$separator < 2} {
        error "malformed stanza line '$line'"
    }
    set key [string trim [string range $line 0 [expr $separator-1]]]
    set value [string trim [string range $line [expr $separator+1] end]]
    return 1
}

# read_stanza_body
#
# given a filehandle and an array name, read the file, pulling key-value
# pairs and putting them into the named array, returning when an empty
# line or EOF is found
#
#
proc read_stanza_body {fp arrayVarName} {
    upvar $arrayVarName stanzaArray
    set success 0
    
    while {[gets $fp line] >= 0} {
        if ![parse_stanza_line $line key value] break
        set success 1
        set stanzaArray($key) $value
    }
    return $success
}

#
# write_stanza
#
# given a filehandle, an array name containing stanza elements
# and a stanza header name, write it out
#
#
proc write_stanza {fp headerName arrayVarName} {
    upvar $arrayVarName stanzaArray
    
    puts $fp "\[$headerName\]"
    foreach name [array names stanzaArray] {
        puts $fp "$name=$rfcArray($name)"
    }
    puts $fp ""
}

proc store_stanza_field {varName upLevel key value} {
    upvar $upLevel $varName myArray

    set myArray($key) $value
}

proc read_stanza_file {fileName arrayVarPrefix {global ""}} {
    set upLevel "2"
    if {$global != ""} {set upLevel "#0"}
    set fp [open $fileName]
    while 1 {
        if {[read_stanza_header $fp section] == 0} {
            close $fp
            return
        }
        store_stanza_field $arrayVarPrefix$section $upLevel ID $section
        while {[gets $fp line] >= 0} {
            if ![parse_stanza_line $line key value] break
            store_stanza_field $arrayVarPrefix$section $upLevel $key $value
        }
    }
}


#
# load_stanza_file and save_stanza_file work differently from the
# above.  these guys read the stanza bodies into keyed lists indexed
# by the header names through an array
#
#

#
# load_stanza_file
#
# load in a stanza file where the stanza headers becomne array names
# and the bodies become keyed lists
#
# slight optimization hack was to append up the list instead of
# keylsetting it, don't know if that really helped or not
#
proc load_stanza_file {fileName arrayVarName} {
    upvar $arrayVarName stanzaArray
    
    set fp [open $fileName]
    while 1 {
        if {[read_stanza_header $fp section] == 0} {
            close $fp
            return
        }
        set keyedList ""
        while {[gets $fp line] >= 0} {
            if ![parse_stanza_line $line key value] break
            lappend keyedList "$key $value"
        }
        set stanzaArray($section) $keyedList
    }
}

#
# save_stanza_file
#
# save a stanza file where the stanza headers come from an array's keys
# and the bodies are from keyed lists indexed by the keys
#
proc save_stanza_file {fileName arrayVarPrefix {global ""}} {
    set upVar "1"
    if {$global != ""} {set upVar "#0"}
    set varPrefixLength [string length $arrayVarPrefix]

    set fp [open $fileName w]
    foreach arrayVarName [uplevel $upVar "info vars $arrayVarPrefix*"] {
        upvar $upVar $arrayVarName stanzaArray

        set setName [string range $arrayVarName $varPrefixLength end]
    
	puts $fp "\[$setName\]"
        foreach key [array names stanzaArray] {
            if {[cindex $key 0] != "_"} {
	        puts $fp "$key=$stanzaArray($key)"
	    }
	}
        puts $fp ""
    }
    close $fp
}

