Apache CouchDB test code

package require Tcl 8.6
package require TclOO
package require http
package require base64

# The CouchDB server interface provides the basic interface to a CouchDB
# server for obtaining CouchDB information and getting and setting
# configuration information.
#
oo::class create CouchDB_Server {
    variable host
    variable port
    variable authtype
    variable username
    variable password
    variable firstcookie
    variable authSession

    constructor {HOST PORT AUTHTYPE {USERNAME ""} {PASSWORD ""}} {
        set host $HOST
        set port $PORT
        set authtype $AUTHTYPE
        set username $USERNAME
        set password $PASSWORD
        set firstcookie 0
        set authSession ""
    }

    destructor {
    }

    method send_request {url method {headers ""} {data ""}} {
        # Now support authtype: no basic cookie
        if {[string compare -nocase $authtype "basic"]==0} {
            set auth "Basic [base64::encode $username:$password]"
            lappend headers Authorization $auth
        } elseif {[string compare -nocase $authtype "cookie"]==0} {
            set cookiestring "AuthSession=$authSession"
            lappend headers Cookie $cookiestring
        }

        if { [string length $data] < 1 } {
            set tok [http::geturl $url -method $method -headers $headers]
        } else {
            set tok [http::geturl $url -method $method -headers $headers -query $data]
        }

        if {[string compare -nocase $authtype "cookie"]==0 && $firstcookie==1} {
            set meta [http::meta $tok]
            foreach {name value} $meta {
                if {[string compare $name Set-Cookie]==0} {
                    set firstlocation [string first "=" $value]
                    incr firstlocation 1
                    set lastlocation  [string first "; " $value]
                    incr lastlocation -1
                    set authSession [string range $value $firstlocation $lastlocation]
                }
            }
        }
        
        set res [http::data $tok] 
        http::cleanup $tok
        return $res
    }

    # Initiates new session for specified user credentials by providing Cookie value.
    method cookie_post {} {
        set firstcookie 1
        set myurl "http://$host:$port/_session"
        set headerl [list Accept "application/json" Content-Type "application/x-www-form-urlencoded"]
        set data [::http::formatQuery name $username password $password]
        set res [my send_request $myurl POST $headerl $data]

        set firstcookie 0

        return $res
    }

    # Returns complete information about authenticated user.
    method cookie_get {} {
        set myurl "http://$host:$port/_session"
        set headerl [list Accept "application/json" Content-Type "application/json"]
        set cookiestring "AuthSession=$authSession"
        lappend headers Cookie $cookiestring
        set res [my send_request $myurl GET $headerl]

        return $res
    }

    # Closes user’s session.
    method cookie_delete {} {
        set myurl "http://$host:$port/_session"
        set headerl [list Accept "application/json" Content-Type "application/json"]
        set cookiestring "AuthSession=$authSession"
        lappend headers Cookie $cookiestring
        set res [my send_request $myurl DELETE $headerl]

        return $res
    }

    # Accessing the root of a CouchDB instance returns meta information
    # about the instance.
    method hello {} {
        set myurl "http://$host:$port/"
        set headerl [list Accept "application/json" Content-Type "application/json"]
        set res [my send_request $myurl GET $headerl]

        return $res
    }

    # List of running tasks, including the task type, name, status and process ID.
    method active_tasks {} {
        set myurl "http://$host:$port/_active_tasks"
        set headerl [list Accept "application/json" Content-Type "application/json"]
        set res [my send_request $myurl GET $headerl]

        return $res
    }

    # Returns a list of all the databases in the CouchDB instance.
    method all_dbs {} {
        set myurl "http://$host:$port/_all_dbs"
        set headerl [list Accept "application/json" Content-Type "application/json"]
        set res [my send_request $myurl GET $headerl]

        return $res
    }

    # Returns a list of all database events in the CouchDB instance.
    method log {} {
        set myurl "http://$host:$port/_log"
        set headerl [list Accept "application/json" Content-Type "application/json"]
        set res [my send_request $myurl GET $headerl]

        return $res
    }

    #
    # CouchDB replication is a mechanism to synchronize databases. Much
    # like rsync synchronizes two directories locally or over a network,
    # replication synchronizes two databases locally or remotely.
    #

    # Request, configure, or stop, a replication operation.
    method replicate {data} {
        set myurl "http://$host:$port/_replicate"
        set headerl [list Accept "application/json" Content-Type "application/json"]
        set res [my send_request $myurl POST $headerl $data]

        return $res
    }

    # Restarts the CouchDB instance.
    method restart {} {
        set myurl "http://$host:$port/_restart"
        set headerl [list Accept "application/json" Content-Type "application/json"]
        set res [my send_request $myurl POST $headerl]

        return $res
    }

    # Returns a JSON object containing the statistics for the running server.
    method stats {} {
        set myurl "http://$host:$port/_stats"
        set headerl [list Accept "application/json" Content-Type "application/json"]
        set res [my send_request $myurl GET $headerl]

        return $res
    }
}

_db_updates 我在執行的時候反應怪怪的（可能是我設定 timeout 的方式錯誤），只會 timeout 以後傳回來空白，所以沒有加上在這段 code，其它關於 CouchDB server interface 的部份，我都試過了，最少不會向 _db_updates 一樣全無反應。

測試環境：
Windows XP SP3
ActiveTcl 8.6.4.1
Apache CouchDB 1.6.1
有設定 HTTP Basic Authentication，所以這份 code 反而是不需要認證的部份沒有測試過。

( *2015-12-08 更新)
( *2015-12-09 更新, add Cookie Authentication support)

下面就是測試這個 class 的 code：

source "./couchdb.tcl"

set username admin
set password mypasswd

set myserver [CouchDB_Server new localhost 5984 basic $username $password]

set response [$myserver all_dbs]
puts $response

set response [$myserver active_tasks]
puts $response

set response [$myserver log]
puts $response

set response [$myserver stats]
puts $response

set response [$myserver restart]
puts $response