Mercurial > hg > egg-tcls
view utillib.tcl @ 542:a57822226ba0
utillib: Rename utl_tdbc_sql_init to utl_sql_init.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Tue, 07 Jul 2020 23:17:02 +0300 |
parents | c9dc79874939 |
children | 2a1f3e0f0977 |
line wrap: on
line source
########################################################################## # # TCL functions library by Matti 'ccr' Hamalainen <ccr@tnsp.org> # (C) Copyright 2015-2020 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 } proc utl_valid_user {uhand} { if {$uhand != "" && $uhand != "{}" && $uhand != "*"} { 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} { # Split message per line foreach qmsg [split $umsg "\n"] { # Split each line to fit max message limit foreach uline [utl_str_split $qmsg 445] { if {$upublic == 1} { putserv "$upreferredmsg $uchan :$uline" } else { putserv "$upreferredmsg $unick :$uline" } } } } # Substitute @n@ -> uvalues{n} in the ustr proc utl_str_map_values {ustr {uvalues {}}} { set narg 1 foreach marg $uvalues { set ustr [string map [list "@$narg@" $marg] $ustr] incr narg } return $ustr } proc utl_msg_args {upreferredmsg upublic unick uchan umsg {uargs {}}} { # Replace named tokens set umsg [string map [list "@nick@" $unick] $umsg] set umsg [string map [list "@chan@" $uchan] $umsg] # Replace numeric tokens set umsg [utl_str_map_values $umsg $uargs] utl_msg_do $upreferredmsg $upublic $unick $uchan $umsg } # Return formatted time string 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_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] }