proc unixtime {} {return [clock scan [strftime "%H:%M:%S"] ]}

proc trouver_masque_precis {nick canal} {
  if [onchan $nick $canal] {
    set host "$nick![getchanhost $nick $canal]"
    return [trouver_masquehost $host "precis"]
  } else {
    return ""
  }
}

proc trouver_masque_net {nick canal} {
  if [onchan $nick $canal] {
    set host "$nick![getchanhost $nick $canal]"
    return [trouver_masquehost $host "net"]
  } else {
    return ""
  }
}

proc trouver_masque {nick canal} {
  if [onchan $nick $canal] {
    set host "$nick![getchanhost $nick $canal]"
    return [trouver_masquehost $host "large"]
  } else {
    return ""
  }
}

proc trouver_masquehost { host type } {
  set split1 [split $host !]
  set split2 [split [lindex $split1 1] @]
  set identd [lindex $split2 0]
  set t 0
  if {[string index $identd 0] == "~"} {
    set identd [string range $identd 1 end]
    set t 1
  }
  if {$type == "large"} {
    set identd "*$identd"
  } elseif {($type == "precis") & $t} {
    set identd "~$identd"
  } else { }
  set split3 [split [lindex $split2 1] .]
  set nbparties [llength $split3]
  set domlast [lindex $split3 [expr $nbparties - 1]]
  set domav [lindex $split3 [expr $nbparties - 2]]
  set domav2 [lindex $split3 [expr $nbparties - 3]]
  set domav3 [lindex $split3 [expr $nbparties - 4]]
  if {($nbparties == 4) && ($domlast < 256)} {
    set masque "*!$identd@[lindex $split3 0].[lindex $split3 1].*"
  } else {
    if {($nbparties > 4) && (([string length $domav3] < 5) && !($domav3 < 256)) && ((([string length $domlast] < 3) && ([string length $domav] < 4)) || (([string length $domav2] < 4) && !($domav2 < 256)))} {
      set masque "*!$identd@*.$domav3.$domav2.$domav.$domlast"
    } elseif {($nbparties > 3) && ((([string length $domlast] < 3) && ([string length $domav] < 4)) || (([string length $domav2] < 4) && !($domav2 < 256)))} {
      set masque "*!$identd@*.$domav2.$domav.$domlast"
    } elseif {$nbparties < 3} {
      set masque "*!$identd@$domav.$domlast"
    } else {
      set masque "*!$identd@*.$domav.$domlast"
    }
  }
  return $masque
}


proc ajouter_espaces { text longueur } {
  set txt $text
  set j 0
  for {set i 0} {$i < [string length $text]} {incr i} {
    if {[string index $text $i] == ""} {
      incr j
      incr i
      if [estunnombre:ok [string index $text $i]] {
        incr j
        incr i
        if [estunnombre:ok [string index $text $i]] {
          incr j
        }
      }
    } elseif [string match *[string index $text $i]* "\\\["] {
      incr j
    }
  }
  for {set i [expr [string length $text] - $j]} {$i < $longueur} {incr i} {
    append txt " "
  }
  return $txt
}

proc dire_niveau {hand} {
  set niveau ""
  if [matchattr $hand b] {
    return "bot"
  } elseif [matchattr $hand H] {
    return "Membre honoraire"
  } elseif [matchattr $hand G] {
    return "Administrat[mf $hand "eur" "rice"] général[mf $hand "" "e"]"
  } elseif [matchattr $hand C] {
    return "Administrat[mf $hand "eur" "rice"] canal"
  } elseif [matchattr $hand T] {
    return "Administrat[mf $hand "eur" "rice"] projets"
  } elseif [matchattr $hand V] {
    return "Aidant[mf $hand "" "e"] du jour"
  } elseif [matchattr $hand N] {
    return "Nouv[mf $hand "eau" "elle"] membre"
  } elseif [matchattr $hand O] {
    set niveau "Opérat[mf $hand "eur" "rice"] canal"
  } elseif [matchattr $hand J] {
    set niveau "Opérat[mf $hand "eur" "rice"] canal adjoint[mf $hand "" "e"]"
  } elseif [matchattr $hand XY] {
    return "Ancien[mf $hand "" "ne"] membre"
  }
  if [matchattr $hand R] {
    if {$niveau == ""} {
      set niveau "Responsable de projet"
    } else {
      append niveau " et Resp.projet"
    }
  }
  if [matchattr $hand P] {
    if {$niveau == ""} {
      set niveau "Participant[mf $hand "" "e"] projet"
    } else {
      append niveau " et Part.projet"
    }
  }
  if [matchattr $hand E] {
    if {$niveau == ""} {
      set niveau "[mf $hand "Parrain" "Marraine"]"
    } else {






      append niveau " et [mf $hand "Parrain" "Marraine"]"
    }
  }
  if {($niveau == "") && [matchattr $hand M]} {
    set niveau "Membre officiel[mf $hand "" "le"]"
  }
  if [matchattr $hand Z] {
    if {$niveau == ""} {
      set niveau "Personnel d'Undernet"
    } else {
      append niveau " et Personnel d'Undernet"
    }
    set tmp [lindex [getuser $hand xtra special] [expr [llength [getuser $hand xtra special]] - 1]]
    if {$tmp != "(IRCop)"} { set tmp "(CService $tmp)" }
    append niveau " $tmp"
  }
  return $niveau
}


proc dire_date {time} {
  set date "[string range [ctime $time] 8 9]"
  set eng [string range [ctime $time] 4 6]
  switch $eng {
    "Feb" { set fra "Fev" }
    "Apr" { set fra "Avr" }
    "May" { set fra "Mai" }
    "Aug" { set fra "Aou" }
    default { set fra $eng }
  }
  append date $fra
  append date [string range [ctime $time] 20 23]
  if {$date == "31Dec1969"} {
    set date "31Dec19??"
  }
  return $date
}

proc dire_date70 {time} {
  return [exec date -d [string range $time 6 end][string range $time 3 4][string range $time 0 1] +%s]
}


proc estunnick:ok {nick} {
  if {[string length $nick] > 9} { return 0 }
  if {[string length $nick] < 1} { return 0 }
  if [regsub -all {\?|\*|\ |\ } $nick "" nick] { return 0 }
  return 1
}

proc estunmail:ok {mail} {
  if {[string length $mail] < 7} { return 0 }
  if [string match *\ * $mail] { return 0 }
  if ![string match *.* $mail] { return 0 }
  if ![string match *@* $mail] { return 0 }
  return 1
}

proc estunurl:ok {url} {
  if {[string length $url] < 7} { return 0 }
  if [string match *\ * $url] { return 0 }
  if ![string match *.* $url] { return 0 }
  if [string match *http* $url] { return 0 }
  return 1
}

proc estunnombre:ok {nombre} {
  if {$nombre == ""} { return 0 }
  foreach i [split $nombre {}] {
    if ![string match \[0-9\] $i] {
      return 0
    }
  }
  return 1
}

proc estunip:ok {host} {
  regsub -all {\.} $host "" host
  return [estunnombre:ok $host]
}

proc estunpays:ok {pays} {
  return [file exists /aide/www/bot/drapeaux/$pays.gif]
}

proc sexe:ok {hand sexe} {
  if [[getuser $hand xtra sexe] == $sexe] {
    return 1
  }
  return 0
}

proc estunedate:ok {date} {
  if {[string index $date 2] != "/"} { return 0 }
  if {[string index $date 5] != "/"} { return 0 }
  set jour [string range $date 0 1]
  set mois [string range $date 3 4]
  set annee [string range $date 6 end]
 ### Una affabulation du TCL, ça m'épate !
   if {$jour != "10"} {
     regsub -all {0} $jour "" jour
   }
   if {$mois != "10"} {
     regsub -all {0} $mois "" mois
   }
 ###
  if ![estunnombre:ok $jour] { return 0 }
  if ![estunnombre:ok $mois] { return 0 }
  if ![estunnombre:ok $annee] { return 0 }
  if {$jour > 31} { return 0 }
  if {$jour < 1} { return 0 }
  if {$mois > 12} { return 0 }
  if {$mois < 1} { return 0 }
  if {$annee < 69} {
    set annee [expr $annee + 2000]
  }
  if {$annee < 100} {
    set annee [expr $annee + 1900]
  }
  if {$annee < 1900} {
    return 0
  }
  return 1
}

proc mf {hand masc fem} {
  if {[getuser $hand xtra sexe] == "F"} {
    return $fem
  } else {
    return $masc
  }
}

proc putdccsi {idx text} {
  if [valididx $idx] {
    putdcc $idx $text
  }
}

proc dire_delai {secondes} {
  set ans [expr $secondes / 31536000]
  set secondes [expr $secondes % 31536000]
  set mois [expr $secondes / 2628000]
  set secondes [expr $secondes % 2628000]
  set semaines [expr $secondes / 604800]
  set secondes [expr $secondes % 604800]
  set jours [expr $secondes / 86400]
  set secondes [expr $secondes % 86400]
  set heures [expr $secondes / 3600]
  set secondes [expr $secondes % 3600]
  set minutes [expr $secondes / 60]
  set secondes [expr $secondes % 60]
  set texte ""
  if $ans { append texte "$ans\A " }
  if $mois { append texte "$mois\M " }
  if $semaines { append texte "$semaines\S " }
  if $jours { append texte "$jours\j " }
  if $heures { append texte "$heures\h " }

  if $minutes { append texte "$minutes\m " }
  if $secondes { append texte "$secondes\s " }
  return $texte
}

proc absent {user} {
  if {[getuser $user xtra absence] == ""} {
    return 0
  } else {
    return 1
  }
}

proc vrainick {user} {
  return [getuser $user xtra vrainick]
}

##########################################
# Procédure de classement d'items divers
# Accepte une liste lindex 0 = item lindex 1 = valeur numérique. 
# L'ordre est croissant (+) ou décroissant (-)

proc classement { liste ordre } {
  set laliste ""
  set longueur [llength $liste]
  while {[llength $laliste] != $longueur} {
    set premier [lindex $liste 0]
    set oki 1
    set liste [lrange $liste 1 end]
    foreach autre $liste {
      if {(([lindex $autre 1] < [lindex $premier 1]) && ($ordre == "+")) || (([lindex $autre 1] > [lindex $premier 1]) && ($ordre == "-"))} {
        set oki 0
      }
    }
    if $oki {
      lappend laliste $premier
    } else {
      lappend liste $premier
    }
  }
  return $laliste
}

# Classement de nombres
proc classement_nombres { liste ordre } {
  foreach item $liste {
    lappend zouf "$item $item"
  }
  foreach item [classement $zouf $ordre] {
    lappend out [lindex $item 0]
  }
  return $out
}

## debug ! ##
proc alo {text} {
  putdccsi [hand2idx alocin] $text
}

proc hola {hand} {
  if ![matchattr $hand n] {
    putdccsi [hand2idx $hand] "Hola, cette fonction n'est pas terminée, on relaxe svp!"
    return 1
  } else {
    return 0
  }
}

#######################################
# Trouver dernière visite d'un usager 
# Paramètre type: 1- dans tous les cas, 0-seulement sur le canal.

proc vu_quand {nick type} {
  set surcanal 0
  set surbot 0
  set connu 0
  set rep [nick2hand $nick]
  if [validuser $rep] {
    # le nick est sur un canal et je le connais
    set surcanal 1
    set connu 1
    set vrainick [getuser $rep xtra vrainick]
    set lenick $nick
  } elseif {$rep == "*"} {
    # le nick est sur un canal et je ne le connais pas
    set surcanal 1
    set vrainick "que je ne reconnais pas"
    set lenick $nick
  } else {
    # le nick n'est pas là
    set rep [hand2nick $nick]
    if {$rep != ""} {
      # On a le hand, pas sur le bot, et le nick diffère ...
      set surcanal 1
      set connu 1
      set vrainick [getuser $nick xtra vrainick]
    }
    set lenick $rep
  }
  if $surcanal {
    set canal ""
    foreach chan [channels] {
      if [onchan $lenick $chan] {
        if [llength $canal] {
          append canal " et $chan"
        } else {
          append canal $chan
        }
      }
    }
  }
  if [validuser $nick] {
    # c'est un nom connu du bot directement dans sa liste
    set connu 1
    set vrainick [getuser $nick xtra vrainick]
    set rep $nick
  }
  foreach dude [dcclist chat] {
    set user [lindex $dude 1]
    if {([string tolower $nick] == [string tolower $user]) || ([string tolower $nick] == [string tolower [getuser $user xtra vrainick]])} {
      # Dans le bot
      set connu 1
      set surbot 1
      set vrainick [getuser $user xtra vrainick]
      set rep $user
    }
  }
  if $connu {
    set delai [expr [unixtime] - [lindex [getuser $rep laston] 0]]
    if {$delai < 60} {
      set delai "moins d'une minute !"
    } else {
      set delai [dire_delai $delai]
    }
    set ou [lindex [getuser $rep laston] 1]
    if {($ou == "") || ($ou == "partyline")} { set ou "AideBot" }
  }
  if {([string tolower $nick] == "aide") & !$type} {
    return "Ben, je suis là! :¬)"
  } elseif {[string tolower $nick] == "aidebot"} {
    return "Pffff! Qu'est-ce que tu en penses?"
  } elseif {($surcanal & !$type) || ($surcanal & !$surbot)} {
    return "Tu trouveras $nick ($vrainick) sur $canal en ce moment même. (Idle: [dire_delai [expr 60 * [getchanidle $lenick [lindex $canal 0]]]])"
  } elseif {$surcanal & $surbot & $type} {
    return "Tu trouveras $nick ($vrainick) sur $canal et dans AideBot ($rep) en ce moment même. (Idle: [dire_delai [expr 60 * [getchanidle $lenick [lindex $canal 0]]]]/[dire_delai [getdccidle [hand2idx $rep]]])"
  } elseif {$surbot & $type} {
    return "Tu trouveras $nick ($vrainick) dans AideBot ($rep) en ce moment même. (Idle: [dire_delai [getdccidle [hand2idx $rep]]])"
  } elseif {$connu} {
    if {[absent $nick] & $type} {
      return "$nick ($vrainick) a été vu pour la dernière fois sur $ou il y a $delai\. (Absent[mf $nick "" "e"]: [getuser $nick xtra absence])"
    } else {
      return "$nick ($vrainick) a été vu pour la dernière fois sur $ou il y a $delai\."
    }
  } else {
    return "Je suis désolé, mais je ne connais pas $nick\."
  }
}

############
# Maths ...

proc moyenne {liste} {
  set tot 0.0
  foreach nbre $liste {
    set tot [expr $tot + $nbre]
  }
  set moy [expr $tot / [llength $liste]]
  return $moy
}

proc mediane {liste} {
  if [expr [llength $liste] % 2] {
    set med [lindex $liste [expr [llength $liste] / 2]]
  } else {
    set med [expr [expr [lindex $liste [expr [expr [llength $liste] / 2] - 1]] + [lindex $liste [expr [llength $liste] / 2]]] / 2]
  }
  return $med
}

proc ecart_type {liste} {
  set ecarts ""
  set moy [moyenne $liste]
  foreach nbre $liste {
    set val [expr $moy - $nbre]
    regsub -all {\-} $val "" val
    lappend ecarts $val
  }
  set ecty [moyenne $ecarts]
  return $ecty
}

proc analyse {liste} {
  return "[moyenne $liste] [mediane $liste] [ecart_type $liste]"
}

proc cote_z {note liste} {
  set cote [expr [expr $note - [moyenne $liste]] / [ecart_type $liste]]
}

# pi!
proc pi { } {
  return "3.141592653589793238462643383279502884197169399375105820974944592307816406286208998628034825342117067982148086513282306647093844609550582231725359408128481117450284102701938521105559644622948954930381964428810975665933446128475648233786783165271201909145648566923460348610454326648213393607260249141273724587006606315588174881520920962829254091715364367892590360011330530548820466521384146951941511609433057270365759591953092186117381932611793105118548074462379962749567351885752724891227938183011949"
}

bind dcc p pi dcc_pi
proc dcc_pi {hand idx arg} {
  putdcc $idx [pi]
  return 1
}

###
# moduser - [moduser $user X 3 allo] modifie le champs xtra X, lindex 3, par allo

proc moduser {user x n mot} {
  setuser $user xtra $x [lreplace [getuser $user xtra $x] $n $n $mot]
}

###
# Calculatrice

bind dcc - = calculatrice
proc calculatrice {hand idx args} {
  set args [lindex $args 0]
  if {$args == ""} {
    putdcc $idx "Calculs simples, sans priorité, selon la syntaxe:  nombre + nombre - nombre * nombre / nombre ..."
  } else {
    set sol [lindex $args 0]
    for {set i 1} {$i < [llength $args]} {incr i} {
      set oper [lindex $args $i]
      incr i
      set terme [lindex $args $i]
      regsub -all {\.} $terme "" tmp
      if {(($oper != "+")&($oper != "-")&($oper != "*")&($oper != "/"))|![estunnombre:ok $tmp]} {
        putdcc $idx "Erreur de syntaxe. Désolé."
        return 0
      }
      set sol [expr $sol $oper $terme]
    }
    putdcc $idx "Solution: $sol"
    putlog "#$hand# Calcule ..."
  }
  return 0
}

###
# hexbin: traducteur multi-sens binaire, décimal hexa-décimal.

bind dcc p hexbin dcc_hexbin
proc dcc_hexbin {hand idx args} {
  set args [lindex $args 0]
  set entree [string toupper $args]
  regsub -all { } $entree "" entree
  regsub -all {A|B|C|D|E|1|2|3|4|5|6|7|8|9|0} $entree "" test
  if {($test != "") | ($entree == "")} {
    putdcc $idx "## Syntaxe: .hexbin <valeur en hexadécimal, décimal ou binaire.>"
    return 0
  }
  regsub -all {1|0|} $entree "" test
  if {$test == ""} {
    ## on a une valeur possiblement en binaire, on en fait du décimal
    if {[string length $entree] > 30} {
      putdcc $idx "Valeur trop grande pour être considérée (binaire)."
      return 1
    }
    set mult 1
    set dec 0
    for {set i [expr [string length $entree] - 1]} {$i >= 0} {set i [expr $i - 1]} {
      set val [string index $entree $i]
      set dec [expr $dec + $mult * $val]
      set mult [expr $mult * 2]
    }
    hexbin2 $idx $entree "binaire" $dec
  }
  regsub -all {A|B|C|D|E} $entree "" test
  if {$entree == $test} {
    # on a du décimal, on passe directement
    if {[string length $entree] > 9} {
      putdcc $idx "Valeur trop grande pour être considérée (décimal)."
      return 1
    }
    hexbin2 $idx $entree "décimal" $entree
  }
  # on a de l'hexa, on transforme en décimal
  if {[string length $entree] > 7} {
    putdcc $idx "Valeur trop grande pour être considérée (hexadécimal)."
    return 1
  }
  set mult 1
  set dec 0
  for {set i [expr [string length $entree] - 1]} {$i >= 0} {set i [expr $i - 1]} {
    switch [string index $entree $i] {
      "A" { set val 11 }
      "B" { set val 12 }
      "C" { set val 13 }
      "D" { set val 14 }
      "E" { set val 15 }
      default { set val [string index $entree $i] }
    }
    set dec [expr $dec + $mult * $val]
    set mult [expr $mult * 16]
  }
  hexbin2 $idx $entree "hexadécimal" $dec
  return 1
}

proc hexbin2 {idx entree type dec} {
  set hexa ""
  set bin ""
  set rb $dec
  set rh $dec
  set sh ""
  set sb ""
  while {($rb > 0) | ($rh > 0)} {
    if $rh {
      set sh "[expr $rh % 16] $sh"
      set rh [expr $rh / 16]
    }
    set sb "[expr $rb % 2] $sb"
    set rb [expr $rb / 2]
  }
  set i [llength $sh]
  foreach c $sh {
    if ![expr $i % 2] {
      append hexa " "
    }
    switch $c {
      11 { append hexa "A" }
      12 { append hexa "B" }
      13 { append hexa "C" }
      14 { append hexa "D" }
      15 { append hexa "E" }
      default { append hexa $c }
    }
    set i [expr $i - 1]
  }
  set i [llength $sb]
  foreach c $sb {
    if ![expr $i % 8] {
      append bin " "
    }
    append bin $c
    set i [expr $i - 1]
  }
  if {[string index $hexa 0] == " "} {set hexa [string range $hexa 1 end]}
  if {[string index $bin 0] == " "} {set bin [string range $bin 1 end]}
  putdcc $idx "HEXBIN > Entrée:   $entree  ($type)"
  putdcc $idx "HEXBIN >> Hexa:    $hexa"
  putdcc $idx "HEXBIN >> Décimal  $dec"
  putdcc $idx "HEXBIN >> Binaire: $bin"
}

###
# Longueur d'un fichier

proc longueurfichier {f} {
  return  [exec wc $f | sed -e "s/ *//" | sed -e "s/ .*//"]
}

###
# Enlever les accents d'un mot et le retourner en minuscules

proc minacc {texte} {
  set texte [string tolower $texte]
  regsub -all {à|â|À|Â} $texte "a" texte
  regsub -all {é|è|ê|ë|É|È|Ê|Ë} $texte "e" texte
  regsub -all {î|ï|Î|Ï} $texte "i" texte
  regsub -all {ô|Ô} $texte "o" texte
  regsub -all {ù|û|ü|Ù|Û|Ü} $texte "u" texte
  regsub -all {ç|Ç} $texte "c" texte
  return $texte
}

###
# Retourne le nom du mois de par son numéro

proc quelmois {num} {
  switch $num {
    1 { return "Janvier" }
    2 { return "Février" }
    3 { return "Mars" }
    4 { return "Avril" }
    5 { return "Mai" }
    6 { return "Juin" }
    7 { return "Juillet" }
    8 { return "Août" }
    9 { return "Septembre" }
    10 { return "Octobre" }
    11 { return "Novembre" }
    12 { return "Décembre" }
    default { return "inconnu" }
  }
}

proc queljour {num} {
  switch $num {
    0 { return "Dimanche" }
    1 { return "Lundi" }
    2 { return "Mardi" }
    3 { return "Mercredi" }
    4 { return "Jeudi" }
    5 { return "Vendredi" }
    6 { return "Samedi" }
    default { return "inconnu" }
  }
}