json tcllib package needed improvements
Bezoar
used the tcllib json package. My first order of business was to see
what keys were needed to access the data I wanted. I wrote a proc to
recurse into the dict and it fails. The first problem I encountered is
that an json array is converted to a list so for instance for the
following json snippet which represents a javascript array:
..."link":["rel","alternate","type","text html","href"],...
is converted to this dict snippet
.... link { rel alternate type {text html} href } ....
there is no way to tell the resulting dict to not interpet list as a
dict. You have to know this before hand. So if your input changes so
does your code. Since javascript would access the results of the as
link[0] == "rel" why not auto index when converting to dict. I
changed my json2dict function to do that so now for the example above
the following results.
.... link { 0 rel 1 alternate 2 type 3 {text html} 4 href } ....
Thats pretty good but then the next problem cropped up notice the
{ text html } ? Is it text or another dict? My function to pull out
the keys of a dict would indeed take "text" as a key with "html" as
its value. Output form getDictKeys (code below) :
...link->0
...link->1
...link->2
...link->3
...link->3->text
...link->4
If you did not know what to expect (and you won't) this is bad news. I
changed the json2dict script to maintain the quotes about the values
and now the json above is converted to:
.... link { 0 "rel" 1 "alternate" 2 "type" 3 {"text html"} 4
"href" } ....
now output from getDictkeys is better:
...link->0
...link->1
...link->2
...link->3
...link->4
These changes are slight and I would like any comments before I
submit this as a bug fix/feature requrest to the tcllib tracker. I
include the following driver script that accesses googles feeds
service with a request for data that matches a books. I used 8.6b.2
but this should run fine for 8.5/8.4 with dict pkg. My only other
question concerns the use of catch to determine if any more keys are
present. I could not find any means to test for this
without catching the error. Perhaps someone can suggest a means?
========DRIVER ===========
#!/bin/sh
# the next line restarts using wish \
exec /opt/usr8.6b.2/bin/tclsh8.6 "$0" ${1+"$@"}
proc getDictKeys { d args } {
# use -terminalsonly to get keys that are leafs
# use default sep to get list o keys
set allowopts [list -terminalsonly -sep ]
array set opts { -terminalsonly 0 -sep " " }
array set opts $args
set badopt ""
foreach option [array names opts ] {
if { $option ni $allowopts } {lappend badopt $option }
}
if { [llength $badopt ] } {
error "Unknown option(s) [join $badopt ,]! Only options [join
$allowopts ,] allowed"
}
set retval ""
set keys {}
try {
set keys [dict keys $d ]
} on error { a b } {
return $retval;
}
foreach key $keys {
set found 0
foreach subkey [getDictKeys [dict get $d $key ] \
-terminalsonly $opts(-terminalsonly) \
-sep $opts(-sep)] {
set found 1
lappend retval "${key}$opts(-sep)$subkey"
}
if { !$found && $opts(-terminalsonly) } {
lappend retval "$key"
}
}
return $retval
}
proc printDict {dict {margin "" } } {
upvar $dict d
foreach keyset [getDictKeys $d -terminalsonly 1 ] {
puts "[join $keyset "->"] : [dict get $d {*}$keyset]"
}
}
if { [ catch {package require http } err ] != 0 } {
puts stderr "Unable to find package http ... adjust your
auto_path!";
}
if { [ catch {package require json } err ] != 0 } {
puts stderr "Unable to find package json ... \n$err\nadjust your
auto_path!";
}
set isbn 9780596004965
set getkeys {feed entry 0 content \$t }
set baseurl {http://www.google.com/base/feeds/snippets}
set querystring [::http::formatQuery bq "\[isbn:\"$isbn\"\]" alt json
max-results 1 ]
set token [::http::geturl $baseurl?$querystring ]
set reply [::json::json2dict [http::data $token ] -indexlists true ]
# output received json object
puts "[http::data $token]"
# output raw dict
puts "$reply"
# get all keys that are terminals only
puts "\nkeys\n[join [getDictKeys $reply -terminalsonly 1 -sep " " ]
\n]"
#pull out all terminal data elements.
puts "\n[string repeat = 80]\n[printDict reply ]\n[string repeat =
80 ]"
# pull out one data element
puts "[join $getkeys "->" ] = [dict get $reply {*}$getkeys]"
=============== END DRIVER ==============
=========== MODIFIED json.tcl file =tcllib 1.11.1
======================
#
# JSON parser for Tcl.
#
# See http://www.json.org/ && http://www.ietf.org/rfc/rfc4627.txt
#
# Copyright 2006 ActiveState Software Inc.
#
# $Id: json.tcl,v 1.2 2006/08/25 23:19:53 hobbs Exp $
#
# C jolly - added option to number lists changed code to always
# quote values
if {$::tcl_version < 8.5} {
package require dict
}
package provide json 1.1
namespace eval json {
variable autoindex false
}
proc json::getc {{txtvar txt}} {
# pop single char off the front of the text
upvar 1 $txtvar txt
if {$txt eq ""} {
return -code error "unexpected end of text"
}
set c [string index $txt 0]
set txt [string range $txt 1 end]
return $c
}
proc json::json2dict {txt args } {
variable autoindex
array set opts { -indexlists 0 }
array set opts $args
if { [array size opts ] > 1 } {
foreach item [array names opts ] {
if { ![string match "-indexlists" $item ] } {
lappend extraopt $item
}
}
return -code error \
"unexpected option(s) [join $extraopt , ] ! Only -indexlists option
permitted"
}
set autoindex $opts(-indexlists)
return [_json2dict]
}
proc json::_json2dict {{txtvar txt}} {
variable autoindex
upvar 1 $txtvar txt
set lcount -1
set state TOP
set txt [string trimleft $txt]
while {$txt ne ""} {
set c [string index $txt 0]
# skip whitespace
while {[string is space $c]} {
getc
set c [string index $txt 0]
}
if {$c eq "\{"} {
# object
switch -- $state {
TOP {
# we are dealing with an Object
getc
set state OBJECT
set dictVal [dict create]
}
VALUE {
# this object element's value is an Object
dict set dictVal $name [_json2dict]
set state COMMA
}
LIST {
# next element of list is an Object
if { $autoindex } {
lappend listVal [incr lcount] [_json2dict]
} else {
lappend listVal [_json2dict]
}
set state COMMA
}
default {
return -code error "unexpected open brace in $state mode"
}
}
} elseif {$c eq "\}"} {
getc
if {$state ne "OBJECT" && $state ne "COMMA"} {
return -code error "unexpected close brace in $state mode"
}
return $dictVal
} elseif {$c eq ":"} {
# name separator
getc
if {$state eq "COLON"} {
set state VALUE
} else {
return -code error "unexpected colon in $state mode"
}
} elseif {$c eq ","} {
# element separator
if {$state eq "COMMA"} {
getc
if {[info exists listVal]} {
set state LIST
} elseif {[info exists dictVal]} {
set state OBJECT
}
} else {
return -code error "unexpected comma in $state mode"
}
} elseif {$c eq "\""} {
# string
# capture quoted string with backslash sequences
set reStr {(?:(?:\")(?:[^\\\"]*(?:\\.[^\\\"]*)*)(?:\"))}
set string ""
if {![regexp $reStr $txt string]} {
set txt [string replace $txt 32 end ...]
return -code error "invalid formatted string in $txt"
}
set txt [string range $txt [string length $string] end]
# chop off outer ""s and substitute backslashes
# This does more than the RFC-specified backslash sequences,
# but it does cover them all
set string [subst -nocommand -novariable \
[string range $string 1 end-1]]
switch -- $state {
TOP {
return $string
}
OBJECT {
set name $string
set state COLON
}
LIST {
if { $autoindex } {
lappend listVal [incr lcount] [_json2dict]
} else {
lappend listVal [_json2dict]
}
set state COMMA
}
VALUE {
dict set dictVal $name \"$string\"
unset name
set state COMMA
}
}
} elseif {$c eq "\["} {
# JSON array == Tcl list
switch -- $state {
TOP {
getc
set state LIST
set lcount -1
}
LIST {
if { $autoindex } {
lappend listVal [incr lcount] [_json2dict]
} else {
lappend listVal [_json2dict]
}
set state COMMA
}
VALUE {
dict set dictVal $name [_json2dict]
set state COMMA
}
default {
return -code error "unexpected open bracket in $state mode"
}
}
} elseif {$c eq "\]"} {
# end of list
getc
if {![info exists listVal]} {
#return -code error "unexpected close bracket in $state mode"
# must be an empty list
return ""
}
return $listVal
} elseif {0 && $c eq "/"} {
# comment
# XXX: Not in RFC 4627
getc
set c [getc]
switch -- $c {
/ {
# // comment form
set i [string first "\n" $txt]
if {$i == -1} {
set txt ""
} else {
set txt [string range $txt [incr i] end]
}
}
* {
# /* comment */ form
getc
set i [string first "*/" $txt]
if {$i == -1} {
return -code error "incomplete /* comment"
} else {
set txt [string range $txt [incr i] end]
}
}
default {
return -code error "unexpected slash in $state mode"
}
}
} elseif {[string match {[-0-9]} $c]} {
# one last check for a number, no leading zeros allowed,
# but it may be 0.xxx
string is double -failindex last $txt
if {$last > 0} {
set num [string range $txt 0 [expr {$last - 1}]]
set txt [string range $txt $last end]
switch -- $state {
TOP {
return $num
}
LIST {
if { $autoindex } {
lappend listVal [incr lcount] [_json2dict]
} else {
lappend listVal [_json2dict]
}
set state COMMA
}
VALUE {
dict set dictVal $name $num
set state COMMA
}
default {
getc
return -code error "unexpected number '$c' in $state mode"
}
}
} else {
getc
return -code error "unexpected '$c' in $state mode"
}
} elseif {[string match {[ftn]} $c]
&& [regexp {^(true|false|null)} $txt val]} {
# bare word value: true | false | null
set txt [string range $txt [string length $val] end]
switch -- $state {
TOP {
return $val
}
LIST {
lappend listVal [incr lcount ] $val
set state COMMA
}
VALUE {
dict set dictVal $name $val
set state COMMA
}
default {
getc
return -code error "unexpected '$c' in $state mode"
}
}
} else {
# error, incorrect format or unexpected end of text
return -code error "unexpected '$c' in $state mode"
}
}
}
proc json::dict2json {dictVal} {
# XXX: Currently this API isn't symmetrical, as to create proper
# XXX: JSON text requires type knowledge of the input data
set json ""
dict for {key val} $dictVal {
# key must always be a string, val may be a number, string or
# bare word (true|false|null)
if {0 && ![string is double -strict $val]
&& ![regexp {^(?:true|false|null)$} $val]} {
set val "\"$val\""
}
append json "\"$key\": $val," \n
}
return "\{${json}\}"
}
proc json::list2json {listVal} {
return "\[$[join $listVal ,]\]"
}
proc json::string2json {str} {
return "\"$str\""
}
tom.rmadilo
> I am trying to parse a json reply from a web server so I naturally
> used the tcllib json package. My first order of business was to see
> what keys were needed to access the data I wanted. I wrote a proc to
> recurse into the dict and it fails. The first problem I encountered is
> that an json array is converted to a list so for instance for the
> following json snippet which represents a javascript array:
>
> ..."link":["rel","alternate","type","text html","href"],...
>
> is converted to this dict snippet
>
> .... link { rel alternate type {text html} href } ....
>
> there is no way to tell the resulting dict to not interpet list as a
> dict. You have to know this before hand. So if your input changes so
> does your code. Since javascript would access the results of the as
> link[0] == "rel" why not auto index when converting to dict. I
> changed my json2dict function to do that so now for the example above
> the following results.
I wrote a json parser which creates a Tcl list which can be converted
back to a json structure:
Code is in the .tcl~ files, or you can try out the conversion with the
web form.
The code has no helper functions to look up data, or anything to
create a json structure, but it does create a Tcl encoding which
distinguishes the different structural elements to any depth.
The main difference between json and tcl structures is that both
arrays and lists are anonymous in json, not sure if a dict actually
matches up with a json structure.