From 2d050e260224ba7bdaf92ee1f9b2cffdc2c9f006 Mon Sep 17 00:00:00 2001 From: dms Date: Fri, 1 Jun 2001 15:28:58 +0000 Subject: [PATCH] - irctextcounter: ORDER by counter, not nick! - merged patch from asuffield wrt db_mysql.pl - attempt to load rootWarn on startup - added &getPerlFiles() for module loading - reloadAllModules: take into account bot_src_dir - on_quit: moved removal of cache _after_ netsplit code. git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@507 c11ca15a-4712-0410-83d8-924469b57eb5 --- src/CommandStubs.pl | 7 ++-- src/DynaConfig.pl | 5 +++ src/IRC/Irc.pl | 7 +--- src/IRC/IrcHooks.pl | 30 ++++++------- src/IRC/Schedulers.pl | 12 +++--- src/Modules/Debian.pl | 4 +- src/Modules/Factoids.pl | 6 ++- src/Process.pl | 3 ++ src/db_mysql.pl | 17 ++++++-- src/modules.pl | 93 ++++++++++++++++++++++------------------- 10 files changed, 103 insertions(+), 81 deletions(-) diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl index bfcc42e..864d78b 100644 --- a/src/CommandStubs.pl +++ b/src/CommandStubs.pl @@ -262,7 +262,7 @@ sub Modules { } # google searching. Simon++ - if ($message =~ /^(?:search\s+)?(\S+)\s+for\s+['"]?(.*?)['"]?\s*\?*$/i) { + if ($message =~ /^(?:search\s+)?(\S+)\s+for\s+['"]?(.*?)["']?\s*\?*$/i) { return unless (&hasParam("wwwsearch")); &Forker("wwwsearch", sub { &W3Search::W3Search($1,$2); } ); @@ -282,12 +282,13 @@ sub Modules { my $arg = $3; if (!defined $arg or $arg =~ /^\s*$/) { - # this is fucking ugly but it works :-) + # this is way fucking ugly. my $x = (&dbRawReturn("SELECT SUM(counter) FROM stats WHERE type=".&dbQuote($type) ))[0]; my %hash = &dbGetCol("stats", "nick,counter", "type=".&dbQuote($type). - " ORDER BY nick DESC LIMIT 3", 1); + " ORDER BY counter DESC LIMIT 3", 1); my $i; my @top; + # unfortunately we have to sort it again! # todo: make dbGetCol return hash and array? too much effort. foreach $i (sort { $b <=> $a } keys %hash) { diff --git a/src/DynaConfig.pl b/src/DynaConfig.pl index fad4ab2..29a5c97 100644 --- a/src/DynaConfig.pl +++ b/src/DynaConfig.pl @@ -62,6 +62,11 @@ sub readUserFile { next; } + if (!defined $nick) { + &WARN("invalid line: $_"); + next; + } + # nice little hack. if ($what eq "HOSTS") { $users{$nick}{$what}{$val} = 1; diff --git a/src/IRC/Irc.pl b/src/IRC/Irc.pl index 00269c0..a5c0ca4 100644 --- a/src/IRC/Irc.pl +++ b/src/IRC/Irc.pl @@ -260,12 +260,7 @@ sub msg { $msgsize = length $msg; } - if ($msgType =~ /private/i) { # hack. - $conn->privmsg($nick, $msg); - - } else { - &DEBUG("msg: msgType is unknown!"); - } + $conn->privmsg($nick, $msg); } } diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl index ece1314..304246b 100644 --- a/src/IRC/IrcHooks.pl +++ b/src/IRC/IrcHooks.pl @@ -459,7 +459,7 @@ sub on_join { } if ($netsplit and !exists $cache{netsplit}) { - &DEBUG("on_join: ok.... re-running chanlimitCheck in 60."); + &VERB("on_join: ok.... re-running chanlimitCheck in 60.",2); $conn->schedule(60, sub { &chanlimitCheck(); delete $cache{netsplit}; @@ -860,25 +860,11 @@ sub on_quit { &DEBUG("on_quit: nick $nick was not found in any chan."); } - &delUserInfo($nick, keys %channels); - - if (exists $nuh{lc $nick}) { - delete $nuh{lc $nick}; - } else { - # well.. it's good but weird that this has happened - lets just - # be quiet about it. - } - delete $userstats{lc $nick} if (&IsChanConf("seenStats")); - delete $chanstats{lc $nick}; - # should fix chanstats inconsistencies bug #2. if ($reason =~ /^($mask{host})\s($mask{host})$/) { # netsplit. $reason = "NETSPLIT: $1 <=> $2"; # chanlimit code. - my @l = &getNickInChans($nick); - &DEBUG("on_quit: l => ".scalar(@l) ); - foreach $chan ( &getNickInChans($nick) ) { next unless ( &IsChanConf("chanlimitcheck") ); next unless ( exists $channels{$_}{'l'} ); @@ -900,6 +886,20 @@ sub on_quit { &ERROR("^^^ THIS SHOULD NEVER HAPPEN (10)."); } + ### + ### ok... lets clear out the cache + ### + &delUserInfo($nick, keys %channels); + if (exists $nuh{lc $nick}) { + delete $nuh{lc $nick}; + } else { + # well.. it's good but weird that this has happened - lets just + # be quiet about it. + } + delete $userstats{lc $nick} if (&IsChanConf("seenStats")); + delete $chanstats{lc $nick}; + ### + # does this work? if ($nick !~ /^\Q$ident\E$/ and $nick =~ /^\Q$param{'ircNick'}\E$/i) { &status("nickchange: own nickname became free; changing."); diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl index 5775ab3..7d79eb6 100644 --- a/src/IRC/Schedulers.pl +++ b/src/IRC/Schedulers.pl @@ -371,7 +371,7 @@ sub chanlimitCheck { if (scalar keys %netsplitservers) { if (defined $limit) { - &DEBUG("chanlimit: removing it for $chan."); + &status("chanlimit: netsplit; removing it for $chan."); &rawout("MODE $chan -l"); $cache{chanlimitChange}{$chan} = time(); } @@ -1173,16 +1173,16 @@ sub mkBackup { return; } + my $age = "New"; if ( -e "$file~" ) { - $backup++ if ((stat $file)[9] - (stat "$file~")[9] > $time); + $backup++ if ((stat $file)[9] - (stat "$file~")[9] > $time); + my $delta = time() - (stat "$file~")[9]; + $age = &Time2String($delta); } else { $backup++; } - return unless ($backup); - # should delta be time(file) - time(file~)? - my $delta = time() - (stat "$file~")[9]; - my $age = &Time2String($delta); + return unless ($backup); ### TODO: do internal copying. &status("Backup: $file ($age)"); diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl index 2dfea69..940c575 100644 --- a/src/Modules/Debian.pl +++ b/src/Modules/Debian.pl @@ -200,10 +200,10 @@ sub searchContents { my $grepRE; ### TODO: search properly if /usr/bin/blah is done. if ($query =~ s/\$$//) { - &::DEBUG("deb: search-regex found."); + &::DEBUG("deb: search-regex found.") if ($debug); $grepRE = "$query\[ \t]"; } elsif ($query =~ s/^\^//) { - &::DEBUG("deb: front marker regex found."); + &::DEBUG("deb: front marker regex found.") if ($debug); $front = 1; $grepRE = $query; } else { diff --git a/src/Modules/Factoids.pl b/src/Modules/Factoids.pl index 3285dd9..fb261d4 100644 --- a/src/Modules/Factoids.pl +++ b/src/Modules/Factoids.pl @@ -588,9 +588,11 @@ sub CmdFactStats { my @list; my $total = 0; my $users = 0; - foreach $rate (sort { $b <=> $a } keys %hash) { + foreach $rate (sort { $a <=> $b } keys %hash) { my $f = join(", ", sort keys %{ $hash{$rate} }); - push(@list, "$f - ".&Time2String($rate)); + my $str = "$f - ".&Time2String($rate); + $str =~ s/\002//g; + push(@list, $str); } my $prefix = "Rank of top factoid rate (time/req): "; diff --git a/src/Process.pl b/src/Process.pl index 4591401..f23143b 100644 --- a/src/Process.pl +++ b/src/Process.pl @@ -400,6 +400,9 @@ sub FactoidStuff { my $limit = &getChanConfDefault("factoidPreventForgetLimit", 0, $chan); + &DEBUG("forget: limit = $limit"); + &DEBUG("forget: count = $count"); + if (IsFlag("r") ne "r") { &msg($who, "you don't have access to remove factoids"); return; diff --git a/src/db_mysql.pl b/src/db_mysql.pl index 1e97faa..9a6c461 100644 --- a/src/db_mysql.pl +++ b/src/db_mysql.pl @@ -497,6 +497,17 @@ sub dbCreateTable { } sub checkTables { + my $database_exists = 0; + foreach (&dbRawReturn("SHOW DATABASES")) { + $database_exists++ if ($_ eq $param{'DBName'}); + } + + unless ($database_exists) { + &status("Creating database $param{DBName}..."); + $query = "CREATE DATABASE $param{DBName}"; + &dbRaw("create(db $param{DBName})", $query); + } + # retrieve a list of db's from the server. my %db; foreach ($dbh->func('_ListTables')) { @@ -505,9 +516,9 @@ sub checkTables { # create database. if (!scalar keys %db) { - &status("Creating database $param{'DBName'}..."); - $query = "CREATE DATABASE $param{'DBName'}"; - &dbRaw("create(db $param{'DBName'})", $query); +# &status("Creating database $param{'DBName'}..."); +# $query = "CREATE DATABASE $param{'DBName'}"; +# &dbRaw("create(db $param{'DBName'})", $query); } foreach ("factoids", "freshmeat", "rootwarn", "seen", "stats", diff --git a/src/modules.pl b/src/modules.pl index facd28b..83d7890 100644 --- a/src/modules.pl +++ b/src/modules.pl @@ -49,23 +49,13 @@ if ($@) { ); ### THIS IS NOT LOADED ON RELOAD :( BEGIN { - @myModulesLoadNow = ('topic', 'uptime', 'news'); + @myModulesLoadNow = ('topic', 'uptime', 'news', 'rootWarn'); @myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl'); } sub loadCoreModules { - if (!opendir(DIR, $bot_src_dir)) { - &ERROR("can't open source directory $bot_src_dir: $!"); - exit 1; - } + my @mods = &getPerlFiles($bot_src_dir); - my @mods; - while (defined(my $file = readdir DIR)) { - next unless $file =~ /\.pl$/; - next unless $file =~ /^[A-Z]/; - push(@mods, $file); - } - closedir DIR; &status("Loading ".scalar(@mods)." CORE modules..."); foreach (sort @mods) { @@ -126,38 +116,31 @@ sub loadDBModules { } sub loadFactoidsModules { - &status("Loading Factoids modules..."); - if (!&IsParam("factoids")) { &status("Factoid support DISABLED."); return; } - if (!opendir(DIR, "$bot_src_dir/Factoids")) { - &ERROR("can't open source directory Factoids: $!"); - exit 1; - } + &status("Loading Factoids modules..."); + + foreach ( &getPerlFiles("$bot_src_dir/Factoids") ) { + my $mod = "$bot_src_dir/Factoids/$_"; - while (defined(my $file = readdir DIR)) { - next unless $file =~ /\.pl$/; - next unless $file =~ /^[A-Z]/; - my $mod = "$bot_src_dir/Factoids/$file"; - ### TODO: use eval and exit gracefully? eval "require \"$mod\""; if ($@) { - &WARN("lFM: $@"); + &ERROR("lFM: $@"); exit 1; } $moduleAge{$mod} = (stat $mod)[9]; - &showProc(" ($file)") if (&IsParam("DEBUG")); + &showProc(" ($_)") if (&IsParam("DEBUG")); } - closedir DIR; } sub loadIRCModules { - &status("Loading IRC modules..."); if (&whatInterface() =~ /IRC/) { + &status("Loading IRC modules..."); + eval "use Net::IRC"; if ($@) { &ERROR("libnet-irc-perl is not installed!"); @@ -170,21 +153,19 @@ sub loadIRCModules { return; } - if (!opendir(DIR, "$bot_src_dir/IRC")) { - &ERROR("can't open source directory Factoids: $!"); - exit 1; - } + foreach ( &getPerlFiles("$bot_src_dir/IRC") ) { + my $mod = "$bot_src_dir/IRC/$_"; + + eval "require \"$mod\""; + if ($@) { + &ERROR("lIRCM => $@"); + &shutdown(); + exit 1; + } - while (defined(my $file = readdir DIR)) { - next unless $file =~ /\.pl$/; - next unless $file =~ /^[A-Z]/; - my $mod = "$bot_src_dir/IRC/$file"; - ### TODO: use eval and exit gracefully? - require $mod; $moduleAge{$mod} = (stat $mod)[9]; - &showProc(" ($file)") if (&IsParam("DEBUG")); + &showProc(" ($_)") if (&IsParam("DEBUG")); } - closedir DIR; } sub loadMyModulesNow { @@ -209,7 +190,9 @@ sub loadMyModulesNow { next; } - &loadMyModule($myModules{$_}); + # weird hack to get rootwarn to work. + # it may break on other cases though, any ideas? + &loadMyModule( $myModules{$_} || $myModules{lc $_} ); $loaded++; } @@ -218,11 +201,14 @@ sub loadMyModulesNow { ### rename to moduleReloadAll? sub reloadAllModules { -### &status("Module: reloading all."); - foreach (map { substr($_,2) } keys %moduleAge) { + &VERB("Module: reloading all.",2); + + # obscure usage of map and regex :) + foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) { &reloadModule($_); } -### &status("Module: reloading done."); + + &VERB("Module: reloading done.",2); } ### rename to modulesReload? @@ -326,7 +312,7 @@ sub loadMyModule { $modulename = $tmp; } } - my $modulefile = "$bot_src_dir/Modules/$modulebase"; + $modulefile = "$bot_src_dir/Modules/$modulebase"; # call reloadModule() which checks age of file and reload. if (grep /\/$modulebase$/, keys %INC) { @@ -388,4 +374,23 @@ sub AUTOLOAD { } } +sub getPerlFiles { + my($dir) = @_; + + if (!opendir(DIR, $dir)) { + &ERROR("cannot open source directory $dir: $!"); + exit 1; + } + + my @mods; + while (defined(my $file = readdir DIR)) { + next unless $file =~ /\.pl$/; + next unless $file =~ /^[A-Z]/; + push(@mods, $file); + } + closedir DIR; + + return reverse sort @mods; +} + 1; -- 2.39.2