From: dms Date: Sun, 13 May 2001 13:09:27 +0000 (+0000) Subject: - moved scripts/setup_sql.pl to src/db_mysql as &createTables() X-Git-Url: https://git.donarmstrong.com/?p=infobot.git;a=commitdiff_plain;h=f31097ab45dca4b19e255801c966e9cd552eece4 - moved scripts/setup_sql.pl to src/db_mysql as &createTables() - &countKeys() now takes secondary option argument of column - added &sumKey(), &dbCreateTable() - added factoid arguments => "testfoo $blah" - run &netsplitCheck() on on_join and on another hook. - run &chanlimitCheck() when netsplit has "joined" - added "factstats total" for general/total statistics on factoids. - maths: 999! would fail; now continues properly. - added "news stats" git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@484 c11ca15a-4712-0410-83d8-924469b57eb5 --- diff --git a/src/Factoids/Question.pl b/src/Factoids/Question.pl index b5c4b48..bd1d47a 100644 --- a/src/Factoids/Question.pl +++ b/src/Factoids/Question.pl @@ -80,6 +80,63 @@ sub doQuestion { $questionWord = "where"; } + if (&IsChanConf("factoidArguments")) { + # to make it eleeter, split each arg and use "blah OR blah or BLAH" + # which will make it less than linear => quicker! + # todo: cache this, update cache when altered. + my @list = &searchTable("factoids", "factoid_key", "factoid_key", "CMD: "); + + # from a design perspective, it's better to have the regex in + # the factoid key to reduce repetitive processing. + + foreach (@list) { + s/^CMD: //; +# &DEBUG("factarg: ''$query[0]' =~ /^$_\$/'"); + my @vals; + my $arg = $_; + + eval { + next unless ($query[0] =~ /^$arg$/i); + + for ($i=1; $i<=5; $i++) { + $val = $$i; + last unless (defined $val); + + push(@vals, $val); + } + }; + + if ($@) { # it failed!!! + &WARN("factargs: regex failed! '$query[0]' =~ /^$_\$/"); + next; + } + + &status("Question: factoid Arguments for '$query[0]'"); + # todo: use getReply() - need to modify it :( + my $i = 0; + my $result = &getFactoid("CMD: $_"); + $result =~ s/^\((.*?)\): //; + + foreach ( split(',', $1) ) { + my $val = $vals[$i]; + if (!defined $val) { + &status("factArgs: vals[$i] == undef; not SARing '$_' for '$query[0]'"); + next; + } + + &status("factArgs: SARing '$_' to '$vals[$i]'."); + $result =~ s/\Q$_\E/$vals[$i]/; + $i++; + } + + # nasty hack to get partial &getReply() functionality. + $result =~ s/^\s*\s*(.*)/\cAACTION $1\cA/i; + $result =~ s/^\s*\s*//i; + + return $result; + } + } + my @link; for (my$i=0; $i '$lhs'."); + &status("Update: orig rhs => '$rhs'."); + $lhs =~ s/^/CMD: /; + my @list; + while ($lhs =~ s/\$(\S+)/(.*?)/) { + push(@list, "\$$1"); + } + my $z = join(',',@list); + $rhs =~ s/^/($z): /; + + &status("Update: new lhs => '$lhs'."); + &status("Update: new rhs => '$rhs'."); + } + # the fun begins. my $exists = &getFactoid($lhs); diff --git a/src/IRC/Irc.pl b/src/IRC/Irc.pl index 3acce09..49c931d 100644 --- a/src/IRC/Irc.pl +++ b/src/IRC/Irc.pl @@ -40,25 +40,25 @@ loop:; } next unless (exists $ircPort{$host}); - my $retval = &irc($host, $ircPort{$host}); - &DEBUG("ircloop: after irc()"); - + my $retval = &irc($host, $ircPort{$host}); next unless (defined $retval and $retval == 0); - $error++; if ($error % 3 == 0 and $error != 0) { - &ERROR("CANNOT connect to this server; next!"); + &status("IRC: Could not connect."); + &status("IRC: "); next; } - if ($error >= 3*3) { - &ERROR("CANNOT connect to any irc server; stopping."); + if ($error >= 3*2) { + &status("IRC: cannot connect to any IRC servers; stopping."); + &shutdown(); exit 1; } } - &DEBUG("ircloop: end... going back."); + &status("IRC: ok, done one cycle of IRC servers; trying again."); + &loadIRCServers(); goto loop; } @@ -90,13 +90,15 @@ sub irc { $irc = new Net::IRC; - $conn = $irc->newconn( + my %args = ( Nick => $param{'ircNick'}, Server => $server, Port => $port, Ircname => $param{'ircName'}, - LocalAddr => $param{'ircHost'}, ); + $args{'LocalAddr'} = $param{'ircHost'} if ($param{'ircHost'}); + + $conn = $irc->newconn(%args); if (!defined $conn) { &ERROR("irc: conn was not created!defined!!!"); @@ -107,6 +109,8 @@ sub irc { # change internal timeout value for scheduler. $irc->{_timeout} = 10; # how about 60? + # Net::IRC debugging. + $irc->{_debug} = 1; $ircstats{'Server'} = "$server:$port"; @@ -555,7 +559,11 @@ sub unban { sub quit { my ($quitmsg) = @_; &status("QUIT $param{'ircNick'} has quit IRC ($quitmsg)"); - $conn->quit($quitmsg); + if (defined $conn) { + $conn->quit($quitmsg); + } else { + &WARN("quit: could not quit!"); + } } sub nick { @@ -622,16 +630,17 @@ sub joinNextChan { } # !scalar @joinchan: - if (exists $cache{joinTime}) { - my $delta = time() - $cache{joinTime}; + my @c = &getJoinChans(); + if (exists $cache{joinTime} and scalar @c) { + my $delta = time() - $cache{joinTime} - 5; my $timestr = &Time2String($delta); - my $rate = sprintf("%.1f", $delta / &getJoinChans() ); + my $rate = sprintf("%.1f", $delta / @c); delete $cache{joinTime}; &DEBUG("time taken to join all chans: $timestr; rate: $rate sec/join"); } - # chanserv check: global channels, in case we missed one. + # chanserv check: global channels, in case we missed one. foreach ( &ChanConfList("chanServ_ops") ) { &chanServCheck($_); } @@ -728,7 +737,7 @@ sub clearChanVars { } sub clearIRCVars { -### &DEBUG("clearIRCVars() called!"); +# &DEBUG("clearIRCVars() called!"); undef %channels; undef %floodjoin; diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl index de238bb..ade6da1 100644 --- a/src/IRC/IrcHooks.pl +++ b/src/IRC/IrcHooks.pl @@ -355,7 +355,7 @@ sub on_endofnames { # sync time should be done in on_endofwho like in BitchX if (exists $cache{jointime}{$chan}) { - my $delta_time = sprintf("%.03f", &timeget() - $cache{jointime}{$chan}); + my $delta_time = sprintf("%.03f", &timedelta($cache{jointime}{$chan}) ); $delta_time = 0 if ($delta_time < 0); if ($delta_time > 100) { &WARN("endofnames: delta_time > 100 ($delta_time)"); @@ -382,7 +382,8 @@ sub on_endofnames { &status("$b_blue$chan$ob: [$chanstats]"); &chanServCheck($chan); - &joinNextChan(); + # schedule used to solve ircu (OPN) "target too fast" problems. + $conn->schedule(5, sub { &joinNextChan(); } ); } sub on_init { @@ -432,16 +433,17 @@ sub on_join { if (exists $netsplit{lc $who}) { delete $netsplit{lc $who}; $netsplit = 1; + &netsplitCheck() if (time() != $sched{netsplitCheck}{TIME}); } - if ($netsplit and !$netsplittime) { + if ($netsplit and !exists $cache{netsplit}) { &DEBUG("on_join: ok.... re-running chanlimitCheck in 60."); $conn->schedule(60, sub { &chanlimitCheck(); - $netsplittime = undef; + delete $cache{netsplit}; } ); - $netsplittime = time(); + $cache{netsplit} = time(); } # how to tell if there's a netjoin??? @@ -489,6 +491,7 @@ sub on_join { # no need to go further. return if ($netsplit); + # who == bot. if ($who eq $ident or $who =~ /^$ident$/i) { if (defined( my $whojoin = $cache{join}{$chan} )) { @@ -617,6 +620,7 @@ sub on_nick { if (exists $netsplit{lc $newnick}) { &status("Netsplit: $newnick/$nick came back from netsplit and changed to original nick! removing from hash."); delete $netsplit{lc $newnick}; + &netsplitCheck() if (time() != $sched{netsplitCheck}{TIME}); } my ($chan,$mode); @@ -838,7 +842,7 @@ sub on_quit { $netsplit{lc $nick} = time(); if (!exists $netsplitservers{$1}{$2}) { - &status("netsplit detected between $1 and $2."); + &status("netsplit detected between $1 and $2 at [".scalar(localtime)."]"); $netsplitservers{$1}{$2} = time(); } } @@ -849,6 +853,7 @@ sub on_quit { &ERROR("^^^ THIS SHOULD NEVER HAPPEN (10)."); } + # does this work? if ($nick !~ /^\Q$ident\E$/ and $nick =~ /^\Q$param{'ircNick'}\E$/i) { &status("nickchange: own nickname became free; changing."); &nick($param{'ircNick'}); @@ -878,11 +883,12 @@ sub on_targettoofast { $cache{sleepTime} = time(); } - } else { - if (!exists $cache{TargetTooFast}) { - &DEBUG("on_ttf: failed: $why"); - $cache{TargetTooFast}++; - } + return; + } + + if (!exists $cache{TargetTooFast}) { + &DEBUG("on_ttf: failed: $why"); + $cache{TargetTooFast}++; } } @@ -953,27 +959,38 @@ sub on_crversion { if ($ver =~ /bitchx/i) { $ver{bitchx}{$nick} = $ver; + } elsif ($ver =~ /xc\!|xchat/i) { $ver{xchat}{$nick} = $ver; + } elsif ($ver =~ /irssi/i) { $ver{irssi}{$nick} = $ver; + } elsif ($ver =~ /epic/i) { $ver{epic}{$nick} = $ver; + } elsif ($ver =~ /mirc/i) { &DEBUG("verstats: mirc: $nick => '$ver'."); $ver{mirc}{$nick} = $ver; + } elsif ($ver =~ /ircle/i) { $ver{ircle}{$nick} = $ver; + } elsif ($ver =~ /ircII/i) { $ver{ircII}{$nick} = $ver; + } elsif ($ver =~ /sirc /i) { $ver{sirc}{$nick} = $ver; + } elsif ($ver =~ /kvirc/i) { $ver{kvirc}{$nick} = $ver; + } elsif ($ver =~ /eggdrop/i) { $ver{eggdrop}{$nick} = $ver; + } elsif ($ver =~ /xircon/i) { $ver{xircon}{$nick} = $ver; + } else { &DEBUG("verstats: other: $nick => '$ver'."); $ver{other}{$nick} = $ver; @@ -1024,6 +1041,7 @@ sub on_whoisuser { sub on_chanfull { my ($self, $event) = @_; my @args = $event->args; + &DEBUG("on_chanfull: args => @args"); &joinNextChan(); } @@ -1031,6 +1049,7 @@ sub on_chanfull { sub on_inviteonly { my ($self, $event) = @_; my @args = $event->args; + &DEBUG("on_inviteonly: args => @args"); &joinNextChan(); } @@ -1038,6 +1057,7 @@ sub on_inviteonly { sub on_banned { my ($self, $event) = @_; my @args = $event->args; + &DEBUG("on_banned: args => @args"); &joinNextChan(); } @@ -1045,6 +1065,7 @@ sub on_banned { sub on_badchankey { my ($self, $event) = @_; my @args = $event->args; + &DEBUG("on_badchankey: args => @args"); &joinNextChan(); } diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl index 6c2ad70..30ef450 100644 --- a/src/IRC/Schedulers.pl +++ b/src/IRC/Schedulers.pl @@ -361,6 +361,9 @@ sub chanlimitCheck { return if ($_[0] eq "2"); } + $cache{chanlimitCheck}++; + &DEBUG("clC: chanlimitCheck => $cache{chanlimitCheck}"); + foreach $chan ( &ChanConfList("chanlimitcheck") ) { next unless (&validChan($chan)); @@ -422,7 +425,8 @@ sub netsplitCheck { return if ($_[0] eq "2"); } - &DEBUG("running netsplitCheck..."); + $cache{'netsplitCache'}++; + &DEBUG("running netsplitCheck... $cache{netsplitCache}"); foreach $s1 (keys %netsplitservers) { &DEBUG("nsC: s1 => $s1"); @@ -434,6 +438,7 @@ sub netsplitCheck { if (time() - $netsplitservers{$s1}{$s2} > 3600) { &status("netsplit between $s1 and $s2 appears to be stale."); delete $netsplitservers{$s1}{$s2}; + &chanlimitCheck(); } } @@ -458,6 +463,11 @@ sub netsplitCheck { &DEBUG("nsC: netsplitservers: ".scalar(keys %netsplitservers) ); &DEBUG("nsC: netsplit: ".scalar(keys %netsplit) ); + if (!scalar %netsplit and scalar %netsplitservers) { + &DEBUG("ok hash netsplit is NULL; purging hash netsplitservers"); + undef %netsplitservers; + } + if ($count and !scalar keys %netsplit) { &DEBUG("nsC: netsplit is hopefully gone. reinstating chanlimit check."); &chanlimitCheck(); diff --git a/src/Modules/Factoids.pl b/src/Modules/Factoids.pl index 5fda311..64bc303 100644 --- a/src/Modules/Factoids.pl +++ b/src/Modules/Factoids.pl @@ -204,6 +204,70 @@ sub CmdFactStats { my $prefix = "broken factoid "; return &formListReply(1, $prefix, @list); + } elsif ($type =~ /^total$/i) { + &status("factstats(total): starting..."); + my $start_time = &timeget(); + my @list; + my $str; + my($i,$j); + my %hash; + + ### lets do it. + # total factoids requests. + $i = &sumKey("factoids", "requested_count"); + push(@list, "total requests - $i"); + + # total factoids modified. + $str = &countKeys("factoids", "modified_by"); + push(@list, "total modified - $str"); + + # total factoids modified. + $j = &countKeys("factoids", "requested_count"); + $str = &countKeys("factoids", "factoid_key"); + push(@list, "total non-requested - ".($str - $i)); + + # average request/factoid. + # i/j == total(requested_count)/count(requested_count) + $str = sprintf("%.01f", $i/$j); + push(@list, "average requested per factoid - $str"); + + # total prepared for deletion. + $str = scalar( &searchTable("factoids", "factoid_key", "factoid_value", " #DEL") ); + push(@list, "total prepared for deletion - $str"); + + # total unique authors. + foreach ( &dbRawReturn("SELECT created_by FROM factoids WHERE created_by IS NOT NULL") ) { + /^(\S+)!/; + my $nick = lc $1; + $hash{$nick}++; + } + push(@list, "total unique authors - ".(scalar keys %hash) ); + undef %hash; + + # total unique requesters. + foreach ( &dbRawReturn("SELECT requested_by FROM factoids WHERE requested_by IS NOT NULL") ) { + /^(\S+)!/; + my $nick = lc $1; + $hash{$nick}++; + } + push(@list, "total unique requesters - ".(scalar keys %hash) ); + undef %hash; + + ### end of "job". + + my $delta_time = &timedelta($start_time); + &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0); + $start_time = &timeget(); + + # bail out on no results. + if (scalar @list == 0) { + return 'no broken factoids... wooohoo.'; + } + + # parse the results. + my $prefix = "General factoid stiatistics "; + return &formListReply(1, $prefix, @list); + } elsif ($type =~ /^deadredir$/i) { my @list = &searchTable("factoids", "factoid_key", "factoid_value", "^ see "); diff --git a/src/Modules/Math.pl b/src/Modules/Math.pl index d8d4898..bf1b41a 100644 --- a/src/Modules/Math.pl +++ b/src/Modules/Math.pl @@ -110,21 +110,22 @@ sub perlMath { $locMsg = sprintf("%1.12f", $locMsg); $locMsg =~ s/\.?0+$//; - if (length($locMsg) > 30) { + if (length $locMsg > 30) { $locMsg = "a number with quite a few digits..."; } } else { if (defined $locMsg) { &DEBUG("math: locMsg => '$locMsg'... FIXME"); } else { - $locMsg = "undefined"; + &status("math: could not really compute."); + $locMsg = ""; } } } else { $locMsg = ""; } - if ($locMsg ne $message) { + if (defined $logMsg and $locMsg ne $message) { return $locMsg; } else { return ''; diff --git a/src/Modules/News.pl b/src/Modules/News.pl index 9a5ed22..dbe7cf0 100644 --- a/src/Modules/News.pl +++ b/src/Modules/News.pl @@ -88,6 +88,10 @@ sub Parse { } elsif ($what =~ /^(latest|new)(\s+(.*))?$/i) { &latest($3 || $chan, 1); +# $::cmdstats{'News latest'}++; + + } elsif ($what =~ /^stats?$/i) { + &stats(); } elsif ($what =~ /^list$/i) { &list(); @@ -363,6 +367,10 @@ sub list { if (defined $x and ($x == 0 or $x == -1)) { &::DEBUG("not updating time for $::who."); } else { + if (!scalar keys %{ $::news{$chan} }) { + &DEBUG("news: should not add $chan/$::who to cache!"); + } + $::newsuser{$chan}{$::who} = time(); } } @@ -729,7 +737,7 @@ sub latest { if (!$flag) { return unless ($unread); - my $reply = "There are unread news in $chan ($unread unread, $total total). /msg $::ident news latest"; + my $reply = "There are unread news in $chan ($unread unread, $total total). /msg $::ident news $::chan latest"; $reply .= " If you don't want further news notification, /msg $::ident news unnotify" if ($unread == $total); &::notice($::who, $reply); @@ -904,4 +912,37 @@ sub do_set { &::DEBUG("do_set: TODO..."); } +sub stats { + &::DEBUG("News: stats called."); + &::msg($::who, "check my logs/console."); + my($i,$j) = (0,0); + + # total request count. + foreach $chan (keys %::news) { + foreach (keys %{ $::news{$chan} }) { + $i += $::news{$chan}{$_}{Request_Count}; + } + } + &::DEBUG("news: stats: total request count => $i"); + $i = 0; + + # total user cached. + foreach $chan (keys %::newsuser) { + $i += $::newsuser{$chan}{$_}; + } + &::DEBUG("news: stats: total user cache => $i"); + $i = 0; + + # average latest time read. + my $t = time(); + foreach $chan (keys %::newsuser) { + $i += $t - $::newsuser{$chan}{$_}; + $j++; + } + &::DEBUG("news: stats: average latest time read: total time: $i"); + &::DEBUG("... count: $j"); + &::DEBUG(" average: ".sprintf("%.02f", $i/($j||1))." sec/user"); + $i = $j = 0; +} + 1; diff --git a/src/UserExtra.pl b/src/UserExtra.pl index 2672304..2fd29f9 100644 --- a/src/UserExtra.pl +++ b/src/UserExtra.pl @@ -152,10 +152,15 @@ sub chaninfo { my %new; foreach (keys %userstats) { next unless (exists $userstats{$_}{'Count'}); + if ($userstats{$_}{'Count'} =~ /^\D+$/) { + &WARN("userstats{$_}{Count} is non-digit."); + next; + } + $new{$_} = $userstats{$_}{'Count'}; } - my($count) = (sort { $b <=> $a } keys %new)[0]; + my($count) = (sort { $a <=> $b } keys %new)[0]; if ($count) { $reply .= ". \002$count\002 has said the most with a total of \002$new{$count}\002 messages"; } diff --git a/src/core.pl b/src/core.pl index 20f75b3..9111514 100644 --- a/src/core.pl +++ b/src/core.pl @@ -89,6 +89,7 @@ sub doExit { &status("parent caught SIG$sig (pid $$).") if (defined $sig); &status("--- Start of quit."); + $ident ||= "blootbot"; # lame hack. &closeDCC(); &closePID(); @@ -354,6 +355,7 @@ sub setup { $shm = &openSHM(); &openSQLDebug() if (&IsParam("SQLDebug")); &openDB($param{'DBName'}, $param{'SQLUser'}, $param{'SQLPass'}); + &checkTables(); &status("Setup: ". &countKeys("factoids") ." factoids."); &News::readNews() if (&ChanConfList("news")); @@ -415,6 +417,8 @@ sub shutdown { # reverse order of &setup(). &DEBUG("shutdown called."); + $ident ||= "blootbot"; # hack. + # opened files must be written to on shutdown/hup/whatever # unless they're write-only, like uptime. &writeUserFile(); diff --git a/src/db_mysql.pl b/src/db_mysql.pl index 3b659b7..eaeb9cd 100644 --- a/src/db_mysql.pl +++ b/src/db_mysql.pl @@ -279,11 +279,19 @@ sub dbRawReturn { ##### ##### -# Usage: &countKeys($table); +# Usage: &countKeys($table, [$col]); sub countKeys { - my ($table) = @_; + my ($table, $col) = @_; + $col ||= "*"; + + return (&dbRawReturn("SELECT count($col) FROM $table"))[0]; +} - return (&dbRawReturn("SELECT count(*) FROM $table"))[0]; +# Usage: &sumKey($table, $col); +sub sumKey { + my ($table, $col) = @_; + + return (&dbRawReturn("SELECT sum($col) FROM $table"))[0]; } ##### NOT USED. @@ -397,4 +405,55 @@ sub SQLDebug { print SQLDEBUG $_[0]."\n"; } +sub dbCreateTable { + my($table) = @_; + my(@path) = (".","..","../.."); + my $found = 0; + my $data; + + foreach (@path) { + my $file = "$_/setup/$table.sql"; + &DEBUG("dbCT: file => $file"); + next unless ( -f $file ); + + &DEBUG("found!!!"); + + open(IN, $file); + $data = ; + + $found++; + last; + } + + if (!$found) { + return 0; + } else { + &dbRaw("create($table)", $data); + return 1; + } +} + +sub checkTables { + # retrieve a list of db's from the server. + my %db; + foreach ($dbh->func('_ListTables')) { + $db{$_} = 1; + } + + # create database. + if (!scalar keys %db) { + &status("Creating database $param{'DBName'}..."); + $query = "CREATE DATABASE $param{'DBName'}"; + &dbRaw("create(db $param{'DBName'})", $query); + } + + foreach ("factoids", "freshmeat", "karma", "rootwarn", "seen", + ) { + next if (exists $db{$_}); + &status(" creating new table $_..."); + + &dbCreateTable($_); + } +} + 1;