2018-12-17

VecTcl: 0.3

VecTcl v0.3:
This is a checkpoint release. Bugfixes since 0.2 are included.


VecTcl 在最近釋出了 v0.3 版,所以我更新了我自己的 openSUSE RPM spec 以進行測試。

2018-12-08

Apache Rivet and DIO

Apache Rivet 提供了 DIO 套件存取資料庫。而 DIO::Postgresql 是以 Pgtcl 作為底層的套件。

我先在 PostgreSQL 建立一個表格 Notes 作為測試:
create table if not exists Notes (id uuid DEFAULT md5(random()::text || clock_timestamp()::text)::uuid, 
title varchar(255), body text, created timestamp, PRIMARY KEY (id));


接下來撰寫一個簡單的程式測試 Apache Rivet。

建立檔案 tdbcnoteservices.tcl,將資料庫的實作部份放在這裡(使用 tdbc::postgres):
package require tdbc::postgres

proc getAllNotes {} {
    set rows {}

    tdbc::postgres::connection create db -user danilo -password danilo -port 5432
    set stmt [db prepare {select * from Notes order by created}]
    $stmt execute
    set rows [$stmt allrows -as lists]

    $stmt close
    db close

    return $rows
}

proc getNote {id} {
    set myparams [dict create id $id]

    tdbc::postgres::connection create db -user danilo -password danilo -port 5432
    set stmt [db prepare {select * from Notes where id = :id}]
    $stmt execute $myparams
    set rows [$stmt allrows -as lists]
   
    $stmt close
    db close

    return $rows    
}

proc addNote {title body} {
    set myparams [dict create title $title body $body]
    tdbc::postgres::connection create db -user danilo -password danilo -port 5432
    set stmt [db prepare {INSERT INTO Notes (Title, Body, Created) values (:title, :body, now())}]
    set resultset [$stmt execute $myparams]
    set rowcount [$resultset rowcount]

    $resultset close
    $stmt close
    db close

    return $rowcount
}

proc updateNote {id title body} {
    set myparams [dict create id $id title $title body $body]
    tdbc::postgres::connection create db -user danilo -password danilo -port 5432
    set stmt [db prepare {UPDATE Notes SET Title = :title, Body = :body where Id = :id}]
    set resultset [$stmt execute $myparams]
    set rowcount [$resultset rowcount]

    $resultset close
    $stmt close
    db close

    return $rowcount
}

proc deleteNote {id} {
    set myparams [dict create id $id]
    tdbc::postgres::connection create db -user danilo -password danilo -port 5432
    set stmt [db prepare {DELETE FROM Notes where Id = :id}]
    set resultset [$stmt execute $myparams]
    set rowcount [$resultset rowcount]

    $resultset close
    $stmt close
    db close

    return $rowcount
}


再來就是測試我比較不熟悉的 DIO 套件,建立 dionoteservices.tcl 檔案,然後實作同樣的功能:
package require DIO

proc getAllNotes {} {
    set rows {}
    set db [::DIO::handle Postgresql -host localhost -port 5432 -user danilo -pass danilo -db danilo]

    set rows [list]
    $db forall {select id, title, body, created from Notes order by created} row {
        set myrow [list $row(id) $row(title) $row(body) $row(created)]    
        lappend rows $myrow
    }

    $db destroy
    return $rows
}

proc getNote {id} {
    set rows {}    
    set db [::DIO::handle Postgresql -host localhost -port 5432 -user danilo -pass danilo -db danilo]

    set query "select id, title, body, created from Notes where id = '$id'"
    set rows [list]
    $db forall $query row {
        set myrow [list $row(id) $row(title) $row(body) $row(created)]
        lappend rows $myrow
    }

    $db destroy
    return $rows    
}

proc addNote {title body} {
    set db [::DIO::handle Postgresql -host localhost -port 5432 -user danilo -pass danilo -db danilo]

    set arrayVar(Title) $title
    set arrayVar(Body) $body
    set arrayVar(Created) "now()"
    set rowcount [$db insert Notes arrayVar]

    $db destroy
    return $rowcount
}

proc updateNote {id title body} {
    set db [::DIO::handle Postgresql -host localhost -port 5432 -user danilo -pass danilo -db danilo]

    set arrayVar(Id) $id
    set arrayVar(Title) $title
    set arrayVar(Body) $body
    set rowcount [$db update arrayVar -table Notes -keyfield Id]

    $db destroy
    return $rowcount
}

proc deleteNote {id} {
    set db [::DIO::handle Postgresql -host localhost -port 5432 -user danilo -pass danilo -db danilo]

    set rowcount [$db delete $id -table Notes -keyfield Id]

    $db destroy    
    return $rowcount
}


這樣只要 source 的檔案不同,就可以測試不同的資料庫實作部份。

2018-12-07

tclws 2.6.2

ANNOUNCE: tclws 2.6.2 released


Web Services for Tcl provides both client side access to Web Services and server side creation of Web Services. Currently only document/literal and rpc/encoded with HTTP Soap transport are supported on the client side.

tclws 這次只有 client 端的修正。我也更新了我自己的 openSUSE RPM spec

2018-12-06

Tcl: argv

argv

$argv is a global variable provided by tclsh and wish mainline code.


下面就是 Tcler's wiki 的範例(我只有改寫第一行):
#!/usr/bin/env tclsh

if { $::argc > 0 } {
    set i 1
    foreach arg $::argv {
        puts "argument $i is $arg"
        incr i
    }
} else {
    puts "no command line argument passed"
}