Mercurial > hg > egg-tcls
view utillib.tcl @ 448:ac3b79eca0ca
fetch_weather: Change to use the new REST/JSON API for fetching Tiehallinto digitraffic weather data.
Sidenote: How can JSON format data be designed so idiotically?
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Thu, 28 Sep 2017 15:22:03 +0300 |
parents | 9c2cc740ec76 |
children | b29b0db02649 |
line wrap: on
line source
########################################################################## # # TCL functions library by Matti 'ccr' Hamalainen <ccr@tnsp.org> # (C) Copyright 2015-2017 Tecnic Software productions (TNSP) # # This script is freely distributable under GNU GPL (version 2) license. # ########################################################################## set utl_html_ent_str "-|-|'|'|—|-|‏||—|-|–|--|‪||‬|" append utl_html_ent_str "|‎||å|å|Å|Å|é|é|:|:| | " append utl_html_ent_str "|”|\"|“|\"|«|<<|»|>>|"|\"" append utl_html_ent_str "|ä|ä|ö|ö|Ä|Ä|Ö|Ö|&|&|<|<|>|>" append utl_html_ent_str "|ä|ä|å|ö|—|--|'|'|–|-|"|\"" append utl_html_ent_str "|||-|’|'|ü|ü|Ü|Ü|•|*|€|€" append utl_html_ent_str "|”|\"|‘|'|ä|ä|·|*|®|®|´|'" append utl_html_ent_str "|ö|ö|ö|ö|#|#|'|'|­||–|-|”|\"" append utl_html_ent_str "|…|...|…|...|"|\"|­||@|#" append utl_html_ent_str "| | |£|£|&|&|ž|ž|Ä|Ä|º|º" append utl_html_ent_str "|…|...|/|/| | |"|\"" set utl_html_ent_list [split [encoding convertfrom "utf-8" $utl_html_ent_str] "|"] # Convert given string, containing HTML/XML style entities into a normal # UTF-8 Unicode string, using the above entity->character mapping proc utl_convert_html_ent {udata} { global utl_html_ent_list return [string map -nocase $utl_html_ent_list [string map $utl_html_ent_list $udata]] } # Split given string "str" into a list of sub-strings of maximum length # "maxlen", by attempting to split at "words", if possible. proc utl_str_split {str maxlen} { set pos 0 set len [string length $str] set ulen 0 set ustr "" set result {} while {$pos < $len} { set end [string wordend $str $pos] set new [expr $end - $pos + 1] if {$ulen + $new < $maxlen} { append ustr [string range $str $pos $end] set ulen [expr $ulen + $new] } else { append ustr [string range $str $pos $end] lappend result $ustr set ustr "" set ulen 0 } set pos [expr $end + 1] } if {$ustr != ""} { lappend result $ustr } return $result } proc utl_match_delim_list {ulist ustr} { foreach ukey [split $ulist ";"] { if {[string match $ukey $ustr]} { return 1 } } return 0 } # Send IRC message with given message type, splitting the # string to fit to IRCNet (etc.) max message length. proc utl_msg_do {upreferredmsg upublic unick uchan umsg} { foreach uline [utl_str_split $umsg 450] { if {$upublic == 1} { putserv "$upreferredmsg $uchan :$uline" } else { putserv "$upreferredmsg $unick :$uline" } } } # Return formatted time for given UNIX timestamp proc utl_ctime {utime} { if {$utime == "" || $utime == "*"} { set utime 0 } return [clock format $utime -format "%d.%m.%Y %H:%M"] } ### ### SQL database handling ### proc utl_tdbc_sql_init {ndb_handle db_type db_name db_host db_port db_user db_pass} { upvar $ndb_handle udb_handle if {$db_type == "sqlite"} { if {$db_name == ""} { putlog " SQLite3 database file not set." return 0 } if {![file exists $db_name]} { putlog " URLLog SQLite3 database file '$db_name' not found, or not accessible!" return 0 } package require tdbc::sqlite3 1.0 if {[catch {set udb_handle [tdbc::sqlite3::connection new $db_name]} db_errmsg]} { putlog " Could not open SQLite3 database '$db_name': $db_errmsg" return 0 } putlog " (Using SQLite3 database $db_name)" } elseif {$db_type == "postgres" || $db_type == "mysql"} { # Check parameters set db_args {} if {$db_user != ""} { lappend db_args -user $db_user } if {$db_pass != ""} { lappend db_args -passwd $db_pass } if {$db_host != ""} { lappend db_args -host $db_pass if {$db_posrt != 0} { lappend db_args -port $db_port set db_host "${db_host}:${db_port}" } } else { set db_host "localhost" } if {$db_name == ""} { putlog " Database name not set." return 0 } lappend db_args -database $db_name if {$db_type == "postgres"} { package require tdbc::postgres 1.0 if {[catch {set udb_handle [tdbc::postgres::connection new {*}$db_args]} db_errmsg]} { putlog " Could not connect to PostgreSQL database '$db_name @ $db_host': $db_errmsg" return 0 } putlog " (Using PostgreSQL database $db_name @ $db_host)" } elseif {$db_type == "mysql"} { package require tdbc::mysql 1.0 if {[catch {set udb_handle [tdbc::mysql::connection new {*}$db_args]} db_errmsg]} { putlog " Could not connect to MySQL database '$db_name @ $db_host': $db_errmsg" return 0 } putlog " (Using MySQL database $db_name @ $db_host)" } } else { putlog " Invalid or unsupported database type: '$db_type'." return 0 } return 1 } proc utl_escape {str} { return [string map {' ''} $str] } ### ### Functions for certain scripts ### proc utl_confirm_yesno { uprompt } { puts -nonewline "$uprompt \[y/N\]? " flush stdout set response [gets stdin] if {[string tolower $response] == "y"} { return 1 } else { return 0 } } proc utl_drop_table { dbh utable } { puts "Dropping current table '$utable'." if {[catch {dbh eval "DROP TABLE $utable"} uerrmsg]} { puts "Dropping table resulted in error (ignored): $uerrmsg." } } proc utl_create_table { dbh utable usql } { puts "Creating new table '$utable'." if {[catch {dbh eval "CREATE TABLE $utable ($usql)"} uerrmsg]} { puts "Error creating table: $uerrmsg." return 0 } return 1 } proc utl_create_table_or_fail { dbh utable usql } { if {![utl_create_table $dbh $utable $usql]} { exit 3 } }