Tcl и JSON

Все чаще использую формат JSON, но средства его генерации в тикле... как бы это сказать... ужасают. В tcllib и вовсе неработающий код (да, deb-пакет tcllib пересобрал, заодно обновив версию, ибо безобразие это надо лечить). Пересмотрел множество реализаций, и что же - все авторы спотыкаются на несоответствии типов данных. Как пример:

set json [::json::encode [list object [list code [list string $code] msg [list string $msg] id [list number $id]]]]

Одним словом, интуитивно понятным такой код не назовешь.

Самое интересное, что JSON - нетипизированный формат. А раз нетипизированный, то нет никакой необходимости указывать эти самые типы, как это делается во многих реализациях. Значит, можно сделать следующим образом - тиклевскому array (в виде списка, разумеется) ставим в соответствие JSON object, а тиклевскому list - JSON array. В Tcl array будем рассматривать ключи как строки (и, если нужно, эскейпить и заключать в дойные кавычки). Отсюда получаем следующую реализацию:

# keys are not escaped!
# values may be any json serialized objects, arrays or strings
proc json::object {args} {
    # 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} $args {
        # key must always be a string, val may be a number, string or
        # bare word (true|false|null)
        append json "\"$key\": $val," \n
    }

    return "\{\n${json}\}"
}

# keys are not escaped!
# values will be escaped
proc json::object_escaped {args} {
    # XXX: Currently this API isn't symmetrical, as to create proper
    # XXX: JSON text requires type knowledge of the input data
    set json ""

    foreach {key val} $args {
        # key must always be a string, val may be a number, string or
        # bare word (true|false|null)
        append json "\"$key\": [json::string_escaped $val]," \n
    }

    return "\{\n${json}\}"
}

# each argument must be prepared as correct json representation!
proc json::array {args} {
    return \[[join $args ,]\]
}

# each argument must be prepared as correct json representation!
proc json::array_escaped {args} {
    return \[[join [json::string_escaped $args] ,]\]
}

# see http://www.json.org/
proc json::string_escaped {val} {
    if {[string is double -strict $val]==1
        || $val eq {true} 
        || $val eq {false} 
        || $val eq {null}
    } {
        return $val
    }
    # table of character substitutions
    set meta {\" \\" \\ \\\\ \/ \\/ \b \\b \f \\f \n \\n \r \\r \t \\t}
    return \"[string map $meta $val]\"
}

Следует отметить, что некоторые последовательности Unicode также следует обрабатывать, но пока не вижу в том потребности.

А вот и код функции ns_returnjson для AOLServer (замечу, что я собрал AOLServer с Tcl 8.5, который предоставляет возможность раскрытия списков с помощью конструкции {*}):

package require json

proc ns_returnjson {args} {
    ns_return 200 text/plain [::json::object_escaped {*}$args]
}

Mime-тип указан "text/plain", т.к. иначе браузер предлагает сохранить полученный JSON-контент в файл. Да и в принципе непонятно, какой же тип "правильный" - то ли application/json, то ли text/x-json (или даже application/jsonrequest)...

В качестве ремарки примечание для javascript-девелоперов - в новых версиях браузеров перестала работать поддержка формата JSON многими яваскрипт-библиотеками. При указании типа данных JSON, Firebug выдает следующую ошибку "missing } in XML expression". Бороться с этим можно так:

// response = doc.body.innerHTML;
if (doc.body.getElementsByTagName("pre")[0] != undefined) {
    response = doc.body.getElementsByTagName("pre")[0].innerHTML;
} else {
    response = doc.body.innerHTML;
}

Как ни странно, готового решения вышеназванной проблемы в сети найти не удалось, пришлось разбираться самому. Как же достает временами этот самый яваскрипт...

Upd. 2009-10-24

В ИЕ6 некорректно работает разбор json, сгенерированного приведенным выше модулем. Приведенный ниже патч решает проблему.

--- json.tcl.old        2009-06-01 11:32:18.000000000 +0400
+++ json.tcl    2009-10-24 11:53:00.000000000 +0400
@@ -253,14 +253,12 @@
     # 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} $args {
         # key must always be a string, val may be a number, string or
         # bare word (true|false|null)
-        append json "\"$key\": $val," \n
+        lappend json \"$key\":$val
     }
-
-    return "\{\n${json}\}"
+    return \{[join $json ,]\}
 }

 # keys are not escaped!
@@ -269,14 +267,12 @@
     # XXX: Currently this API isn't symmetrical, as to create proper
     # XXX: JSON text requires type knowledge of the input data
     set json ""
-
     foreach {key val} $args {
         # key must always be a string, val may be a number, string or
         # bare word (true|false|null)
-        append json "\"$key\": [json::string_escape $val]," \n
+        lappend json \"$key\":[json::string_escape $val]
     }
-
-    return "\{\n${json}\}"
+    return \{[join $json ,]\}
 }

 # each argument must be prepared as correct json representation!

Upd.
Как подсказывает Anton Kovalenko, при обработке строк вида "01" в моей реализации будет потерян "0". Поправить можно или проверкой для чисел, не начинаются ли они с нуля, или представлением всех чисел в виде строки. Пока не решил, какой вариант лучше.