From c53a047e7a5f63c954a2ce515687a937ca8720f3 Mon Sep 17 00:00:00 2001
From: dms <dms@c11ca15a-4712-0410-83d8-924469b57eb5>
Date: Sun, 10 Jun 2001 13:09:44 +0000
Subject: [PATCH] - irctextcounters: add percentage to top3 - use &dbQuote()
for all unprotected dbGet calls. - added rehashConfVars() - the beginning. -
now keep stats of all commands - saved on exit. - forget: check if backup
exists - don't overwrite if it does. - typo in nslookup/dns var. - added
dbGetColNiceHash - not used. - dbSetRow: values now parsed by reference;
$delay now works - removed getKeys() - factArgs: sort list from longest to
shortest - factArgs: go through all CMDs and check for possible dupes -
factArgs: when SARing, doing /g - found by greycat. - schedule ircCheck more
often - chanlimitcheck: removed next statement, should work now - renamed
"factstats broken" to vandalism. - fm: disabled table locking; enabled
DELAYED INSERTs - news: show time when next item should expire
git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@508 c11ca15a-4712-0410-83d8-924469b57eb5
---
src/CommandStubs.pl | 19 +++++---
src/DynaConfig.pl | 31 ++++++++++++-
src/Factoids/DBCommon.pl | 2 +-
src/Factoids/Question.pl | 35 +++++++++++----
src/Factoids/Reply.pl | 3 +-
src/Factoids/Update.pl | 2 +-
src/IRC/IrcHooks.pl | 11 +++--
src/IRC/Schedulers.pl | 9 ++--
src/Misc.pl | 17 +++++++-
src/Modules/Debian.pl | 8 ++--
src/Modules/Factoids.pl | 14 +++---
src/Modules/Freshmeat.pl | 15 ++++---
src/Modules/News.pl | 12 ++++-
src/Modules/RootWarn.pl | 3 +-
src/Modules/UserDCC.pl | 7 +++
src/Process.pl | 20 ++++++---
src/UserExtra.pl | 16 ++++++-
src/core.pl | 3 +-
src/db_mysql.pl | 94 +++++++++++++++++++++++++++-------------
19 files changed, 230 insertions(+), 91 deletions(-)
diff --git a/src/CommandStubs.pl b/src/CommandStubs.pl
index 864d78b..eba7a50 100644
--- a/src/CommandStubs.pl
+++ b/src/CommandStubs.pl
@@ -48,14 +48,15 @@ sub parseCmdHook {
return 0;
}
+ if (!defined $cmd) {
+ &WARN("cstubs: cmd == NULL.");
+ return 0;
+ }
+
foreach (keys %{"hooks_$hashname"}) {
# rename to something else! like $id or $label?
my $ident = $_;
- if (!defined $cmd or !defined $ident) {
- &WARN("cstubs: cmd or ident == NULL. ($cmd, $ident)");
- next;
- }
next unless ($cmd =~ /^$ident$/i);
if ($done) {
@@ -291,12 +292,16 @@ sub Modules {
# unfortunately we have to sort it again!
# todo: make dbGetCol return hash and array? too much effort.
+ my $tp = 0;
foreach $i (sort { $b <=> $a } keys %hash) {
foreach (keys %{ $hash{$i} }) {
- push(@top, "$_ - $i");
+ my $p = sprintf("%.01f", 100*$i/$x);
+ $tp += $p;
+ push(@top, "\002$_\002 -- $i ($p%)");
}
}
my $topstr = "";
+ &DEBUG("tp => $tp");
if (scalar @top) {
$topstr = ". Top ".scalar(@top).": ".join(', ', @top);
}
@@ -544,7 +549,7 @@ sub seen {
if ($person eq "random") {
@seen = &randKey("seen", $select);
} else {
- @seen = &dbGet("seen", $select, "nick='$person'");
+ @seen = &dbGet("seen", $select, "nick=".&dbQuote($person) );
}
if (scalar @seen < 2) {
@@ -583,7 +588,7 @@ sub seen {
"saying\002:\002 '$seen[4]'.";
}
- &performStrictReply($reply);
+ &pSReply($reply);
return;
}
diff --git a/src/DynaConfig.pl b/src/DynaConfig.pl
index 29a5c97..b64ba0b 100644
--- a/src/DynaConfig.pl
+++ b/src/DynaConfig.pl
@@ -349,7 +349,7 @@ sub writeChanFile {
}
foreach (keys %opts) {
- next unless ($opts{$_} > 1);
+ next unless ($opts{$_} > 2);
&DEBUG(" opts{$_} => $opts{$_}");
}
@@ -773,6 +773,35 @@ sub chanSet {
return;
}
+sub rehashConfVars {
+ # this is an attempt to fix where an option is loaded but the module
+ # has not loaded. it also can be used for other things.
+
+ foreach (keys %{ $cache{confvars} }) {
+ my $i = $cache{confvars}{$_};
+ &DEBUG("rehashConfVars: _ => $_");
+
+ if (/^news$/ and $i) {
+ &loadMyModule("news");
+ delete $cache{confvars}{$_};
+ }
+
+ if (/^uptime$/ and $i) {
+ &loadMyModule("uptime");
+ delete $cache{confvars}{$_};
+ }
+
+ if (/^rootwarn$/i and $i) {
+ &loadMyModule($_);
+ delete $cache{confvars}{$_};
+ }
+ }
+
+ &DEBUG("end of rehashConfVars");
+
+ delete $cache{confvars};
+}
+
my @regFlagsChan = (
"autojoin",
"freshmeat",
diff --git a/src/Factoids/DBCommon.pl b/src/Factoids/DBCommon.pl
index 3ae3694..48b2eee 100644
--- a/src/Factoids/DBCommon.pl
+++ b/src/Factoids/DBCommon.pl
@@ -12,7 +12,7 @@ if (&IsParam("useStrict")) { use strict; }
sub setFactInfo {
&dbSet("factoids",
{ factoid_key => $_[0] },
- { $_[1] => $_[2] }
+ { $_[1] => $_[2] } # dbquote done in dbset!
);
}
diff --git a/src/Factoids/Question.pl b/src/Factoids/Question.pl
index 0abb9bb..e61b30f 100644
--- a/src/Factoids/Question.pl
+++ b/src/Factoids/Question.pl
@@ -167,21 +167,27 @@ sub factoidArgs {
# 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.
+ # todo: cache this, update cache when altered. !!! !!! !!!
+# my $t = &timeget();
my @list = &searchTable("factoids", "factoid_key", "factoid_key", "CMD: ");
+# my $delta_time = &timedelta($t);
+# &DEBUG("factArgs: delta_time = $delta_time s");
+# &DEBUG("factArgs: list => ".scalar(@list) );
# from a design perspective, it's better to have the regex in
# the factoid key to reduce repetitive processing.
- foreach (@list) {
+ # it does not matter if it's not alphabetically sorted.
+ foreach (sort { length($b) <=> length($a) } @list) {
next if (/#DEL#/); # deleted.
- s/^CMD: //;
+ s/^CMD: //i;
# &DEBUG("factarg: ''$str' =~ /^$_\$/'");
my @vals;
my $arg = $_;
# todo: make eval work with $$i's :(
+ # fuck this is an ugly hack. it works though.
eval {
if ($str =~ /^$arg$/i) {
for ($i=1; $i<=5; $i++) {
@@ -200,12 +206,23 @@ sub factoidArgs {
next unless (@vals);
+ if (defined $result) {
+ &WARN("factargs: '$_' matches aswell.");
+ next;
+ }
+
# &DEBUG("vals => @vals");
&status("Question: factoid Arguments for '$str'");
# todo: use getReply() - need to modify it :(
my $i = 0;
- $result = &getFactoid("CMD: $_");
+ my $r = &getFactoid("CMD: $_");
+ if (!defined $r) {
+ &DEBUG("question: !result... should this happen?");
+ return;
+ }
+
+ $result = $r;
$result =~ s/^\((.*?)\): //;
foreach ( split(',', $1) ) {
@@ -234,7 +251,7 @@ sub factoidArgs {
if (!$done) {
&status("factArgs: SARing '$_' to '$vals[$i]'.");
- $result =~ s/\Q$_\E/$vals[$i]/;
+ $result =~ s/\Q$_\E/$vals[$i]/g;
}
$i++;
}
@@ -243,12 +260,14 @@ sub factoidArgs {
$result =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i;
$result =~ s/^\s*<reply>\s*//i;
$result = &SARit($result);
-# $result = &substVars($result);
- return $result;
+# well... lets go through all of them. not advisable if we have like
+# 1000 commands, heh.
+# return $result;
+ $cmdstats{'Factoid Commands'}++;
}
- return;
+ return $result;
}
1;
diff --git a/src/Factoids/Reply.pl b/src/Factoids/Reply.pl
index 745b7dc..c920b32 100644
--- a/src/Factoids/Reply.pl
+++ b/src/Factoids/Reply.pl
@@ -48,7 +48,7 @@ sub getReply {
$result =~ s/^\s*//;
}
- my $fauthor = &dbGet("factoids", "created_by", "factoid_key='$message'");
+ my $fauthor = &dbGet("factoids", "created_by", "factoid_key=".&dbQuote($message) );
$result = &SARit($result);
$reply = $result;
@@ -291,7 +291,6 @@ sub substVars {
$reply =~ s/\$rand/$rand/g;
}
- $reply =~ s/\$factoid/$lhs/g;
$reply =~ s/\$ident/$ident/g;
if ($reply =~ /\$startTime/) {
diff --git a/src/Factoids/Update.pl b/src/Factoids/Update.pl
index 1f117c4..68c0cfc 100644
--- a/src/Factoids/Update.pl
+++ b/src/Factoids/Update.pl
@@ -55,7 +55,7 @@ sub update {
# freshmeat
if (&IsChanConf("freshmeatForFactoid")) {
# todo: "name" is invalid for fm ][
- if (&dbGet("freshmeat", "name", "name='$lhs'")) {
+ if ( &dbGet("freshmeat", "name", "name=".&dbQuote($lhs)) ) {
&msg($who, "permission denied. (freshmeat)");
&status("alert: $who wanted to teach me something that freshmeat already has info on.");
return 1;
diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl
index 304246b..b181714 100644
--- a/src/IRC/IrcHooks.pl
+++ b/src/IRC/IrcHooks.pl
@@ -360,8 +360,10 @@ sub on_disconnect {
&clearIRCVars();
if (!$self->connect()) {
- &WARN("not connected? help me. gonna call ircCheck() in 1800s");
- &ScheduleThis(30, "ircCheck");
+ &WARN("not connected? help me. gonna call ircCheck() in 60s");
+ &ScheduleThis(1, "ircCheck");
+# &ScheduleThis(10, "ircCheck");
+# &ScheduleThis(30, "ircCheck");
}
}
@@ -818,9 +820,10 @@ sub on_public {
if ($_ = &getChanConf("ircTextCounters")) {
foreach (split /[\s]+/) {
next unless ($msg =~ /^\Q$_\E$/i);
- &status("textcounters: $_ matched for $who");
+ &VERB("textcounters: $_ matched for $who",2);
- my $v = &dbGet("stats", "counter", "nick='$who' and type='$msg'");
+ my $v = &dbGet("stats", "counter", "nick=".&dbQuote($who).
+ " AND type='$msg'");
$v++;
&dbReplace("stats", (nick => $who, type => $_, counter => $v) );
diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl
index 7d79eb6..fd19da2 100644
--- a/src/IRC/Schedulers.pl
+++ b/src/IRC/Schedulers.pl
@@ -261,7 +261,7 @@ sub seenFlushOld {
my $time = time();
foreach (keys %seen) {
- my $delta_time = $time - &dbGet("seen", "time", "nick='$_'");
+ my $delta_time = $time - &dbGet("seen", "time", "nick", $_);
next unless ($delta_time > $max_time);
&DEBUG("seenFlushOld: ".&Time2String($delta_time) );
@@ -384,7 +384,6 @@ sub chanlimitCheck {
### run NAMES again and flush it.
}
- next unless (!defined $limit);
if (defined $limit and $limit == $newlimit) {
$cache{chanlimitChange}{$chan} = time();
next;
@@ -419,7 +418,7 @@ sub netsplitCheck {
my ($s1,$s2);
if (@_) {
- &ScheduleThis(30, "netsplitCheck");
+ &ScheduleThis(15, "netsplitCheck");
return if ($_[0] eq "2");
}
@@ -542,7 +541,7 @@ sub seenFlush {
### old code.
###
- my $exists = &dbGet("seen", "nick", "nick='$nick'");
+ my $exists = &dbGet("seen", "nick", "nick=".&dbQuote($nick) );
if (defined $exists and $exists) {
&dbUpdate("seen", "nick", $nick, (
@@ -688,7 +687,7 @@ sub ignoreCheck {
sub ircCheck {
if (@_) {
- &ScheduleThis(60, "ircCheck");
+ &ScheduleThis(15, "ircCheck");
return if ($_[0] eq "2"); # defer.
}
diff --git a/src/Misc.pl b/src/Misc.pl
index 6264b00..ffc6fb6 100644
--- a/src/Misc.pl
+++ b/src/Misc.pl
@@ -453,7 +453,7 @@ sub isStale {
return 1 unless ( -f $file);
if ($file =~ /idx/) {
my $age2 = time() - (stat($file))[9];
- &DEBUG("stale: $age2. (". &Time2String($age2) .")");
+ &VERB("stale: $age2. (". &Time2String($age2) .")",2);
}
$age *= 60*60*24 if ($age >= 0 and $age < 30);
@@ -699,4 +699,19 @@ sub mkcrypt {
return crypt($str, $salt);
}
+sub closeStats {
+ return unless (&getChanConfList("ircTextCounters"));
+
+ foreach (keys %cmdstats) {
+ my $type = $_;
+ my $i = &dbGet("stats", "counter", "nick=".&dbQuote($type).
+ " AND type='cmdstats'");
+ $i += $cmdstats{$type};
+
+ &dbReplace("stats",
+ (nick => $type, type => "cmdstats", counter => $i)
+ );
+ }
+}
+
1;
diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl
index 940c575..1053f16 100644
--- a/src/Modules/Debian.pl
+++ b/src/Modules/Debian.pl
@@ -360,7 +360,7 @@ sub searchAuthor {
$files .= " ".$_;
}
- &::DEBUG("deb: good = $good, bad = $bad...");
+ &::DEBUG("deb: good = $good, bad = $bad...") if ($debug);
if ($good == 0 and $bad != 0) {
my %urls = &fixDist($dist, %urlpackages);
@@ -422,7 +422,7 @@ sub searchAuthor {
return 1;
}
- &::DEBUG("deb: showing all packages by '$list[0]'...");
+ &::DEBUG("deb: showing all packages by '$list[0]'...") if ($debug);
my @pkg = sort keys %{ $pkg{$list[0]} };
@@ -983,10 +983,10 @@ sub searchPackage {
$file = $1;
if (&::isStale($file, $refresh)) {
- &::DEBUG("deb: STALE $file! regen.");
+ &::DEBUG("deb: STALE $file! regen.") if ($debug);
&generateIndex(($dist));
### @files = searchPackage("$query $dist");
- &::DEBUG("deb: EVIL HACK HACK HACK.");
+ &::DEBUG("deb: EVIL HACK HACK HACK.") if ($debug);
last;
}
diff --git a/src/Modules/Factoids.pl b/src/Modules/Factoids.pl
index fb261d4..5c2fc06 100644
--- a/src/Modules/Factoids.pl
+++ b/src/Modules/Factoids.pl
@@ -174,14 +174,14 @@ sub CmdFactStats {
my $prefix = "factoid statistics by author: ";
return &formListReply(0, $prefix, @list);
- } elsif ($type =~ /^broken$/i) {
- &status("factstats(broken): starting...");
+ } elsif ($type =~ /^vandalism$/i) {
+ &status("factstats(vandalism): starting...");
my $start_time = &timeget();
my %data = &dbGetCol("factoids", "factoid_key,factoid_value", "factoid_value IS NOT NULL");
my @list;
my $delta_time = &timedelta($start_time);
- &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
+ &status(sprintf("factstats(vandalismbroken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
$start_time = &timeget();
# parse the factoids.
@@ -193,15 +193,15 @@ sub CmdFactStats {
}
$delta_time = &timedelta($start_time);
- &status(sprintf("factstats(broken): %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
+ &status(sprintf("factstats(vandalism): %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
# bail out on no results.
if (scalar @list == 0) {
- return 'no broken factoids... wooohoo.';
+ return 'no vandalised factoids... wooohoo.';
}
# parse the results.
- my $prefix = "broken factoid ";
+ my $prefix = "Vandalised factoid ";
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^total$/i) {
@@ -588,7 +588,7 @@ sub CmdFactStats {
my @list;
my $total = 0;
my $users = 0;
- foreach $rate (sort { $a <=> $b } keys %hash) {
+ foreach $rate (sort { $b <=> $a } keys %hash) {
my $f = join(", ", sort keys %{ $hash{$rate} });
my $str = "$f - ".&Time2String($rate);
$str =~ s/\002//g;
diff --git a/src/Modules/Freshmeat.pl b/src/Modules/Freshmeat.pl
index 40c36fa..a6a07c5 100644
--- a/src/Modules/Freshmeat.pl
+++ b/src/Modules/Freshmeat.pl
@@ -84,7 +84,8 @@ sub Freshmeat {
sub showPackage {
my ($pkg) = @_;
- my @fm = &::dbGet("freshmeat", "*", "projectname_short='$pkg'");
+ my @fm = &::dbGet("freshmeat", "*",
+ "projectname_short=".&dbQuote($pkg) );
if (scalar @fm) { #1: perfect match of name.
my $retval;
@@ -188,7 +189,7 @@ sub downloadIndex {
{ "latest_version" => time() }
);
- &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
+# &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
@cols = &::dbGetColInfo("freshmeat");
$locktime = time();
@@ -247,7 +248,7 @@ sub downloadIndex {
}
close IN;
- &::dbRaw("UNLOCK", "UNLOCK TABLES");
+# &::dbRaw("UNLOCK", "UNLOCK TABLES");
my $delta_time = &::timedelta($start_time);
&::status(sprintf("Freshmeat: %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
@@ -329,7 +330,7 @@ sub xml_end {
}
$i++;
- &::dbSetRow("freshmeat", @data);
+ &::dbSetRow("freshmeat", [@data], "DELAY");
undef @data;
undef %pkg;
@@ -342,10 +343,10 @@ sub xml_end {
# I think the following leaks 120k of memory each time it's
# called... the wonders of libmysql-perl leaking!
- &::dbRaw("UNLOCK", "UNLOCK TABLES");
+# &::dbRaw("UNLOCK", "UNLOCK TABLES");
### another lame hack to "prevent" errors.
- select(undef, undef, undef, 0.2);
- &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
+# select(undef, undef, undef, 0.2);
+# &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
}
}
}
diff --git a/src/Modules/News.pl b/src/Modules/News.pl
index a112d09..8075a51 100644
--- a/src/Modules/News.pl
+++ b/src/Modules/News.pl
@@ -192,7 +192,7 @@ sub readNews {
close NEWS;
my $cn = scalar(keys %::news);
- &::status("News: Read ".
+ &::status("News: read ".
$ci. &::fixPlural(" item", $ci). " for ".
$cn. &::fixPlural(" chan", $cn). ", ".
$cu. &::fixPlural(" user", $cu), " cache"
@@ -381,14 +381,24 @@ sub list {
my $count = scalar keys %{ $::news{$chan} };
&::msg($::who, "|==== News for \002$chan\002: ($count items)");
my $newest = 0;
+ my $expire = 0;
+ my $eno = 0;
foreach (keys %{ $::news{$chan} }) {
my $t = $::news{$chan}{$_}{Time};
+ my $e = $::news{$chan}{$_}{Expire};
$newest = $t if ($t > $newest);
+ if ($e > 1 and $e < $expire) {
+ $expire = $e;
+ $eno = &newsS2N($item);
+ }
}
my $timestr = &::Time2String(time() - $newest);
&::msg($::who, "|= Last updated $timestr ago.");
&::msg($::who, " \037Num\037 \037Item ".(" "x40)." \037");
+ &DEBUG("list: expire = $expire");
+ &DEBUG("list: eno = $eno");
+
my $i = 1;
foreach ( &getNewsAll() ) {
my $subtopic = $_;
diff --git a/src/Modules/RootWarn.pl b/src/Modules/RootWarn.pl
index 6944b19..835c605 100644
--- a/src/Modules/RootWarn.pl
+++ b/src/Modules/RootWarn.pl
@@ -9,7 +9,8 @@
sub rootWarn {
my ($nick,$user,$host,$chan) = @_;
- my $attempt = &dbGet("rootwarn", "attempt", "nick='".lc($nick)."'") || 0;
+ my $n = lc $nick;
+ my $attempt = &dbGet("rootwarn", "attempt", "nick=".&dbQuote($n) ) || 0;
my $warnmode = &getChanConf("rootWarnMode");
if ($attempt == 0) { # first timer.
diff --git a/src/Modules/UserDCC.pl b/src/Modules/UserDCC.pl
index d67fa36..acc4a17 100644
--- a/src/Modules/UserDCC.pl
+++ b/src/Modules/UserDCC.pl
@@ -566,6 +566,9 @@ sub userDCC {
return;
}
+ $cache{confvars}{$what} = $val;
+ &rehashConfVars();
+
foreach (@chans) {
&chanSet($cmd, $_, $what, $val);
}
@@ -617,6 +620,8 @@ sub userDCC {
$chanconf{$_}{$args} = $val;
}
delete $chanconf{_default}{$args};
+ $cache{confvars}{$args} = 0;
+ &rehashConfVars();
return;
}
@@ -629,6 +634,8 @@ sub userDCC {
&DEBUG("delete chanconf{$_}{$args};");
delete $chanconf{$_}{$args};
}
+ $cache{confvars}{$args} = 0;
+ &rehashConfVars();
return;
}
diff --git a/src/Process.pl b/src/Process.pl
index f23143b..8133d7a 100644
--- a/src/Process.pl
+++ b/src/Process.pl
@@ -294,7 +294,8 @@ sub process {
return;
}
- my $karma = &dbGet("stats", "counter", "nick='$term' and type='karma'") || 0;
+ my $karma = &dbGet("stats", "counter", "nick=".&dbQuote($term).
+ " AND type='karma'") || 0;
if ($inc eq '++') {
$karma++;
} else {
@@ -429,15 +430,20 @@ sub FactoidStuff {
if (!defined $check or $check =~ /^\s*$/) {
if ($faqtoid !~ / #DEL#$/) {
my $new = $faqtoid." #DEL#";
- &DEBUG("Process: backing up $faqtoid to '$new'.");
+ my $backup = &getFactoid($faqtoid);
# this looks weird but does it work?
- &setFactInfo($faqtoid, "factoid_key", $new);
- &setFactInfo($new, "modified_by", $who);
- &setFactInfo($new, "modified_time", time());
+ if ($backup) {
+ &DEBUG("forget: not overwriting backup: $faqtoid");
+ } else {
+ &status("forget: backing up '$faqtoid'");
+ &setFactInfo($faqtoid, "factoid_key", $new);
+ &setFactInfo($new, "modified_by", $who);
+ &setFactInfo($new, "modified_time", time());
+ }
} else {
- &status("not backing up $faqtoid.");
+ &status("forget: not backing up $faqtoid.");
}
} else {
@@ -687,7 +693,7 @@ sub FactoidStuff {
# &performReply( &getRandom(keys %{ $lang{'moron'} }) );
$count{'Moron'}++;
- &performReply("You are moron #".$count{'Moron'}."!");
+ &performReply("You are moron \002#". $count{'Moron'} ."\002");
return;
}
diff --git a/src/UserExtra.pl b/src/UserExtra.pl
index f4cb809..7079f6a 100644
--- a/src/UserExtra.pl
+++ b/src/UserExtra.pl
@@ -219,7 +219,8 @@ sub factstats {
sub karma {
my $target = lc( shift || $who );
- my $karma = &dbGet("stats", "counter", "nick='$target' and type='karma'") || 0;
+ my $karma = &dbGet("stats", "counter", "nick=".
+ &dbQuote($target)." AND type='karma'") || 0;
if ($karma != 0) {
&pSReply("$target has karma of $karma");
@@ -392,8 +393,8 @@ sub DNS {
$dns =~ s/^\s+|\s+$//g;
if ($dns =~ /(\d+\.\d+\.\d+\.\d+)/) {
- &status("DNS query by IP address: $in");
$match = $1;
+ &status("DNS query by IP address: $match");
$y = pack('C4', split(/\./, $match));
$x = (gethostbyaddr($y, &AF_INET));
@@ -762,6 +763,7 @@ sub userCommands {
my $startString = scalar(localtime $^T);
my $upString = &Time2String(time() - $^T);
my $count = &countKeys("factoids");
+
$count{'Commands'} = 0;
foreach (keys %cmdstats) {
$count{'Commands'} += $cmdstats{$_};
@@ -785,6 +787,16 @@ sub userCommands {
"kB of memory."
);
+ # todo: make dbGetColNiceHash().
+ my %hash = &dbGetCol("stats", "nick,counter", "type='cmdstats'".
+# " ORDER BY counter DESC LIMIT 3", 1);
+ " ORDER BY counter DESC", 1);
+
+ foreach (keys %hash) {
+ &DEBUG("cmdstats: hash{$_} => $hash{$_}");
+ }
+ &DEBUG("end of cmdstats.");
+
return;
}
diff --git a/src/core.pl b/src/core.pl
index b49d9b2..63c8406 100644
--- a/src/core.pl
+++ b/src/core.pl
@@ -99,6 +99,7 @@ sub doExit {
&closeDCC();
&closePID();
+ &closeStats();
&seenFlush();
&quit($param{'quitMsg'}) if (&whatInterface() =~ /IRC/);
&writeUserFile();
@@ -455,7 +456,7 @@ sub restart {
### crappy bug in Net::IRC?
if (!$conn->connected and time - $msgtime > 900) {
- &status("reconnecting because of uncaught disconnect.");
+ &status("reconnecting because of uncaught disconnect \@ ".scalar(localtime) );
### $irc->start;
$conn->connect();
### return;
diff --git a/src/db_mysql.pl b/src/db_mysql.pl
index 9a6c461..185a5bf 100644
--- a/src/db_mysql.pl
+++ b/src/db_mysql.pl
@@ -19,8 +19,10 @@ sub openDB {
} else {
&ERROR("cannot connect to $param{'SQLHost'}.");
&ERROR("since mysql is not available, shutting down bot!");
- &shutdown();
&closePID();
+ &closeSHM($shm);
+ &closeLog();
+
exit 1;
}
}
@@ -30,6 +32,7 @@ sub closeDB {
&status("Closed MySQL connection to $param{'SQLHost'}.");
$dbh->disconnect();
+
return 1;
}
@@ -125,6 +128,36 @@ sub dbGetCol {
return %retval;
}
+#####
+# Usage: &dbGetColNiceHash($table, $select, $where);
+sub dbGetColNiceHash {
+ my ($table, $select, $where) = @_;
+ $select ||= "*";
+ my $query = "SELECT $select FROM $table";
+ $query .= " WHERE ".$where if ($where);
+ my %retval;
+
+ &DEBUG("dbGetColNiceHash: query => '$query'.");
+
+ my $sth = $dbh->prepare($query);
+ &SQLDebug($query);
+ if (!$sth->execute) {
+ &ERROR("GetColNiceHash: execute: '$query'");
+# &ERROR("GetCol => $DBI::errstr");
+ $sth->finish;
+ return;
+ }
+
+ # todo: get column names, do $hash{$primkey}{blah} = ...
+ while (my @row = $sth->fetchrow_array) {
+ # reverse it to make it easier to count.
+ }
+
+ $sth->finish;
+
+ return %retval;
+}
+
####
# Usage: &dbGetColInfo($table);
sub dbGetColInfo {
@@ -153,6 +186,7 @@ sub dbGetColInfo {
#####
# Usage: &dbSet($table, $primhash_ref, $hash_ref);
+# Note: dbSet does dbQuote.
sub dbSet {
my ($table, $phref, $href) = @_;
my $where = join(' AND ', map {
@@ -200,6 +234,7 @@ sub dbSet {
#####
# Usage: &dbUpdate($table, $primkey, $primval, %hash);
+# Note: dbUpdate does dbQuote.
sub dbUpdate {
my ($table, $primkey, $primval, %hash) = @_;
my (@array);
@@ -217,6 +252,7 @@ sub dbUpdate {
#####
# Usage: &dbInsert($table, $primkey, %hash);
+# Note: dbInsert does dbQuote.
sub dbInsert {
my ($table, $primkey, %hash, $delay) = @_;
my (@keys, @vals);
@@ -241,6 +277,7 @@ sub dbInsert {
#####
# Usage: &dbReplace($table, %hash);
+# Note: dbReplace does optional dbQuote.
sub dbReplace {
my ($table, %hash) = @_;
my (@keys, @vals);
@@ -268,13 +305,21 @@ sub dbReplace {
}
#####
-# Usage: &dbSetRow($table, @values);
+# Usage: &dbSetRow($table, $vref, $delay);
+# Note: dbSetRow does dbQuote.
sub dbSetRow ($@$) {
- my ($table, @values, $delay) = @_;
+ my ($table, $vref, $delay) = @_;
my $p = ($delay) ? " DELAYED " : "";
- foreach (@values) {
- $_ = &dbQuote($_);
+ # see 'perldoc perlreftut'
+ my @values;
+ foreach (@{ $vref }) {
+ push(@values, &dbQuote($_) );
+ }
+
+ if (!scalar @values) {
+ &WARN("dbSetRow: values array == NULL.");
+ return;
}
return &dbRaw("SetRow", "INSERT $p INTO $table VALUES (".
@@ -283,6 +328,7 @@ sub dbSetRow ($@$) {
#####
# Usage: &dbDel($table, $primkey, $primval, [$key]);
+# Note: dbDel does dbQuote
sub dbDel {
my ($table, $primkey, $primval, $key) = @_;
@@ -354,26 +400,6 @@ sub sumKey {
return (&dbRawReturn("SELECT sum($col) FROM $table"))[0];
}
-##### NOT USED.
-# Usage: &getKeys($table,$primkey);
-sub getKeys {
- my ($table,$primkey) = @_;
- my @retval;
-
- my $query = "SELECT $primkey FROM $table";
- my $sth = $dbh->prepare($query);
-
- &SQLDebug($query);
- &WARN("ERROR: getKeys($query)") unless $sth->execute;
-
- while (my @row = $sth->fetchrow_array) {
- push(@retval, $row[0]);
- }
- $sth->finish;
-
- return @retval;
-}
-
#####
# Usage: &randKey($table, $select);
sub randKey {
@@ -396,7 +422,9 @@ sub deleteTable {
&dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
}
+#####
# Usage: &searchTable($table, $select, $key, $str);
+# Note: searchTable does dbQuote.
sub searchTable {
my($table, $select, $key, $str) = @_;
my $origStr = $str;
@@ -420,7 +448,10 @@ sub searchTable {
&dbQuote($str);
my $sth = $dbh->prepare($query);
&SQLDebug($query);
- &WARN("Search($query)") unless $sth->execute;
+ if (!$sth->execute) {
+ &WARN("Search($query)");
+ return;
+ }
while (my @row = $sth->fetchrow_array) {
push(@results, $row[0]);
@@ -436,8 +467,9 @@ sub searchTable {
#####
# Usage: &getFactInfo($faqtoid, type);
+# Note: getFactInfo does dbQuote
sub getFactInfo {
- return &dbGet("factoids", $_[1], "factoid_key='$_[0]'");
+ return &dbGet("factoids", $_[1], "factoid_key=".&dbQuote($_[0]) );
}
#####
@@ -460,7 +492,7 @@ sub delFactoid {
sub SQLDebug {
return unless (&IsParam("SQLDebug"));
- return if (!fileno SQLDEBUG);
+ return unless (fileno SQLDEBUG);
print SQLDEBUG $_[0]."\n";
}
@@ -476,7 +508,7 @@ sub dbCreateTable {
&DEBUG("dbCT: file => $file");
next unless ( -f $file );
- &DEBUG("found!!!");
+ &DEBUG("dbCT: found!!!");
open(IN, $file);
while (<IN>) {
@@ -491,14 +523,14 @@ sub dbCreateTable {
if (!$found) {
return 0;
} else {
- &dbRaw("create($table)", $data);
+ &dbRaw("createTable($table)", $data);
return 1;
}
}
sub checkTables {
my $database_exists = 0;
- foreach (&dbRawReturn("SHOW DATABASES")) {
+ foreach ( &dbRawReturn("SHOW DATABASES") ) {
$database_exists++ if ($_ eq $param{'DBName'});
}
--
2.39.5