Skip to content

Commit

Permalink
Merge branch 'master' of github.com:flightaware/yajl-tcl
Browse files Browse the repository at this point in the history 
Conflicts:
	ChangeLog

BUGZID:
  • Loading branch information
@lehenbauer
lehenbauer committed Jul 6, 2012
2 parents dcb1482 + 1cb6988 commit 30965b0
Show file tree
Hide file tree
Showing 2 changed files with 67 additions and 58 deletions.
4 changes: 4 additions & 0 deletions ChangeLog
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,10 @@
<<<<<<< HEAD
2012-07-06 karl
* Comments.

2012-06-26 bovine
* Improve performance of json2dict method by reducing copying

2012-02-15 bovine
* Make the "parse" command output "bool" commands instead of "boolean"
to avoid roundtrip failure (Issue 5)
Expand Down
121 changes: 63 additions & 58 deletions yajl.tcl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,14 +8,15 @@ package require yajltcl

namespace eval ::yajl {

# helper method used by json2dict
proc yajl_array_to_list {_yajl} {
# internal helper method used by json2dict
proc yajl_array_to_list {_yajl _index yajlLength} {
upvar $_yajl yajl
upvar $_index index

set result {}
while {$yajl != ""} {
set first [lindex $yajl 0]
set yajl [lrange $yajl 1 end]
while {$index < $yajlLength} {
set first [lindex $yajl $index]
incr index
switch -exact $first {
"array_close" {
return $result
Expand All @@ -25,20 +26,20 @@ proc yajl_array_to_list {_yajl} {
"double" -
"number" -
"string" {
set val [lindex $yajl 0]
set yajl [lrange $yajl 1 end]
set val [lindex $yajl $index]
incr index
lappend result $val
}
"null" {
lappend result "null"
}
"array_open" {
# nested array
lappend result [yajl_array_to_list yajl]
lappend result [yajl_array_to_list yajl index $yajlLength]
}
"map_open" {
# nested map
lappend result [yajl_map_to_list yajl]
lappend result [yajl_map_to_list yajl index $yajlLength]
}
default {
error "unexpected yajl tag: $first"
Expand All @@ -48,13 +49,15 @@ proc yajl_array_to_list {_yajl} {
error "reached end of yajl without finding array_close"
}

# helper method used by json2dict
proc yajl_map_to_list {_yajl} {
# internal helper method used by json2dict
proc yajl_map_to_list {_yajl _index yajlLength} {
upvar $_yajl yajl
upvar $_index index

set result {}
while {$yajl != ""} {
set first [lindex $yajl 0]
set yajl [lrange $yajl 1 end]
while {$index < $yajlLength} {
set first [lindex $yajl $index]
incr index
switch -exact $first {
"map_close" {
if {[llength $result] % 2 != 0} {
Expand All @@ -68,20 +71,20 @@ proc yajl_map_to_list {_yajl} {
"double" -
"number" -
"string" {
set val [lindex $yajl 0]
set yajl [lrange $yajl 1 end]
set val [lindex $yajl $index]
incr index
lappend result $val
}
"null" {
lappend result "null"
}
"array_open" {
# nested array
lappend result [yajl_array_to_list yajl]
lappend result [yajl_array_to_list yajl index $yajlLength]
}
"map_open" {
# nested map
lappend result [yajl_map_to_list yajl]
lappend result [yajl_map_to_list yajl index $yajlLength]
}
default {
error "unexpected yajl tag: $first"
Expand All @@ -91,41 +94,42 @@ proc yajl_map_to_list {_yajl} {
error "reached end of yajl without finding map_close"
}

# helper method used by json2dict
proc yajl_atom_to_list {_yajl} {
# internal helper method used by json2dict
proc yajl_atom_to_list {_yajl _index yajlLength} {
upvar $_yajl yajl
upvar $_index index

set result {}
set level 0

if {$yajl != ""} {
set first [lindex $yajl 0]
set yajl [lrange $yajl 1 end]
if {$index < $yajlLength} {
set first [lindex $yajl $index]
incr index
switch -exact $first {
"integer" -
"bool" -
"double" -
"number" -
"string" {
set val [lindex $yajl 0]
set yajl [lrange $yajl 1 end]
set val [lindex $yajl $index]
incr index
lappend result $val
}
"null" {
lappend result "null"
}
"map_open" {
lappend result [yajl_map_to_list yajl]
lappend result [yajl_map_to_list yajl index $yajlLength]
}
"array_open" {
lappend result [yajl_array_to_list yajl]
lappend result [yajl_array_to_list yajl index $yajlLength]
}
default {
error "unexpected yajl tag: $first"
}
}
if {$yajl != ""} {
error "leftover yajl tags: $yajl"
if {$index < $yajlLength} {
error "leftover yajl tags: [lrange $yajl $index end]"
}
}

Expand All @@ -134,14 +138,15 @@ proc yajl_atom_to_list {_yajl} {

#
# json2dict - parse json and return a key-value list suitable for
# loading into a dict or an array. This is usually a friendlier
# loading into a dict or an array. This is usually a friendlier
# format to parse than the direct output of the "get" method.
# (inspired and named after the tcllib proc ::json::json2dict)
#
proc json2dict {jsonText} {
set obj [yajl create #auto]
set yajl [$obj parse $jsonText]
set result [yajl_atom_to_list yajl]
set index 0
set result [yajl_atom_to_list yajl index [llength $yajl]]
$obj delete
return {*}$result
}
Expand All @@ -152,28 +157,28 @@ proc json2dict {jsonText} {
# a yajltcl object
#
proc add_array_to_json {json _array} {
upvar $_array array
upvar $_array array

$json map_open
$json map_open

foreach key [lsort [array names array]] {
$json string $key string $array($key)
}
foreach key [lsort [array names array]] {
$json string $key string $array($key)
}

$json map_close
$json map_close
}

#
# array_to_json - convert an array to json
#
proc array_to_json {_array} {
upvar $_array array
upvar $_array array

set json [yajl create #auto -beautify 1]
add_array_to_json $json array
set result [$json get]
rename $json ""
return $result
set json [yajl create #auto -beautify 1]
add_array_to_json $json array
set result [$json get]
rename $json ""
return $result
}

#
Expand All @@ -182,28 +187,28 @@ proc array_to_json {_array} {
# pairs, one object per tuple in the result
#
proc add_pgresult_tuples_to_json {json res} {
$json array_open
set numTuples [pg_result $res -numTuples]
for {set tuple 0} {$tuple < $numTuples} {incr tuple} {
unset -nocomplain row
pg_result $res -tupleArrayWithoutNulls $tuple row
add_array_to_json $json row
}
$json array_close
$json array_open
set numTuples [pg_result $res -numTuples]
for {set tuple 0} {$tuple < $numTuples} {incr tuple} {
unset -nocomplain row
pg_result $res -tupleArrayWithoutNulls $tuple row
add_array_to_json $json row
}
$json array_close
}

#
# pg_select_to_json - given a connection handle and a sql select statement,
# return the corresponding json as an array of objects of tuples
#
proc pg_select_to_json {db sql} {
set json [yajl create #auto -beautify 1]
set res [pg_exec $db $sql]
add_pgresult_tuples_to_json $json $res
pg_result $res -clear
set result [$json get]
rename $json ""
return $result
set json [yajl create #auto -beautify 1]
set res [pg_exec $db $sql]
add_pgresult_tuples_to_json $json $res
pg_result $res -clear
set result [$json get]
rename $json ""
return $result
}

} ;# namespace ::yajl

0 comments on commit 30965b0

Please sign in to comment.