1: # class p_subtables {
2: # "foo"
3: # "bar"
4: # }
5:
6: when HTTP_REQUEST {
7:
8: set full_uri [split [URI::path [HTTP::uri]] "/"]
9:
10: if { [class match [lindex $full_uri 1] equals p_subtables] } {
11:
12: switch [llength $full_uri] {
13: 3 { set tname [lindex $full_uri 1] }
14: 4 { scan [lrange $full_uri 1 end-1] %s%s tname key }
15: 5 { scan [lrange $full_uri 1 end-1] %s%s%s tname key val }
16: default { HTTP::respond 200 content "<HTML><BODY>ERROR</BODY></HTML>" }
17: }
18: switch [HTTP::method] {
19: "GET" {
20: if { [info exists tname] && [info exists key] } {
21: set kvpair [table lookup -notouch -subtable $tname $key]
22: } elseif { [info exists tname] } {
23: foreach tkey [table keys -subtable $tname] {
24: lappend kvpair "$tkey:[table lookup -notouch -subtable $tname $tkey]"
25: }
26: } else { HTTP::respond 200 content "<HTML><BODY>Table and/or Key information invalid</BODY></HTML>" }
27: HTTP::respond 200 content "<HTML><BODY>$kvpair</BODY></HTML>"
28: }
29: "POST" {
30: if { [info exists tname] && [info exists key] && [info exists val] } {
31: table add -subtable $tname $key $val indefinite indefinite
32: HTTP::respond 200 content "<HTML><BODY>SUCCESS</BODY></HTML>"
33: } else { HTTP::respond 200 content "<HTML><BODY>Error! Must supply /table/key/value/</BODY></HTML>" }
34: }
35: "PUT" {
36: if { [info exists tname] && [info exists key] && [info exists val] } {
37: table replace -subtable $tname $key $val indefinite indefinite
38: HTTP::respond 200 content "<HTML><BODY>SUCCESS</BODY></HTML>"
39: } else { HTTP::respond 200 content "<HTML><BODY>Error! Must supply /table/key/value/</BODY></HTML>" }
40: }
41: "DELETE" {
42: if { [info exists tname] && [info exists key] } {
43: table delete -subtable $tname $key
44: HTTP::respond 200 content "<HTML><BODY>SUCCESS</BODY></HTML>"
45: } else { HTTP::respond 200 content "<HTML><BODY>Error! Must supply /table/key/</BODY></HTML>" }
46: }
47: default { HTTP::respond 200 content "<HTML><BODY>Not a valid method for this interface</BODY></HTML>" }
48: }
49: } else { HTTP::respond 200 content "<HTML><BODY>Not Permitted</BODY></HTML>" }
50: }