Updated 2015-09-04 02:16:24 by venks

This contains a simple one way json to tcl converter. It converts JSON objects to Tcl dicts and JSON arrays to Tcl lists.

Usage is: set var [getjson filename.json]
proc toks2var {l i} {
    upvar $i idx
    set state idle 
    set tok [lindex $l $idx]
    incr idx
    switch -- $tok {
        "\{" {        
            # object.  Converts to a dict
            set r [dict create]
            while {[set tok [lindex $l $idx]] ne "\}"} {
                if {[string index $tok 0] ne "\"" || [string index $tok end] ne "\""} {
                   error "Paranoid. Must get String, but got $tok. (So far have $r)"
                }
                incr idx
                if {[lindex $l $idx] ne ":"} {
                   error "Paranoid. Must have : as second token in object"
                }
                incr idx
                dict set r [string range $tok 1 end-1] [toks2var $l idx]
                set tok [lindex $l $idx]
                if {$tok eq ","} {
                    incr idx
                } elseif {$tok ne "\}"} {
                    error "Paranoid. Must have a , or a \} after object item"
                }
            }
            incr idx
            return $r
        }
        "\[" {
            set r [list]
            while {[set tok [lindex $l $idx]] ne "\]"} {
                lappend r [toks2var $l idx]
                set tok [lindex $l $idx]
                if {$tok eq ","} {
                    incr idx
                } elseif {$tok ne "\]"} {
                    error "Paranoid. Must have a , or a \] after list item, Got $tok"
                }
            }
            incr idx
            return $r
        }
        true - false - null {
            return $tok
        }
        default {
            if {[string index $tok 0] eq "\""} {
                if {[string index $tok end] ne "\""} {
                    error "Paranoid.  String $tok starts with a quote but doesn't end with one."
                }
                return [string range $tok 1 end-1]
            }
            if {![string is double $tok]} {
                error "Paranoid.  Unknown non-number $tok"
            }
            return $tok
        }
    }
}

proc getjson {fn} {
    set fi [open $::tdir/$fn]
    set toks [list]
    foreach {junk tok} [regexp -inline -expanded -all -- {
        [[:space:]]* |
        (
         [{}\[\],:] |
         "(?:[^\\\"]|\\[\"\\/bfnrt]|\\u[[:xdigit:]]{4})*" |
         true|false|null |
         -?(?:0|[1-9][[:digit:]]*)(?:[.][[:digit:]]+)?(?:[eE][+-]?[[:digit:]]+)?
         )
    } [read $fi]] {
        lappend toks $tok
    }
    close $fi
    set idx 0
    return [toks2var $toks idx]
}