Index: openacs-4/packages/acs-tcl/tcl/json-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/json-procs.tcl,v
diff -u -r1.11.2.3 -r1.11.2.4
--- openacs-4/packages/acs-tcl/tcl/json-procs.tcl	7 Jul 2024 10:18:33 -0000	1.11.2.3
+++ openacs-4/packages/acs-tcl/tcl/json-procs.tcl	23 Jul 2024 13:31:42 -0000	1.11.2.4
@@ -366,7 +366,7 @@
                 return [util::json::array2json $arg]
             }
             default {
-                if { ![string is double -strict $value] 
+                if { ![string is double -strict $value]
                     && ![regexp {^(?:true|false|null)$} $value]} {
                     set value "\"$value\""
                 }
@@ -588,8 +588,8 @@
             -object [util::json::object::create \
                         [list a [util::json::object::create [list d null]]]] \
             -path {a b c} \
-            -value 3]  
- 
+            -value 3]
+
     Result:
 
     {"a":{"b":{"c":3},"d":null}}
@@ -653,6 +653,65 @@
     return [join $output \n]
 }
 
+
+ad_proc -private util::tdomNodes2dict { nodes } {
+
+    Helper proc for util::json2dict, which outputs the tDOM structure
+    in the form of a Tcl dict.
+
+    Use this proc only on dom structures created with "porse -json",
+    since it depends on the internal node structure of tDOM. It would
+    be certainly better to have this function built-in in tDOM (call
+    like "asDict", similar to "asXML")
+
+    @return dict
+    @author Gustaf Neumann
+} {
+    set result ""
+    foreach n $nodes {
+        set children [$n childNodes]
+        #puts "tdomNodes2dict $n [$n jsonType] [$n nodeName] <[$n nodeValue]> #children [llength $children]"
+        set childrendValue [tdomNodes2dict $children]
+
+        switch [$n jsonType] {
+            OBJECT {
+                if {[$n nodeName] ne "objectcontainer"} {
+                    lappend result [$n nodeName] $childrendValue
+                } else {
+                    lappend result $childrendValue
+                }
+            }
+            NONE -
+            ARRAY {
+                lappend result [$n nodeName] $childrendValue
+            }
+            default {
+                set op [expr {[llength $nodes] > 1 ? "lappend" : "set"} ]
+                $op result [$n nodeValue]
+            }
+        }
+    }
+    #puts "tdomNodes2dict returns <$result>"
+    return $result
+}
+
+ad_proc util::json2dict { jsonText } {
+
+    Parse JSON text into a Tcl dict.
+
+    This function is NOT based on the functions from the
+    "util::json::" namepsace, and is built on top of tDOM.  It is a
+    replacement for the "json::json2dict" in the tcllib package
+    "json", but is on sample documents several times faster.
+
+    @param jsonText JSON text
+    @return dict containing the JSON objects represented by jsonText
+    @author Gustaf Neumann
+} {
+    #ns_log notice "PARSE\n$jsonText"
+    return [util::tdomNodes2dict [[dom parse -json $jsonText] childNodes]]
+}
+
 # Local variables:
 #    mode: tcl
 #    tcl-indent-level: 4
Fisheye: Tag 1.1 refers to a dead (removed) revision in file `openacs-4/packages/acs-tcl/tcl/test/json-test-procs.tcl'.
Fisheye: No comparison available.  Pass `N' to diff?