TCL HTML Channel Statistics

HTML Channel Statistics

set web_chans(#online) online.html
set web_dir D:/Abs/www
set web_update 1
foreach i [timers] {
    if {[lindex $i 1] == "web_write"} {
        killtimer [lindex $i 2]
    }
}

if ![info exists web_topic] {set web_topic(*) "*"}
foreach i [channels] {set web_topic($i) ""}
proc web_write {} {
    global web_dir web_update botnick nick web_topic web_chans
    foreach i [array names web_chans] {
        set wpage $web_dir$web_chans($i)
        set web_page $web_chans($i)
        set web_chan $i
        set a [open $wpage w]
        if {$web_topic($i) == ""} {
            set web_topic($i) "topic unknown"
        }
        puts $a "<META HTTP-EQUIV=\"refresh\" content=\"[expr $web_update * 60]\; url=$web_page\">"
        puts $a "<TITLE>$web_chan IRC channel stats (Written at [time] [date])</TITLE>"
        puts $a "<CENTER><FONT face=Verdana SIZE=\"5\"><B>$nick's $web_chan stats</B></FONT><BR><FONT face=Verdana size=2>Topic:$web_topic($i)</FONT></CENTER><P>"
        if {![onchan $botnick $web_chan]} {
            puts $a "<FONT face=Verdana SIZE=2><center><B>I ($nick) am currently not on $web_chan, try again later</center></B></FONT>"
            puts $a "<CENTER><FONT face=Verdana SIZE=4><B>$web_chan, [getchanmode $web_chan] ([llength [chanlist $web_chan]] users)</FONT></B></CENTER>"
        }
        puts $a "<CENTER>"
        puts $a "<TABLE BORDER=0 bgcolor=black cellSpacing=1 cellPadding=0 width=100%>"
        puts $a "<TR bgcolor=silver><TD bgcolor=silver><FONT face=Verdana size=2 COLOR=black><center><B>Nickname</B></center></td><td bgcolor=silver><FONT face=Verdana size=2 COLOR=black><center><B>Status/info line</B></center></td><td bgcolor=silver><FONT face=Verdana size=2 COLOR=black><center><b>Address</B></center></td></tr>"
        set chanlist [chanlist $web_chan]
        set chanlist "$botnick [lsort [lrange $chanlist 1 end]]"
        set oplist ""
        set vlist ""
        set noplist ""
        set noplist2 ""
        foreach i $chanlist {if [isop $i $web_chan] {lappend oplist $i} {lappend noplist $i}}
        foreach i $noplist {
            if [isvoice $i $web_chan] {
                lappend vlist $i
            } {
                lappend noplist2 $i
            }
        }
        set noplist $noplist2
        foreach i "\{$oplist\} \{$noplist\} \{$vlist\}" {
            foreach b $i {
                set c ""
                if {[isop $b $web_chan]} {set q "<FONT face=Verdana COLOR=red size=2>@</FONT>"} {set q ""}
                if {[isvoice $b $web_chan]} {set q "<FONT face=Verdana COLOR=red size=2>+</FONT>"}
                if {[matchattr [nick2hand $b $web_chan] b]} {append c ", (BOT)"}
                if {$botnick == $b} {
                    puts $a "<TR bgcolor=white><TD bgcolor=white><FONT face=Verdana size=2>$q$b</TD><TD bgcolor=white><FONT face=Verdana size=2>Eggdrop Service</TD><TD bgcolor=white></TD></TR>"
                }
                if {$botnick != $b} {
                    set hand [nick2hand $b $web_chan]
                    puts $a "<TR bgcolor=white><TD bgcolor=white><FONT face=Verdana size=2>$q$b</TD><TD bgcolor=white><FONT face=Verdana size=2>Idle [getchanidle $b $web_chan] min$c</TD><TD bgcolor=white><FONT face=Verdana size=2>[getchanhost $b $web_chan]</TD></TR>"
                    if {[getchaninfo $hand $web_chan] != "" && ![matchattr $b b] && $hand != "*"} {
                        puts $a "<TR bgcolor=white><TD bgcolor=white></TD><TD COLSPAN=2 bgcolor=white><FONT face=Verdana size=2><I>Info: [getchaninfo [nick2hand $b $web_chan] $web_chan]</I></TD></TR>"
                    }
                }
            }
        }
        puts $a "</TABLE>"
        if {[chanbans $web_chan] != ""} {
            puts $a "<P><TABLE BORDER=0 bgcolor=black cellSpacing=1 cellPadding=0 width=100%>"
            puts $a "<TR bgcolor=silver><TD bgcolor=silver><CENTER><FONT face=Verdana SIZE=2><B>Bans:</B></FONT></CENTER></TD></TR>"
            foreach c [chanbans $web_chan] {
                puts $a "<TR bgcolor=white><TD bgcolor=white><FONT face=Verdana size=2>$c</TD></TR>"
            }
            puts $a "</TABLE>"
        }
        puts $a "</CENTER>"
        puts $a "<P><BR><FONT face=Verdana SIZE=2><CENTER>This page is updated every $web_update minute(s).</CENTER>"
        puts $a "<FONT face=Verdana SIZE=2><CENTER>HTML2.Tcl Eggdrop 1.3 script</CENTER>"
        close $a
    }
    timer $web_update web_write
}
bind topc - * web_topic
proc web_topic {nick uhost handle channel vars} {
    global web_topic web_chans
    if {[lsearch [array names web_chans] $channel] != "-1"} {
        set web_topic($channel) $vars
    }
}
web_write
putlog "\002HTML2\002 - Writing: [array names web_chans] :stats files"