tclhttpd

Check-in [4c9c257145]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added the tao-sqlite module
Timelines: family | ancestors | descendants | both | 4_0
Files: files | file ages | folders
SHA1:4c9c2571450e95c629e62e84acabcddb14c7e0d9
User & Date: hypnotoad 2015-04-02 10:30:48
Context
2015-04-02
15:43
Adding markdown documentation into the source repo check-in: 001675d4e9 user: hypnotoad tags: 4_0
10:30
Added the tao-sqlite module check-in: 4c9c257145 user: hypnotoad tags: 4_0
10:20
Updated the readme check-in: ee8656421b user: hypnotoad tags: 4_0
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added modules/tao-sqlite/connection.tcl.















































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
###
# topic: 1f4bc558d601dd0621d4f441fcf94b07
# title: High level database container
# description:
#    A taodb::connection
#    <p>
#    This object is assumed to be a nexus of an sqlite connector
#    and several subject objects to manage the individual tables
#    accessed by this application.
###
tao::class taodb::connection {
  superclass tao.onion
  property docentry {}

  ###
  # topic: 124b0e5697a3e0a179a5bc044c735a54
  ###
  method active_layers {} {
    # Return a mapping of tables to their handler classes
    return {}
  }

  ###
  # topic: ad8b51dd1884240d87d7a99ee2a8b862
  ###
  method Database_Create {} {
  }

  ###
  # topic: 7cb96867401c18478a3dfb74b4cd37d8
  ###
  method Database_Functions {} {
  }

  ###
  # topic: 62f531b6d83adc8a10d15b27ec17b675
  ###
  method schema::create_sql {} {
    set result {}
    foreach {layer obj} [my layers] {
      set table [$obj property schema table]
      append result "-- BEGIN $table" \n
      append result [$obj property schema create_sql] \n
      append result "-- END $table" \n
    }
    return $result
  }

  ###
  # topic: fb34f12af081276e36172acfbbea52cf
  ###
  method schema::tables {} {
    set result {}
    foreach {layer obj} [my layers] {
      set table [$obj property schema table]
      lappend result $table
    }
    return $result
  }
}

###
# topic: eaf5daa1dd0baa5e8501e97af3224656
# title: High level database container
# description: A taodb::connection implemented for sqlite
###
tao::class taodb::connection.sqlite {
  superclass taodb::connection tao::onion
  aliases moac.sqliteDb


  option filename {
    widget filename
    extensions {.sqlite {Sqlite Database}}
  }

  option read-only {
    default 0
    widget boolean
  }
  
  option timeout {
    default 30000
    type integer
  }

  ###
  # topic: f71dcb5b2e2312180e379356f3263ff9
  ###
  method attach_sqlite_methods sqlchan {
    my graft db $sqlchan
foreach func {
authorizer
backup
busy
cache
changes
close
collate
collation_needed
commit_hook
complete
copy
enable_load_extension
errorcode
eval
exists
function
incrblob
last_insert
last_insert_rowid
nullvalue
one
onecolumn
profile
progress
restore
rollback_hook
status
timeout
total_changes
trace
transaction
unlock_notify
update_hook
version
    } {
        my forward $func $sqlchan $func
    }
  }

  ###
  # topic: 93c3c991254fd21abc02add7babe5b51
  # title: Evaluate an SQL expression that alters the database
  # description:
  #    This method is a wrapper around "eval" that will catch
  #    "not authorized" messages and give the user some notice that
  #    they should rename the file before altering it.
  ###
  method change args {
    if {[my cget read-only]} {
      my message readOnlyDatabase
      return
    }
    uplevel 1 [list [self] eval {*}$args]
  }

  ###
  # topic: 8a8ecce021e1fcbf8fc25be3ce4cd1d5
  ###
  method Database {submethod args} {
    return [my Database_$submethod {*}$args]
  }

  ###
  # topic: ba1114cdc19c7835f848f9c6ce2f21c7
  ###
  method Database_Attach filename {
    set alias db
    if { $filename in {:memory: {}}} {
      set exists 0
    } else {
      set exists [file exists $filename]
    }
    my put filename $filename
    set objname [my SubObject $alias]
    sqlite3 $objname $filename
    ###
    # Register our busy method
    ###
    $objname busy [namespace code {my Database_Busy}]
    ###
    # Wait up to 2 seconds for
    # a busy database
    ###
    $objname timeout [my cget timeout]
    my graft $alias $objname
    my Database_Functions
    my attach_sqlite_methods $objname
    if {!$exists} {
      my Database_Create
    }
  }

  ###
  # topic: 6319133f765170f9949de3e3329bf07f
  # description:
  #    Action to perform when database is busy
  #    return "1" to cause action to fail,
  #    0 to allow Sqlite to wait and try again
  ###
  method Database_Busy {} {
    update
    return 0
  }

  ###
  # topic: 4251a1e7abd66d20c66f9dcd25bb1e54
  # description:
  #    Deep wizardry
  #    Disable journaling and disk syncronization
  #    If the app crashes, we really don't give a
  #    rat's ass about the output, anyway
  ###
  method journal_mode onoff {
    # Store temporary tables in memory
    if {[string is false $onoff]} {
      my <db> eval {
PRAGMA synchronous=0;
PRAGMA journal_mode=MEMORY;
PRAGMA temp_store=2;
      }
    } else {
      my <db> eval {
PRAGMA synchronous=2;
PRAGMA journal_mode=DELETE;
PRAGMA temp_store=0;
      }
    }
  }

  ###
  # topic: 9363820d1352dc0b02d8b433be02a5b7
  ###
  method message::readonly {} {
    error "Database is read-only"
  }

  ###
  # topic: 29d3a99d20a7f3aaa7911b2666bdf17e
  ###
  method native::table_info table {
    set info {}
    my one {select type,sql from sqlite_master where tbl_name=$table} {
      foreach {type field value} [::schema::createsql_to_dict $sql] {
        dict set info $type $field $value
      }
    }
    return $info
  }

  ###
  # topic: df7ff05563eae14512f945ac80b18ea6
  ###
  method native::tables {} {
      return [my eval {SELECT name FROM sqlite_master WHERE type ='table'}]
  }

  ###
  # topic: 4e2dc71f459beab3d31cd49f012340fb
  ###
  method Option_set::filename filename {
    my Database_Attach $filename
  }

  ###
  # topic: d5591c09b59c6a8d50001af79d108e13
  ###
  method SubObject::db {} {
    return [namespace current]::Sqlite_db
  }
}

Added modules/tao-sqlite/index.tcl.





























>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
package provide tao-sqlite 0.3

package require tao
package require sqlite3
package require sha1 2
::tao::module push tao-sqlite

::namespace eval ::taodb {}

::tao::load_path [::tao::script_path] {
  procs.tcl connection.tcl oosqlite.tcl module.tcl
}
::tao::module pop

Added modules/tao-sqlite/module.tcl.

















































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
###
# topic: d3e536874747b4e5a6b879e6f2422cd4
# description: Modules are objects that wrap around sqlite connections
###
tao::class taodb::module.sqlite {
  superclass taodb::connection.sqlite
  
  constructor filename {
    package require sqlite3
    
    if [catch {
      my Database_Attach $filename
      ###
      # Allow up to 2 seconds of
      # slack time for another process to
      # write to the database
      ###
      my <db> timeout 2000
    }] {
      puts "Falling back to temporary storage"
      my Database_Attach {}
    }
    return 0
  }

  ###
  # topic: 6292ac0c78dbb91c7aaa629f48a301a3
  ###
  method Database_Create {} {
    my <db> eval [my property create_sql]
  }

  ###
  # topic: 582bb8d10136f632866e73a6b72a9c32
  ###
  method Database_Functions {} {
    my <db> function uuid_generate ::tao::uuid_generate
  }
}

Added modules/tao-sqlite/oosqlite.tcl.



































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
###
# topic: 4f78c3dbc3f04099f8388b0aaf87df97
# description:
#    This class abstracts the normal operations undertaken
#    my containers and nodes that write to a single data table
###
tao::class taodb::table {
  aliases moac.sqliteTable
  superclass

  # Properties that need to be set:
  # table - SQL Table
  # primary_key - Primary key for the sql table
  # default_record - Key/value list of defaults
  

  ###
  # topic: 6283f1ecde341c8b7dc0199226cfad86
  # title: Delete a record from the database backend
  ###
  method db_record_delete nodeid {
    set table [my property schema table]
    set primary_key [my property schema primary_key]
    my <db> change "delete from $table where $primary_key=:nodeid"
  }

  ###
  # topic: d4c5e9cfea2fa029e80ac21e3173a702
  ###
  method db_record_exists nodeid {
    set table [my property schema table]
    set primary_key [my property schema primary_key]
    return [my <db> exists "select $primary_key from $table where $primary_key=:nodeid"]
  }

  ###
  # topic: e1e4bb66d9cfc158ec9dfb8e13cfe0ce
  # title: Detect record key
  # description: The nodeid of this table from a key/value list of table contents
  ###
  method db_record_key record {
    set primary_key [my property schema primary_key]
    if {[dict exists $record $primary_key]} {
      return [dict get $record $primary_key]
    }
    if {[dict exists $record rowid]} {
      return [dict get $record rowid]
    }
    error "Could not locate the primary key"
  }

  ###
  # topic: 505661a4862772908e986e255ffe1f79
  # description: Read a record from the database
  ###
  method db_record_load {nodeid {arrayvar {}}} {
    if { $arrayvar ne {} } {
      upvar 1 $arrayvar R
    }
    set table [my property schema table]
    if {$nodeid eq {}} {
      return {}
    }
    my <db> eval "select * from $table where rowid=:nodeid" R {}
    unset -nocomplain R(*)
    return [array get R]
  }

  ###
  # topic: 37e78a4cf9ab491f9894c28a128922e4
  # title: Return a record number for a new entry
  ###
  method db_record_nextid {} {
    set primary_key [my property schema primary_key]
    set maxid [my <db> one "select max($primary_key) from [my property schema table]"]
    if { ![string is integer -strict $maxid]} {
      return 1
    } else {
      return [expr {$maxid + 1}]
    }
  }

  ###
  # topic: 0960b530335749a9315d8d05af8c02c2
  # description:
  #    Write a record to the database. If nodeid is negative,
  #    create a new record and return its ID.
  #    This action will also perform any container specific prepwork
  #    to stitch the node into the model, as well as re-read the node
  #    from the database and into memory for use by the gui
  ###
  method db_record_save {nodeid record} {
    appmain signal  dbchange

    set table [my property schema table]
    set primary_key [my property schema primary_key]
    
    set now [clock seconds]
    if { $nodeid < 1 || $nodeid eq {} } {
      set nodeid [my db_record_nextid]
    }
    if {![my <db> exists "select $primary_key from $table where rowid=:nodeid"]} {
      my <db> change "INSERT INTO $table ($primary_key) VALUES (:nodeid)"
      foreach {var val} [my property default_record] {
        if {![dict exists $record $var]} {
          dict set record $var $val
        }
      }
    }
    set oldrec [my db_record_load $nodeid]
    set fields {}
    set values {}
    set stmt "UPDATE $table SET "
    set stmtl {}
    set columns [dict keys $oldrec]
    
    foreach {field value} $record {
        if { $field in [list $primary_key mtime uuid] } continue
        if { $field ni $columns } continue
        if {[dict exists $oldrec $field]} {
            # Screen out values that have not changed
            if {[dict get $oldrec $field] eq $value } continue
        }
        lappend stmtl "$field=\$rec_${field}"
        set rec_${field} $value
    }
    if { $stmtl == {} } {
        return 0
    }
    if { "mtime" in $columns } {
      lappend stmtl "mtime=now()"
    }
    append stmt [join $stmtl ,]
    append stmt " WHERE $primary_key=:nodeid"
    my <db> change $stmt
    return $nodeid
  }
}

###
# topic: 9032e81e051b67fa089f1326da6081f1
# description:
#    Managing records for tables that consist of a primary
#    key and a blob field that contains a key/value list
#    that represents the record
###
tao::class taodb::table.blob {
  aliases moac.sqliteTable.blob
  superclass

  ###
  # topic: 24d95fd922c7d9d188b60b35b382b8dd
  ###
  method db_record_delete nodeid {
    set table        [my property schema table]
    set primary_key  [my property schema primary_key]
    my <db> one "delete from $table where $primary_key=:nodeid"
  }

  ###
  # topic: c4c57639b09ab0f1bd81700cabd6ab88
  ###
  method db_record_load {nodeid {arrayvar {}}} {
    set table  [my property schema table]
    set vfield [my property field_value]
    set primary_key [my property schema primary_key]
    
    if { $arrayvar ne {} } {
      upvar 1 $arrayvar R
      array set R [my <db> one "select $vfield from $table where $primary_key=:nodeid"]
      return [array get R]
    } else {
      return  [my <db> one "select $vfield from $table where $primary_key=:nodeid"]
    }
  }

  ###
  # topic: 268efa2a6aac3451f3e5e525013ec091
  ###
  method db_record_save {nodeid record} {
    set table  [my property schema table]
    set vfield [my property field_value]
    set primary_key [my property schema primary_key]
    
    set result [my property default_record]
    foreach {var val} [my <db> one "select $vfield from $table where $primary_key=:nodeid"] {
      dict set result $var $val
    }
    foreach {var val} $record {
      dict set result $var $val
    }
    my <db> eval "update $table set $vfield=:result where $primary_key=:nodeid"
  }
}

###
# topic: df933b39a39e106c1c0b3f8651d4b5b7
# description:
#    Managing records for tables that consist of a primary
#    key a column representing a "field" and another
#    column representing a "value"
###
tao::class taodb::table.keyvalue {
  aliases moac.sqliteTable.keyvalue
  superclass

  ###
  # topic: c32d751f91d518b47ad400ef04e4f719
  ###
  method db_record_delete nodeid {
    set table        [my property schema table]
    set primary_key  [my property schema primary_key]
    my <db> one "delete from $table where $primary_key=:nodeid"
  }

  ###
  # topic: 34b5a0fefa9a9655a3f8184c3eb640a9
  ###
  method db_record_load nodeid {
    set table  [my property schema table]
    set ffield [my property field_name]
    set vfield [my property field_value]
    set primary_key [my property schema primary_key]

    set result [my property default_record]
    my <db> eval "select $ffield as field,$vfield as value from $table where $primary_key=:nodeid" {
      dict set result $field $value
    }
    return $result
  }

  ###
  # topic: 176679ea4e972f4eac12d4325979369e
  ###
  method db_record_save {nodeid record} {
    set table  [my property schema table]
    set ffield [my property field_name]
    set vfield [my property field_value]
    set primary_key [my property schema primary_key]
    
    set oldrecord [my db_record_load $nodeid]
    foreach {var val} $record {
      if {[dict exists $oldrecord $var]} {
        if {[dict get $oldrecord $var] eq $val } continue
      }
      dict set outrecord $var $val
    }
    if {![llength $outrecord]} return
    
    my <db> transaction {
      foreach {var val} $outrecord {
        my <db> change "insert or replace into $table ($primary_key,$ffield,$vfield) VALUES (:nodeid,$var,$val)"
      }
    }
  }
}

Added modules/tao-sqlite/pkgIndex.tcl.

























>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded ::tao::helpdoc 0.1 [list source [file join $dir yggdrasil.tcl]]
package ifneeded tao-sqlite 0.3 [list source [file join $dir index.tcl]]

Added modules/tao-sqlite/prefdb.tcl.









































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
###
# topic: a499aa36ee878a743ac8a269bfd3a1e3
# description: Sqlite based storage for application settings
###
tao::class taodb::prefdb {
  superclass taodb::module.sqlite

  property create_sql {
create table prefs (
  field string,
  value string,
  mtime integer,
  primary key (field)
);
create table history (
  field string,
  value string,
  mtime integer,
  primary key (field,value) on conflict replace
);
create index historyMtime on history (mtime);
}

  ###
  # topic: bd83ad1abbfc4516fd6adc5d6ddfd553
  ###
  method create_temp_tables {} {
create table property (
  node  string,
  field string,
  value string,
  primary key (node,field) on conflict replace
);
  }
}

Added modules/tao-sqlite/procs.tcl.

































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
::namespace eval ::tao {}

###
# topic: 0a19b0bfb98162a8a37c1d3bbfb8bc3d
# description:
#    Because the tcllib version of uuid generate requires
#    network port access (which can be slow), here's a fast
#    and dirty rendition
###
proc ::tao::uuid_generate args {
  if {![llength $args]} {
    set block [list [incr ::tao::nextuuid] {*}$::tao::UUID_Seed]
  } else {
    set block $args
  }
  return [::sha1::sha1 -hex [join $block ""]]
}

###
# topic: ee3ec43cc2cc2c7d6cf9a4ef1c345c19
###
proc ::tao::uuid_short args {
  if {![llength $args]} {
    set block [list [incr ::tao::nextuuid] {*}$::tao::UUID_Seed]
  } else {
    set block $args
  }
  return [string range [::sha1::sha1 -hex [join $block ""]] 0 16]
}

###
# topic: b14c505537274904578340ec1bc12af1
# description:
#    Implementation the uses a compiled in ::md5 implementation
#    commonly used by embedded application developers
###
namespace eval ::tao {
  namespace export *

  ###
  # Cache the bits of the UUID seed that aren't likely to change
  # once the software is loaded, but which can be expensive to
  # generate
  ###
  variable ::tao::UUID_Seed [list [info hostname] [get env(USER)] [get env(user)] [clock format [clock seconds]]]
}


Added modules/tao-sqlite/record.tcl.





















































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
###
# topic: 49fee6ecf96ef7b3d3ecd7565a047b20
# title: Generic class to process database records
###
tao::class taodb::record {
  superclass
  
  option layer {
    class organ
    description {Object which abstracts access to the underlying storage}
  }
  property variable nodeid {default -1}
  property variable unit   {default {}}  
  property array db_record {}
  property array db_specs  {}

  ###
  # topic: b5cf9de15d1e7c7fead7b5794acb59db
  ###
  method action::delete {} {
    set objid [my objid]
    # Note: we are counting on the layer's node_edit_delete
    # method to call our destructor and/or destroy our window
    my layer db_record_delete $objid
  }

  ###
  # topic: 1d8ca0d3c3b915fadae5f1edb4343833
  ###
  method action::destroy {} {}

  ###
  # topic: fa3fbe68c3a633950547bbe096dd762d
  ###
  method action::save {
    my variable db_record
    set pkey [my <layer> db_record_key [array get db_record]]
    set savedata [array get db_record]
    my <layer> db_record_
  }
}

Added modules/tao-sqlite/tao-sqlite.md.

Added modules/tao-sqlite/yggdrasil.md.

Added modules/tao-sqlite/yggdrasil.tcl.





















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
###
# Structure that manages an interactive help system
###
package provide ::tao::helpdoc 0.1

###
# topic: f5641520f17f23259b96facbe936c875
###
tao::class taodb::yggdrasil {
  aliases tao.yggdrasil
  superclass taodb::module.sqlite
  
  property create_sql {
    CREATE TABLE if not exists config(
      name TEXT PRIMARY KEY,
      value ANY
    );
    create table if not exists entry (
      entryid string default (uuid_generate()),
      indexed integer default 0,
      parent integer references entry (entryid),
      class string,
      name string,
      mtime integer,
      primary key (entryid)
    );
    create table if not exists property (
      entryid    string references entry (entryid),
      field      string,
      value      string,
      primary key (entryid,field)
    );
    create table if not exists link (
      linktype string,
      entry integer references entry (entryid),
      refentry integer references entry (entryid)
    );
    create table if not exists idset (
      class string,
      id    integer,
      name  string,
      primary key (class,id)
    );
    create table if not exists aliases (
      class string,
      alias string,
      cname string references entry (name),
      primary key (class,alias)
    );
    create table if not exists repository (
      handle string,
      localpath string,
      primary key (handle)
    );
    create table if not exists file (
      fileid         string default (uuid_generate()),
      repo           string references repository (handle),
      path           string,  --path relative to repo
      localpath      string,  --cached path to local file
      filename       string,  --filename
      content_type   string,  --Content/Type of file
      package        string,  --Name of any packages provided,
      size           integer, --File size in bytes
      mtime          integer, --mtime in unix time
      hash           string,   --md5 hash of file
      primary key (fileid)
    );
    create table if not exists filelink (
      linktype string,
      entryid integer references entry (entryid),
      fileid integer references file   (fileid)
    );
  }
  
  
  property create_index_sql {
    create index if not exists nameidx on entry (entryid,name);
    create index if not exists parentidx on entry (parent,entryid);    
  }
  

  ###
  # topic: ce057acc3716a2d568a7031702a08db6
  ###
  method alias_list class {
    return [my <db> eval {select alias,cname from aliases where class=:class order by cname,alias}]
  }

  ###
  # topic: 181987917bb442b19b20c6a381b68e65
  ###
  method canonical {class name} {
    set name [string tolower $name]
    if { $class in {{} * any}} {
      return [my <db> eval {select distinct class from aliases order by class}]
    }
    if { $name in {{} * any}} {
      return [my <db> eval {select alias,cname from aliases where class=:class order by cname,alias}]
    }
    set rows [my <db> eval {select entryid from entry where class=:class and name=:name}]
    if {[llength $rows] == 1} {
      return $name
    }
    if {[my <db> exists {select cname from aliases where class=:class and (alias=:name or cname=:name)}]} {
      return [my <db> one {select cname from aliases where class=:class and (alias=:name or cname=:name) limit 1}]
    }
  }

  ###
  # topic: e1fb31429cfba5b9c8939b3089d7dccf
  ###
  method canonical_aliases {class name} {
    set name [string tolower $name]
    return [my <db> eval {select distinct alias from aliases where class=:class and cname=:name and alias!=:name}]
  }

  ###
  # topic: 9892395f48e5568923ee0516ca23313a
  ###
  method canonical_id {class name} {
    return [my <db> eval {select id from idset where class=:class and name=:name}]
  }

  ###
  # topic: 0e2b411c94df5cdc082f6d909045f44c
  ###
  method canonical_set {type name cname} {
    set class [string tolower $type]
    set name [string tolower $name]
    set cname [string tolower $cname] 
    variable canonical_name
    dict set canonical_name $class $name $cname
    set address $type/$name
    my <db> eval {replace into aliases (class,alias,cname) VALUES ($class,$name,$cname)}
  }

  ###
  # topic: a3ee1a620e5659107eea8b3f9ef38b0d
  ###
  method class_list class {
    return [lsort -dictionary [my <db> eval {select name from entry where class=:class}]]
  }

  ###
  # topic: 7e5caa43f37e38328ca83784db16face
  ###
  method class_nodes class {
    set result {}
    foreach {entryid name} [my <db> eval {select entryid,name from entry where class=:class order by name}] {
      lappend result $name [my node_properties $entryid]
    }
    return $result
  }

  ###
  # topic: 85fa5fdaecfbc8a8236d726b37adc8b8
  ###
  method enum_dump class {
    return [my <db> eval {select id,name from idset where class=:class order by id}]
  }

  ###
  # topic: 54b27245e29c98708a964c0739583737
  ###
  method enum_id {class name} {
    set arr ::irm::${class}_name_to_idx
    if {![info exists $arr]} {
      my <db> eval {select name as aname,id as aid from idset where class=:class} {
        set ${arr}($aname) $aid
      }
    }
    set cname [my canonical $class $name]
    if {![info exists ${arr}($cname)]} {
      error "Invalid $class $name"
    }
    return [set ${arr}($cname)]
  }

  ###
  # topic: 944e9861c8d04a693896c7a093bcb641
  ###
  method enum_name {class id} {
    return [my <db> one {select name from idset where class=:class and id=:id}]
  }

  ###
  # topic: ff79f9268801cbdbf06bee1d0827a8ed
  ###
  method enum_set {class name id} {
    set class [string tolower $class]
    set name [string tolower $name]
    set ::irm::${class}_name_to_idx($name) $id
    set ::irm::${class}_idx_to_name($id) $name
    my <db> eval {insert or replace into idset (class,id,name) VALUES ($class,$id,$name)}
  }

  ###
  # topic: 848689c2e58328b9da8b97afee687e52
  ###
  method file_hash {rawfileid {newhash {}}} {
    set fileid [my file_id $rawfileid]
    if {$fileid ne {}} {
      return [my <db> one {select hash from file where fileid=:fileid}]
    }
    return {}
  }

  ###
  # topic: 438f616e49033a8d7215330112d314ad
  ###
  method file_id {addr {create 0}} {
    if {[my <db> exists {select fileid from file where fileid=:addr}]} {
      return $addr
    }
    if {[my <db> exists {select fileid from file where hash=:addr}]} {
      return [my <db> one {select fileid from file where hash=:addr}]
    }
    if {[llength $addr]==2} {
      set repo [lindex $addr 0]
      set path [lindex $addr 1]
      if {[my <db> exists {select fileid from file where repo=:repo and path=:path}]} {
        return [my <db> one {select fileid from file where repo=:repo and path=:path}]
      }
    }
    if {[my <db> exists {select fileid from file where path=:addr}]} {
      return [my <db> one {select fileid from file where path=:addr}]
    }
    if {[my <db> exists {select fileid from file where localpath=:addr}]} {
      return [my <db> one {select fileid from file where localpath=:addr}]
    }
    if {$create} {
      set newuuid [my <db> one {select uuid_generate()}]
      if {[llength $addr]==2} {
        set repo [lindex $addr 0]
        set path [lindex $addr 1]
        my <db> eval {insert into file (fileid,repo,path) VALUES (:newuuid,:repo,:path);}
      } else {
        my <db> eval {insert into file (fileid,path) VALUES (:newuuid,:path);}
      }
      return $newuuid
    }
    return {}
  }

  ###
  # topic: c2cab41e44bb7cdcca831e05aa5ef902
  ###
  method file_restore {nodeid info} {
    set stmtl {}
    dict with info {}
    set fileid [my file_id $nodeid 1]
    set stmt "UPDATE file SET "
    set stmtl {}
    foreach {field value} $info {
      switch $field {
        repo -
        path -
        localpath -
        filename -
        content_type -
        package -
        size -
        mtime -
        hash {
          if { $value ne {} } {
            set _$field $value
            lappend stmtl "$field=:_${field}"
          }
        }
      }
    }
    if {![llength $stmt]} return
    append stmt "[join $stmtl ,]"
    append stmt " where fileid=:fileid"
    my <db> eval $stmt
  }

  ###
  # topic: fba89244d9f7fba909fb01dc7a25535a
  ###
  method file_serialize nodeid {
    set result {}
    my <db> eval {
      select * from file
      where fileid=$nodeid
    } record {
      set fileid $record(fileid)
      append result "[list [self] file_restore [list $record(repo) $record(path)]] \{" \n
      
      foreach {field value} [array get record] {
        if { $field in {* fileid indexed export} } continue
        append result "  [list $field $value]" \n
      }
      append result "\}"
    }
    return $result
  }

  ###
  # topic: f8abb1cd4c82172741704b789371c706
  # title: Build a full text index
  ###
  method full_text_index {{force 0}} {
    my <db> eval {
    CREATE TABLE if not exists config(
      name TEXT PRIMARY KEY,
      value ANY
    );
    }
    if {!$force && [my <db> exists {select * from config where name='fts_indexed' and value='1'}]} {
      return
    }
    
    my <db> eval {
DROP TABLE IF EXISTS search;
CREATE VIRTUAL TABLE search USING fts4(uuid,class,title,body);
insert into search (uuid,class,title,body)
  SELECT entry.entryid,entry.class,entry.name,property.value
  FROM entry,property where entry.entryid=property.entryid and field='description';

INSERT OR REPLACE INTO config(name,value) VALUES ('fts_indexed',1);
    }
  }

  ###
  # topic: 6892a2438c56b5e207888f6683d684cc
  ###
  method link_create {entryid to {type {}}} {
    if { $type eq {} } {
      set exists [my one {select count(entry) from link where entry=$entryid and refentry=$to}]
      if {!$exists} {
        my <db> eval {insert or replace into link (entry,refentry) VALUES ($entryid,$to)}
      }
    } else {
      set exists [my one {select count(entry) from link where entry=$entryid and refentry=$to and linktype=$type}]
      if {!$exists} {
        my <db> eval {insert or replace into link (entry,refentry,linktype) VALUES ($entryid,$to,$type)}
      } 
    }
  }

  ###
  # topic: bebaa55db9d00f615f4c3e589b9f5cca
  ###
  method link_detect_address args {
    set args [string tolower $args]
    if {[my node_exists $args entryid]} {
      return [my <db> eval {select entryid from entry where entryid=$entryid}]
    }
    ###
    # If the link contains a / we know it is a hard
    # path
    ###
    if {[my node_exists $args entryid]} {
      return $entryid
    }
    if {[llength $args] > 1} {
      set rootentries [my <db> eval {select name from entry where class='section'}]
      
      if {[lindex $args 0] in $rootentries} {
        set type [lindex $args 0]
        set name [my canonical $type [lindex $args 1]]
        if {[my node_exists [list $type $name] entryid]} {
          return $entryid
        }
      }
      if {[lindex $args 1] in $rootentries} {
        set type [lindex $args 1]
        set name [my canonical $type [lindex $args 0]]
        if {[my node_exists [list $type $name] entryid]} {
          return $entryid
        }
      }
    }
    set addr [lindex $args 0]
    set cnames [my <db> eval {select class,cname from aliases where alias=$addr}]
  
    if {[llength $cnames] == 2} {
      if {[my node_exists $cnames entryid]} {
        return $entryid
      }
    }
    #if {[string first / $addr] > 0 } {
    #  return $addr
    #}
    set candidates [my <db> eval {select entryid,name from entry where name like '%$addr%'}]
    foreach address $candidates {
      if {[regexp simnode $address]} {
        return $address
      }
    }
    #puts [list CAN'T RESOLVE $args]
    return $args
  }

  ###
  # topic: 4be4c2c74388621448494e1ced97fccb
  # description:
  #    Return a list of all children of node,
  #    Filter is a key/value list that understands
  #    the following:
  #    type - Limit children to type
  #    dump - Output the contents of the child node, not their id
  ###
  method node_children {nodeid class} {
    set dump 1
    set entryid [my node_id $nodeid]
    if { $class eq {} } {
      set nodes [my <db> eval {select name,entryid from entry where parent=$entryid}]
    } else {
      set nodes [my <db> eval {select name,entryid from entry where parent=$entryid and class=$class}]
    }
    if {!$dump} {
      return $nodes
    }
    set result {}
    foreach {cname cid} $nodes {
      dict set result $cname [my <db> eval {select field,value from property where entryid=$cid order by field}]
    }
    return $result
  }

  ###
  # topic: 1ddcdaedcca9f6bf1d17564fc2b80dbe
  ###
  method node_define {class name info {nodeidvar {}}} {
    if {$nodeidvar ne {}} {
      upvar 1 $nodeidvar nodeid
    }
    set class [string tolower $class]
    set name  [string tolower $name]
    if { $class eq {} || $class eq "section" } {
      set nodeid $name
    } else {
      set nodeid {}
      if {[dict exists $info topic]} {
        set nodeid [dict get $info topic]
        dict unset info topic
      }
    }    
    if { $nodeid eq {} } {
      if {![my node_exists [list $class $name] nodeid]} {
        set nodeid [helpdoc node_id [list $class $name] 1]
        foreach {var val} [my node_empty $class] {
          my node_property_set $nodeid $var $val        
        }
      }
    } elseif {![my node_exists $nodeid]} {
      my canonical_set $class $name $name
      my <db> eval {insert into entry (entryid,class,name) VALUES (:nodeid,:class,:name)}
      foreach {var val} [my node_empty $class] {
        my node_property_set $nodeid $var $val        
      }
    }
  
    foreach {var val} $info {
      my node_property_set $nodeid $var $val
    }
  }

  ###
  # topic: 5cf8420243fb46472b33a18cb340f8cf
  ###
  method node_define_child {parent class name info {nodeidvar {}}} {
    if {$nodeidvar ne {}} {
      upvar 1 $nodeidvar nodeid
    }
    ###
    # Return an already registered node with this address
    ###
    if {[my <db> exists {select entryid from entry where parent=:parent and class=:class and name=:name}]} {
      set nodeid [my <db> one {select entryid from entry where parent=:parent and class=:class and name=:name}]
    } else {
      set nodeid {}
  
      if {[dict exists $info topic]} {
        set topicid [dict get $info topic]
        dict unset info topic
        if {![my <db> exists {select entryid from entry where entryid=:topicid}]} {
          # If we are recycling an unused UUID re-create the entry in the table
          my <db> eval {insert or replace into entry (entryid,parent,class,name) VALUES (:topicid,:parent,:class,:name)}
          set nodeid $topicid
        }
      }
      if { $nodeid eq {} } {
        set nodeid [::tao::uuid_generate $parent $class $name]
      }
      if {[my <db> exists {select entryid from entry where entryid=:nodeid and class=:class and name=:name}]} {
        ###
        # Correct a misfiled node
        ###
        my <db> eval {update entry set parent=:parent where entryid=:nodeid}
      } else {
        my <db> eval {insert or replace into entry (entryid,parent,class,name) VALUES (:nodeid,:parent,:class,:name)}
      }
      foreach {var val} [my node_empty $class] {
        if {![dict exists $info $var]} {
          dict set info $var $val
        }
      }
    }
    foreach {var val} $info {
      my node_property_set $nodeid $var $val        
    }
    return $nodeid
  }

  ###
  # topic: 1ce63e18b2072f0218695df90c83b5e6
  ###
  method node_empty class {
    set id [my <db> one {select entryid from entry where name=:class and class='section'}]
    return [my <db> one {select value from property where entryid=:id and field='template'}]
  }

  ###
  # topic: 8a70c9ed461c3728787f2e5385f8be66
  ###
  method node_exists {node {resultvar {}}} {
    set parent 0
    if { $resultvar != {} } {
      upvar 1 $resultvar row
    }
    if {[llength $node]==1} {
      set name [lindex $node 0]
      if {[my <db> exists {select entryid from entry where name=:name or entryid=:name}]} {
        set row [my <db> one {select entryid from entry where name=:name or entryid=:name}]
        return 1
      }
    } elseif {[llength $node]==2} {
      set class [lindex $node 0]
      set name [lindex $node 1]
      if {[my <db> exists {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]} {
        set row [my <db> one {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]
        return 1
      }
    }
    set class [lindex $node 0]
    set name [lindex $node 1]
    if {[my <db> exists {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]} {
      set parent [my <db> one {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]
    } else {
      return 0
    }
    foreach {eclass ename} [lrange $node 2 end] {
      set row {}
      if {$eclass eq {}} {
        if {[my <db> exists {select entryid from entry where parent=:parent and (entryid=:ename or name=:ename)}]} {
          set row [my <db> one {select entryid from entry where parent=:parent and (entryid=:ename or name=:ename)}]
        }
      } else {
        if {[my <db> exists {select entryid from entry where parent=:parent and class=:eclass and (entryid=:ename or name=:ename)}]} {
          set row [my <db> one {select entryid from entry where parent=:parent and class=:eclass and (entryid=:ename or name=:ename)}]
        }
      }
      if { $row eq {} } {
        return 0
      }
      set parent $row
    }
    return 1
  }

  ###
  # topic: 6c3e041a03a5b2bcf5c6fdab1721d7b6
  ###
  method node_get {nodeid {field {}}} {
    set result {}
    if {[my node_exists $nodeid entryid]} {
      set result [helpdoc node_properties $entryid]
    } else {
      if {[llength $nodeid] > 1} {
        set type [lindex $nodeid 0]
        set result [my node_empty $type]
      }
    }
    if { $field eq {} } {
      return $result    
    }
    return [dict getnull $result $field]
  }

  ###
  # topic: bdeb89732bc42953dedf39bce57ab75b
  ###
  method node_id {node {create 0}} {
    if {[my <db> exists {select entryid from entry where entryid=:node;}]} {
      return [my <db> one {select entryid from entry where entryid=:node;}]
    }
    if {[llength $node]==1} {
      set name [lindex $node 0]
      if {[my <db> exists {select entryid from entry where name=:name or entryid=:name}]} {
        return [my <db> one {select entryid from entry where name=:name or entryid=:name}]
      }
      if { $create } {
        my <db> eval {insert into entry (class,name) VALUES ('section',:name)}
        return $name
      } else {
        error "Node $node does not exist"
      }
    } elseif {[llength $node]==2} {
      set class [lindex $node 0]
      set name [lindex $node 1]

      if {[my <db> exists {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]} {
        set row [my <db> one {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]
        return $row
      }
    }
    set class [lindex $node 0]
    set name [lindex $node 1]
    if {[my <db> exists {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]} {
      set parent [my <db> one {select entryid from entry where (class=:class or parent=:class) and (name=:name or entryid=:name)}]
    } else {
      if {!$create} {
        error "Node $node does not exist"
      }

      ###
      # If the name contains no spaces, dots, slashes, or ::
      ###
      set row [::tao::uuid_generate $class $name]
      my <db> eval {insert into entry (entryid,class,name) VALUES (:row,:class,:name)}
      set parent $row
    }
    if { $create } {
      set classes [my <db> eval {select distinct class from entry}]
    }
    set eclass {}
    foreach token [lrange $node 2 end] {
      set ename $token
      set row {}
      if {$eclass eq {}} {
        if {[my <db> exists {select entryid from entry where parent=:parent and (entryid=:ename or name=:ename)}]} {
          set row [my <db> one {select entryid from entry where parent=:parent and (entryid=:ename or name=:ename)}]
        }
      } else {
        if {[my <db> exists {select entryid from entry where parent=:parent and class=:eclass and (entryid=:ename or name=:ename)}]} {
          set row [my <db> one {select entryid from entry where parent=:parent and class=:eclass and (entryid=:ename or name=:ename)}]
        }
      }
      if { $row eq {} } {
        if { $create } {
          if { $ename in $classes } {
            set eclass $token
            continue            
          } else {
            set eclass {}
            my node_define_child $parent $eclass $ename {} row
          }          
        } else {
          error "Node $node does not exist"
        }
      }
      set parent $row
    }
    return $row
  }

  ###
  # topic: 6f5dc7fcf3eb6204800a7b910d283483
  ###
  method node_properties entryid {
    return [my <db> eval {select field,value from property where entryid=$entryid}]
  }

  ###
  # topic: 51611e18a49da769364ef583f439e8a2
  ###
  method node_property_append {nodeid field text} {
    set buffer [my one {select value from property where entryid=:nodeid and field=:field}]
    append buffer " " [string trim $text]
    my <db> eval {insert or replace into property (entryid,field,value) VALUES (:nodeid,:field,:buffer)}
  }

  ###
  # topic: 79b939dca06915d886b2d6c0a393e803
  ###
  method node_property_get {nodeid field} {
    return [my <db> one {select value from property where entryid=:nodeid and field=:field}]
  }

  ###
  # topic: cecb9e2416c9fec272e7beb9d4c183df
  # description: nodeid is any value acceptable to [lb]my node_alloc[rb]
  ###
  method node_property_lappend {entryid field args} {
    if {![llength $args]} return
    set dbvalue [my <db> eval {select value from property where entryid=$entryid and field=$field}]
    foreach value $args {
      if { $value eq {} } continue
      ::ladd dbvalue $value
    }
    my <db> eval {update property set value=$dbvalue where entryid=$entryid and field=$field}
  }

  ###
  # topic: 3f633c4bdd0fe22bb94870976e2e3aa8
  ###
  method node_property_set {entryid args} {
    my variable property_info property_cname
    if {[llength $args]==1} {
      set arglist [lindex $args 0]
    } else {
      set arglist $args
    }
    foreach {field value} $arglist {
      if {[info exists property_cname($field)]} {
        set cname $property_cname($field)
        set rawvalue $value
        eval [dict getnull $property_info $cname script]
      } else {
        set cname $field
      }
      if {![my <db> exists {select value from property where entryid=:entryid and field=:cname and value=:value}]} {
        my <db> eval {insert or replace into property (entryid,field,value) VALUES (:entryid,:cname,:value)}
      }
    }
  }

  ###
  # topic: 7a941df07b5299ec365d98e284ca4442
  ###
  method node_restore {nodeid info} {
    set stmtl {}
    dict with info {}
    set fields entryid
    set _entryid $nodeid
    set values "\$_entryid"
    
    foreach {field value} $info {
      switch $field {
        properties {
          foreach {var val} $value {
            my node_property_set $_entryid $var $val
          }
        }
        references {
          foreach {refid reftype} $references {
            my link_create $_entryid $refid $reftype
          }
        }
        enumid {
          my enum_set [lindex $value 0] [dict get $info name] [lindex $value 1]
        }
        aliases {
          foreach a $value {
            my canonical_set $_class $a $_name
          }
        }
        parent {
          if {![string is integer $value]} {
            set value [my node_id $value 1]
          }
          lappend fields $field
          lappend values "\$_$field"
          set _$field $value            
        }
        class -
        address -
        name {
          if { $value ne {} } {
            lappend fields $field
            lappend values "\$_$field"
            set _$field $value
          }
        }
      }
    }
    my <db> eval "insert or replace into entry ([join $fields ,]) VALUES ([join $values ,]);"
  }

  ###
  # topic: 399c322eb03e90aacbc10ae171557cfd
  ###
  method node_serialize nodeid {
    set result {}
    my <db> eval {
      select * from entry
      where entryid=$nodeid
    } record {
      set entryid $record(entryid)
      append result "[list [self] node_restore $entryid] \{" \n
      
      foreach {field value} [array get record] {
        if { $field in {* entryid indexed export} } continue
        append result "  [list $field $value]" \n
      }
      set class $record(class)
  
      set id [my canonical_id $class $record(name)]
      if { $id ne {} } {
          append result "  [list enumid [list $class $id]]" \n
      }
      
      append result "  properties \{" \n
      set info [my node_empty $record(class)]
      foreach {var val} [my node_properties $entryid] {
        dict set info $var $val
      }

      foreach {var} [lsort -dictionary [dict keys $info]] {
        if { $var in {aliases field method fields methods references id} } continue
        append result "    [list $var [string trim [dict get $info $var]]]" \n
      }
      
      append result "  \}" \n
      set references [my <db> eval {select refentry,linktype from link where entry=$entryid}]
      if {[llength $references]} {
        append result "  [list references $references]" \n
      }
      set aliases [my canonical_aliases $record(class) $record(name)]
      if {[llength $aliases]} {
        append result "  [list aliases $aliases]" \n
      }
      set attachments [my <db> eval {select file.hash,filelink.linktype from file,filelink where filelink.entryid=$entryid and filelink.fileid=file.fileid}]
      if {[llength $attachments]} {
        append result "  [list attachments $attachments]" \n
      }
      append result "\}"
    }
    return $result
  }

  ###
  # topic: 841e0e684d5dd1035ed56316e3a075b2
  ###
  method property_define {property info} {
    my variable property_info property_cname
    foreach {f v} $info {
      dict set property_info $property $f $v
    }
    foreach alias [dict getnull $property_info $property aliases] {
      set property_cname($alias) $property
    }
    set property_cname($property) $property
  }

  ###
  # topic: db9d2312731e0b51f1cf0ce4f597ecdb
  ###
  method reindex {} {
    my variable canonical_name
    my <db> eval {select class,alias,cname from aliases order by class,cname,alias} {
      dict set canonical_name $class $alias $cname
    }
  }

  ###
  # topic: 5b3aeab40382b22c6a5dda372de4faec
  ###
  method repository_restore {handle info} {
    set stmtl {}
    dict with info {}
    set fields handle
    set _handle $handle
    set values "\$_handle"
    foreach {field value} $info {
      switch $field {
        localpath {
          if { $value ne {} } {
            lappend fields $field
            lappend values "\$_$field"
            set _$field $value
          }
        }
      }
    }
    my <db> eval "insert or replace into repository ([join $fields ,]) VALUES ([join $values ,]);"
  }
}

interp alias {} tao.yggdrasil {} ::taodb::yggdrasil