Posted to tcl by Napier at Wed Oct 15 00:33:09 GMT 2014view raw
- namespace eval Firebase {
- # The following packages are required for operation:
- package require json::write
- package require json
- package require http
- package require tls
- variable URL "automationapps.firebaseio.com"
- variable Secret "8ba9dbadzve2pnPdrIMLpCgcc9cYf7t10EhNavRS"
- variable Timestamp "{\".sv\": \"timestamp\"}"
- variable DefaultMethod "PATCH"
- variable DefaultBlocking 0
- ::http::register https 443 tls::socket
- proc Register {url secret} {
- # Provide the URL & Auth Token / Firebase Secret to be used on all Send Calls
- # this will be the permament default for all calls after registering.
- set ::Firebase::URL $url
- set ::Firebase::Secret $secret
- }
- proc Send {args} {
- ## Description / Overview:
- # Sends Data to Firebase and uses the following Arguments
- ## Example Call:
- # ::Firebase::Send -method PATCH -directory users -dict "{Key 1} {Value 1} {Key 2} {Value 2}"
- #
- ## -method : This can be PUT, PATCH, POST and defaults to PATCH if not defined
- ### Example: -method "PUT"
- #
- ## -directory : This defines where the data will go relative to the Firebase URL
- ### Note: Do not provide trailing or leading /'s
- ### Example: -directory "dir1/dir2/dir3"
- #
- ## -data : This must be a valid TCL Dictionary with your Keys & Values that should be placed
- ## at the location provided in the "-directory" argument.
- ### Example: -dict "{Key 1} {Value 1} {Key 2} {Value 2}"
- #
- ## -secret : You can temporarily replace the default Firebase Secret (Auth Token) by defining the -secret argument.
- ### Example: -secret $firebaseSecret
- #
- ## -url : You can temporarily replace the default Firebase URL by defining the -url argument.
- ### Example: -url $firebaseURL
- #
- ## -arguments : You can define arguments as a Tcl Dictionary to be included
- ### NOTE: Not currently available
- #
- ## -blocking : Defines whether the call should be made with blocking or unblocking. Should be a 0 (Unlocking) or 1 (Blocking)
- ### Note: This will default to 0 (Unblocking).
- ### Note: You must use blocking if a response is required in the return value.
- ### Example: -blocking 1
- #
- if {[dict exists $args -secret]} {set secret [dict get $args -secret]} else {set secret ${::Firebase::Secret}}
- if {[dict exists $args -url]} {set url [string map {"https://" ""} [dict get $args -url]]} else {set url ${::Firebase::URL}}
- if {[dict exists $args -method]} {set method [dict get $args -method]} else {set method ${::Firebase::DefaultMethod}}
- if {[dict exists $args -directory]} {set directory [string map {" " "+"} [dict get $args -directory]]} else {set directory ""}
- if {[dict exists $args -dict]} {set tempDict [dict get $args -dict]} else {return -code error "Must Define a Tcl Dictionary in -dict"}
- if {[dict exists $args -arguments]} {set arguments [dict get $args -arguments]} else {set arguments ""}
- if {[dict exists $args -blocking]} {
- set blocking [dict get $args -blocking]
- if {![string is bool $blocking]} {return -code error "Argument -blocking must be a boolean value"}
- } else {set blocking ${::Firebase::DefaultBlocking}}
- dict for {k v} $tempDict {
- if {[string is integer $v] || [string index $v 0] == {\"} && [string index $v end] == {\"}} { continue
- } else {dict set tempDict $k [::json::write string $v]}
- }
- set data [::json::write object {*}$tempDict]
- if {!$blocking} {
- ::http::geturl https://${url}/${directory}.json?auth=${secret}${arguments} -query $data -method $method -command ::Firebase::UnblockingCallback
- } else {
- set token [::http::geturl https://${url}/${directory}.json?auth=${secret}${arguments} -query $data -method $method]
- set response [::http::data $token]
- ::http::cleanup $token
- return $response
- }
- return
- }
- proc UnblockingCallback {token} {
- puts "Cleaning up $token"
- ::http::cleanup $token
- }
- proc Get {args} {
- ## Description / Overview:
- # Gets Data from Firebase based on the specified Arguments. Will respond with a Tcl Dictionary.
- # If -key or -keys is not provided, the entire directory and all sub directories will be returned as a Tcl Dictionary.
- #
- ## -directory : This defines where the data will be retrieved relative to the Firebase URL
- ### Note: Do not provide trailing or leading /'s
- ### Example: -directory "dir1/dir2/dir3"
- #
- ## -key: The "Key" to get from the Firebase Directory provided. Will return the keys value in a Tcl Dictionary.
- ### Example: -key "Key 1"
- ### Returns: {Key 1} {Value 1}
- #
- ## -keys : If provided, will attempt to get each Key provided from the directory. Should be a Tcl List.
- ### Note: This will return a Tcl Dictionary
- ### Example: -keys "{Key 1} {Key 2} {Key 3}"
- ### Returns: {Key 1} {Value 1} {Key 2} {Value 2} {Key 3} {Value 3}
- ## -secret : You can temporarily replace the default Firebase Secret (Auth Token) by defining the -secret argument.
- ### Example: -secret $firebaseSecret
- #
- ## -url : You can temporarily replace the default Firebase URL by defining the -url argument.
- ### Example: -url $firebaseURL
- set tempDict [dict create]; set keys ""
- if {[dict exists $args -directory]} {set directory [string map {" " "+"} [dict get $args -directory]]} else {set directory ""}
- if {[dict exists $args -secret]} {set secret [dict get $args -secret]} else {set secret $::Firebase::Secret}
- if {[dict exists $args -url]} {set url [string map {"https://" ""} [dict get $args -url]]} else {set url $::Firebase::URL}
- if {[dict exists $args -key]} {
- lappend keys [dict get $args -key]
- } elseif {[dict exists $args -keys]} {
- lappend keys {*}[dict get $args -keys]
- } else {
- set token [::http::geturl https://${url}/${directory}/.json?auth=${secret}]
- set response [::http::data $token]
- ::http::cleanup $token
- set tempDict [::json::json2dict $response]
- return $tempDict
- }
- foreach key $keys {
- puts "Key is $key"
- set FormattedKey [::Firebase::ue $key]
- set token [::http::geturl https://${url}/${directory}/${FormattedKey}.json?auth=${secret}]
- set response [::http::data $token]
- ::http::cleanup $token
- set response [::json::json2dict $response]
- lappend tempDict $key $response
- }
- return $tempDict
- }
- proc Delete {args} {
- ## Description / Overview:
- # Deletes data from Firebase based on the specified Arguments
- # Note: Only 1 of the "-key" "-keys" or "-dict" should be called at any time or an error will be returned.
- # Note: If -key, -keys, or -dict are not provided the directory will be deleted.
- #
- ## Example Call:
- # ::Firebase::Delete -directory dir1/dir2/dir3 -key Test
- #
- ## -directory : This defines where the data will be deleted relative to the Firebase URL
- ### Note: Do not provide trailing or leading /'s
- ### Example: -directory "dir1/dir2/dir3"
- #
- ## -key : The "Key" to delete from the Firebase Directory provided.
- ### Example: -key "Key 1"
- #
- ## -keys : If provided, will attempt to delete each Key provided. Should be a Tcl List.
- ### Example: -keys "{Key 1} {Key 2} {Key 3}"
- #
- ## -dict : If provided will attempt to delete each Key of the provided Tcl Dict.
- ### Example: -dict "{Key 1} {Value 1} {Key 2} {Value 2} {Key 3} {Value 3}"
- #
- ## -secret : You can temporarily replace the default Firebase Secret (Auth Token) by defining the -secret argument.
- ### Example: -secret $firebaseSecret
- #
- ## -url : You can temporarily replace the default Firebase URL by defining the -url argument.
- ### Example: -url $firebaseURL
- #
- ## -blocking : Defines whether the call should be made with blocking or unblocking. Should be a 0 (Unlocking) or 1 (Blocking)
- ### Note: This will default to 0 (Unblocking).
- ### Note: You must use blocking if a response is required in the return value.
- ### Example: -blocking 1
- if {[dict exists $args -directory]} {set directory [string map {" " "+"} [dict get $args -directory]]} else {set directory ""}
- if {[dict exists $args -secret]} {set secret [dict get $args -secret]} else {set secret $::Firebase::Secret}
- if {[dict exists $args -url]} {set url [string map {"https://" ""} [dict get $args -url]]} else {set url $::Firebase::URL}
- if {[dict exists $args -blocking]} {
- set blocking [dict get $args -blocking]
- if {![string is bool $blocking]} {return -code error "Argument -blocking must be a boolean value"}
- } else {set blocking ${::Firebase::DefaultBlocking}}
- set keys ""
- if {[dict exists $args -key]} {
- lappend keys [dict get $args -key]
- } elseif {[dict exists $args -keys]} {
- lappend keys {*}[dict get $args -keys]
- } elseif {[dict exists $args -dict]} {
- lappend keys [dict keys [dict get $args -dict]]
- } else {
- if {!$blocking} {
- ::http::geturl https://${url}/${directory}/.json?auth=${secret} -method DELETE -command ::Firebase::UnblockingCallback
- } else {
- set token [::http::geturl https://${url}/${directory}/.json?auth=${secret} -method DELETE]
- ::http::cleanup $token
- }
- return
- }
- foreach key $keys {
- set key [::Firebase::ue $key]
- if {!$blocking} {
- ::http::geturl https://${url}/${directory}/${key}.json?auth=${secret} -method DELETE -command ::Firebase::UnblockingCallback
- continue
- } else {
- set token [::http::geturl https://${url}/${directory}/${key}.json?auth=${secret} -method DELETE]
- ::http::cleanup $token
- continue
- }
- }
- return
- }
- proc ue_init {} {
- lappend d + { }
- for {set i 0} {$i < 256} {incr i} {
- set c [format %c $i]; set x %[format %02x $i]
- if {![string match {[a-zA-Z0-9]} $c]} {lappend e $c $x; lappend d $x $c}
- }
- set ::ue_map $e; set ::ud_map $d
- }
- ::Firebase::ue_init
- proc ue {s} {string map $::ue_map $s}; proc ud {s} {string map $::ud_map $s}
- }