##########################################################################
#
# 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 "&#45;|-|&#39;|'|—|-|&rlm;||&#8212;|-|&#8211;|--|&#x202a;||&#x202c;|"
append utl_html_ent_str "|&lrm;||&aring;|å|&Aring;|Å|&eacute;|é|&#58;|:|&nbsp;| "
append utl_html_ent_str "|&#8221;|\"|&#8220;|\"|&laquo;|<<|&raquo;|>>|&quot;|\""
append utl_html_ent_str "|&auml;|ä|&ouml;|ö|&Auml;|Ä|&Ouml;|Ö|&amp;|&|&lt;|<|&gt;|>"
append utl_html_ent_str "|&#228;|ä|&#229;|ö|&mdash;|--|&#039;|'|&ndash;|-|&#034;|\""
append utl_html_ent_str "|&#124;|-|&#8217;|'|&uuml;|ü|&Uuml;|Ü|&bull;|*|&euro;|€"
append utl_html_ent_str "|&rdquo;|\"|&#8216;|'|&#xe4;|ä|&#xb7;|*|&#174;|®|&acute;|'"
append utl_html_ent_str "|&#246;|ö|&#xf6;|ö|&#35;|#|&apos;|'|&shy;||–|-"
append utl_html_ent_str "|&#x2026;|...|&hellip;|...|&#34;|\"|&#xad;||&#064;|#"
append utl_html_ent_str "|&#xa0;| |&pound;|£|&#38;|&|&#158;|ž|&#196;|Ä|&#186;|º"
append utl_html_ent_str "|&#8230;|...|&#47;|/|&#10;| |&#034;|\"|&#x27;|\""
append utl_html_ent_str "|‘|'|’|'|”|\"|&scaron;|š|&Scaron;|Š|&#37;|%|&#214;|Ö"

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 8000 -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"]
}