-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathoc_dict-1.0.tm
188 lines (126 loc) · 3.63 KB
/
oc_dict-1.0.tm
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
#===============================================================================
# oc_dict-1.0.tm
#
# dict utilities.
#
# Copyright Sam O'Connor 2014
# Licenced for use under the same terms as Tcl 8.6. See:
# http://core.tcl.tk/tcl/artifact/537ba3f664b958496ab51849e23d7f564342014b
# http://github.com/tcltk/tcl/raw/core_8_6_1/license.terms
#===============================================================================
package provide oc_dict 1.0
package require oclib::oc_proc
package require csv
package require json
package require http
proc rfc_2822 {dict} {
Format "dict" as an RFC 2882 message.
} example {
[rfc_2822 {To A From B body Hi!}] eq "To: A\r\nFrom: B\r\n\r\nHi!"
} do {
for {name value} in $dict {
if {$name ne "body"} {
append header "$name: $value\r\n"
}
}
append header \r\n[get $dict body]
}
proc json_string {s} {
return \"[string map [list \\ \\\\ \" \\\"] $s]\"
}
proc _json {v} {
# Recursive JSON formatter...
if {[llength $v] == 1} {
return [json_string [lindex $v 0]]
} elseif {[regexp {^[A-Z]} [lindex $v 0]]} {
if {[lindex $v 0] eq "JSONDict:"} {
set v [lrange $v 1 end]
}
for {n v} in $v {lappend items "\"$n\": [_json $v]"}
return \{\n[join $items ,\n]\n\}
} else {
for v in $v {lappend items [_json $v]}
return "\[\n[join $items ,\n]\n\]"
}
}
proc json {dict} {
Format "dict" as a JSON string.
Note: Value lists begining with an upper-case letter are treated as
nested dictionaries. Other value lists are treated as plain lists.
To embed a nested dictionary with lower-case keys prepend "JSONDict:"
to the start of the nested dictionary.
e.g.
json {A 1 B 2 L {i j k}}
{"A": "1", "B": "2", "L": [ "i", "j", "k" ]}
} do {
# Generate JSON format...
set lines [_json $dict]
# Pretty indenting...
set indent ""
for l in [lines $lines] {
if {[regexp {[\}\]]} $l]} {
set indent [range $indent 0 end-4]
}
append result $indent$l\n
if {[regexp {[\{\[]} $l]} {
append indent " "
}
}
return $result
}
proc csv {dict} {
Format "dict" as "name,value\r\n"...
} example {
[csv {1 one 2 two 3 three}] eq "1,one\r\n2,two\r\n3,three\r\n"
} do {
join [lmap {k v} $dict {get [csv::join [list $k $v]]\r\n}] {}
}
proc qstring {args} {
Format "args" as a HTTP Query String.
"args" can be a dict, or can be contain a single item containing a dict.
} example {
[qstring {a "A B" b ✓ c \[\]}] eq "a=A%20B&b=%E2%9C%93&c=%5B%5D"
} do {
if {[llength $args] == 1} {
http::formatQuery {*}[lindex $args 0]
} else {
http::formatQuery {*}$args
}
}
proc pop {dict_var key_var {key {}}} {
Set "key_var" from "$key" in "dict_var".
Remove "key" from dictionary.
"key" defaults to "key_var".
} do {
if {$key eq {}} {
set key $key_var
}
upvar $dict_var d
upvar $key_var v
set v [get $d $key]
dict unset d $key
return $v
}
proc dlist {dict args} {
List of dict values for keys listed in "args".
} do {
lmap key $args {dict get $dict $key}
}
package require oclib::oc_ensemble
for cmd in {
assign
rfc_2822
json
csv
qstring
pop
} {
extend_proc dict $cmd $cmd
}
import_ensemble dict d
package require oclib::oc_string
package require oclib::oc_list
package require oclib::oc_file
#===============================================================================
# End of file.
#===============================================================================