Mercurial > hg > egg-tcls
view utillib.tcl @ 677:3f20ba53d3c7
Remove obsolete script.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Tue, 23 Feb 2021 15:12:27 +0200 |
parents | 586caf75fccc |
children | 204699e84dee |
line wrap: on
line source
########################################################################## # # TCL functions library by Matti 'ccr' Hamalainen <ccr@tnsp.org> # (C) Copyright 2015-2021 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 "|…|...|/|/| | |"|\"|'|\"" append utl_html_ent_str "|‘|'|’|'|”|\"|š|š|Š|Š|%|%|Ö|Ö" set utl_html_ent_list [split [encoding convertfrom "utf-8" $utl_html_ent_str] "|"] # 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 [validuser $uhand] } 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 {ustamp} { if {$ustamp == "" || $ustamp == "*"} { set ustamp 0 } return [clock format $ustamp -format "%d.%m.%Y %H:%M"] } proc utl_cmd_match { ucommands uid ustr } { upvar $ucommands ucmds if {[info exists ucmds($uid)] && [regexp -nocase -- $ucmds($uid) $ustr]} { return 1 } else { return 0 } } proc utl_arg_get {uarglist uindex uarg uautoinc} { upvar $uindex rindex upvar $uarg rarg if {[llength $uarglist] < $rindex + 1} { return 0 } set rarg [lindex $uarglist $rindex] set rindex [expr $rindex + $uautoinc] return 1 } proc utl_arg_rest {uarglist uindex ustr} { upvar $ustr dstr if {$uindex < [llength $uarglist]} { set dstr [join [lrange $uarglist $uindex end] " "] return 1 } else { set dstr "" return 0 } } ### ### HTML / HTTP related ### # 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]] } proc utl_http_clear_request { urlStatus urlSCode urlCode urlData urlMeta } { ### Clear the request data upvar $urlStatus ustatus upvar $urlSCode uscode upvar $urlCode ucode upvar $urlData udata upvar $urlMeta umeta unset ustatus unset uscode unset ucode unset udata array unset umeta } proc utl_http_do_request { urlHeaders urlStr urlStatus urlSCode urlCode urlData urlMeta } { upvar $urlStatus ustatus upvar $urlSCode uscode upvar $urlCode ucode upvar $urlData udata upvar $urlMeta umeta #set urlHeaders {} #lappend urlHeaders "Accept-Encoding" "identity" #lappend urlHeaders "Connection" "keep-alive" ### Perform request if {[catch {set utoken [::http::geturl $urlStr -timeout 6000 -binary 1 -headers $urlHeaders]} uerror]} { set uscode $uerror return -1 } ### Check status set ustatus [::http::status $utoken] set uscode [::http::code $utoken] set ucode [::http::ncode $utoken] if {$ustatus != "ok"} { return -2 } ### Get data set udata [::http::data $utoken] array set umeta [::http::meta $utoken] ::http::cleanup $utoken ### Sanitize the metadata KEYS foreach {ukey uvalue} [array get umeta] { set ukey [string tolower $ukey] set umeta($ukey) $uvalue } return 0 } ### ### 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] } proc utl_sql_stamp_to_datetime { ustamp } { return [clock format $ustamp -format "%Y-%m-%d %H:%M:%S"] } proc utl_sql_datetime_to_stamp { ustr } { return [clock scan $ustr -format "%Y-%m-%d %H:%M:%S"] }