fnml.tcl

::fnml::getContent

::fnml::getContent

SYNOPSIS

proc ::fnml::getContent {nmlName fileChannel {must_exist 0} {match_first 1} {delim_re {[, \t\n]}}} {

PURPOSE

Extract the content of the specified namelist from the file-channel. The content of the namelist is trimmed from the namelist's begin and end tags (i.e. &name, / or &end).

ARGUMENTS

nmlName -- name of the namelist
fileChannel -- file-channel
must_exist -- [optional] must the namelist $nmlName exists, if $must_exist and namelist is not found, an error is thrown
match_first -- [optional] if true then the first non-empty line must start with the $nmlName word (default = 1)
delim_re -- [optional] regexp for the allowed delimeter characters (default = {[, \t\n]})

SIDE EFFECTS

If error occurs, fileChannel is closed.

RETURN VALUE

The content of the namelist w/o the namelist's begin and end tags (i.e. &name, / or &end).

ERRORS

Upon a parsing error (either EOF or if the namelist was not found) an error is triggered and error-code is set to PARSE_ERROR

SOURCE

    variable errInfo 
    variable errCode 

    set nmlName &[string trimleft $nmlName &]

    while {1} {
        incr nl
        set line [readline_ $fileChannel]

        # allow for, e.g., &NAMELIST,var=value ...
        set name [lindex [regsub , $line { }] 0]
        
        if { $nl == 1 } { set name_1st $name }
        
        if { [string toupper $name] eq [string toupper $nmlName] } {
            if { $match_first && $nl > 1 } {
                # the namelist wasn't found at the first non-empty line
                close $fileChannel
                error "expected namelist $nmlName, but got \"$name_1st\""  $errInfo $errCode
            }
            break
        }
        if { [eof $fileChannel] } {
            if { $must_exist } {
                close $fileChannel
                error "end of file while searching for namelist $nmlName"  $errInfo $errCode
            }
            return {}
        }
    }    
    
    # strip the nmlName from line               
    set line [regsub -nocase "^$nmlName" $line {}]
        
    set s ';  # single-quote
    set d \"; # double-quote    
    set q -1;       # stores the quoted character
    set inside_q 0; # inside|outside the quoted string
    set result  {}; # resulting correctly-delimiter-split list
    set end      0; # will be 1 when encountering end-of-namelist

    while {1} {

        foreach c [split $line\n {}] {
            
            if { ! $inside_q } {
                
                # outside quoted string

                if { $c eq "!" } {
                    # it's comment, skip the rest of the line
                    append result \n
                    break
                }
                if { $c eq "/" } {
                    # it's the end of namelist character
                    set end 1
                    break
                }

                if { $c eq $s || $c eq $d } {
                    # string starting quote
                    set q $c
                    set inside_q 1
                }
                    
                if { [regexp $delim_re $c] } {
                    if { [info exists word]} {
                        # delimiter outside the string --> it's delimiter
                        if { [string tolower $word] eq "&end" } {
                            #  it's the end of namelist character
                            set end 1
                            break
                        }
                        unset word
                    }
                } else {
                    append word $c
                }               
            } else {
                # inside quoted string
            
                if { $c eq $q } {
                    # string ending quote
                    set inside_q 0
                }
                append word $c
            }
            append result $c
        }
        
        if { $end } {
            # trim possible &end
            return [regsub -nocase {&end$} $result {}]
        }
        if { $must_exist && [eof $fileChannel] && $end == 0 } {
            error "end of file, while reading namelist $nmlName"  $errInfo $errCode
        }

        set line [readline_ $fileChannel]
    }
    return {}
}

TABLE OF CONTENTS

::fnml::getContent