🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: be.comp.internet.irc
Article #1067

STATWWW TCL PROBLEM

#1067
From: Sven DE TROCH
Date: Sun, 27 Jul 1997 00:00
581 lines
20338 bytes
[news: be.comp.internet.irc]
[news: alt.irc.bots.eggdrop]

Hi eggdrop-specialists,
Can someone look at the script to find out what's the problem?
or
is it an installation problem?
I don't know tcl, so I'm lost!
thank you

symptoms:
----------------

I've installed the tck
But I've got a little problem:
- logfiles are created (automatically) and updated without any problem
- html-files are created (automtically) but they stay empty (0 bytes)
- dir and files are owned by the bot
- bot was rehashed
- !stat and !when are working fine

SCRIPT I USE:

##########################################################################
###                     CHANNELTALK STATISTICS 1.1
###
###                � Goblet 1997     email: goblet@sci.fi
###
###   READ ALL THE DOCUMENTATION FIRST!   Use with your own risk :)
###
##########################################################################
### NOTES: This script uses xtra-field in userfile and flags 1 & 2,
###
###        so it WILL interfere with other scripts using those!
###
###        Also this script cannot be used with multichannel bots!
###
##########################################################################
##            Sorry for some finnish-language variable names,
##
##                 I'm just too lazy to translate them :)
##
##########################################################################

## A few little bugs were corrected since ver 1.0, ctcp action is now

## bindable and you'll not get "tcl error count_words no such user!
## anymore.
## !when tells now idletime also, if asked user is on channel.

##########################################################################
## ================== DCC COMMANDS TO HANDLE THE STATS
===================
##                      (only masters can use these)
## CLRUSER <handle>
##    Sets somebody's all stats to 0 
## SUMUSER <handle1> <handle2>
##    Adds handle2's hostmask(s) and stats to handle1 and deletes
handle2

## ============================ MSG & PUB COMMANDS
=======================
##                        (everybody can use these)
## These work also via public by using "!" prefix, f.ex. !when foo
##
## STAT
##    Sends a notice to the user and tells his/her statistics
## WHEN <nick>
##    Sends a notice to the user and tells when <nick> was last on
channel

## ================ SPECIAL FLAGS USED BY THIS SCRIPT:
===================
## 1 = Do not include this user to the list output. (counting still
works)
## 2 = Lock this handle, if someone uses same nick, he'll get handle
_nick
##     M (master) flag does the same also for security.
## IMPORTANT: If you use auto-op on your bot, be sure to lock all
opers.
##            Otherwise people using same nick will get ops!!
##            You can use .sumuser command later in need.

## ============================= SETTINGS
================================
catch {unset lfile}
catch {unset wwwfile}
catch {unset wwwlfile}
## These are in order:
## fastlog file for logging the channel which clears after 200 publics
## webfile with a html-table, shows 50 top talkers
## webfile, only text for lynx users and it shows all talkers except
with flag 1
## and shows also known hostmasks

set lfile "/sven/html/botstats.log"
logfile jkps * $lfile
set wwwfile "/sven/html/stat.html"
set wwwlfile "/sven/html/stat_lynx.html"

## tag for the output, if you want to use your own colors etc.
set bodytag "<body bgcolor=#FFFFFF text=#000000>"

## which channel should stat?
set statchan "#vlaanderenboven"
## after how minutes should update be done?
set updatestat 5
## should userfile be saved same time as the statistics-web page
updates?
set saveonupdate 1
## should bot learn new users when they start talkin at channel?
## not good idea if you don't like BIG userfile... 1=enable 0=disable
## if a user with same nick already exists, new hostmask is added to
user.
## auto-add removes flags ofxp for security when bot learns new user.
set autoadd 0

### ------------------------- CODE BEGINS HERE -----------------------

proc auto_adduser {nick uhost hand chan text} {
        set sana [llength [split $text " "]]
        set kirjain [string length $text]
	if {[validuser $nick] == 1} {
           if {([matchattr $nick 2] == 1) || ([matchattr $nick m] ==
1)} {
               set nick "_$nick"
              }
           if {([matchattr $nick 2] != 1) && ([matchattr $nick m] !=
1)} {
              addhost $nick [maskhost $nick!$uhost]
              putlog "Learned hostmask [maskhost $nick!$uhost] for
$nick"
              set sanoja [user_get $hand "words"]
              user_set $hand "words" [expr { $sanoja + $sana }]
              set pubcomments [user_get $hand "comments"]
              user_set $hand "comments" [expr { $pubcomments + 1 }]
              set kirj [user_get $hand "letters"]
              user_set $hand "letters" [expr { $kirj + $kirjain -
$sana + 1 }]
              return 1    
              }            
           }
        adduser $nick [maskhost $nick!$uhost]
        putlog "Learned user $nick [maskhost $nick!$uhost]"
        chattr $nick "-ofxp"
        user_set $nick "words" $sana
        user_set $nick "comments" 1
        user_set $nick "letters" [expr { $kirjain - $sana + 1 }]
        user_set $nick "mode" 0
        user_set $nick "kick" 0
        user_set $nick "topc" 0
        user_set $nick "acti" 0
        return 1
}

bind pubm - * count_words
proc count_words {nick uhost hand chan text} {
global autoadd
	if {$hand == "*"} {
             auto_adduser $nick $uhost $hand $chan $text
	     return 0
           }
     if {[validuser $hand]} {
        set sana [llength [split $text " "]]
        set kirjain [string length $text]

        set sanoja [user_get $hand "words"]
        user_set $hand "words" [expr { $sanoja + $sana }]
        set pubcomments [user_get $hand "comments"]
        user_set $hand "comments" [expr { $pubcomments + 1 }]
        set kirj [user_get $hand "letters"]
        user_set $hand "letters" [expr { $kirj + $kirjain - $sana + 1
}]
        }
}

## .sumuser sums two usernames' stats together, if automatic-add-user
## has created two entries to same user...

bind dcc m sumuser dcc_sumuser

proc dcc_sumuser {hand idx text} {
        set realuser [lindex [split $text { }] 0]
        set fakeuser [lindex [split $text { }] 1]
	if {[validuser $realuser] != 1} {return 0}
	if {[validuser $fakeuser] != 1} {return 0}
	set apu [expr {[user_get $realuser "words"] + [user_get
$fakeuser "words"]}]
        user_set $realuser "sanat" $apu
	set apu [expr {[user_get $realuser "comments"] + [user_get
$fakeuser "comments"]}]
        user_set $realuser "komment" $apu
	set apu [expr {[user_get $realuser "letters"] + [user_get
$fakeuser "letters"]}]
        user_set $realuser "kirjaim" $apu
	set apu [getlaston $fakeuser]
	if {[getlaston $realuser] < $apu} {
		setlaston $realuser $apu
		}
	unset apu
	addhost $realuser [lindex [gethosts $fakeuser] 0]
	putlog "$fakeuser stats added to $realuser and $fakeuser
deleted."
	putlog "[lindex [gethosts $fakeuser] 0] hostmask added to
$realuser"
	deluser $fakeuser
	}

## .clruser handle clears somebody's statistics if he has flooded
## to get higher on the list (this has really happened ;-)

bind dcc m clruser dcc_formatuser
proc dcc_formatuser {hand idx text} {
        putlog "Set parms user $text to 0"
        user_set $text "words" 0
        user_set $text "comments" 0
        user_set $text "letters" 0
        user_set $text "kick" 0
        user_set $text "mode" 0
        user_set $text "topc" 0
        user_set $text "acti" 0
	}

proc user_get {handle key} {
  set xtra [getxtra $handle]
  for {set i 0} {$i < [llength $xtra]} {incr i} {
    set this [lindex $xtra $i]
    if {[string compare [lindex $this 0] $key] == 0} {
      return [lindex $this 1]
    }
  }
  return 0
}

proc user_set {handle key data} {
  set xtra [getxtra $handle]
  for {set i 0} {$i < [llength $xtra]} {incr i} {
    set this [lindex $xtra $i]
    if {[string compare [lindex $this 0] $key] == 0} {
      set this [list $key $data]
      setxtra $handle [lreplace $xtra $i $i $this]
      return
    }
  }
  lappend xtra [list $key $data]
  setxtra $handle $xtra
}

set cmnts 198

bind pubm - * count_comment
proc count_comment {nick uhost hand chan text} {
	global cmnts lfile updatestat statchan
	incr cmnts
        if {$cmnts >= 200} {
        set fdlog [open $lfile w]
	set cmnts 1 
        puts $fdlog "Members on channel $statchan at [datetime
[unixtime]]"
        foreach i [chanlist $statchan] {
           if {[isop $i $statchan]} {append foo "@$i "}
           if {![isop $i $statchan]} {append foo "$i "}
        }
        puts $fdlog $foo
        puts $fdlog " "
	close $fdlog
	}
}

proc do_stats {} {
  global wwwfile wwwlfile updatestat statchan saveonupdate bodytag
      set foo [llength [userlist]]
      if {$foo > 50} {set foo 50}
      set fd [open $wwwfile w]
      set fdl [open $wwwlfile w]
      puts $fd "<meta http-equiv=\"Refresh\" content=[expr 300]>"
      puts $fd "<html><head><title>Top $foo talkers on channel
$statchan</title></head>"
      puts $fd $bodytag
      puts $fd "<center><h1>Top $foo talkers on channel
$statchan</h1>"
      puts $fdl "<html><head><title>Top talkers on channel
$statchan</title></head>"
      puts $fdl "<body>Top talkers on channel $statchan<br>"
      puts $fd "<table border=2 cellpadding=1>"
      puts $fd "<caption> [datetime [unixtime]] </caption>"
      puts $fdl "[datetime [unixtime]] <br><br>"
      puts $fd "<th align=left>Nr"
      puts $fd "<th align=left>Nick"
      puts $fd "<th align=left>Last on"
      puts $fd "<th align=left>Words"
      puts $fd "<th align=left>Publics"
      puts $fd "<th align=left>W/P"
      puts $fd "<th align=left>Letters"
      puts $fd "<th align=left>Kicks"
      puts $fd "<th align=left>Modes"
      puts $fd "<th align=left>Topics"
      puts $fd "<th align=left>Actions"
      foreach i [userlist] {
        if {[matchattr $i 1] == 0} {
        set apu "[user_get $i "words"] $i"
	   if {$i != "*ban"} {lappend apulist $apu}
        }
	}
	set apulista [lsort -decreasing -command cmp $apulist]
	set no 0
      foreach i $apulista {
	incr no
        set handle [lindex $i 1]
        set chost  [gethosts $handle]
        set w_word [user_get $handle "words"]
        set w_comm [user_get $handle "comments"]
        set w_letr [user_get $handle "letters"]
        set w_kick [user_get $handle "kick"]
        set w_mode [user_get $handle "mode"]
        set w_topc [user_get $handle "topc"]
        set w_acti [user_get $handle "acti"]
        set lastonchan [datetime [getlaston $handle]]
        set w_wordperpub "[expr {$w_word / $w_comm}]."
        append w_wordperpub "[expr {($w_word * 10 / $w_comm) -
($w_word / $w_comm *10)}]"
        if {[getlaston $handle] == 0} {set lastonchan "???"}
        if {[handonchan $handle $statchan] == 1 } {
            if {[getchanidle [hand2nick $handle $statchan] $statchan]
< 11} {
                set lastonchan "NOW!"
               }
            if {[getchanidle [hand2nick $handle $statchan] $statchan]
> 10} {
                set fooidle [getchanidle [hand2nick $handle $statchan]
$statchan]
                set lastonchan "idle "
                if {$fooidle > 59} {append lastonchan "[expr $fooidle
/ 60]h "}
                append lastonchan "[expr $fooidle - ($fooidle / 60 *
60)]min"
               }
           }
        if {[onchansplit [hand2nick $handle $statchan] $statchan]} {
            set lastonchan "SPLIT"
           }
	if {$no < 51} {
            puts $fd "<tr>"
            puts $fd "<td align=left>$no</td>"
            puts $fd "<td align=left>$handle</td>"
            puts $fd "<td>$lastonchan</td>"
            puts $fd "<td align=right>$w_word</td>"
            puts $fd "<td align=right>$w_comm</td>"
            puts $fd "<td align=right>$w_wordperpub</td>"
            puts $fd "<td align=right>$w_letr</td>"
            puts $fd "<td align=right>$w_kick</td>"
            puts $fd "<td align=right>$w_mode</td>"
            puts $fd "<td align=right>$w_topc</td>"
            puts $fd "<td align=right>$w_acti</td>"
           }
	puts $fdl "<pre>"
        puts $fdl "Nr:          $no"
        puts $fdl "Nick:        $handle"
        puts $fdl "Hostmasks:   $chost"
        puts $fdl "Last on:     $lastonchan"
        puts $fdl "Words:       $w_word"
        puts $fdl "Publics:     $w_comm"        
        puts $fdl "Words/pub:   $w_wordperpub"
        puts $fdl "Letters:     $w_letr"
        puts $fdl "Kicks:       $w_kick"
        puts $fdl "Modes:       $w_mode"
        puts $fdl "Topics:      $w_topc"
        puts $fdl "Actions:     $w_acti"
        puts $fdl "---------------------------------------------"
	puts $fdl "</pre>"
	}
      puts $fd "</table></center><br>"
      puts $fd "<center>This page updates every $updatestat
minutes.</center><br>"
      puts $fd "<center><address>&copy; <a
href=\"http://www.sci.fi/~goblet/\">Goblet</a>
1997</address></center>"
      puts $fd "</body></html>"
      puts $fdl "This page updates every $updatestat minutes.<br>"
      puts $fdl "&copy; <a
href=\"http://www.sci.fi/~goblet/\">Goblet</a> 1997"
      puts $fdl "</body></html>"
      close $fd
      close $fdl
      if {$saveonupdate == 1} {save}
      timer $updatestat do_stats ; return 1 
}

proc cmp {one two} {
  if {[lindex $one 0] > [lindex $two 0]} {
    return 1
  } elseif {[lindex $one 0] < [lindex $two 0]} {
    return -1
  } else {
    return 0
  }
}

proc datetime {foob} {
  set months {foo Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}
  set foo [ctime $foob]
  append aika "[string range $foo 8 9]."
  append aika "[lsearch -exact $months [string range $foo 4 6]]."
  append aika "\x20[string range $foo 11 15]"
  return $aika
}

bind msg - stat msg_stat

proc msg_stat {nick uhost hand arg} {
        if {[validuser $hand] != 1} {return 0}
        set statmessage "You've said "
        append statmessage "[user_get $hand "words"] words, "
        append statmessage "[user_get $hand "comments"] publics, "
        append statmessage "[user_get $hand "letters"] letters."
        putserv "NOTICE $nick :$statmessage"
        set statmessage "You've done "
        append statmessage "[user_get $hand "kick"] kicks, "
        append statmessage "[user_get $hand "mode"] mode changes, "
        append statmessage "[user_get $hand "topc"] topic changes, "
        append statmessage "[user_get $hand "acti"] actions."
        putserv "NOTICE $nick :$statmessage"
}
bind pub - !stat pub_stat

proc pub_stat {nick uhost hand chan text} {
        if {[validuser $hand] != 1} {return 0}
        set statmessage "You've said "
        append statmessage "[user_get $hand "words"] words, "
        append statmessage "[user_get $hand "comments"] publics, "
        append statmessage "[user_get $hand "letters"] letters."
        putserv "PRIVMSG $chan :$nick: $statmessage"
        set statmessage "and done "
        append statmessage "[user_get $hand "kick"] kicks, "
        append statmessage "[user_get $hand "mode"] mode changes, "
        append statmessage "[user_get $hand "topc"] topic changes, "
        append statmessage "[user_get $hand "acti"] actions."
        putserv "PRIVMSG $chan :$nick: $statmessage"
}

proc check_when {user nick} {
   global botnick statchan
   if {[string compare [string tolower $botnick] [string tolower
$nick]] == 0} {
       return "Oh yeah, if I look at mirror :)"
      }
   if {[string compare [string tolower $nick] [string tolower $user]]
== 0} {
       return "HUH? Don't you know where you are?"
      }
   if {[onchansplit $nick $statchan]} {
       return "$nick was just here, but got netsplit."
      }
   if {[onchan $nick $statchan]} {
       set foo [getchanidle $nick $statchan]
       set idletime "idle "
       if {$foo > 59} {append idletime "[expr $foo / 60] h "}
       append idletime "[expr $foo - ($foo / 60 * 60)] min."
       return "$nick is on channel $statchan just now! $idletime"
      }

   foreach i [chanlist $statchan] {
      set hand [finduser $i![getchanhost $i $statchan]]
      if {($hand != "*") && ([string compare [string tolower $hand]
[string tolower $nick]] == 0)} {
          if {[onchansplit $i $statchan]} {
              return "$i used nick $nick, and was here just but got
netsplit"
             }
          if {[onchan $i $statchan]} {
              set foo [getchanidle $i $statchan]
              set idletime "idle "
              if {$foo > 59} {append idletime "[expr $foo / 60] h "}
              append idletime "[expr $foo - ($foo / 60 * 60)] min."
             return "$nick uses nick $i, and is on $statchan now.
$idletime"
             }
         }
   }
   if {[validuser $nick] != 1} { return "I don't know :-o" }
   if {[validuser $nick] == 1} {
       set lasttime [datetime [getlaston $nick]]
       if {[getlaston $nick] == 0} {
           return "$nick? I don't know :-o"
          }
      }
   return "$nick was on $statchan at $lasttime"
}

bind pub - !when pub_when

proc pub_when {nick uhost hand chan args} {
        puthelp "PRIVMSG $chan :$nick: [check_when $nick $args]"
}

bind msg - when msg_when

proc msg_when {nick uhost hand text} {
        putserv "NOTICE $nick :[check_when $nick $text]"
}

bind splt - * set_utim_p
bind part - * set_utim_p
proc set_utim_p {nick uhost hand chan} {
   if {[validuser $hand] == 1} { setlaston $hand }
}

bind sign - * set_utim_s
proc set_utim_s {nick uhost hand chan arg} {
   if {[validuser $hand] == 1} { setlaston $hand }
}

bind mode - * set_umode
proc set_umode {nick uhost hand chan arg} {
   if {[validuser $hand] == 1} {
        set foo [user_get $hand "mode"]
        if {$foo == ""} {set foo 0}
        incr foo
        user_set $hand "mode" $foo
      }
}
bind kick - * set_ukick
proc set_ukick {nick uhost hand chan knick reason} {
   if {[validuser $hand] == 1} {
        set foo [user_get $hand "kick"]
        if {$foo == ""} {set foo 0}
        incr foo
        user_set $hand "kick" $foo
      }
}
bind topc - * set_utopc
proc set_utopc {nick uhost hand chan topic} {
   if {[validuser $hand] == 1} {
        set foo [user_get $hand "topc"]
        if {$foo == ""} {set foo 0}
        incr foo
        user_set $hand "topc" $foo
      }
}
bind ctcp - ACTION set_uaction
proc set_uaction {nick uhost hand dest keyword args} {
   if {[validuser $hand] == 1} {
        set foo [user_get $hand "acti"]
        if {$foo == ""} {set foo 0}
        incr foo
        user_set $hand "acti" $foo
        return 0
      }
}

if {![info exists stats_going]} {
  timer 2 do_stats
  set stats_going 1
}
                                       
## this is a little kludge for userfile from version 1.0
proc fixtra {} {
  foreach i [userlist] {
     if {[user_get $i "gone"] != 0} {
        lappend foo [list "words" [user_get $i "words"]]
        lappend foo [list "comments" [user_get $i "comments"]]
        lappend foo [list "letters" [user_get $i "letters"]]
        lappend foo [list "kick" [user_get $i "kick"]]
        lappend foo [list "mode" [user_get $i "mode"]]
        lappend foo [list "topc" [user_get $i "topc"]]
        lappend foo [list "acti" [user_get $i "acti"]]
        setxtra $i $foo
        unset foo
     }
  }
}
timer 1 fixtra

putlog "Channeltalk-statistics 1.1  by Goblet"

-------------------------
Met vriendelijke groeten,

Sven DE TROCH
Email: sven@sven.net
Technical Details
Message-ID: <33dcba3c.150560637@news.innet.be>
Path: arc1-ca.pugleaf.net!unknown!not-for-mail

Show Full Headers
Complete Article Headers
X-Google-Language: ENGLISH,ASCII
X-Google-Thread: 10e7f5,8aa113a36368b648,start
X-Google-Attributes: gid10e7f5,public
From: sven@sven.net (Sven DE TROCH)
Subject: STATWWW TCL PROBLEM
Date: 1997/07/27
Message-ID: <33dcba3c.150560637@news.innet.be>
X-Deja-AN: 259563362
Organization: ---
Reply-To: sven@sven.net
Newsgroups: be.comp.internet.irc