下載中央銀行貨幣總計數M2年增率資料

#!c:/tcl/bin/tclsh86.exe
########################################################################
# 下載中央銀行貨幣總計數M2年增率資料 
########################################################################

package require http

set url "http://www.cbc.gov.tw/np.asp?ctNode=643&mp=1"
set token [http::geturl $url -validate 1]

# create an easy-to-use array variable
upvar #0 $token head

set location "http://www.cbc.gov.tw/"
append location [dict get $head(meta) Location]

puts "### Get file: $location"
http::cleanup $token

set filename "cbc_m1b.xls"

set f [open $filename {WRONLY CREAT EXCL}]
set token [http::geturl $location -channel $f]
http::cleanup $token
close $f

exit

中央銀行貨幣總計數M2年增率資料在首頁就有，只是不是採用直接連結的方式，而是要從 head 裡取得檔案的下載位址，再從下載位址下載。在查過 Tcler's Wiki 該怎麼處理以後，我稍微改寫一下，目前可以正確的從網站下載我需要的資料。

如果中央銀行讓使用者下載資料的位址是固定的，那麼這段 code 就可以一直用下去，如果位址不固定的話，那就要想一下該怎麼做才對。

下載台灣證券交易所的市值週報

#!c:/tcl/bin/tclsh86.exe
package require http
package require vfs::zip

########################################################################
# Download zip file
########################################################################
set remoteFile "http://www.twse.com.tw/ch/statistics/download/week.zip"
set localFile "week.zip"

set token [::http::geturl $remoteFile -binary 1]
set data [::http::data $token]

set channel [open $localFile w+]
fconfigure $channel -encoding binary -translation binary
puts -nonewline $channel $data
close $channel

::http::cleanup $token

########################################################################
# Now handle zip file
########################################################################
set mnt_file [vfs::zip::Mount $localFile $localFile]
file copy -force [glob $localFile/*] ./
vfs::zip::Unmount $mnt_file $localFile
file delete $localFile

exit

和之前寫的東西很像，使用 http 套件下載檔案，然後使用 vfs::zip 來解 zip 檔。要取得台灣證券交易所的市值週報資料的原因是因為我看到一篇 GDP 與市場大盤的文章，所以想要自己算看看目前的情況。

因為有可能會長期並且以季為單位的進行觀測，所以寫了這個 script，讓自己不用開瀏覽器就拿到資料，應該可以節省一些時間。

Threading Support: Configuration and Package

TIP #364: Threading Support: Configuration and Package


在 [incr Tcl] , TDBC 之後，Thread package 也成為內建的 contributed package，因此 Thread package 也會成為 8.6 的一員。

節錄會有影響的地方：

This will have no effect on Windows and OSX, where threaded configurations are default anyway, but will have an impact on other Unixes (Linux, Solaris, etc.)

The main issues arising from this relate to the Expect and TclX packages. This is because they make fork and signal commands available; these APIs are troublesome because of how they interact with Tcl's notifier and the POSIX Thread system in general.

使用 EXIF 的時間資料來改檔案名稱

第一版的 script 已經 OK 了，不過考慮到如果有多過於一天的照片，這樣好像還是有點麻煩，所以改寫變成為讀取 EXIF 的資料以後，再用檔案內的日期資料來改檔名。

Tcllib 有提供 jpeg 和 exif 二個套件可以使用，因為 jpeg 有提供範例，所以最後使用 jpeg 套件來實作：

#!/usr/bin/tclsh
#
# Rename script
#
# argument 1: folder location (option)
#

package require jpeg

puts "##########   Start   ##########"

if {$argc >= 1} {
 cd [lindex $argv 0]
} elseif {$argc == 0} {
 cd "c:/tmp"
}

foreach filename [glob *.jpg] {
 array set exif [::jpeg::getExif $filename]
 set today [clock format [clock scan $exif(DateTimeOriginal) \
          -format {%Y:%m:%d %H:%M:%S}] -format %Y%m%d]

 regsub -all {\mIMG} $filename $today newFileName

 file rename $filename $newFileName
}

puts "##########    End    ##########"

exit

相關資訊：
Wiki：Exchangeable image file format

Exchangeable image file format (Exif) is a specification for the image file format used by digital cameras. The specification uses the existing JPEG, TIFF Rev. 6.0, and RIFF WAV file formats, with the addition of specific metadata tags. It is not supported in JPEG 2000, PNG, or GIF.

File rename

#!/usr/bin/tclsh
#
# Rename script
#

puts "##########   Start   ##########"

if {$argc >= 1} {
   cd [lindex $argv 0]
} elseif {$argc == 0} {
   cd "c:/tmp"
}

set today [clock format [clock seconds] -format %Y%m%d]

foreach filename [glob *.jpg] {
   regsub -all {\mIMG} $filename $today newFileName
  
   file rename $filename $newFileName
}

puts "##########    End    ##########"

exit

會寫這個 script，是因為我的數位相機照完相以後，會是 IMG_0001.JPG, IMG_0002.JPG 這樣編號，而我習慣用日期來整理，所以要把檔名改為 20100116_0001.JPG 這種形式，而自己手動改有點浪費時間，所以寫一個改檔名的 script 來做這件事情。

使用了 glob 來列出所有 *.JPG 的檔案，再來把檔名前半部的 IMG 換成今天的日期，最後改檔名，應該就完成任務了。

tcllib 1.12 is out

這個消息已經晚了幾天（1.12 在 2009/12/08 已經 release 了），不過因為我是到現在才知道，所以還算是「新」消息吧。

官方網站還沒有更新，但是 SourceForge 檔案列表上已經有放上去檔案了。

Read Me 上的 Overview：

72 new packages in 10 modules
46 changed packages in 25 modules
14 internally changed packages in 12 modules
166 unchanged packages in 65 modules
301 packages, total in 95 modules, total

有趣的是，我看到有一個 coroutine package 包含在 1.12 這次的 release 裡，這需要 Tcl/Tk 8.6 或者是更高的版本才可以使用。

更新 Windows 平台環境： 使用 ActiveTcl 8.6 beta-2

Active Tcl 8.6 Beta

我發現 Active Tcl 更新了安裝檔案，所以也跟著更新了。這次的更新也更新了原本附帶的套件到目前的最新版（例如說 VFS），所以我已經昇級到這個版本了。

注意：這一版的 code base 仍然是 Tcl/Tk 8.6 beta 1，可以算是針對一些套件做 upgrade 的吧。

清除掉 Visual C++ 2008 Express 最近使用的專案列表

package require registry

label .show -text "Below is the list:"
grid .show -row 0 -column 0 -columnspan 2 -pady 3 -ipady 1

set count 0
set rootKey "HKEY_CURRENT_USER\\Software\\Microsoft\\VCExpress\\9.0\\ProjectMRUList"

foreach id [registry values $rootKey] {
if {[string length $id] >= 4} {
set text [registry get $rootKey $id]
ttk::checkbutton .$count -text $text -variable check($id)
grid .$count -column 0 -columnspan 4 -ipady 1 -sticky nsew
set check($id) 0
incr count 1
}
}

proc doClean {} {
foreach id [registry values $::rootKey] {
if {[string length $id] >= 4} {
    if {$::check($id) == 1} {    
        registry delete $::rootKey $id
    }
}
}

exit
}

# Let our button in next row
incr count 1

button .exit -text "Exit" -command exit
grid .exit -column 2 -row $count -pady 3 -ipady 1 -sticky nsew
button .clean -text "Clean" -command doClean
grid .clean -column 3 -row $count -pady 3 -ipady 1 -sticky nsew

使用 checkbutton 建立列表，讓使用者選擇要清除最近使用的專案列表中的哪一個。我們使用一個陣列記住目前使用者的選擇，如果使用者按 Clean，就去清掉使用者所選擇的那些項目。

Geometry Manager 使用 grid 來管理。

tDom and TclXML

Tcl 是個極容易擴充的語言（並且因此影響到後面出現或者是同期的 scripting language），在處理 XML 方面，有二個主要的套件：

• tDom
• TclXML/TclDOM

我會比較偏好 tDom，因為他雖然是用 C 實作，而且在架構上沒有 TclXML 的野心那麼大，但是 tDom 在管理上比較簡單（只有一個套件），不像 TclXML/TclDOM 需要好幾個套件組合起來、而且 TclDOM 隨著各個實作的不同，能力也不同（pure Tcl, Expat, libxml2）。

更多資料：TclDOM vs tDOM

TDBC 1.0 b13 已經包含 tdbc::postgres

我發現 TDBC PostgreSQL driver 已經完成了，所以小小的測試了一下（使用 PostgreSQL 8.4.1）：

package require tdbc::postgres
tdbc::postgres::connection create db -user danilo -password test -port 5432

set statement [db prepare {
 SELECT VERSION()
}]

$statement foreach row {
 puts [dict get $row version]
}

$statement close
db close

沒錯，確實已經可以運作了，而 tdbc::postgres 主要是透過 libpg 來實作的。

另外，TDBC 同時也包含了 Oracle 的 driver，但是這一個我就沒有測試了。