putils.tcl 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127
  1. # putils
  2. namespace eval ::putils {
  3. ## some internal variables for messaging and stuff :) not your business after all.
  4. # if putils-variable (thus, putils!) is already loaded, then .. well .. load again, but, this time, quietly. ;-)
  5. if {![info exists putils]} {
  6. putlog "::putils:: paul utils for eggdrop bots in tcl $putils(version) loading..."
  7. }
  8. # set again .. perhaps we changed version while in development ;) - even while putils was already loaded.
  9. set putils(version) "0.3"
  10. }
  11. ### this "library" supplies the following procedures:
  12. # gets botnick, truncates it and lowercases it. If input-value of a botnick was
  13. # already correct, then it won't change anything. ;)
  14. proc ::putils::proper_botnick {botnick} {
  15. set temp [string tolower $botnick]
  16. # abfrage ob zu lang, dann fixen
  17. # putlog "::putils:: $botnick lowercase: $temp"
  18. if {[string length $botnick] > 9} {
  19. set temp [string range $temp 0 8 ]
  20. # putlog "::putils:: botnickname $botnick too long: capping to: $temp"
  21. }
  22. return $temp
  23. }
  24. proc ::putils::proper_channelname {channelname} {
  25. # channel names ARE NOT and SHOULD NOT BE CASE SENSITIVE!
  26. set temp [string tolower $channelname]
  27. set temp [::putils::umlauts $temp]
  28. # putlog "::putils:: $channelname lowercase: $temp"
  29. return $temp
  30. }
  31. # puts out a normal channel message.
  32. proc ::putils::put_local_msg {chan text} {
  33. putserv "PRIVMSG $chan :$text"
  34. putlog "::putils:: + normal message: ${chan} => '$text'"
  35. }
  36. # puts a NOTICE to a specified nickname with a specified message.
  37. proc ::putils::put_nick {nick msg} {
  38. putserv "NOTICE $nick :$msg"
  39. }
  40. proc ::putils::kill_spaces {text} {
  41. regsub -all "\\s+" $text "" text
  42. return $text
  43. }
  44. # cleans the input text from all irc control codes... and even has
  45. # some spam-protection.
  46. proc ::putils::clean_txt {text} {
  47. #putlog "filter_A: ${text}"
  48. #regsub -all "\\" $text "\\\\" text
  49. # fixes many whitespace between words down to one space between words
  50. regsub -all "\\s+" $text " " text
  51. # filtering out all colorcodes (works well)
  52. regsub -all "\003\[0-9\]\{1,2\},\[0-9\]\{1,2\}" $text "" text
  53. regsub -all "\003\[0-9\]\{1,2\}" $text "" text
  54. regsub -all "\003" $text "" text
  55. # filtering out BOLD text
  56. regsub -all "\002" $text "" text
  57. # underline gets filtered too. (since +c on quakenet would suppress it ...)
  58. regsub -all "\037" $text "" text
  59. # replacing like !!!!!!!!!!!!! with !!!!! (5 letters)
  60. # s/(.?)\1{4,}/\1\1\1\1\1/g;
  61. # - max 5 same chars in a row
  62. regsub -all -nocase -expanded {(.)\1\1\1\1+} $text {\1\1\1\1\1} text
  63. #putlog "test: $text"
  64. set text [string trim $text]
  65. # putlog "filter_B: ${text}"
  66. return $text
  67. }
  68. # replace found umlauts with umlauts.. funny, eh? We have to do this to channel names with
  69. # umlauts, because of some encoding problem inside eggdrop.
  70. # Afterwards, you can check for channelnames - without errors.
  71. proc ::putils::umlauts {text} {
  72. # A REAL STRANGE BUG WORKAROUND WITH UMLAUTS
  73. regsub -all "Ä" ${text} "Ä" text
  74. regsub -all "Ü" ${text} "Ü" text
  75. regsub -all "Ö" ${text} "Ö" text
  76. regsub -all "ä" ${text} "ä" text
  77. regsub -all "ü" ${text} "ü" text
  78. regsub -all "ö" ${text} "ö" text
  79. return ${text}
  80. }
  81. # safe "bot-knows-the-channel-and-is-in-there"-function, returns boolean
  82. proc ::putils::botonchannel {chan} {
  83. if {[validchan $chan] == 1 && [botonchan $chan] == 1} {
  84. return 1
  85. } else {
  86. return 0
  87. }
  88. }
  89. return 1