List ODBC data sources

這是一個簡單的程式，列出目前環境中 ODBC 的 data sources。

#!/usr/bin/env tclsh

#
# A simple program to list ODBC Data Sources by Tcl/Tk, version 0.1
#

package require Tcl 8.6
package require Tk
package require tablelist
package require tdbc::odbc

if { [catch {package require awthemes}]==0} {
    ttk::setTheme "awlight"
}

wm geometry . 600x400+100+100

frame .menubar -relief raised -bd 2
pack .menubar -side top -fill x

ttk::menubutton .menubar.file -text File -menu .menubar.file.menu
menu .menubar.file.menu -tearoff 0
.menubar.file.menu add command -label Quit -command Exit
ttk::menubutton .menubar.help -text Help -menu .menubar.help.menu
menu .menubar.help.menu -tearoff 0
.menubar.help.menu add command -label About -command HelpAbout
pack .menubar.file .menubar.help -side left

# Contextual Menus
menu .menu
foreach i [list Exit] {
    .menu add command -label $i -command $i
}

if {[tk windowingsystem]=="aqua"} {
    bind . <2> "tk_popup .menu %X %Y"
    bind . <Control-1> "tk_popup .menu %X %Y"
} else {
    bind . <3> "tk_popup .menu %X %Y"
}

# Get data sources list and list
tablelist::tablelist .t -columns {0 "DSN" 0 "Driver"} -stretch all \
    -background white -font {Helvetica -14}
pack .t -fill both -expand 1 -side top
set sources [::tdbc::odbc::datasources]
foreach {dsn driver} $sources {
   .t insert end [list $dsn $driver]
}

# Handle special key
bind all <F1> HelpAbout

#=================================================================
# Event Handler
#=================================================================

proc Exit {} {
    set answer [tk_messageBox -message "Really quit?" -type yesno -icon warning]
    switch -- $answer {
        yes exit
    }
}

proc HelpAbout {} {
    set ans [tk_messageBox -title "About" -type ok -message \
    "Using TDBC-ODBC to list ODBC Data Sources." ]
}

RSS to HTML

下面的程式使用 TclCurl 自網站下載 RSS XML 的資料， 下載以後使用 tDom 分析並且將 title 與 link 的資料儲存為 html 格式。

#!/usr/bin/env tclsh

package require TclCurl
package require tdom

proc get_rss {url} {
    try {
        set curlHandle [curl::init]
        $curlHandle configure -url $url -bodyvar result
        $curlHandle setopt CURLOPT_HTTP_VERSION 2TLS

        catch { $curlHandle perform } curlErrorNumber
        if { $curlErrorNumber != 0 } {
            throw error [curl::easystrerror $curlErrorNumber]
        }
    } on error {em} {
        error "Error: $em"
    } finally {
       $curlHandle cleanup
    }

    return $result
}

proc parse {XML ofname} {
    set doc [dom parse $XML]
    set root [$doc documentElement]
    set titleList [$root selectNodes //item/title]
    set linkList [$root selectNodes //item/link]

    set out [open $ofname w 0666]
    foreach tnode $titleList lnode $linkList {
        set ntitle [$tnode text]
        set nlink [$lnode text]
        puts $out "<a href=\"$nlink\">$ntitle</a><br>"
    }
    close $out
}

if {$argc == 2} {
    set url [lindex $argv 0]
    set ofile [lindex $argv 1]
} else {
    puts "Usage:"
    puts "\ttclsh rss2html.tcl url filename"
    exit
}

if {[catch {set data [get_rss $url]} err]} {
    puts $err
} else {
    parse $data $ofile
}