average.tcl

Thunderdome · Post by **Thunderdome** » Tue May 10, 2005 2:58 pm

# average.tcl (C) perpleXa 2005
# just type *average to receive some channel statistics.

namespace eval average {
  variable version "2.13";
  variable dbase "scripts/dbase/average";
  bind pub  m|m "*average"   [namespace current]::pubtrigger;
  bind time -|- "* * * * *"  [namespace current]::expression;
  bind evnt -|- "save"       [namespace current]::savedb;
}

proc average::pubtrigger {nick host hand chan args} {
  set text [lindex $args 0];
  if {[llength [clean $text]] < 1} {
    set channel $chan;
  } else {
    set channel [lindex [clean $text] 0];
  }
  if {![validchan $channel]} {
    putquick "PRIVMSG $chan :Channel $channel is unknown.";
    return;
  }
  set data [getchaninfo [string tolower $channel]];
  set lasthour [lindex $data 0]; set today [lindex $data 1]; set yesterday [lindex $data 2];
  set sevenday [lindex $data 3]; set fourteenday [lindex $data 4];
  set lasthoura [lindex [split $lasthour] 0]
  set todaya [lindex [split $today] 0]; set todaym [lindex [split $today] 1];
  set yesterdaya [lindex [split $yesterday] 0]; set yesterdaym [lindex [split $yesterday] 1];
  set sevendaya [lindex [split $sevenday] 0]; set sevendaym [lindex [split $sevenday] 1];
  set fourteendaya [lindex [split $fourteenday] 0]; set fourteendaym [lindex [split $fourteenday] 1];

  putquick [format "PRIVMSG %s :Statistics for channel %s:" $chan $channel];
  putquick [format "PRIVMSG %s :  Last hour     : %6.1f average users" $chan $lasthoura];
  putquick [format "PRIVMSG %s :  Today so far  : %6.1f average users, %4d max" $chan $todaya $todaym];
  putquick [format "PRIVMSG %s :  Yesterday     : %6.1f average users, %4d max" $chan $yesterdaya $yesterdaym];
  putquick [format "PRIVMSG %s :  7-day average : %6.1f average users, %4d max" $chan $sevendaya $sevendaym];
  putquick [format "PRIVMSG %s :  14-day average: %6.1f average users, %4d max" $chan $fourteendaya $fourteendaym];
}

proc average::getchaninfo {chan} {
  variable data;
  set houra 0; set todaya 0; set yesterdaya 0; set sevendaya 0; set fourteendaya 0;
  set todaym 0; set yesterdaym 0; set sevendaym 0; set fourteendaym 0;
  set time [clock seconds];
  set todayts [clock scan [strftime "%m/%d/%Y" $time]];
  set yesterdayts [clock scan [strftime "%m/%d/%Y" [expr $time-86400]]];
  foreach {item value} [array get data [string tolower $chan],*] {
    set timestamp [lindex [split $item ,] 1];
    if {[expr $time - $timestamp] <= 3600} {
      # last hour
      incr houra $value;
    }
    if {$timestamp >= $todayts} {
      # today
      incr todaya $value;
      if {$value > $todaym} {set todaym $value;}
    }
    if {($timestamp >= $yesterdayts) && ($timestamp < $todayts)} {
      # yesterday
      incr yesterdaya $value;
      if {$value > $yesterdaym} {set yesterdaym $value;}
    }
    if {[expr $time - $timestamp] <= 604800} {
      # 7 days
      incr sevendaya $value;
      if {$value > $sevendaym} {set sevendaym $value;}
    }
    if {[expr $time - $timestamp] <= 1209600} {
      # 14 days
      incr fourteendaya $value;
      if {$value > $fourteendaym} {set fourteendaym $value;}
    }
  }
  set houra [expr $houra/60.0];
  set todaya [expr $todaya/(($time-$todayts)/60.0)];
  set yesterdaya [expr $yesterdaya/1440.0];
  set sevendaya [expr $sevendaya/10080.0];
  set fourteendaya [expr $fourteendaya/20160.0];
  return [list $houra "$todaya $todaym" \
  "$yesterdaya $yesterdaym" "$sevendaya $sevendaym" "$fourteendaya $fourteendaym"];
}

proc average::expression {args} {
  variable data;
  set time [clock seconds];
  foreach chan [channels] {
    set data([string tolower $chan],$time) [users $chan];
  }
}

proc average::users {chan} {
  set users 0; set clones 0;
  foreach user [chanlist $chan] {
    if {[string length $user] == 1} {
      continue;
    }
    set host [lindex [split [getchanhost $user] @] 1];
    incr users;
    if {![info exists fakeuser($host)]} {
      set fakeuser($host) $user;
    } else {
      lappend fakeuser($host) $user;
      incr clones 1;
    }
  }
  return [expr $users - $clones];
}

proc average::clean {i} {
  return [regsub -all -- {([\(\)\[\]\{\}\$\"\\])} $i {\\\1}];
}

proc average::loaddb {args} {
  variable dbase; variable data;
  if {![file exists $dbase]} {return 0;}
  set fp [open $dbase r+];
  while {![eof $fp]} {
    gets $fp line;
    if {[regexp -- {^([^\s]+)\s(\d+)\s(\d+)$} $line -> chan timestamp udata]} {
      set data($chan,$timestamp) $udata;
    }
  }
  close $fp;
  return;
}

proc average::savedb {args} {
  variable dbase; variable data;
  if {![file isdirectory [file dirname $dbase]]} {
    file mkdir [file dirname $dbase];
  }
  set fp [open $dbase w+];
  foreach item [array names data] {
    set chan [lindex [split $item ,] 0];
    set timestamp [lindex [split $item ,] 1];
    set time [clock seconds];
    if {[expr $time - $timestamp] < 1209600} {
      if {[validchan $chan]} {
        puts $fp "$chan $timestamp $data($item)";
      } else {
        unset data($item);
      }
    } else {
      unset data($item);
    }
  }
  close $fp;
  return;
}

proc average::version {args} {
  variable file [lindex [split [info script] "/"] end];
  variable version;
  variable modified [clock format [file mtime [info script]] -format "%Y/%m/%d %H:%M:%S"];
  variable owner "perpleXa";
  putlog "\$Id: $file,v $version $modified $owner Exp \$";
}

average::loaddb;
average::version;

I would like this to function as notice for the person who asks.... however, when I change it to NOTICE $nick it simply does an error and won't work... why? What am I doing wrong?
greetz and thanks...

ps: is there a way this script could get info from the regular eggdrop gseen module or something? or is there a simpler way to get this averages?

Thunderdome · Post by **Thunderdome** » Thu May 12, 2005 12:16 pm

I still haven't worked this out... there is another similar problem with another script... perhaps it is the same problem... can you give me a helping hand?

greenbear · Post by **greenbear** » Thu May 12, 2005 3:15 pm

there's no code related to notices in the code you pasted.

maybe you could paste the code that you actually use, along with the error msg.

Thunderdome · Post by **Thunderdome** » Thu May 12, 2005 4:38 pm

Code: Select all

# average.tcl (C) perpleXa 2005
# just type !average or !avg to receive some channel statistics.

namespace eval average {
  variable version "2.13";
  variable dbase "scripts/dbase/average";
  bind pub  -|- "!avg"   [namespace current]::pubtrigger;
  bind pub  -|- "!average"   [namespace current]::pubtrigger;
  bind time -|- "* * * * *"  [namespace current]::expression;
  bind evnt -|- "save"       [namespace current]::savedb;
}

proc average::pubtrigger {nick host hand chan args} {
  set text [lindex $args 0];
  if {[llength [clean $text]] < 1} {
    set channel $chan;
  } else {
    set channel [lindex [clean $text] 0];
  }
  if {![validchan $channel]} {
    putquick "NOTICE $nick :4,5Channel0,5 $channel 4,5is unknown.";
    return;
  }
  set data [getchaninfo [string tolower $channel]];
  set lasthour [lindex $data 0]; set today [lindex $data 1]; set yesterday [lindex $data 2];
  set sevenday [lindex $data 3]; set fourteenday [lindex $data 4];
  set lasthoura [lindex [split $lasthour] 0]
  set todaya [lindex [split $today] 0]; set todaym [lindex [split $today] 1];
  set yesterdaya [lindex [split $yesterday] 0]; set yesterdaym [lindex [split $yesterday] 1];
  set sevendaya [lindex [split $sevenday] 0]; set sevendaym [lindex [split $sevenday] 1];
  set fourteendaya [lindex [split $fourteenday] 0]; set fourteendaym [lindex [split $fourteenday] 1];

  putquick [format "NOTICE $nick :4,5Statistics for channel %s:" $chan $channel];
  putquick [format "NOTICE $nick :4,5  Last hour     :0,5 %6.1f 4,5average gabbers" $chan $lasthoura];
  putquick [format "NOTICE $nick :4,5  Today so far  :0,5 %6.1f 4,5average gabbers,0,5 %4d 4,5max" $chan $todaya $todaym];
  putquick [format "NOTICE $nick :4,5  Yesterday     :0,5 %6.1f 4,5average gabbers,0,5 %4d 4,5max" $chan $yesterdaya $yesterdaym];
  putquick [format "NOTICE $nick :4,5  7-day average :0,5 %6.1f 4,5average gabbers,0,5 %4d 4,5max" $chan $sevendaya $sevendaym];
  putquick [format "NOTICE $nick :4,5  14-day average:0,5 %6.1f 4,5average gabbers,0,5 %4d 4,5max" $chan $fourteendaya $fourteendaym];
}

proc average::getchaninfo {chan} {
  variable data;
  set houra 0; set todaya 0; set yesterdaya 0; set sevendaya 0; set fourteendaya 0;
  set todaym 0; set yesterdaym 0; set sevendaym 0; set fourteendaym 0;
  set time [clock seconds];
  set todayts [clock scan [strftime "%m/%d/%Y" $time]];
  set yesterdayts [clock scan [strftime "%m/%d/%Y" [expr $time-86400]]];
  foreach {item value} [array get data [string tolower $chan],*] {
    set timestamp [lindex [split $item ,] 1];
    if {[expr $time - $timestamp] <= 3600} {
      # last hour
      incr houra $value;
    }
    if {$timestamp >= $todayts} {
      # today
      incr todaya $value;
      if {$value > $todaym} {set todaym $value;}
    }
    if {($timestamp >= $yesterdayts) && ($timestamp < $todayts)} {
      # yesterday
      incr yesterdaya $value;
      if {$value > $yesterdaym} {set yesterdaym $value;}
    }
    if {[expr $time - $timestamp] <= 604800} {
      # 7 days
      incr sevendaya $value;
      if {$value > $sevendaym} {set sevendaym $value;}
    }
    if {[expr $time - $timestamp] <= 1209600} {
      # 14 days
      incr fourteendaya $value;
      if {$value > $fourteendaym} {set fourteendaym $value;}
    }
  }
  set houra [expr $houra/60.0];
  set todaya [expr $todaya/(($time-$todayts)/60.0)];
  set yesterdaya [expr $yesterdaya/1440.0];
  set sevendaya [expr $sevendaya/10080.0];
  set fourteendaya [expr $fourteendaya/20160.0];
  return [list $houra "$todaya $todaym" \
  "$yesterdaya $yesterdaym" "$sevendaya $sevendaym" "$fourteendaya $fourteendaym"];
}

proc average::expression {args} {
  variable data;
  set time [clock seconds];
  foreach chan [channels] {
    set data([string tolower $chan],$time) [users $chan];
  }
}

proc average::users {chan} {
  set users 0; set clones 0;
  foreach user [chanlist $chan] {
    if {[string length $user] == 1} {
      continue;
    }
    set host [lindex [split [getchanhost $user] @] 1];
    incr users;
    if {![info exists fakeuser($host)]} {
      set fakeuser($host) $user;
    } else {
      lappend fakeuser($host) $user;
      incr clones 1;
    }
  }
  return [expr $users - $clones];
}

proc average::clean {i} {
  return [regsub -all -- {([\(\)\[\]\{\}\$\"\\])} $i {\\\1}];
}

proc average::loaddb {args} {
  variable dbase; variable data;
  if {![file exists $dbase]} {return 0;}
  set fp [open $dbase r+];
  while {![eof $fp]} {
    gets $fp line;
    if {[regexp -- {^([^\s]+)\s(\d+)\s(\d+)$} $line -> chan timestamp udata]} {
      set data($chan,$timestamp) $udata;
    }
  }
  close $fp;
  return;
}

proc average::savedb {args} {
  variable dbase; variable data;
  if {![file isdirectory [file dirname $dbase]]} {
    file mkdir [file dirname $dbase];
  }
  set fp [open $dbase w+];
  foreach item [array names data] {
    set chan [lindex [split $item ,] 0];
    set timestamp [lindex [split $item ,] 1];
    set time [clock seconds];
    if {[expr $time - $timestamp] < 1209600} {
      if {[validchan $chan]} {
        puts $fp "$chan $timestamp $data($item)";
      } else {
        unset data($item);
      }
    } else {
      unset data($item);
    }
  }
  close $fp;
  return;
}

proc average::version {args} {
  variable file [lindex [split [info script] "/"] end];
  variable version;
  variable modified [clock format [file mtime [info script]] -format "%Y/%m/%d %H:%M:%S"];
  variable owner "perpleXa";
  putlog "\$Id: $file,v $version $modified $owner Exp \$";
}

average::loaddb;
average::version;

the error:

Code: Select all

Tcl error [::average::pubtrigger]: expected floating-point number but got "#Thunderdome"

metroid · Post by **metroid** » Fri May 13, 2005 1:39 am

Have you bothered to look at the code?

It's a format so to make it notice you will have to use

Code: Select all

  putquick [format "NOTICE %s :Statistics for channel %s:" $nick $channel];
  putquick [format "NOTICE %s :  Last hour     : %6.1f average users" $nick $lasthoura];
  putquick [format "NOTICE %s :  Today so far  : %6.1f average users, %4d max" $nick $todaya $todaym];
  putquick [format "NOTICE %s :  Yesterday     : %6.1f average users, %4d max" $nick $yesterdaya $yesterdaym];
  putquick [format "NOTICE %s :  7-day average : %6.1f average users, %4d max" $nick $sevendaya $sevendaym];
  putquick [format "NOTICE %s :  14-day average: %6.1f average users, %4d max" $nick $fourteendaya $fourteendaym];

Thunderdome · Post by **Thunderdome** » Fri May 13, 2005 10:32 am

that will notice the channel and not the nick: I've posted the exact same code modified by me for notice...
But I want nick notice and not channel notice

dwickie · Post by **dwickie** » Fri May 13, 2005 3:32 pm

Thunderdome wrote:that will notice the channel and not the nick: I've posted the exact same code modified by me for notice...
But I want nick notice and not channel notice

try replace

NOTICE %s

with

NOTICE $nick

edit: oops sorry, did not noticed, you aleready tried that

Thunderdome · Post by **Thunderdome** » Fri May 13, 2005 3:39 pm

already did, as you can see in the code above....
it gives error.

Thunderdome · Post by **Thunderdome** » Mon May 16, 2005 9:56 am

Hum, I've now tried some things, but I can't make this work with notice nick.... anyone can give me a little hand?
Is it something about that "format" procedure?

Alchera · Post by **Alchera** » Mon May 16, 2005 10:27 am

May be a look at the format TCL command might help.

Thunderdome · Post by **Thunderdome** » Mon May 16, 2005 11:47 am

I read it... I tried to change a few things, but still does not work properly... I can make it notice me, but nothing shows up...
How can I change it in a correct form?

metroid · Post by **metroid** » Mon May 16, 2005 1:30 pm

I'll help you again.

Code: Select all

 putquick [format "NOTICE %s :Statistics for channel %s:" $nick $channel];
 putquick [format "NOTICE %s :  Last hour     : %6.1f average users" $nick $lasthoura];
 putquick [format "NOTICE %s :  Today so far  : %6.1f average users, %4d max" $nick $todaya $todaym];
 putquick [format "NOTICE %s :  Yesterday     : %6.1f average users, %4d max" $nick $yesterdaya $yesterdaym];
 putquick [format "NOTICE %s :  7-day average : %6.1f average users, %4d max" $nick $sevendaya $sevendaym];
 putquick [format "NOTICE %s :  14-day average: %6.1f average users, %4d max" $nick $fourteendaya $fourteendaym];

This is notices you, If you still continue to say it notices the channel, You're a fool and you don't know how format works.

Any other person that knows anything about tcl/format should see i'm right.

Thunderdome · Post by **Thunderdome** » Mon May 16, 2005 4:09 pm

You are damn right! When I looked at your post, I did not notice you had exchanged the place where you put $nick. sorry, my fault. I tough you had posted the same thing I tried afterwards!

So $nick should always come after %s, so everything comes out right...
I am very very new at tcl, so I am learning... sometimes RTFM does not help out when you don't know much...

Thanks, works 100%.