Posted to tcl by ace at Sat Nov 03 01:47:44 GMT 2007view raw

  1. bind pub - !define learn_it
  2. bind pub - !learn learn_learn
  3. bind pub - "!whatis" learn_explain
  4. bind pub - "!search" learn_search
  5.  
  6. bind dcc n|n sort learn_sortFile:dcc
  7. bind dcc - allwords learn_alldef:dcc
  8.  
  9. #bind time - "5 0 1 * *" learn_sortFile
  10.  
  11. set learn_whodid "*"
  12.  
  13. proc learn_alldef:dcc {hand idx args} {
  14. global learn_db
  15. putdcc $idx "\[ ° ° Available definitions ° ° \]"
  16. set lista ""
  17. set fp [open $learn_db r]
  18. while {![eof $fp]} {lappend lista [lindex [split [gets $fp] " "] 1]}
  19. close $fp
  20. foreach {a b c d e f g h i j} [lsort -unique $lista] {putdcc $idx " \0037$a $b $c $d $e $f $g $h $i $j\003"}
  21. putdcc $idx "\[ ° ° === END === ° ° \]"
  22. }
  23.  
  24. proc learn_it { nick uhost hand chan args } {
  25. global chan_ign
  26. set args [lindex $args 0]
  27. set args [split $args " "]
  28. if {[lindex $args 1] == ""} {
  29. if {[lsearch $chan_ign $chan] < "0" } {
  30. puthelp "NOTICE $nick :Try !define <keyword> defenition!"
  31. }
  32. } else {
  33. if {[lindex $args 1] == "*"} {
  34. learn_addEntry [lindex $args 1] [lindex $args 0] [lrange $args 2 end]
  35. learn_flood "[lindex $args 0]" $chan
  36. } else {
  37. learn_addEntry $nick [lindex $args 0] [lrange $args 1 end]
  38. if {[lsearch $chan_ign $chan] < "0" } {
  39. puthelp "NOTICE $nick :Defenition added"
  40. }
  41. learn_flood "[lindex $args 0]" $chan
  42. }
  43. }
  44. }
  45.  
  46. proc learn_learn { nick uhost hand chan args } {
  47. global chan_ign
  48. if {[lsearch $chan_ign $chan] < "0" } {
  49. set args [lindex $args 0]
  50. set args [split $args " "]
  51. switch [lindex $args 0] {
  52. "add" {
  53. if {[lindex $args 2] == ""} {
  54. puthelp "NOTICE $nick :Try !learn add <keyword> defenition!"
  55. } else {
  56. learn_addEntry $nick [lindex $args 1] [lrange $args 2 end]
  57. puthelp "NOTICE $nick :Defenition added"
  58. learn_flood "[lindex $args 1]" $chan
  59. }
  60. }
  61. "del" {
  62. if {[lindex $args 2]!=""} {
  63. learn_delEntry [lindex $args 1] [lindex $args 2]
  64. puthelp "NOTICE $nick :Defenition removed"
  65. learn_flood "[lindex $args 1]" $chan
  66. } else {
  67. learn_delEntry [lindex $args 1]
  68. puthelp "NOTICE $nick :Defenition removed"
  69. }
  70. }
  71. "ins" {
  72. if {[lindex $args 3]!=""} {
  73. learn_insEntry [lindex $args 1] [lindex $args 2] [lrange $args 3 end]
  74. puthelp "NOTICE $nick :Defenition inserted"
  75. learn_flood "[lindex $args 1]" $chan
  76. } else {puthelp "NOTICE $nick :Insert Syntax: !learn ins <keyword> num text" }
  77. }
  78. "put" {
  79. if {[lindex $args 3]!=""} {
  80. learn_putEntry [lindex $args 1] [lindex $args 2] [lrange $args 3 end] $nick
  81. puthelp "NOTICE $nick :Defenition inserted"
  82. learn_flood "[lindex $args 1]" $chan
  83. } else {puthelp "NOTICE $nick :Put Syntax: !learn put <keyword> num text" }
  84. }
  85. "rep" {
  86. if {[lindex $args 3]!=""} {
  87. learn_repEntry [lindex $args 1] [lindex $args 2] [lrange $args 3 end]
  88. puthelp "NOTICE $nick :Defenition replaced"
  89. learn_flood "[lindex $args 1]" $chan
  90. } else {puthelp "NOTICE $nick :Replace Syntax: !learn rep <keyword> num text" }
  91. }
  92. "status" {
  93. learn_status $nick $chan
  94. learn_flood "[lindex $args 0]" $chan
  95. }
  96. default { puthelp "NOTICE $nick :\0037Syntax: !learn <add|del|info|ins|rep> <keyword> <num> text\003" }
  97. }
  98. }
  99. }
  100.  
  101. proc learn_explain { nick uhost hand chan args } {
  102. global chan_ign
  103. if {[lsearch $chan_ign $chan] < "0" } {
  104. global learn_db learn_whodid;if {![info exists learn_whodid]} {set learn_whodid ""}
  105. set real_chan $chan
  106. set args [split [lindex $args 0] " "]
  107. set nogo [split [lindex $chan_ign 0] " "]
  108. if {$args == ""} {
  109. puthelp "PRIVMSG $chan :\0037Say what?: Usage: !whatis <keyword> or !whatis <keyword> > <yournick>\003"
  110. return
  111. }
  112. set explain [string tolower [lindex $args 0]];
  113. set chan [string tolower $chan]
  114. if {([lindex $args 1] == ">" || [lindex $args 1] == ">>") && [lindex $args 2] != ""} {
  115. set chan [lindex $args 2]
  116. }
  117. set fp [open $learn_db r]
  118. set allEntrys ""
  119. while {![eof $fp]} {
  120. gets $fp curEntry
  121. set curEntry [split $curEntry " "]
  122. if {[string equal -nocase [lindex $curEntry 1] $explain]} {
  123. lappend allEntrys [join $curEntry " "]
  124. }
  125. }
  126. close $fp
  127. set count 0
  128. if {[llength $allEntrys]==1} {
  129. # Single line output
  130. if {[lsearch -exact $learn_whodid [list $explain [string tolower $chan]]] != -1} {
  131. puthelp "PRIVMSG $real_chan :\0027Hey ${nick}\002, i've already told $chan about \"$explain\"... no need to repeat (i think)"
  132. return 0
  133. } else {
  134. set dump [learn_filterstr [join [lrange [split [lindex $allEntrys 0] " "] 2 end]]]
  135. puthelp "PRIVMSG $chan :\00311${explain}\003:\0037 ${dump}\003";incr count
  136. }
  137. } else {
  138. # Chan flood protection
  139. if {[llength $allEntrys]>17&&[string index $chan 0]=="#"&&!(([lindex $args 1] == ">" || [lindex $args 1] == ">>") && [lindex $args 2] != "")} {
  140. set chan $nick;
  141. puthelp "PRIVMSG $real_chan :\00311\037${explain}?\002\003 \0037What a huge defenition... i'll tell you in private instead...\003"
  142. }
  143. if {[lsearch -exact $learn_whodid [list $explain [string tolower $chan]]] != -1} {
  144. puthelp "PRIVMSG $real_chan :\002Hey ${nick}\002, i've already told you about \"$explain\"... no need to repeat (i think)"
  145. return 0
  146. }
  147. # Multi line output
  148. foreach curEntry $allEntrys {
  149. incr count
  150. set dump [learn_filterstr [join [lrange [learn_filterstr $curEntry] 2 end]]]
  151. putquick "PRIVMSG $chan :\00311${explain} \037\|\037${count}\037|\037:\003\0037 ${dump}\003"
  152. }
  153. }
  154. # No ouput found and more
  155. if {$count == 0} { puthelp "PRIVMSG $chan :\00311${explain} \037\|\037\002x\002\037\|\037: \003\0037No defenition found for word.\003" }
  156. if {([lindex $args 1] == ">" || [lindex $args 1] == ">>") && [lindex $args 2] != ""} {
  157. #puthelp "NOTICE $nick :Ok, done."
  158. }
  159. lappend learn_whodid [list $explain [string tolower $chan]]
  160. #set explain [learn_filterstr $explain] ;# Don't allow code to be executed
  161. set chan [learn_filterstr $chan] ;# ensure []s are properly handled...
  162. utimer 60 "learn_flood \"$explain\" \"$chan\""
  163. }
  164. }
  165.  
  166. proc learn_flood {word target} {
  167. # removes from "already told so" list
  168. global learn_whodid
  169. set word [string tolower $word]; set target [string tolower $target]
  170. set lin [lsearch -exact $learn_whodid [list $word $target]]
  171. if {$lin == -1} {
  172. return
  173. } else {
  174. set learn_whodid [lreplace $learn_whodid $lin $lin]
  175. }
  176. }
  177.  
  178. proc learn_addEntry { nick word defenition } {
  179. global learn_db;set word [string tolower $word]
  180. if {![file exists $learn_db]} {file mkdir [lindex [split $learn_db /] 0];set fp [open $learn_db w+]
  181. puts $fp "Infodb."
  182. } else {set fp [open $learn_db a]};puts $fp "$nick $word [join $defenition]";close $fp
  183. }
  184.  
  185. proc learn_delEntry { word {remnum "all"}} {
  186. global learn_db
  187. set word [string tolower $word]
  188. set fp [open $learn_db r]
  189. set allEntrys ""
  190. set count 1
  191. if {$remnum == "all"} {
  192. while {![eof $fp]} {gets $fp curEntry;if {![string equal -nocase [lindex [split $curEntry] 1] $word]} {lappend allEntrys $curEntry}}
  193. } else {
  194. while {![eof $fp]} {
  195. gets $fp curEntry
  196. if {![string equal -nocase [lindex [split $curEntry] 1] $word] || ($count != $remnum && $remnum != -2)} {
  197. if {[info exists curEntry]&&$curEntry!=""} {lappend allEntrys $curEntry}
  198. if {[string equal -nocase [lindex [split $curEntry] 1] $word]} {incr count}
  199. } else {incr count}
  200. }
  201. }
  202. close $fp;set fp [open $learn_db w];foreach curEntry $allEntrys {puts $fp $curEntry};close $fp
  203. }
  204.  
  205. proc learn_insEntry {word num text} {
  206. global learn_db
  207. set word [string tolower $word]
  208. set fp [open $learn_db r]
  209. set allEntrys ""
  210. set count 1
  211. while {![eof $fp]} {
  212. gets $fp curEntry
  213. if {![string equal -nocase [lindex [split $curEntry] 1] $word] || ($count != $num && $num != -2)} {
  214. if {[info exists curEntry]&&$curEntry!=""} {lappend allEntrys $curEntry}
  215. if {[string equal -nocase [lindex [split $curEntry] 1] $word]} {incr count}
  216. } else {incr count;lappend allEntrys "$curEntry [join $text]"}
  217. }
  218. close $fp;set fp [open $learn_db w];foreach curEntry $allEntrys {puts $fp $curEntry};close $fp
  219. }
  220.  
  221. proc learn_putEntry {word num text {whodid "."}} {
  222. global learn_db
  223. set word [string tolower $word]
  224. set fp [open $learn_db r]
  225. set allEntrys ""
  226. set count 1
  227. if {$num==1} {lappend allEntrys "$whodid $word [join $text]"}
  228. while {![eof $fp]} {
  229. gets $fp curEntry
  230. if {[string equal -nocase [lindex [split $curEntry] 1] $word]} {incr count}
  231. if {[info exists curEntry]&&$curEntry!=""} {lappend allEntrys $curEntry}
  232. if {$count==$num&&$num!=1} {lappend allEntrys "$whodid $word [join $text]"}
  233. }
  234. close $fp;set fp [open $learn_db w];foreach curEntry $allEntrys {puts $fp $curEntry};close $fp
  235. }
  236.  
  237.  
  238. proc learn_repEntry {word num text} {
  239. global learn_db
  240. set word [string tolower $word]
  241. set fp [open $learn_db r]
  242. set allEntrys ""
  243. set count 1
  244. while {![eof $fp]} {
  245. gets $fp curEntry
  246. if {![string equal -nocase [lindex [split $curEntry] 1] $word] || ($count != $num && $num != -2)} {
  247. if {[info exists curEntry]&&$curEntry!=""} {lappend allEntrys $curEntry}
  248. if {[string equal -nocase [lindex [split $curEntry] 1] $word]} {incr count}
  249. } else {incr count;lappend allEntrys "[lrange [split $curEntry] 0 1] [join $text]"}
  250. }
  251. close $fp;set fp [open $learn_db w];foreach curEntry $allEntrys {puts $fp $curEntry};close $fp
  252. }
  253.  
  254.  
  255. proc learn_status {nick chan} {
  256. global learn_db
  257. set fp [open $learn_db r]
  258. set allEntrys ""
  259. set cache ""
  260. set count 0
  261. set lines 0
  262. while {![eof $fp]} {
  263. set curEntry [gets $fp]
  264. if {[info exists curEntry]&&$curEntry!=""} {lappend allEntrys [split $curEntry " "]}
  265. }
  266. close $fp
  267. set lines [llength $allEntrys]
  268. foreach line $allEntrys {
  269. set word [join [lindex $line 1]]
  270. if {![string match -nocase "*$word*" $cache]} {
  271. append cache "$word "
  272. incr count
  273. }
  274. }
  275. puthelp "PRIVMSG $chan :\00311Status\003: \0037There's \037\002$lines\002\037 enties and \037\002$count\002\037 unique definitions in the DataBase.\003"
  276. }
  277.  
  278.  
  279. proc learn_sortFile {a c d e f} {
  280. global learn_db
  281. set t_count [clock clicks -milliseconds]
  282. set fp [open $learn_db r]
  283. set allEntrys ""
  284. while {![eof $fp]} {
  285. set curEntry [gets $fp]
  286. if {[info exists curEntry]&&$curEntry!=""} {lappend allEntrys [split $curEntry " "]}
  287. }
  288. close $fp; set allEntrys [lsort -index 1 $allEntrys]
  289. set fp [open $learn_db w];foreach curEntry $allEntrys {puts $fp [join $curEntry " "]};close $fp
  290. putlog "\[!learn\]-> Auto sorted data in the database ($learn_db)->[expr double([clock clicks -milliseconds]-$t_count)/1000]s"
  291. }
  292.  
  293. proc learn_sortFile:dcc {hand idx args} {
  294. global learn_db
  295. set t_count [clock clicks -milliseconds]
  296. set allEntrys ""
  297. set fp [open $learn_db r]
  298. while {![eof $fp]} {
  299. set curEntry [gets $fp]
  300. if {[info exists curEntry]&&$curEntry!=""} {lappend allEntrys [split $curEntry " "]}
  301. }
  302. close $fp; set allEntrys [lsort -index 1 $allEntrys]
  303. set fp [open $learn_db w];foreach curEntry $allEntrys {puts $fp [join $curEntry " "]};close $fp
  304. putdcc $idx "\[!learn\]-> Sorted data in the database ($learn_db)->[expr double([clock clicks -milliseconds]-$t_count)/1000]s"
  305. }
  306.  
  307. proc learn_filterstr { data } {
  308. regsub -all -- \\\\ $data \\\\\\\\ data
  309. regsub -all -- \\\[ $data \\\\\[ data
  310. regsub -all -- \\\] $data \\\\\] data
  311. regsub -all -- \\\} $data \\\\\} data
  312. regsub -all -- \\\{ $data \\\\\{ data
  313. regsub -all -- \\\" $data \\\\\" data
  314. return $data
  315. }
  316.  
  317. proc learn_search { nick uhost hand chan args } {
  318. global chan_ign
  319. if {[lsearch $chan_ign $chan] < "0" } {
  320. global learn_db
  321. set args [string tolower [lindex $args 0]]
  322. if {$args==""} {
  323. puthelp "PRIVMSG $chan :\0037Not enough arguments.\003"
  324. return
  325. }
  326. set init_t [clock clicks -milliseconds]
  327. set fp [open $learn_db r]
  328. set matches ""
  329. set allEntrys ""
  330. while {![eof $fp]} {
  331. gets $fp curEntry;
  332. if {[info exists curEntry]&&$curEntry!=""} {
  333. set curEntry [split [string tolower $curEntry] " "]
  334. set thisEntry [join [lrange $curEntry 1 end] " "]
  335. if {[string match -nocase "*${args}*" $thisEntry]} {
  336. # putserv "PRIVMSG #meta :worked $curEntry"
  337. if {[lsearch $allEntrys [lindex curEntry 1]]==-1} {
  338. lappend allEntrys [lindex $curEntry 1]
  339. set allEntrys [lsort -unique $allEntrys]
  340. }
  341. }
  342. }
  343. }
  344. set init_t [expr double(([clock clicks -milliseconds] - $init_t))/1000]
  345. if {$allEntrys==""} {
  346. puthelp "PRIVMSG $chan :\0037\002No matches\002 for \037\002$args\002\037 in the DataBase, sorry. (Search tok: \002\037${init_t}s\037\002)\003"
  347. } else {
  348. if {[llength $allEntrys]>20} {
  349. puthelp "PRIVMSG $chan :\0037\002Too many matches.\002 Please try a more complex search.\003"
  350. } else {
  351. puthelp "PRIVMSG $chan :\0037\002Found \037[llength $allEntrys]\037 matches.\002 Sorted: \037[join [lsort -dictionary $allEntrys] "\037, \037"]\037. (\002\037${init_t}\037s)\003"
  352. }
  353. }
  354. }
  355. }
  356.