Posted to tcl by Napier at Wed Oct 15 00:33:09 GMT 2014view raw

  1. namespace eval Firebase {
  2. # The following packages are required for operation:
  3. package require json::write
  4. package require json
  5. package require http
  6. package require tls
  7.  
  8. variable URL "automationapps.firebaseio.com"
  9. variable Secret "8ba9dbadzve2pnPdrIMLpCgcc9cYf7t10EhNavRS"
  10. variable Timestamp "{\".sv\": \"timestamp\"}"
  11. variable DefaultMethod "PATCH"
  12. variable DefaultBlocking 0
  13. ::http::register https 443 tls::socket
  14.  
  15. proc Register {url secret} {
  16. # Provide the URL & Auth Token / Firebase Secret to be used on all Send Calls
  17. # this will be the permament default for all calls after registering.
  18. set ::Firebase::URL $url
  19. set ::Firebase::Secret $secret
  20. }
  21.  
  22. proc Send {args} {
  23. ## Description / Overview:
  24. # Sends Data to Firebase and uses the following Arguments
  25. ## Example Call:
  26. # ::Firebase::Send -method PATCH -directory users -dict "{Key 1} {Value 1} {Key 2} {Value 2}"
  27. #
  28. ## -method : This can be PUT, PATCH, POST and defaults to PATCH if not defined
  29. ### Example: -method "PUT"
  30. #
  31. ## -directory : This defines where the data will go relative to the Firebase URL
  32. ### Note: Do not provide trailing or leading /'s
  33. ### Example: -directory "dir1/dir2/dir3"
  34. #
  35. ## -data : This must be a valid TCL Dictionary with your Keys & Values that should be placed
  36. ## at the location provided in the "-directory" argument.
  37. ### Example: -dict "{Key 1} {Value 1} {Key 2} {Value 2}"
  38. #
  39. ## -secret : You can temporarily replace the default Firebase Secret (Auth Token) by defining the -secret argument.
  40. ### Example: -secret $firebaseSecret
  41. #
  42. ## -url : You can temporarily replace the default Firebase URL by defining the -url argument.
  43. ### Example: -url $firebaseURL
  44. #
  45. ## -arguments : You can define arguments as a Tcl Dictionary to be included
  46. ### NOTE: Not currently available
  47. #
  48. ## -blocking : Defines whether the call should be made with blocking or unblocking. Should be a 0 (Unlocking) or 1 (Blocking)
  49. ### Note: This will default to 0 (Unblocking).
  50. ### Note: You must use blocking if a response is required in the return value.
  51. ### Example: -blocking 1
  52. #
  53. if {[dict exists $args -secret]} {set secret [dict get $args -secret]} else {set secret ${::Firebase::Secret}}
  54. if {[dict exists $args -url]} {set url [string map {"https://" ""} [dict get $args -url]]} else {set url ${::Firebase::URL}}
  55. if {[dict exists $args -method]} {set method [dict get $args -method]} else {set method ${::Firebase::DefaultMethod}}
  56. if {[dict exists $args -directory]} {set directory [string map {" " "+"} [dict get $args -directory]]} else {set directory ""}
  57. if {[dict exists $args -dict]} {set tempDict [dict get $args -dict]} else {return -code error "Must Define a Tcl Dictionary in -dict"}
  58. if {[dict exists $args -arguments]} {set arguments [dict get $args -arguments]} else {set arguments ""}
  59. if {[dict exists $args -blocking]} {
  60. set blocking [dict get $args -blocking]
  61. if {![string is bool $blocking]} {return -code error "Argument -blocking must be a boolean value"}
  62. } else {set blocking ${::Firebase::DefaultBlocking}}
  63.  
  64. dict for {k v} $tempDict {
  65. if {[string is integer $v] || [string index $v 0] == {\"} && [string index $v end] == {\"}} { continue
  66. } else {dict set tempDict $k [::json::write string $v]}
  67. }
  68. set data [::json::write object {*}$tempDict]
  69. if {!$blocking} {
  70. ::http::geturl https://${url}/${directory}.json?auth=${secret}${arguments} -query $data -method $method -command ::Firebase::UnblockingCallback
  71. } else {
  72. set token [::http::geturl https://${url}/${directory}.json?auth=${secret}${arguments} -query $data -method $method]
  73. set response [::http::data $token]
  74. ::http::cleanup $token
  75. return $response
  76. }
  77. return
  78. }
  79.  
  80. proc UnblockingCallback {token} {
  81. puts "Cleaning up $token"
  82. ::http::cleanup $token
  83. }
  84.  
  85. proc Get {args} {
  86. ## Description / Overview:
  87. # Gets Data from Firebase based on the specified Arguments. Will respond with a Tcl Dictionary.
  88. # If -key or -keys is not provided, the entire directory and all sub directories will be returned as a Tcl Dictionary.
  89. #
  90. ## -directory : This defines where the data will be retrieved relative to the Firebase URL
  91. ### Note: Do not provide trailing or leading /'s
  92. ### Example: -directory "dir1/dir2/dir3"
  93. #
  94. ## -key: The "Key" to get from the Firebase Directory provided. Will return the keys value in a Tcl Dictionary.
  95. ### Example: -key "Key 1"
  96. ### Returns: {Key 1} {Value 1}
  97. #
  98. ## -keys : If provided, will attempt to get each Key provided from the directory. Should be a Tcl List.
  99. ### Note: This will return a Tcl Dictionary
  100. ### Example: -keys "{Key 1} {Key 2} {Key 3}"
  101. ### Returns: {Key 1} {Value 1} {Key 2} {Value 2} {Key 3} {Value 3}
  102. ## -secret : You can temporarily replace the default Firebase Secret (Auth Token) by defining the -secret argument.
  103. ### Example: -secret $firebaseSecret
  104. #
  105. ## -url : You can temporarily replace the default Firebase URL by defining the -url argument.
  106. ### Example: -url $firebaseURL
  107. set tempDict [dict create]; set keys ""
  108. if {[dict exists $args -directory]} {set directory [string map {" " "+"} [dict get $args -directory]]} else {set directory ""}
  109. if {[dict exists $args -secret]} {set secret [dict get $args -secret]} else {set secret $::Firebase::Secret}
  110. if {[dict exists $args -url]} {set url [string map {"https://" ""} [dict get $args -url]]} else {set url $::Firebase::URL}
  111. if {[dict exists $args -key]} {
  112. lappend keys [dict get $args -key]
  113. } elseif {[dict exists $args -keys]} {
  114. lappend keys {*}[dict get $args -keys]
  115. } else {
  116. set token [::http::geturl https://${url}/${directory}/.json?auth=${secret}]
  117. set response [::http::data $token]
  118. ::http::cleanup $token
  119. set tempDict [::json::json2dict $response]
  120. return $tempDict
  121. }
  122. foreach key $keys {
  123. puts "Key is $key"
  124. set FormattedKey [::Firebase::ue $key]
  125. set token [::http::geturl https://${url}/${directory}/${FormattedKey}.json?auth=${secret}]
  126. set response [::http::data $token]
  127. ::http::cleanup $token
  128. set response [::json::json2dict $response]
  129. lappend tempDict $key $response
  130. }
  131. return $tempDict
  132. }
  133.  
  134. proc Delete {args} {
  135. ## Description / Overview:
  136. # Deletes data from Firebase based on the specified Arguments
  137. # Note: Only 1 of the "-key" "-keys" or "-dict" should be called at any time or an error will be returned.
  138. # Note: If -key, -keys, or -dict are not provided the directory will be deleted.
  139. #
  140. ## Example Call:
  141. # ::Firebase::Delete -directory dir1/dir2/dir3 -key Test
  142. #
  143. ## -directory : This defines where the data will be deleted relative to the Firebase URL
  144. ### Note: Do not provide trailing or leading /'s
  145. ### Example: -directory "dir1/dir2/dir3"
  146. #
  147. ## -key : The "Key" to delete from the Firebase Directory provided.
  148. ### Example: -key "Key 1"
  149. #
  150. ## -keys : If provided, will attempt to delete each Key provided. Should be a Tcl List.
  151. ### Example: -keys "{Key 1} {Key 2} {Key 3}"
  152. #
  153. ## -dict : If provided will attempt to delete each Key of the provided Tcl Dict.
  154. ### Example: -dict "{Key 1} {Value 1} {Key 2} {Value 2} {Key 3} {Value 3}"
  155. #
  156. ## -secret : You can temporarily replace the default Firebase Secret (Auth Token) by defining the -secret argument.
  157. ### Example: -secret $firebaseSecret
  158. #
  159. ## -url : You can temporarily replace the default Firebase URL by defining the -url argument.
  160. ### Example: -url $firebaseURL
  161. #
  162. ## -blocking : Defines whether the call should be made with blocking or unblocking. Should be a 0 (Unlocking) or 1 (Blocking)
  163. ### Note: This will default to 0 (Unblocking).
  164. ### Note: You must use blocking if a response is required in the return value.
  165. ### Example: -blocking 1
  166.  
  167. if {[dict exists $args -directory]} {set directory [string map {" " "+"} [dict get $args -directory]]} else {set directory ""}
  168. if {[dict exists $args -secret]} {set secret [dict get $args -secret]} else {set secret $::Firebase::Secret}
  169. if {[dict exists $args -url]} {set url [string map {"https://" ""} [dict get $args -url]]} else {set url $::Firebase::URL}
  170. if {[dict exists $args -blocking]} {
  171. set blocking [dict get $args -blocking]
  172. if {![string is bool $blocking]} {return -code error "Argument -blocking must be a boolean value"}
  173. } else {set blocking ${::Firebase::DefaultBlocking}}
  174. set keys ""
  175. if {[dict exists $args -key]} {
  176. lappend keys [dict get $args -key]
  177. } elseif {[dict exists $args -keys]} {
  178. lappend keys {*}[dict get $args -keys]
  179. } elseif {[dict exists $args -dict]} {
  180. lappend keys [dict keys [dict get $args -dict]]
  181. } else {
  182. if {!$blocking} {
  183. ::http::geturl https://${url}/${directory}/.json?auth=${secret} -method DELETE -command ::Firebase::UnblockingCallback
  184. } else {
  185. set token [::http::geturl https://${url}/${directory}/.json?auth=${secret} -method DELETE]
  186. ::http::cleanup $token
  187. }
  188. return
  189. }
  190. foreach key $keys {
  191. set key [::Firebase::ue $key]
  192. if {!$blocking} {
  193. ::http::geturl https://${url}/${directory}/${key}.json?auth=${secret} -method DELETE -command ::Firebase::UnblockingCallback
  194. continue
  195. } else {
  196. set token [::http::geturl https://${url}/${directory}/${key}.json?auth=${secret} -method DELETE]
  197. ::http::cleanup $token
  198. continue
  199. }
  200. }
  201. return
  202. }
  203.  
  204. proc ue_init {} {
  205. lappend d + { }
  206. for {set i 0} {$i < 256} {incr i} {
  207. set c [format %c $i]; set x %[format %02x $i]
  208. if {![string match {[a-zA-Z0-9]} $c]} {lappend e $c $x; lappend d $x $c}
  209. }
  210. set ::ue_map $e; set ::ud_map $d
  211. }
  212. ::Firebase::ue_init
  213. proc ue {s} {string map $::ue_map $s}; proc ud {s} {string map $::ud_map $s}
  214. }