tclhttpd

###
# 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
  }
}

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

###
# 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
  }
}

###
# 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)"
      }
    }
  }
}

# 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]]

###
# 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
);
  }
}

::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]]]
}

###
# 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_
  }
}

###
# 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