2021-07-25

tcl-gremlin

tcl-gremlin: Gremlin Server driver for Tcl


上一篇文章的延續,整合成為一個套件。只有簡單的測試過,目前已經可以使用 Websocket 連線 Gremlin server,送出 query string 然後取得結果。

2021-07-20

Websocket

Apache TinkerPop 的 Gremlin Server 使用 Websocket 或者是 HTTP 協定與 client 溝通。 如果是 Websocket,使用的指令如下:

bin/gremlin-server.sh conf/gremlin-server-classic.yaml

而使用者可以透過 Websocket 傳送 script string 給 Gremlin Server 執行,並且取得執行的結果。

Tcllib 提供了 websocket server 與 client 的實作,這裡測試 client 的部份。 下面就是使用 Tcl 寫的測試程式(改寫自 Tcllib 文件的範例):

package require websocket
package require uuid
::websocket::loglevel debug

proc handler { sock type msg } {
    switch -glob -nocase -- $type {
        co* {
            puts "Connected on $sock"
        }
        te* {
            puts "RECEIVED: $msg"
        }
        cl* -
        dis* {
        }
    }    
}

proc test { sock } {
    puts "[::websocket::conninfo $sock type] from \
          [::websocket::conninfo $sock sockname] to \
          [::websocket::conninfo $sock peername]"

    set id [::uuid::uuid generate]
    set msg "{\"requestId\":\"$id\",
              \"op\":\"eval\",
              \"processor\":\"\",
              \"args\":{\"gremlin\":\"g.V(x).out()\",
                        \"bindings\":{\"x\":1},
                        \"language\":\"gremlin-groovy\"}}"

    ::websocket::send $sock text $msg
}

set sock [::websocket::open ws://localhost:8182/gremlin handler]
after 400 test $sock
vwait forever

Gremlin server 除了支援 TEXT type 的訊息,也支援 BINARY type 的訊息,下面是相關的測試:

package require websocket
package require uuid
::websocket::loglevel debug

proc handler { sock type msg } {
    switch -glob -nocase -- $type {
        co* {
            puts "Connected on $sock"
        }
        bi* {
            puts "RECEIVED: $msg"
            set ::received 1
        }
        cl* -
        dis* {
        }
    }    
}

proc test { sock } {
    puts "[::websocket::conninfo $sock type] from \
          [::websocket::conninfo $sock sockname] to \
          [::websocket::conninfo $sock peername]"

    set id [::uuid::uuid generate]
    set msg "{\"requestId\":\"$id\",
              \"op\":\"eval\",
              \"processor\":\"\",
              \"args\":{\"gremlin\":\"g.V(x).out()\",
                        \"bindings\":{\"x\":1},
                        \"language\":\"gremlin-groovy\"}}"
    set mimetype "application/json"
    set length [binary format c [string length $mimetype]]
    set finalmsg [string cat $length $mimetype $msg]

    ::websocket::send $sock binary $finalmsg
}

set sock [::websocket::open ws://localhost:8182/gremlin handler]
after 400 test $sock
set received 0
vwait received
after 100
::websocket::close $sock 1000

2021-07-16

Invert Bit

You are given integers 0 <= $m <= 255 and 1 <= $n <= 8.

Write a script to invert $n bit from the end of the binary representation of $m and print the decimal representation of the new binary number.

#!/usr/bin/env tclsh

if {$argc >= 2} {
    set m [lindex $argv 0]
    set n [lindex $argv 1]
} else {
    puts "Please input two numbers, m and n."
    exit    
}

if {$m < 0 || $m > 255} {
    puts "Number requires 0 <= M <= 255"
    exit
}

if {$n < 1 || $n > 8} {
    puts "Number requires 1 <= N <= 8"
    exit
}

set bnumber [format %08b $m]
set string1 ""
set string3 ""
set string2 [string index $bnumber [expr 8 - $n]]
if {$n < 8} {
    set string1 [string range $bnumber 0 [expr 8 - $n - 1]]
}
if {$n > 1} {
    set string3 [string range $bnumber [expr 8 - $n + 1] end]
}

if {[string compare $string2 "1"]==0} {
    set result [string cat $string1 "0" $string3]
} else {
    set result [string cat $string1 "1" $string3]
}

puts [format "%d" 0b$result]

2021-07-05

Swap Odd/Even bits

You are given a positive integer $N less than or equal to 255.

Write a script to swap the odd positioned bit with even positioned bit and print the decimal equivalent of the new binary representation.

#!/usr/bin/env tclsh
if {$argc >= 1} {
    set number [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a number"
    exit    
}

if {$number <=0 || $number > 255} {
    puts "Number requires 0 < N <= 255"
    exit
}

set bnumber [format %08b $number]
set length [string length $bnumber]
set answer ""
for {set i 0} {$i < $length} {incr i 2} {
    set n1 [string index $bnumber $i]
    set n2 [string index $bnumber [expr $i + 1]]
    set answer [string cat $answer $n2 $n1]
}
puts [format "%d" 0b$answer]

Clock Angle

You are given time $T in the format hh:mm.

Write a script to find the smaller angle formed by the hands of an analog clock at a given time.

#!/usr/bin/env tclsh

if {$argc >= 1} {
    set timestring [lindex $argv 0]
} elseif {$argc == 0} {
    puts "Please input a string"
    exit    
}

set clockstring [split $timestring ":"]
set hour [lindex $clockstring 0]
set second [lindex $clockstring 1]

# Remove leading zero to let expr work correctly
scan $hour %d hour
scan $second %d second

if {$hour < 0 || $hour >= 12} {
    puts "Invalid hour data."
}

if {$second < 0 || $second >= 60} {
    puts "Invalid second data."
}

set secvalue [expr $second * 6]
set hourvalue [expr ($hour * 30) + ($secvalue / 12)]

if {$hourvalue > $secvalue} {
    set value1 [expr 360 - $hourvalue + $secvalue]
    set value2 [expr $hourvalue - $secvalue]
    if {$value1 > 0 && $value1 < $value2} {
        puts "$value1 degree"
    } else {
        puts "$value2 degree"
    }
} else {
    set value1 [expr 360 - $secvalue + $hourvalue]
    set value2 [expr $secvalue - $hourvalue]
    if {$value1 > 0 && $value1 < $value2} {
        puts "$value1 degree"
    } else {
        puts "$value2 degree"
    }
}

tcl-awthemes

tcl-awthemes 簡介:

awdark and awlight themes for Tk, loosely based on the adwaita themes. Scalable themes: awdark, awlight, black, winxpblue, breeze, arc, clearlooks.


我發現有些 Linux Distribution 有包這個 套件,所以寫了 tcl-awthemes-spec 用來打包成 RPM 檔案並且在 openSUSE 使用。

2021-07-04

tcl-rocksdb TLS error issue

我發現 tcl-rocksdb 在載入時會出現 TLS error: cannot allocate memory in static TLS block 的問題,經過搜尋與研究,是因為 RocksDB 使用了 jemalloc,而 jemalloc 在 5.0 之後就會有這個問題

解決的方法有幾個,一個是連結 jemalloc 時使用 static library 而非動態連結;一個是編譯 jemalloc 時加入選項 --disable-initial-exec-tls 來解決 TLS error issue,但是這樣使用者就要自己編譯 jemalloc。

另外的解決方法就是暫時在 RocksDB 關掉 jemalloc,沒有使用 jemalloc 就沒有載入問題。經過思考,因為我目前不想要在自己的 OBS repo 放一個 jemalloc,所以暫時關掉了我放在 OpenSUSE Build Service 上 RocksDB jemalloc 的選項,這樣連結到 rocksdb 的程式或者是函式庫就不會出現載入問題。