# announcer.tcl for rlslog.net # Simon Shine package require http set lastposts(debug) 1 set lastposts(file) "scripts/lastposts.txt" set lastposts(url) "http://rlslog.net/lastposts.php" set lastposts(chan) "#rlslog" set lastposts(cache_after_clean_up) 10 ##### proc recreate_memory_cache {args} { global lastposts _announcer_db set _fd [open $lastposts(file) r] set _announcer_db [split [read $_fd] "\n"] close $_fd } if {![file exists $lastposts(file)]} { set _fd [open $lastposts(file) w+] close $_fd } if {![info exists _announcer_db]} { recreate_memory_cache } for {set _i 0} {$_i < 60} {incr _i 3} {bind time - "$_i * * * *" time:check_a} proc time:check_a {args} { global lastposts set token [::http::geturl $lastposts(url)] set data [split [::http::data $token] "\n"] set new_ones 0 foreach entry $data { set entry [split $entry "|"] set is_new [is_new [lindex $entry 0]] if {$is_new} { puthelp "PRIVMSG $lastposts(chan) :[lastposts_format $entry]" make_old [lindex $entry 0] incr new_ones } } return $new_ones } proc is_new {entry} { global _announcer_db foreach old_entry $_announcer_db { if {$entry == $old_entry} {return 0} } return 1 } proc make_old {entry} { global lastposts _announcer_db lappend _announcer_db $entry set fd [open $lastposts(file) a+] puts $fd $entry close $fd } proc lastposts_format {entry} { return "\0037New Article ->\003 [join [lrange $entry 1 end] " | "]" } bind time - "0 0 * * *" clean_up proc clean_up {args} { global lastposts _announcer_db set fd [open $lastposts(file) r+] set cache [split [read $fd] "\n"] close $fd set i $lastposts(cache_after_clean_up) set j [llength $cache] set fd [open $lastposts(file) w+] puts $fd [join [lrange $cache end-$i end] "\n"] close $fd set _announcer_db [lrange $cache end-$i end] putlog "Cleaned up announce cache so there's max $i entries." } bind pub - !new pub:latest proc pub:latest {nick host hand chan text} { set new_ones [time:check_a] ;# I know, bit hack-ish if {$new_ones == 0} { puthelp "PRIVMSG $chan :No new entries. That makes me a sad panda. :(" } }