X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=json.tcl;h=1acd13f16877d6d2146f9e0e52b36ed5ff59ec72;hb=4bac215042d68670cd0a8245825bae99f64af989;hp=9d382e673e4fdde740f6abaa72118afdc3f7cc22;hpb=5d26694fefe30bc2d4340aba1b1f8b7c71f6183d;p=scpubgit%2FTenDotTcl.git diff --git a/json.tcl b/json.tcl index 9d382e6..1acd13f 100644 --- a/json.tcl +++ b/json.tcl @@ -32,6 +32,13 @@ namespace eval ten::json { return $num } + proc decomma {str} { + switch [string index $str end] { + , { string range $str 0 end-1 } + default { return $str } + } + } + proc list {args} { variable indent variable nl @@ -41,6 +48,7 @@ namespace eval ten::json { append out $nl$indent append out [ deparse $el ], } + set out [ decomma $out ] outdent_one append out $nl$indent\] return $out @@ -54,14 +62,15 @@ namespace eval ten::json { dict for {k v} $args { append out $nl$indent[ str $k ]:\ [ deparse $v ], } + set out [ decomma $out ] outdent_one append out $nl$indent\} } proc deparse {data} { switch -regexp [lindex $data 0] { - ^true|false|null$ { lindex $data 0 } - ^num|str|obj|list$ { eval $data } + ^(true|false|null)$ { lindex $data 0 } + ^(num|str|obj|list)$ { eval $data } default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] } } } @@ -90,8 +99,8 @@ namespace eval ten::json { proc tclify {data} { switch -regexp [lindex $data 0] { - ^true|false|null$ { uplevel 1 return [lindex $data 0] } - ^num|str|obj|list$ {} + ^(true|false|null)$ { uplevel 1 return [lindex $data 0] } + ^(num|str|obj|list)$ {} default { error [ concat "Invalid JSON type " [lindex $data 0 0] ] } } eval $data @@ -106,30 +115,57 @@ namespace eval ten::json { variable json - proc eat_comma {} { + proc eat_spaces {} { variable json set json [string trimleft $json] - if {[string index $json 0] eq ","} { - set json [string range $json 1 end] + } + + proc eat_char {char} { + variable json + eat_spaces + if {[string index $json 0] eq "$char"} { + eat_any } } - proc eat_char {} { + proc eat_any {} { variable json set json [ string range $json 1 end ] } proc parse_list {} { variable json - eat_char + eat_any set tcl {list} while {"$json" ne ""} { + eat_spaces if {[string index $json 0] eq "]"} { - eat_char + eat_any + return $tcl + } + lappend tcl [ parse ] + eat_char , + } + error "Ran out of JSON. Confused now." + } + + proc parse_obj {} { + variable json + eat_any + set tcl {obj} + while {"$json" ne ""} { + eat_spaces + if {[string index $json 0] eq "\}"} { + eat_any return $tcl } + eat_spaces + lappend tcl [ parse_str ] + eat_spaces + eat_char : + eat_spaces lappend tcl [ parse ] - eat_comma + eat_char , } error "Ran out of JSON. Confused now." } @@ -139,7 +175,7 @@ namespace eval ten::json { # like Text::Balanced except ugly (borrowed from tcvJSON's code) set reStr {(?:(?:\")(?:[^\\\"]*(?:\\.[^\\\"]*)*)(?:\"))} if {![regexp $reStr $json string]} { - error [ concat "Invalid string: " [string range $json 0 32] + error "Invalid string: $json" } set json [string range $json [string length $string] end] # chop off outer ""s and substitute backslashes @@ -159,9 +195,19 @@ namespace eval ten::json { list num $num } + proc parse_bare {} { + variable json + if [regexp {^(true|false|null)} $json matched] { + set json [ string range $json [ string length $matched ] end ] + return $matched + } else { + error "Out of ideas parsing: $json" + } + } + proc parse {} { variable json - set json [string trimleft $json] + eat_spaces if {$json eq ""} { return } @@ -172,7 +218,7 @@ namespace eval ten::json { {[-0-9]} { parse_num } - default { error "argh" } + default { parse_bare } } } } @@ -180,11 +226,14 @@ namespace eval ten::json { proc parse_json {json} { set parse::json [ string trim $json ] set result [ parse::parse ] - if {[string trimleft $parse::json] ne ""} { + parse::eat_spaces + if {$parse::json ne ""} { error "Had JSON left over: $parse::json" } return $result } + + namespace export parse_json deparse_json tclify_json } set ex_json { list {str foo} {num 0} {obj __remote_object__ {str 512}} {null} } @@ -200,12 +249,44 @@ set jtext { ] } -puts [ ten::json::deparse_json $ex_json 2 ] +namespace eval ten::connection { + + proc receive_data_for {name} { + + + proc conn_setup {name input output initial_handlers} { + variable "${name}_input" $input + variable "${name}_input_closed" "" + variable "${name}_output" $output + variable "${name}_handlers" + array set "${name}_handlers" $initial_handlers + fileevent $input readable [list receive_data_for $name] + puts $output Shere + } + + proc run_until_close {name} { + vwait "${name}_input_closed" + set close_value "\$${name}_input_closed" + teardown $name + return $close_value + } + + proc teardown {name} { + close [ expr "\$${name}_output" ] + unset "${name}_input" + unset "${name}_input_closed" + unset "${name}_output" + unset "${name}_handlers" + } + +namespace import ten::json::* + +puts [ deparse_json $ex_json 2 ] -dict for {k v} [ ten::json::tclify_json [ - lindex [ ten::json::tclify_json $ex_json ] 2 +dict for {k v} [ tclify_json [ + lindex [ tclify_json $ex_json ] 2 ] ] { puts "$k: $v" } -#puts [ ten::json::parse_json $jtext ] +puts [ parse_json $jtext ] -puts [ ten::json::parse_json {["foo",2345,["bar"]]} ] +puts [ parse_json {["foo",2345,["bar"]]} ]