All pastes #757788 Raw Edit

Miscellany

public text v1 · immutable
·published 2007-11-01 16:39 UTC
rendered paste body
# announcer.tcl for rlslog.net
# Simon Shine <http://shine.eu.org/>
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. :("
    }
}