Mercurial > hg > egg-tcls
view utillib.tcl @ 378:b706e8ebecf8
fetch_weather: Possibly improve FMI XML mess parsing.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Sun, 07 Feb 2016 17:54:09 +0200 |
parents | e01963cb88fd |
children | 880a07485275 |
line wrap: on
line source
########################################################################## # # TCL functions library by Matti 'ccr' Hamalainen <ccr@tnsp.org> # (C) Copyright 2015 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 "| | " set utl_html_ent_list [split [encoding convertfrom "utf-8" $utl_html_ent_str] "|"] 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]] } 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 } ### ### 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 } }