Связь Tcl и JSON с помощью расширения SQLite

1. Использование SQLite для связи Tcl и JSON

Расширение SQLite для Tcl может служить связующим звеном, устраняя несоответствие между Tcl и JSON и перенося всю обработку и экранирование из Tcl в SQLite с минимальными усилиями. В разделах ниже показаны способы чтения и формирования JSON с помощью SQLite.

1.1. Обработка JSON

Один из простейших способов обработать и разобрать данные JSON — передать их в SQLite и извлечь результаты с помощью функции lassign в Tcl:

set json theJSON...
lassign [db eval {
  with payload(j) as (select jsonb($json)) select
  -- A simple value:
  j->>'foo',
  -- A sub-object or array:
  CASE WHEN json_valid(j->>'bar') THEN j->>'bar' ELSE NULL END
  -- Any other fields...
  from payload
}] foo bar

Массивы можно загрузить с помощью json_each():

set json {[1, "two", 3.0, {"nested": true}, null]}
set myList [db eval {
  select value from json_each($json)
}]

# Emits: 1 two 3.0 {{"nested":true}} {}

Массивы объектов можно преобразовать в список объектов dict:

set json {[{"id":1, "v":"A"}, {"id":2, "v":"B"}]}
set myDictList [db eval {
  select json_object('id', value->>'id', 'v', value->>'v')
  from json_each($json)
}]

# Emits: {{"id":1,"v":"A"}} {{"id":2,"v":"B"}}

Элементы объектов в массивах объектов можно извлечь способом, подобным описанному в первом примере выше.

1.2. Формирование JSON: таблица БД как объект JSON

Описанный здесь подход использует базу данных в памяти для поэтапного построения объекта JSON и автоматически обрабатывает различия между типами данных, например числами и строками.

#
# Initialize, if needed, the sqlite3 connection for the JR temp db and
# return its command name.
#
# JR = JSON Response (to an HTTP request)
#
proc jr-db {} {
  if {"" eq [info command ::__jrdb]} {
    sqlite3 ::__jrdb ":memory:"
    ::__jrdb eval {
      -- Holds a list of key/value pairs for a JSON response object
      create table jr(k TEXT UNIQUE ON CONFLICT REPLACE,v ANY);
    }
  }
  return ::__jrdb
}

#
# Remove all entries from the JR buffer.
#
proc jr-reset {args} {
  [jr-db] eval {delete from jr}
}

#
# Set one or more key/value pairs in the JR object.
#
proc jr-set {args} {
  set db [jr-db]
  foreach {k v} $args {
    $db eval {insert into jr(k,v) values($k,$v)}
  }
}

#
# Returns a JSON-format object representing the current JR state.
#
proc jr-get {} {
  [jr-db] onecolumn {
    select json_group_object(k,CASE WHEN json_valid(v,1)
                             THEN json(v) ELSE v END) from jr
  }
}

Пример использования:

jr-set message "This is a message."
jr-set aBool true isNull null anInt 37 aFloat 42.42
puts [jr-get]

Результат:

{"message":"This is a message.","aBool":true,"isNull":null,"anInt":37,"aFloat":42.42}

1.3. Формирование JSON: поэтапное построение

В описанном здесь подходе используются две процедуры для поэтапного построения вложенного объекта или массива с корректной обработкой типов, благодаря чему целые числа, null и значения, похожие на логические, выводятся как есть, а не как строки.

#
# Returns the command name of the shared SQLite3 instance used by the
# X-to-JSON APIs, initializing it on demand.
#
proc json-db {} {
  if {"" eq [info command ::__jsonDb]} {
    sqlite3 ::__jsonDb ":memory:"
  }
  return ::__jsonDb
}

#
# Given a dict-style object, this creates a JSON object representation.
# It does not handle nested objects but each value may itself be the result
# of its own call to this method, which has a similar effect.
#
proc json-obj {kvps} {
  set q "select json_object("
  set n 0
  set nn 1
  foreach {k v} $kvps {
    set $n $k
    set $nn $v
    if {$n} {append q ","}
    append q "\$$n, CASE WHEN json_valid(\$$nn) THEN json(\$$nn) ELSE \$$nn END"
    # This may look like an SQL injection opportunity, but it's
    # injecting prepared statement placeholders, not values.
    incr n 2
    incr nn 2
  }
  append q ")"
  [json-db] onecolumn $q
}

#
# Returns a JSON-format array of the given arguments. See json-object
# for notes about nesting.
#
proc json-array {args} {
  set n 0
  set q "select json_array("
  foreach a $args {
    set $n $a
    if {$n} {append q ","}
    append q "CASE WHEN json_valid(\$$n) THEN json(\$$n) ELSE \$$n END"
    incr n
  }
  append q ")"
  [json-db] onecolumn $q
}

Пример использования:

proc json-pretty {arg {space "  "}} {
  [json-db] onecolumn {select json_pretty($arg,$space)}
}
set o {
  hi world
  number 17.3
  truth true
  lies false
  nil null
  nada "null"
  notNull "Null"
}
lappend o list [json-array hello there [json-obj {nested true}]]
lappend o obj [json-obj {name "Nested object"}]
puts [json-pretty [json-obj $o]]

Результат:

{
  "hi": "world",
  "number": 17.3,
  "truth": true,
  "lies": false,
  "nil": null,
  "nada": null,
  "notNull": "Null",
  "list": [
    "hello",
    "there",
    {
      "nested": true
    }
  ],
  "obj": {
    "name": "Nested object"
  }
}

Последнее обновление этой страницы: 2026-02-24 16:01:53Z