nda.tcl (4515B)
1 # This whole didgeridoo is legacy code and I need to kill it with fire! 2 3 package require base64 4 5 proc ndaenc {n} { 6 return [string map {/ [} [::base64::encode [string tolower $n]]] 7 } 8 9 proc ndadec {n} { 10 return [::base64::decode [string map {[ /} $n]] 11 } 12 13 proc ndcenc {n} { 14 return [string map {/ [} [::base64::encode $n]] 15 } 16 17 proc ndcdec {n} { 18 return [::base64::decode [string map {[ /} $n]] 19 } 20 21 set nd [set tnd [list]] 22 23 namespace eval nda { 24 proc ::nda::get {path} { 25 #puts stdout "invoked with $path" 26 global nd 27 ::set parr [split $path "/"] 28 if {[lindex $parr 0] == ""} { 29 return "" 30 } 31 ::set pathe [lrange $parr 1 end] 32 if {[info exists nd] && ![catch {dict get $nd {*}$parr} eee]} {return $eee} {return ""} 33 } 34 35 proc ::nda::set {path val} { 36 #puts stdout "invoked with $path" 37 global nd 38 ::set parr [split $path "/"] 39 if {[lindex $parr 0] == ""} { 40 return "" 41 } 42 return [dict set nd {*}$parr $val] 43 } 44 45 proc ::nda::unset {path} { 46 #puts stdout "invoked with $path" 47 global nd 48 ::set parr [split $path "/"] 49 if {[lindex $parr 0] == ""} { 50 return "" 51 } 52 if {[info exists nd] && ![catch {dict unset nd {*}$parr} eee]} {return $eee} {return ""} 53 } 54 55 proc ::nda::incr {path} { 56 #puts stdout "invoked with $path" 57 global nd 58 ::set parr [split $path "/"] 59 if {[lindex $parr 0] == ""} { 60 return "" 61 } 62 set orig [::nda::get $path] 63 if {[string is integer $orig]} { 64 ::nda::set $path [expr $orig+$inc] 65 } { 66 ::nda::set $path $inc 67 } 68 } 69 70 namespace export * 71 namespace ensemble create 72 } 73 74 # alt API: 75 namespace eval dbase { 76 proc ::dbase::get {args} { 77 global nd 78 if {[info exists nd] && ![catch {dict get $nd {*}$args} eee]} {return $eee} {return ""} 79 } 80 81 proc ::dbase::set {args} { 82 global nd 83 if {[lindex $args 1] == ""} { 84 return "" 85 } 86 return [dict set nd {*}$args] 87 } 88 89 proc ::dbase::lappend {args} { 90 global nd 91 if {[lindex $args 1] == ""} { 92 return "" 93 } 94 ::set orig [::dbase::get {*}[lrange $args 0 end-1]] 95 ::lappend orig [lindex $args end] 96 return [dict set nd {*}[lrange $args 0 end-1] $orig] 97 } 98 99 proc ::dbase::unset {args} { 100 global nd 101 return [dict unset nd {*}$args] 102 } 103 104 namespace export * 105 namespace ensemble create 106 } 107 108 namespace eval tnda { 109 proc ::tnda::get {path} { 110 #puts stdout "invoked with $path" 111 global tnd 112 ::set parr [split $path "/"] 113 if {[lindex $parr 0] == ""} { 114 return "" 115 } 116 #::set pathe [lrange $parr 1 end] 117 if {[info exists tnd] && ![catch {dict get $tnd {*}$parr} eee]} {return $eee} {return ""} 118 } 119 proc ::tnda::set {path val} { 120 #puts stdout "invoked with $path" 121 global tnd 122 ::set parr [split $path "/"] 123 if {[lindex $parr 0] == ""} { 124 return "" 125 } 126 #::set pathe [lrange $parr 1 end] 127 return [dict set tnd {*}$parr $val] 128 } 129 130 proc ::tnda::unset {path} { 131 #puts stdout "invoked with $path" 132 global tnd 133 ::set parr [split $path "/"] 134 if {[lindex $parr 0] == ""} { 135 return "" 136 } 137 if {[info exists tnd] && ![catch {dict unset tnd {*}$parr} eee]} {return $eee} {return ""} 138 } 139 140 proc ::tnda::incr {path {inc 1}} { 141 #puts stdout "invoked with $path" 142 global tnd 143 ::set parr [split $path "/"] 144 if {[lindex $parr 0] == ""} { 145 return "" 146 } 147 ::set orig [::tnda::get $path] 148 if {[string is integer $orig]} { 149 ::tnda::set $path [expr $orig+$inc] 150 } { 151 ::tnda::set $path $inc 152 } 153 } 154 155 namespace export * 156 namespace ensemble create 157 } 158 159 # cdbase is for interacting with the temporary DB. 160 namespace eval cdbase { 161 proc ::cdbase::get {args} { 162 global tnd 163 if {[info exists tnd] && ![catch {dict get $tnd {*}$args} eee]} {return $eee} {return ""} 164 } 165 166 proc ::cdbase::set {args} { 167 global tnd 168 if {[lindex $args 1] == ""} { 169 return "" 170 } 171 return [dict set tnd {*}$args] 172 } 173 174 proc ::cdbase::lappend {args} { 175 global tnd 176 if {[lindex $args 1] == ""} { 177 return "" 178 } 179 ::set orig [::cdbase::get {*}[lrange $args 0 end-1]] 180 ::lappend orig [lindex $args end] 181 return [dict set tnd {*}[lrange $args 0 end-1] $orig] 182 } 183 184 proc ::cdbase::unset {args} { 185 global tnd 186 return [dict unset tnd {*}$args] 187 } 188 189 namespace export * 190 namespace ensemble create 191 } 192 193 proc tdb {args} {set l [list cdbase]; foreach {i} $args {lappend l $i}; $l} 194 195 proc gettext {stringname args} { 196 gettext.i18n $stringname en $args 197 } 198 199 proc gettext.i18n {stringname language arg} { 200 if {"" == [set out [format [dict get $::gettext [format "%s.%s" $language $stringname]] {*}$arg]]} { 201 # default to the English locale if we don't know 202 set out [format [dict get $::gettext [format "%s.%s" en $stringname]] {*}$arg] 203 } 204 return $out 205 }