$itc =~ s/([^\w\s])/\\$1/g;
my $z = join '|', split ' ', $itc;
+ if ($message =~ /^_stats(\s+(\S+))$/i) {
+ &textstats_main($2);
+ return;
+ }
+
if ($message =~ /^($z)stats(\s+(\S+))?$/i) {
my $type = $1;
my $arg = $3;
&DEBUG("not using chan arg") if (!defined $c);
my $sum = (&dbRawReturn("SELECT SUM(counter) FROM stats"
." WHERE ".$where ))[0];
- &DEBUG("type => $type, arg => $arg");
if (!defined $arg or $arg =~ /^\s*$/) {
# this is way fucking ugly.
}
if (defined $sum) {
- &pSReply("total count of '$type' on $c: $sum$topstr");
+ &pSReply("total count of \037$type\037 on \002$c\002: $sum$topstr");
} else {
- &pSReply("zero counter for '$type'.");
+ &pSReply("zero counter for \037$type\037.");
}
} else {
my $x = (&dbRawReturn("SELECT SUM(counter) FROM stats".
my $xtra = "";
if ($total and $good) {
my $pct = sprintf("%.01f", 100*(1+$total-$i)/$total);
- $xtra = ", ranked $i/$total (percentile: $pct %)";
+ $xtra = ", ranked $i\002/\002$total (percentile: \002$pct\002 %)";
}
my $pct1 = sprintf("%.01f", 100*$x/$sum);
- &pSReply("$arg has said $type $x times ($pct1 %)$xtra");
+ &pSReply("\002$arg\002 has said \037$type\037 \002$x\002 times (\002$pct1\002 %)$xtra");
}
return;
return;
}
+sub textstats_main {
+ my($arg) = @_;
+
+ # even more uglier with channel/time arguments.
+ my $c = $chan;
+# my $c = $chan || "PRIVATE";
+ my $where = "channel=".&dbQuote($c) if (defined $c);
+ &DEBUG("not using chan arg") if (!defined $c);
+ my $sum = (&dbRawReturn("SELECT SUM(counter) FROM stats"
+ ." WHERE ".$where ))[0];
+
+ if (!defined $arg or $arg =~ /^\s*$/) {
+ # this is way fucking ugly.
+ &DEBUG("_stats: !arg");
+
+ my %hash = &dbGetCol("stats", "nick,counter",
+ $where." 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.
+ my $tp = 0;
+ foreach $i (sort { $b <=> $a } keys %hash) {
+ foreach (keys %{ $hash{$i} }) {
+ my $p = sprintf("%.01f", 100*$i/$sum);
+ $tp += $p;
+ push(@top, "\002$_\002 -- $i ($p%)");
+ }
+ }
+
+ my $topstr = "";
+ &DEBUG("tp => $tp");
+ if (scalar @top) {
+ $topstr = ". Top ".scalar(@top).": ".join(', ', @top);
+ }
+
+ if (defined $sum) {
+ &pSReply("total count of \037$type\037 on \002$c\002: $sum$topstr");
+ } else {
+ &pSReply("zero counter for \037$type\037.");
+ }
+ } else {
+ my %hash = &dbGetCol("stats", "type,counter",
+ "$where AND nick=".&dbQuote($arg) );
+
+ foreach (keys %hash) {
+ &DEBUG("_stats: hash{$_} => $hash{$_}");
+ # ranking.
+ my @array = &dbGet("stats", "nick",
+ $where." ORDER BY counter", 1);
+ my $good = 0;
+ my $i = 0;
+ for($i=0; $i<scalar @array; $i++) {
+ next unless ($array[0] =~ /^\Q$who\E$/);
+ $good++;
+ last;
+ }
+ $i++;
+
+ my $total = scalar(@array);
+ &DEBUG(" i => $i, good => $good, total => $total");
+ }
+
+ return;
+
+ if (!defined $x) { # !defined.
+ &pSReply("$arg has not said $type yet.");
+ return;
+ }
+
+ my $xtra = "";
+ if ($total and $good) {
+ my $pct = sprintf("%.01f", 100*(1+$total-$i)/$total);
+ $xtra = ", ranked $i\002/\002$total (percentile: \002$pct\002 %)";
+ }
+
+ my $pct1 = sprintf("%.01f", 100*$x/$sum);
+ &pSReply("\002$arg\002 has said \037$type\037 \002$x\002 times (\002$pct1\002 %)$xtra");
+ }
+}
+
sub nullski { my ($arg) = @_; return unless (defined $arg);
foreach (`$arg`) { &msg($who,$_); } }
--- /dev/null
+#
+# Misc.pl: Miscellaneous stuff.
+# Author: dms
+# Version: v0.1 (20010906)
+# Created: 20010906
+#
+
+if (&IsParam("useStrict")) { use strict; }
+
+# Usage: &validFactoid($lhs,$rhs);
+sub validFactoid {
+ my ($lhs,$rhs) = @_;
+ my $valid = 0;
+
+ for (lc $lhs) {
+ # allow the following only if they have been made on purpose.
+ if ($rhs ne "" and $rhs !~ /^</) {
+ / \Q$ident$/i and last; # someone said i'm something.
+ /^i('m)? / and last;
+ /^(it|that|there|what)('s)?(\s+|$)/ and last;
+ /^you('re)?(\s+|$)/ and last;
+
+ /^(where|who|why|when|how)(\s+|$)/ and last;
+ /^(this|that|these|those|they)(\s+|$)/ and last;
+ /^(every(one|body)|we) / and last;
+
+ /^say / and last;
+ }
+
+ # uncaught commands.
+ /^add topic / and last; # topic management.
+ /( add$| add |^add )/ and last; # borked teach statement.
+ /^learn / and last; # teach. damn morons.
+ /^tell (\S+) about / and last; # tell.
+ /\=\~/ and last; # substituition.
+ /^\S+ to \S+ \S+/ and last; # babelfish.
+
+ /^\=/ and last; # botnick = heh is.
+ /wants you to know/ and last;
+
+ # symbols.
+ /(\"\*)/ and last;
+ /, / and last;
+ (/^'/ and /'$/) and last;
+ (/^"/ and /"$/) and last;
+
+ # delimiters.
+ /\=\>/ and last; # '=>'.
+ /\;\;/ and last; # ';;'.
+ /\|\|/ and last; # '||'.
+
+ /^\Q$ident\E[\'\,\: ]/ and last;# dupe addressed.
+ /^[\-\, ]/ and last;
+ /\\$/ and last; # forgot shift for '?'.
+ /^all / and last;
+ /^also / and last;
+ / also$/ and last;
+ / and$/ and last;
+ /^because / and last;
+ /^but / and last;
+ /^gives / and last;
+ /^h(is|er) / and last;
+ /^if / and last;
+ / is,/ and last;
+ / it$/ and last;
+ /^or / and last;
+ / says$/ and last;
+ /^should / and last;
+ /^so / and last;
+ /^supposedly/ and last;
+ /^to / and last;
+ /^was / and last;
+ / which$/ and last;
+
+ # nasty bug I introduced _somehow_, probably by fixMySQLBug().
+ /\\\%/ and last;
+ /\\\_/ and last;
+
+ # weird/special stuff. also old blootbot or stock infobot bugs.
+ $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last; # ownership.
+
+ # duplication.
+ $rhs =~ /^\Q$lhs /i and last;
+ last if ($rhs =~ /^is /i and / is$/);
+
+ $valid++;
+ }
+
+ return $valid;
+}
+
+sub FactoidStuff {
+ # inter-infobot.
+ if ($msgType =~ /private/ and $message =~ s/^:INFOBOT://) {
+ ### identification.
+ &status("infobot <$nuh> identified") unless $bots{$nuh};
+ $bots{$nuh} = $who;
+
+ ### communication.
+
+ # query.
+ if ($message =~ /^QUERY (<.*?>) (.*)/) { # query.
+ my ($target,$item) = ($1,$2);
+ $item =~ s/[.\?]$//;
+
+ &status(":INFOBOT:QUERY $who: $message");
+
+ if ($_ = &getFactoid($item)) {
+ &msg($who, ":INFOBOT:REPLY $target $item =is=> $_");
+ }
+
+ return 'INFOBOT QUERY';
+ } elsif ($message =~ /^REPLY <(.*?)> (.*)/) { # reply.
+ my ($target,$item) = ($1,$2);
+
+ &status(":INFOBOT:REPLY $who: $message");
+
+ my ($lhs,$mhs,$rhs) = $item =~ /^(.*?) =(.*?)=> (.*)/;
+
+ if ($param{'acceptUrl'} !~ /REQUIRE/ or $rhs =~ /(http|ftp|mailto|telnet|file):/) {
+ &msg($target, "$who knew: $lhs $mhs $rhs");
+
+ # "are" hack :)
+ $rhs = "<REPLY> are" if ($mhs eq "are");
+ &setFactInfo($lhs, "factoid_value", $rhs);
+ }
+
+ return 'INFOBOT REPLY';
+ } else {
+ &ERROR(":INFOBOT:UNKNOWN $who: $message");
+ return 'INFOBOT UNKNOWN';
+ }
+ }
+
+ # factoid forget.
+ if ($message =~ s/^forget\s+//i) {
+ return 'forget: no addr' unless ($addressed);
+
+ my $faqtoid = $message;
+ if ($faqtoid eq "") {
+ &help("forget");
+ return;
+ }
+
+ $faqtoid =~ tr/A-Z/a-z/;
+ my $result = &getFactoid($faqtoid);
+
+ if (defined $result) {
+ my $author = &getFactInfo($faqtoid, "created_by");
+ my $count = &getFactInfo($faqtoid, "requested_count") || 0;
+ 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;
+ }
+
+ return 'locked factoid' if (&IsLocked($faqtoid) == 1);
+
+ # factoidPreventForgetLimit:
+ if ($limit and $count > $limit and (&IsFlag("o") ne "o")) {
+ &msg($who, "will not delete '$faqtoid', count > limit ($count > $limit)");
+ return;
+ }
+
+ if (&IsParam("factoidDeleteDelay") or &IsChanConf("factoidDeleteDelay")) {
+ if ($faqtoid =~ / #DEL#$/ and !&IsFlag("o")) {
+ &msg($who, "cannot delete it ($faqtoid).");
+ return;
+ }
+
+ &status("forgot (safe delete): <$who> '$faqtoid' =is=> '$result'");
+ ### TODO: check if the "backup" exists and overwrite it
+ my $check = &getFactoid("$faqtoid #DEL#");
+
+ if (!defined $check or $check =~ /^\s*$/) {
+ if ($faqtoid !~ / #DEL#$/) {
+ my $new = $faqtoid." #DEL#";
+
+ my $backup = &getFactoid($faqtoid);
+ # this looks weird but does it work?
+ 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("forget: not backing up $faqtoid.");
+ }
+
+ } else {
+ &status("forget: not overwriting backup!");
+ }
+
+ } else {
+ &status("forget: <$who> '$faqtoid' =is=> '$result'");
+ }
+ &delFactoid($faqtoid);
+
+ &performReply("i forgot $faqtoid");
+
+ $count{'Update'}++;
+ } else {
+ &performReply("i didn't have anything called '$faqtoid'");
+ }
+
+ return;
+ }
+
+ # factoid unforget/undelete.
+ if ($message =~ s/^un(forget|delete)\s+//i) {
+ return 'unforget: no addr' unless ($addressed);
+
+ my $i = 0;
+ $i++ if (&IsParam("factoidDeleteDelay"));
+ $i++ if (&IsChanConf("factoidDeleteDelay"));
+ if (!$i) {
+ &performReply("safe delete has been disable so what is there to undelete?");
+ return;
+ }
+
+ my $faqtoid = $message;
+ if ($faqtoid eq "") {
+ &help("undelete");
+ return;
+ }
+
+ $faqtoid =~ tr/A-Z/a-z/;
+ my $result = &getFactoid($faqtoid." #DEL#");
+ my $check = &getFactoid($faqtoid);
+
+ if (!defined $result) {
+ &performReply("i didn't have anything ('$faqtoid') to undelete.");
+ return;
+ }
+
+ if (defined $check) {
+ &performReply("cannot undeleted '$faqtoid' because it already exists?");
+ return;
+ }
+
+ &setFactInfo($faqtoid." #DEL#", "factoid_key", $faqtoid);
+
+ ### delete info. modified_ isn't really used.
+ &setFactInfo($faqtoid, "modified_by", "");
+ &setFactInfo($faqtoid, "modified_time", 0);
+
+ &performReply("Successfully recovered '$faqtoid'. Have fun now.");
+
+ $count{'Undelete'}++;
+
+ return;
+ }
+
+ # factoid locking.
+ if ($message =~ /^((un)?lock)(\s+(.*))?\s*?$/i) {
+ return 'lock: no addr 2' unless ($addressed);
+
+ my $function = lc $1;
+ my $faqtoid = lc $4;
+
+ if ($faqtoid eq "") {
+ &help($function);
+ return;
+ }
+
+ if (&getFactoid($faqtoid) eq "") {
+ &msg($who, "factoid \002$faqtoid\002 does not exist");
+ return;
+ }
+
+ if ($function eq "lock") {
+ # strongly requested by #debian on 19991028. -xk
+ if (1 and $faqtoid !~ /^\Q$who\E$/i and &IsFlag("o") ne "o") {
+ &msg($who,"sorry, locking cannot be used since it can be abused unneccesarily.");
+ &status("Replace 1 with 0 in Process.pl#~324 for locking support.");
+ return;
+ }
+
+ &CmdLock($faqtoid);
+ } else {
+ &CmdUnLock($faqtoid);
+ }
+
+ return;
+ }
+
+ # factoid rename.
+ if ($message =~ s/^rename(\s+|$)//) {
+ return 'rename: no addr' unless ($addressed);
+
+ if ($message eq "") {
+ &help("rename");
+ return;
+ }
+
+ if ($message =~ /^'(.*)'\s+'(.*)'$/) {
+ my($from,$to) = (lc $1, lc $2);
+
+ my $result = &getFactoid($from);
+ if (defined $result) {
+ my $author = &getFactInfo($from, "created_by");
+
+ if (&IsFlag("m") or $author =~ /^\Q$who\E\!/i) {
+ &msg($who, "It's not yours to modify.");
+ return;
+ }
+
+ if ($_ = &getFactoid($to)) {
+ &performReply("destination factoid already exists.");
+ return;
+ }
+
+ &setFactInfo($from,"factoid_key",$to);
+
+ &status("rename: <$who> '$from' is now '$to'");
+ &performReply("i renamed '$from' to '$to'");
+ } else {
+ &performReply("i didn't have anything called '$from'");
+ }
+ } else {
+ &msg($who,"error: wrong format. ask me about 'help rename'.");
+ }
+
+ return;
+ }
+
+ # factoid substitution. (X =~ s/A/B/FLAG)
+ if ($message =~ m|^(.*?)\s+=~\s+s([/,#])(.+?)\2(.*?)\2([a-z]*);?\s*$|) {
+ my ($faqtoid,$delim,$op,$np,$flags) = (lc $1, $2, $3, $4, $5);
+ return 'subst: no addr' unless ($addressed);
+
+ # incorrect format.
+ if ($np =~ /$delim/) {
+ &msg($who,"looks like you used the delimiter too many times. You may want to use a different delimiter, like ':' or '#'.");
+ return;
+ }
+
+ # success.
+ if (my $result = &getFactoid($faqtoid)) {
+ return 'subst: locked' if (&IsLocked($faqtoid) == 1);
+ my $was = $result;
+
+ if (($flags eq "g" && $result =~ s/\Q$op/$np/gi) || $result =~ s/\Q$op/$np/i) {
+ if (length $result > $param{'maxDataSize'}) {
+ &performReply("that's too long");
+ return;
+ }
+ &setFactInfo($faqtoid, "factoid_value", $result);
+ &status("update: '$faqtoid' =is=> '$result'; was '$was'");
+ &performReply("OK");
+ } else {
+ &performReply("that doesn't contain '$op'");
+ }
+ } else {
+ &performReply("i didn't have anything called '$faqtoid'");
+ }
+
+ return;
+ }
+
+ # Fix up $message for question.
+ my $question = $message;
+ for ($question) {
+ # fix the string.
+ s/^hey([, ]+)where/where/i;
+ s/\s+\?$/?/;
+ s/whois/who is/ig;
+ s/where can i find/where is/i;
+ s/how about/where is/i;
+ s/ da / the /ig;
+
+ # clear the string of useless words.
+ s/^(stupid )?q(uestion)?:\s+//i;
+ s/^(does )?(any|ne)(1|one|body) know //i;
+
+ s/^[uh]+m*[,\.]* +//i;
+
+ s/^well([, ]+)//i;
+ s/^still([, ]+)//i;
+ s/^(gee|boy|golly|gosh)([, ]+)//i;
+ s/^(well|and|but|or|yes)([, ]+)//i;
+
+ s/^o+[hk]+(a+y+)?([,. ]+)//i;
+ s/^g(eez|osh|olly)([,. ]+)//i;
+ s/^w(ow|hee|o+ho+)([,. ]+)//i;
+ s/^heya?,?( folks)?([,. ]+)//i;
+ }
+
+ if ($addressed and $message =~ s/^no([, ]+)(\Q$ident\E\,+)?\s*//i) {
+ $correction_plausible = 1;
+ &status("correction is plausible, initial negative and nick deleted ($&)") if ($param{VERBOSITY});
+ } else {
+ $correction_plausible = 0;
+ }
+
+ my $result = &doQuestion($question);
+ if (!defined $result or $result eq $noreply) {
+ return 'result from doQ undef.';
+ }
+
+ if (defined $result and $result !~ /^0?$/) { # question.
+ &status("question: <$who> $message");
+ $count{'Question'}++;
+ } elsif (&IsChanConf("perlMath") > 0 and $addressed) { # perl math.
+ &loadMyModule("perlMath");
+ my $newresult = &perlMath();
+
+ if (defined $newresult and $newresult ne "") {
+ $cmdstats{'Maths'}++;
+ $result = $newresult;
+ &status("math: <$who> $message => $result");
+ }
+ }
+
+ if ($result !~ /^0?$/) {
+ &performStrictReply($result);
+ return;
+ }
+
+ # why would a friendly bot get passed here?
+ if (&IsParam("friendlyBots")) {
+ return if (grep lc($_) eq lc($who), split(/\s+/, $param{'friendlyBots'}));
+ }
+
+ # do the statement.
+ if (!defined &doStatement($message)) {
+ return;
+ }
+
+ return unless ($addressed);
+
+ if (length $message > 64) {
+ &status("unparseable-moron: $message");
+# &performReply( &getRandom(keys %{ $lang{'moron'} }) );
+ $count{'Moron'}++;
+
+ &performReply("You are moron \002#". $count{'Moron'} ."\002");
+ return;
+ }
+
+ &status("unparseable: $message");
+ &performReply( &getRandom(keys %{ $lang{'dunno'} }) );
+ $count{'Dunno'}++;
+}
+
+1;
&performAddressedReply("okay");
- ### BROKEN!!!
if (1) { # old
+ &setFactInfo($lhs,"factoid_value", $rhs);
&setFactInfo($lhs,"created_by", $nuh);
&setFactInfo($lhs,"created_time", time());
- &setFactInfo($lhs,"factoid_value", $rhs);
} else {
+ ### BROKEN!!!
+ # I'd prefer to use dbReplace but it don't work.
&dbReplace("factoids", (
factoid_key => $lhs,
created_by => time(),
Ircname => $param{'ircName'},
);
$args{'LocalAddr'} = $param{'ircHost'} if ($param{'ircHost'});
+ $args{'Password'} = $param{'ircPasswd'} if ($param{'ircPasswd'});
$conn = $irc->newconn(%args);
&status("joining $b_blue$chan$ob");
if (!$conn->join($chan)) {
&DEBUG("joinchan: join failed. trying connect!");
+ &clearIRCVars();
$conn->connect();
}
}
}
if (exists $channels{$chan}) {
+ if ($chan eq "_default") {
+# &WARN("validC: chan cannot be _default! returning 0!");
+ return 0;
+ }
+
return 1;
} else {
return 0;
}
sub clearIRCVars {
-# &DEBUG("clearIRCVars() called!");
+ &DEBUG("clearIRCVars() called!");
undef %channels;
undef %floodjoin;
&clearIRCVars();
if (!$self->connect()) {
&WARN("not connected? help me. gonna call ircCheck() in 60s");
+ &clearIRCVars();
&ScheduleThis(1, "ircCheck");
# &ScheduleThis(10, "ircCheck");
# &ScheduleThis(30, "ircCheck");
$chan = lc( ($event->to)[0] ); # CASING!!!!
$who = $event->nick();
$msgType = "public";
+ my $i = scalar(keys %{ $channels{$chan} });
+ my $j = $cache{maxpeeps}{$chan} || 0;
$chanstats{$chan}{'Join'}++;
$userstats{lc $who}{'Join'} = time() if (&IsChanConf("seenStats"));
+ $cache{maxpeeps}{$chan} = $i if ($i > $j);
&joinfloodCheck($who, $chan, $event->userhost);
return if ($_[0] eq "2");
}
+ my $str = join(' ', &ChanConfList("chanlimitcheck") );
+ &DEBUG("chanlimitCheck: str => $str");
+
foreach $chan ( &ChanConfList("chanlimitcheck") ) {
next unless (&validChan($chan));
+ if ($chan eq "_default") {
+ &WARN("chanlimit: we're doing $chan!! HELP ME!");
+ next;
+ }
+
my $limitplus = &getChanConfDefault("chanlimitcheckPlus", 5, $chan);
my $newlimit = scalar(keys %{ $channels{$chan}{''} }) + $limitplus;
my $limit = $channels{$chan}{'l'};
delete $netsplit{$_};
}
+ # yet another hack.
+ foreach (keys %channels) {
+ my $i = $cache{maxpeeps}{$chan} || 0;
+ my $j = scalar(keys %{ $channels{$chan} });
+ next unless ($i > 10 and 0.25*$i > $j);
+
+ &DEBUG("netsplit: 0.25*max($i) > current($j); possible netsplit?");
+ }
+
if ($delete) {
my $j = scalar(keys %netsplit);
&DEBUG("nsC: removed from netsplit list: (before: $count; after: $j)");
return $str;
}
-
-
##########
### get commands.
###
}
}
-# Usage: &validFactoid($lhs,$rhs);
-sub validFactoid {
- my ($lhs,$rhs) = @_;
- my $valid = 0;
-
- for (lc $lhs) {
- # allow the following only if they have been made on purpose.
- if ($rhs ne "" and $rhs !~ /^</) {
- / \Q$ident$/i and last; # someone said i'm something.
- /^i('m)? / and last;
- /^(it|that|there|what)('s)?(\s+|$)/ and last;
- /^you('re)?(\s+|$)/ and last;
-
- /^(where|who|why|when|how)(\s+|$)/ and last;
- /^(this|that|these|those|they)(\s+|$)/ and last;
- /^(every(one|body)|we) / and last;
-
- /^say / and last;
- }
-
- # uncaught commands.
- /^add topic / and last; # topic management.
- /( add$| add |^add )/ and last; # borked teach statement.
- /^learn / and last; # teach. damn morons.
- /^tell (\S+) about / and last; # tell.
- /\=\~/ and last; # substituition.
- /^\S+ to \S+ \S+/ and last; # babelfish.
-
- /^\=/ and last; # botnick = heh is.
- /wants you to know/ and last;
-
- # symbols.
- /(\"\*)/ and last;
- /, / and last;
- (/^'/ and /'$/) and last;
- (/^"/ and /"$/) and last;
-
- # delimiters.
- /\=\>/ and last; # '=>'.
- /\;\;/ and last; # ';;'.
- /\|\|/ and last; # '||'.
-
- /^\Q$ident\E[\'\,\: ]/ and last;# dupe addressed.
- /^[\-\, ]/ and last;
- /\\$/ and last; # forgot shift for '?'.
- /^all / and last;
- /^also / and last;
- / also$/ and last;
- / and$/ and last;
- /^because / and last;
- /^but / and last;
- /^gives / and last;
- /^h(is|er) / and last;
- /^if / and last;
- / is,/ and last;
- / it$/ and last;
- /^or / and last;
- / says$/ and last;
- /^should / and last;
- /^so / and last;
- /^supposedly/ and last;
- /^to / and last;
- /^was / and last;
- / which$/ and last;
-
- # nasty bug I introduced _somehow_, probably by fixMySQLBug().
- /\\\%/ and last;
- /\\\_/ and last;
-
- # weird/special stuff. also old blootbot or stock infobot bugs.
- $rhs =~ /( \Q$ident\E's|\Q$ident\E's )/i and last; # ownership.
-
- # duplication.
- $rhs =~ /^\Q$lhs /i and last;
- last if ($rhs =~ /^is /i and / is$/);
-
- $valid++;
- }
-
- return $valid;
-}
-
# Usage: &hasProfanity($string);
sub hasProfanity {
my ($string) = @_;
sub showPackage {
my ($pkg) = @_;
my @fm = &::dbGet("freshmeat", "*",
- "projectname_short=".&dbQuote($pkg) );
+ "projectname_short=".&::dbQuote($pkg) );
if (scalar @fm) { #1: perfect match of name.
my $retval;
### lets get on with business.
# set the last refresh time. fixes multiple spawn bug.
&::dbSet("freshmeat",
- { "projectname_short" => "_" },
- { "latest_version" => time() }
+ { "projectname_short" => "_" },
+ { "latest_version" => time()
+ "desc_short" => "" }
);
# &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
$attempt++;
### TODO: OPTIMIZE THIS.
# ok... don't record the attempt if nick==root.
- if (1 and $nick ne "root") { # old
- &dbSet("rootwarn", { nick => lc($nick) }, { attempt => $attempt });
- &dbSet("rootwarn", { nick => lc($nick) }, { time => time() });
- &dbSet("rootwarn", { nick => lc($nick) }, { host => $user."\@".$host });
- &dbSet("rootwarn", { nick => lc($nick) }, { channel => $chan });
- } else { # new. replace. TODO
- &dbSet("rootwarn", "nick", lc($nick), "attempt", $attempt);
- &dbSet("rootwarn", "nick", lc($nick), "time", time());
- &dbSet("rootwarn", "nick", lc($nick), "host", $user."\@".$host);
- &dbSet("rootwarn", "nick", lc($nick), "channel", $chan);
- }
+ return if ($nick eq "root");
+
+ &dbSet("rootwarn", { nick => lc($nick) }, {
+ attempt => $attempt,
+ time => time(),
+ host => $user."\@".$host,
+ channel => $chan,
+ } );
return;
}
$reply = "there ".&fixPlural("has",$count) ." been \002$count\002 ".
&fixPlural("rooter",$count) ." warned about root.";
- if ($param{'DBType'} !~ /^mysql$/i) {
- &FIXME("rootwarn does not yet support non-mysql.");
+ if ($param{'DBType'} !~ /^(pg|my)sql$/i) {
+ &FIXME("rootwarn does not yet support non-{my,pg}sql.");
return;
}
}
}
-sub FactoidStuff {
- # inter-infobot.
- if ($msgType =~ /private/ and $message =~ s/^:INFOBOT://) {
- ### identification.
- &status("infobot <$nuh> identified") unless $bots{$nuh};
- $bots{$nuh} = $who;
-
- ### communication.
-
- # query.
- if ($message =~ /^QUERY (<.*?>) (.*)/) { # query.
- my ($target,$item) = ($1,$2);
- $item =~ s/[.\?]$//;
-
- &status(":INFOBOT:QUERY $who: $message");
-
- if ($_ = &getFactoid($item)) {
- &msg($who, ":INFOBOT:REPLY $target $item =is=> $_");
- }
-
- return 'INFOBOT QUERY';
- } elsif ($message =~ /^REPLY <(.*?)> (.*)/) { # reply.
- my ($target,$item) = ($1,$2);
-
- &status(":INFOBOT:REPLY $who: $message");
-
- my ($lhs,$mhs,$rhs) = $item =~ /^(.*?) =(.*?)=> (.*)/;
-
- if ($param{'acceptUrl'} !~ /REQUIRE/ or $rhs =~ /(http|ftp|mailto|telnet|file):/) {
- &msg($target, "$who knew: $lhs $mhs $rhs");
-
- # "are" hack :)
- $rhs = "<REPLY> are" if ($mhs eq "are");
- &setFactInfo($lhs, "factoid_value", $rhs);
- }
-
- return 'INFOBOT REPLY';
- } else {
- &ERROR(":INFOBOT:UNKNOWN $who: $message");
- return 'INFOBOT UNKNOWN';
- }
- }
-
- # factoid forget.
- if ($message =~ s/^forget\s+//i) {
- return 'forget: no addr' unless ($addressed);
-
- my $faqtoid = $message;
- if ($faqtoid eq "") {
- &help("forget");
- return;
- }
-
- $faqtoid =~ tr/A-Z/a-z/;
- my $result = &getFactoid($faqtoid);
-
- if (defined $result) {
- my $author = &getFactInfo($faqtoid, "created_by");
- my $count = &getFactInfo($faqtoid, "requested_count") || 0;
- 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;
- }
-
- return 'locked factoid' if (&IsLocked($faqtoid) == 1);
-
- # factoidPreventForgetLimit:
- if ($limit and $count > $limit and (&IsFlag("o") ne "o")) {
- &msg($who, "will not delete '$faqtoid', count > limit ($count > $limit)");
- return;
- }
-
- if (&IsParam("factoidDeleteDelay") or &IsChanConf("factoidDeleteDelay")) {
- if ($faqtoid =~ / #DEL#$/ and !&IsFlag("o")) {
- &msg($who, "cannot delete it ($faqtoid).");
- return;
- }
-
- &status("forgot (safe delete): <$who> '$faqtoid' =is=> '$result'");
- ### TODO: check if the "backup" exists and overwrite it
- my $check = &getFactoid("$faqtoid #DEL#");
-
- if (!defined $check or $check =~ /^\s*$/) {
- if ($faqtoid !~ / #DEL#$/) {
- my $new = $faqtoid." #DEL#";
-
- my $backup = &getFactoid($faqtoid);
- # this looks weird but does it work?
- 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("forget: not backing up $faqtoid.");
- }
-
- } else {
- &status("forget: not overwriting backup!");
- }
-
- } else {
- &status("forget: <$who> '$faqtoid' =is=> '$result'");
- }
- &delFactoid($faqtoid);
-
- &performReply("i forgot $faqtoid");
-
- $count{'Update'}++;
- } else {
- &performReply("i didn't have anything called '$faqtoid'");
- }
-
- return;
- }
-
- # factoid unforget/undelete.
- if ($message =~ s/^un(forget|delete)\s+//i) {
- return 'unforget: no addr' unless ($addressed);
-
- my $i = 0;
- $i++ if (&IsParam("factoidDeleteDelay"));
- $i++ if (&IsChanConf("factoidDeleteDelay"));
- if (!$i) {
- &performReply("safe delete has been disable so what is there to undelete?");
- return;
- }
-
- my $faqtoid = $message;
- if ($faqtoid eq "") {
- &help("undelete");
- return;
- }
-
- $faqtoid =~ tr/A-Z/a-z/;
- my $result = &getFactoid($faqtoid." #DEL#");
- my $check = &getFactoid($faqtoid);
-
- if (!defined $result) {
- &performReply("i didn't have anything ('$faqtoid') to undelete.");
- return;
- }
-
- if (defined $check) {
- &performReply("cannot undeleted '$faqtoid' because it already exists?");
- return;
- }
-
- &setFactInfo($faqtoid." #DEL#", "factoid_key", $faqtoid);
-
- ### delete info. modified_ isn't really used.
- &setFactInfo($faqtoid, "modified_by", "");
- &setFactInfo($faqtoid, "modified_time", 0);
-
- &performReply("Successfully recovered '$faqtoid'. Have fun now.");
-
- $count{'Undelete'}++;
-
- return;
- }
-
- # factoid locking.
- if ($message =~ /^((un)?lock)(\s+(.*))?\s*?$/i) {
- return 'lock: no addr 2' unless ($addressed);
-
- my $function = lc $1;
- my $faqtoid = lc $4;
-
- if ($faqtoid eq "") {
- &help($function);
- return;
- }
-
- if (&getFactoid($faqtoid) eq "") {
- &msg($who, "factoid \002$faqtoid\002 does not exist");
- return;
- }
-
- if ($function eq "lock") {
- # strongly requested by #debian on 19991028. -xk
- if (1 and $faqtoid !~ /^\Q$who\E$/i and &IsFlag("o") ne "o") {
- &msg($who,"sorry, locking cannot be used since it can be abused unneccesarily.");
- &status("Replace 1 with 0 in Process.pl#~324 for locking support.");
- return;
- }
-
- &CmdLock($faqtoid);
- } else {
- &CmdUnLock($faqtoid);
- }
-
- return;
- }
-
- # factoid rename.
- if ($message =~ s/^rename(\s+|$)//) {
- return 'rename: no addr' unless ($addressed);
-
- if ($message eq "") {
- &help("rename");
- return;
- }
-
- if ($message =~ /^'(.*)'\s+'(.*)'$/) {
- my($from,$to) = (lc $1, lc $2);
-
- my $result = &getFactoid($from);
- if (defined $result) {
- my $author = &getFactInfo($from, "created_by");
-
- if (&IsFlag("m") or $author =~ /^\Q$who\E\!/i) {
- &msg($who, "It's not yours to modify.");
- return;
- }
-
- if ($_ = &getFactoid($to)) {
- &performReply("destination factoid already exists.");
- return;
- }
-
- &setFactInfo($from,"factoid_key",$to);
-
- &status("rename: <$who> '$from' is now '$to'");
- &performReply("i renamed '$from' to '$to'");
- } else {
- &performReply("i didn't have anything called '$from'");
- }
- } else {
- &msg($who,"error: wrong format. ask me about 'help rename'.");
- }
-
- return;
- }
-
- # factoid substitution. (X =~ s/A/B/FLAG)
- if ($message =~ m|^(.*?)\s+=~\s+s([/,#])(.+?)\2(.*?)\2([a-z]*);?\s*$|) {
- my ($faqtoid,$delim,$op,$np,$flags) = (lc $1, $2, $3, $4, $5);
- return 'subst: no addr' unless ($addressed);
-
- # incorrect format.
- if ($np =~ /$delim/) {
- &msg($who,"looks like you used the delimiter too many times. You may want to use a different delimiter, like ':' or '#'.");
- return;
- }
-
- # success.
- if (my $result = &getFactoid($faqtoid)) {
- return 'subst: locked' if (&IsLocked($faqtoid) == 1);
- my $was = $result;
-
- if (($flags eq "g" && $result =~ s/\Q$op/$np/gi) || $result =~ s/\Q$op/$np/i) {
- if (length $result > $param{'maxDataSize'}) {
- &performReply("that's too long");
- return;
- }
- &setFactInfo($faqtoid, "factoid_value", $result);
- &status("update: '$faqtoid' =is=> '$result'; was '$was'");
- &performReply("OK");
- } else {
- &performReply("that doesn't contain '$op'");
- }
- } else {
- &performReply("i didn't have anything called '$faqtoid'");
- }
-
- return;
- }
-
- # Fix up $message for question.
- my $question = $message;
- for ($question) {
- # fix the string.
- s/^hey([, ]+)where/where/i;
- s/\s+\?$/?/;
- s/whois/who is/ig;
- s/where can i find/where is/i;
- s/how about/where is/i;
- s/ da / the /ig;
-
- # clear the string of useless words.
- s/^(stupid )?q(uestion)?:\s+//i;
- s/^(does )?(any|ne)(1|one|body) know //i;
-
- s/^[uh]+m*[,\.]* +//i;
-
- s/^well([, ]+)//i;
- s/^still([, ]+)//i;
- s/^(gee|boy|golly|gosh)([, ]+)//i;
- s/^(well|and|but|or|yes)([, ]+)//i;
-
- s/^o+[hk]+(a+y+)?([,. ]+)//i;
- s/^g(eez|osh|olly)([,. ]+)//i;
- s/^w(ow|hee|o+ho+)([,. ]+)//i;
- s/^heya?,?( folks)?([,. ]+)//i;
- }
-
- if ($addressed and $message =~ s/^no([, ]+)(\Q$ident\E\,+)?\s*//i) {
- $correction_plausible = 1;
- &status("correction is plausible, initial negative and nick deleted ($&)") if ($param{VERBOSITY});
- } else {
- $correction_plausible = 0;
- }
-
- my $result = &doQuestion($question);
- if (!defined $result or $result eq $noreply) {
- return 'result from doQ undef.';
- }
-
- if (defined $result and $result !~ /^0?$/) { # question.
- &status("question: <$who> $message");
- $count{'Question'}++;
- } elsif (&IsChanConf("perlMath") > 0 and $addressed) { # perl math.
- &loadMyModule("perlMath");
- my $newresult = &perlMath();
-
- if (defined $newresult and $newresult ne "") {
- $cmdstats{'Maths'}++;
- $result = $newresult;
- &status("math: <$who> $message => $result");
- }
- }
-
- if ($result !~ /^0?$/) {
- &performStrictReply($result);
- return;
- }
-
- # why would a friendly bot get passed here?
- if (&IsParam("friendlyBots")) {
- return if (grep lc($_) eq lc($who), split(/\s+/, $param{'friendlyBots'}));
- }
-
- # do the statement.
- if (!defined &doStatement($message)) {
- return;
- }
-
- return unless ($addressed);
-
- if (length $message > 64) {
- &status("unparseable-moron: $message");
-# &performReply( &getRandom(keys %{ $lang{'moron'} }) );
- $count{'Moron'}++;
-
- &performReply("You are moron \002#". $count{'Moron'} ."\002");
- return;
- }
-
- &status("unparseable: $message");
- &performReply( &getRandom(keys %{ $lang{'dunno'} }) );
- $count{'Dunno'}++;
-}
-
1;
$new{$_} = $userstats{$_}{'Count'};
}
+ # todo: show top 3 with percentages?
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";
my $raw_perc2 = $cpu_usage2*100/$time;
my $perc;
my $perc2;
+ my $total;
+ my $ratio;
if ($raw_perc > 1) {
$perc = sprintf("%.01f", $raw_perc);
$perc2 = sprintf("%.01f", $raw_perc2);
+ $total = sprintf("%.01f", $raw_perc+$raw_perc2);
} elsif ($raw_perc > 0.1) {
$perc = sprintf("%.02f", $raw_perc);
$perc2 = sprintf("%.02f", $raw_perc2);
+ $total = sprintf("%.02f", $raw_perc+$raw_perc2);
} else { # <=0.1
$perc = sprintf("%.03f", $raw_perc);
$perc2 = sprintf("%.03f", $raw_perc2);
+ $total = sprintf("%.03f", $raw_perc+$raw_perc2);
}
+ $ratio = sprintf("%.01f", 100*$perc/($perc+$perc2) );
- &pSReply("Total CPU usage: $cpu_usage s ... Percentage CPU used: $perc % (+childs: $perc2 %)");
+ &pSReply("Total CPU usage: \002$cpu_usage\002 s ... ".
+ "Total used: \002$total\002 % ".
+ "(parent/child ratio: $ratio %)"
+ );
return;
}
if (!$conn->connected and time - $msgtime > 900) {
&status("reconnecting because of uncaught disconnect \@ ".scalar(localtime) );
### $irc->start;
+ &clearIRCVars();
$conn->connect();
### return;
}
# Usage: &dbGet($table, $select, $where);
sub dbGet {
my ($table, $select, $where) = @_;
- my $query = "SELECT $select FROM $table";
+ my $query = "SELECT $select FROM $table";
$query .= " WHERE $where" if ($where);
if (!defined $select) {
#####
#####
-# Usage: &getFactInfo($faqtoid, type);
+# Usage: &getFactInfo($faqtoid, $type);
# Note: getFactInfo does dbQuote
sub getFactInfo {
return &dbGet("factoids", $_[1], "factoid_key=".&dbQuote($_[0]) );
return 1;
}
-sub SQLDebug {
- return unless (&IsParam("SQLDebug"));
-
- return unless (fileno SQLDEBUG);
-
- print SQLDEBUG $_[0]."\n";
-}
-
sub dbCreateTable {
my($table) = @_;
my(@path) = (".","..","../..");
#
# db_pgsql.pl: PostgreSQL database frontend.
-# Author: dms <dms@users.sourceforge.net>
-# Version: v0.1 (20000629)
+# Author: dms
+# Version: v0.2 (20010908)
# Created: 20000629
#
if (&IsParam("useStrict")) { use strict; }
sub openDB {
- $dbh = Pg::connectdb("dbname=$param{'DBName'}");
-# $dbh = Pg::setdbLogin($param{'SQLHost'}, , , , $param{'DBName'},
-# $param{'SQLUser'}, $param{'SQLPass'});
+ my $connectstr="dbi:Pg:dbname=$param{DBName};";
+ $connectstr.=";host=$param{SQLHost}" if(defined $param{'SQLHost'});
+ $dbh = DBI->connect($connectstr, $param{'SQLUser'}, $param{'SQLPass'});
- if (PGRES_CONNECTION_OK eq $dbh->status) {
- &status("Opened pgSQL connection to $param{'SQLHost'}");
+ if (!$dbh->err) {
+ &status("Opened PgSQL connection to $param{'SQLHost'}");
} else {
&ERROR("cannot connect to $param{'SQLHost'}.");
- &ERROR("pgSQL: ".$dbh->errorMessage);
+ &ERROR("pgSQL: ".$dbh->errstr);
+
+ &closePID();
&closeSHM($shm);
&closeLog();
+
exit 1;
}
}
sub closeDB {
- if (!$dbh) {
- &WARN("closeDB: connection already closed?");
- return 0;
- }
+ return 0 unless ($dbh);
&status("Closed pgSQL connection to $param{'SQLHost'}.");
$dbh->disconnect();
+
return 1;
}
#####
# Usage: &dbQuote($str);
sub dbQuote {
- $_[0] =~ s/\'/\\\\'/g;
- return "'$_[0]'";
+ return $dbh->quote($_[0]);
+
+ $_ = $_[0];
+ s/'/\\'/g;
+ return "'$_'";
}
#####
-# Usage: &dbGet($table, $primkey, $primval, $select);
+# Usage: &dbGet($table, $select, $where);
sub dbGet {
- my ($table, $primkey, $primval, $select) = @_;
- my $query = "SELECT $select FROM $table WHERE $primkey=".
- &dbQuote($primval);
+ my ($table, $select, $where) = @_;
+ my $query = "SELECT $select FROM $table";
+ $query .= " WHERE $where" if ($where);
- my $res = $dbh->exec($query);
- if (PGRES_TUPLES_OK ne $res->resultStatus) {
- &ERROR("Get: $dbh->errorMessage");
+ if (!defined $select) {
+ &WARN("dbGet: select == NULL. table => $table");
return;
}
- if (!$sth->execute) {
- &ERROR("Get => '$query'");
- &ERROR("Get => $DBI::errstr");
+ my $sth;
+ if (!($sth = $dbh->prepare($query))) {
+ &ERROR("Get: prepare: $DBI::errstr");
return;
}
- my @retval = $res->fetchrow;
+ &SQLDebug($query);
+ if (!$sth->execute) {
+ &ERROR("Get: execute: '$query'");
+ $sth->finish;
+ return 0;
+ }
+
+ my @retval = $sth->fetchrow_array;
+
+ $sth->finish;
if (scalar @retval > 1) {
return @retval;
}
#####
-# Usage: &dbGetCol($table, $primkey, $key, [$type]);
+# Usage: &dbGetCol($table, $select, $where, [$type]);
sub dbGetCol {
- my ($table, $primkey, $key, $type) = @_;
- my $query = "SELECT $primkey,$key FROM $table WHERE $key IS NOT NULL";
+ my ($table, $select, $where, $type) = @_;
+ my $query = "SELECT $select FROM $table";
+ $query .= " WHERE ".$where if ($where);
my %retval;
my $sth = $dbh->prepare($query);
- &ERROR("GetCol => '$query'") unless $sth->execute;
+ &SQLDebug($query);
+ if (!$sth->execute) {
+ &ERROR("GetCol: execute: '$query'");
+ $sth->finish;
+ return;
+ }
- if (defined $type and $type == 1) {
+ if (defined $type and $type == 2) {
+ &DEBUG("dbgetcol: type 2!");
+ while (my @row = $sth->fetchrow_array) {
+ $retval{$row[0]} = join(':', $row[1..$#row]);
+ }
+ &DEBUG("dbgetcol: count => ".scalar(keys %retval) );
+
+ } elsif (defined $type and $type == 1) {
while (my @row = $sth->fetchrow_array) {
# reverse it to make it easier to count.
- $retval{$row[1]}{$row[0]} = 1;
+ if (scalar @row == 2) {
+ $retval{$row[1]}{$row[0]} = 1;
+ } elsif (scalar @row == 3) {
+ $retval{$row[1]}{$row[0]} = 1;
+ }
+ # what to do if there's only one or more than 3?
}
} else {
while (my @row = $sth->fetchrow_array) {
}
#####
-# Usage: &dbSet($table, $primkey, $primval, $key, $val);
+# 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) {
+ # todo: reverse it to make it easier to count.
+ }
+
+ $sth->finish;
+
+ return %retval;
+}
+
+####
+# Usage: &dbGetColInfo($table);
+sub dbGetColInfo {
+ my ($table) = @_;
+
+# my $query = "SELECT * FROM $table LIMIT 1;";
+ my $query = "SHOW COLUMNS from $table";
+ my %retval;
+
+ my $sth = $dbh->prepare($query);
+ &SQLDebug($query);
+ if (!$sth->execute) {
+ &ERROR("GRI => '$query'");
+ &ERROR("GRI => $DBI::errstr");
+ $sth->finish;
+ return;
+ }
+
+ if (0) {
+ %retval=%{$sth->fetchrow_hashref()};
+ return keys %retval;
+ }
+
+ my @cols;
+ while (my @row = $sth->fetchrow_array) {
+ push(@cols, $row[0]);
+ }
+ $sth->finish;
+
+ return @cols;
+}
+
+#####
+# Usage: &dbSet($table, $primhash_ref, $hash_ref);
+# Note: dbSet does dbQuote.
sub dbSet {
- my ($table, $primkey, $primval, $key, $val) = @_;
- my $query;
+ my ($table, $phref, $href) = @_;
+ my $where = join(' AND ', map {
+ $_."=".&dbQuote($phref->{$_})
+ } keys %{$phref}
+ );
- my $result = &dbGet($table,$primkey,$primval,$primkey);
+ my $result = &dbGet($table, join(',', keys %{$phref}), $where);
+
+ my(@keys,@vals);
+ foreach (keys %{$href}) {
+ push(@keys, $_);
+ push(@vals, &dbQuote($href->{$_}) );
+ }
+
+ if (!@keys or !@vals) {
+ &WARN("dbset: keys or vals is NULL.");
+ return;
+ }
+
+ my $query;
if (defined $result) {
- $query = "UPDATE $table SET $key=".&dbQuote($val).
- " WHERE $primkey=".&dbQuote($primval);
+ my @keyval;
+ for(my$i=0; $i<scalar @keys; $i++) {
+ push(@keyval, $keys[$i]."=".$vals[$i] );
+ }
+
+ $query = "UPDATE $table SET ".
+ join(' AND ', @keyval).
+ " WHERE $where";
} else {
- $query = "INSERT INTO $table ($primkey,$key) VALUES (".
- &dbQuote($primval).",".&dbQuote($val).")";
+ foreach (keys %{$phref}) {
+ push(@keys, $_);
+ push(@vals, &dbQuote($phref->{$_}) );
+ }
+
+ $query = sprintf("INSERT INTO $table (%s) VALUES (%s)",
+ join(',',@keys), join(',',@vals) );
}
&dbRaw("Set", $query);
}
#####
-# Usage: &dbUpdate($table, $primkey, $primval, $key, $val);
+# Usage: &dbUpdate($table, $primkey, $primval, %hash);
sub dbUpdate {
- my ($table, $primkey, $primval, $key, $val) = @_;
+ my ($table, $primkey, $primval, %hash) = @_;
+ my (@array);
+
+ foreach (keys %hash) {
+ push(@array, "$_=".&dbQuote($hash{$_}) );
+ }
- &dbRaw("Update", "UPDATE $table SET $key=".&dbQuote($val).
+ &dbRaw("Update", "UPDATE $table SET ".join(', ', @array).
" WHERE $primkey=".&dbQuote($primval)
);
}
#####
-# Usage: &dbInsert($table, $primkey, $primval, $key, $val);
+# Usage: &dbInsert($table, $primkey, $primval, %hash);
sub dbInsert {
- my ($table, $primkey, $primval, $key, $val) = @_;
+ my ($table, $primkey, $primval, %hash, $delay) = @_;
+ my (@keys, @vals);
+ my $p = "";
+
+ if ($delay) {
+ &DEBUG("dbI: delay => $delay");
+ $p = " DELAYED";
+ }
- &dbRaw("Insert", "INSERT INTO $table ($primkey,$key) VALUES (".
- &dbQuote($primval).",".&dbQuote($val).")"
+ foreach (keys %hash) {
+ push(@keys, $_);
+ push(@vals, &dbQuote($hash{$_}));
+ }
+
+ &dbRaw("Insert($table)", "INSERT $p INTO $table (".join(',',@keys).
+ ") VALUES (".join(',',@vals).")"
);
return 1;
}
#####
-# Usage: &dbSetRow($table, @values);
-sub dbSetRow {
- my ($table, @values) = @_;
+# Usage: &dbReplace($table, %hash);
+# Note: dbReplace does optional dbQuote.
+sub dbReplace {
+ my ($table, %hash) = @_;
+ my (@keys, @vals);
+ my $iquery = "INSERT INTO $table ";
+ my $uquery = "UPDATE $table SET ";
+
+ foreach (keys %hash) {
+ if (s/^-//) { # as is.
+ push(@keys, $_);
+ push(@vals, $hash{'-'.$_});
+ } else {
+ push(@keys, $_);
+ push(@vals, &dbQuote($hash{$_}));
+ }
+ $uquery .= "$keys[-1] = $vals[-1], ";
+ }
+ $uquery = ~s/, $/;/;
+ $iquery .= "(". join(',',@keys) .") VALUES (". join(',',@vals) .");";
+
+ &DEBUG($query) if (0);
+
+ if(!&dbRaw("Replace($table)", $iquery)) {
+ &dbRaw("Replace($table)", $uquery);
+ }
+
+ return 1;
+}
+
+#####
+# Usage: &dbSetRow($table, $vref, $delay);
+# Note: dbSetRow does dbQuote.
+sub dbSetRow ($@$) {
+ my ($table, $vref, $delay) = @_;
+ my $p = ($delay) ? " DELAYED " : "";
+
+ # see 'perldoc perlreftut'
+ my @values;
+ foreach (@{ $vref }) {
+ push(@values, &dbQuote($_) );
+ }
- foreach (@values) {
- $_ = &dbQuote($_);
+ if (!scalar @values) {
+ &WARN("dbSetRow: values array == NULL.");
+ return;
}
- return &dbRaw("SetRow", "INSERT INTO $table VALUES (".
+ return &dbRaw("SetRow", "INSERT $p INTO $table VALUES (".
join(",", @values) .")" );
}
#####
# Usage: &dbDel($table, $primkey, $primval, [$key]);
+# Note: dbDel does dbQuote
sub dbDel {
my ($table, $primkey, $primval, $key) = @_;
my ($prefix,$query) = @_;
my $sth;
- my $res = $dbh->exec($query);
- if (PGRES_COMMAND_OK ne $res->resultStatus) {
- &ERROR("Raw($prefix): $dbh->errorMessage");
+ if (!($sth = $dbh->prepare($query))) {
+ &ERROR("Raw($prefix): $DBI::errstr");
return 0;
}
- &DEBUG("Raw: oid status => '$res->oidStatus'.");
-
+ &SQLDebug($query);
if (!$sth->execute) {
&ERROR("Raw($prefix): => '$query'");
- &ERROR("Raw($prefix): $DBI::errstr");
+ $sth->finish;
return 0;
}
my @retval;
my $sth = $dbh->prepare($query);
+ &SQLDebug($query);
&ERROR("RawReturn => '$query'.") unless $sth->execute;
while (my @row = $sth->fetchrow_array) {
push(@retval, $row[0]);
#####
#####
-# Usage: &countKeys($table);
+# Usage: &countKeys($table, [$col]);
sub countKeys {
- my ($table) = @_;
+ my ($table, $col) = @_;
+ $col ||= "*";
- return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
+ return (&dbRawReturn("SELECT count($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);
-
- $sth->execute;
- while (my @row = $sth->fetchrow_array) {
- push(@retval, $row[0]);
- }
- $sth->finish;
+# Usage: &sumKey($table, $col);
+sub sumKey {
+ my ($table, $col) = @_;
- return @retval;
+ return (&dbRawReturn("SELECT sum($col) FROM $table"))[0];
}
#####
my $query = "SELECT $select FROM $table LIMIT $rand,1";
my $sth = $dbh->prepare($query);
- $sth->execute;
+ &SQLDebug($query);
+ &WARN("randKey($query)") unless $sth->execute;
my @retval = $sth->fetchrow_array;
$sth->finish;
return @retval;
}
+#####
+# Usage: &deleteTable($table);
+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;
my $query = "SELECT $select FROM $table WHERE $key LIKE ".
&dbQuote($str);
my $sth = $dbh->prepare($query);
- $sth->execute;
+ &SQLDebug($query);
+ if (!$sth->execute) {
+ &WARN("Search($query)");
+ return;
+ }
while (my @row = $sth->fetchrow_array) {
push(@results, $row[0]);
#####
#####
-# Usage: &getFactInfo($faqtoid, [$what]);
+# Usage: &getFactInfo($faqtoid, $type);
+# Note: getFactInfo does dbQuote
sub getFactInfo {
- return &dbGet("factoids", "factoid_key", $_[0], $_[1]);
+ return &dbGet("factoids", $_[1], "factoid_key=".&dbQuote($_[0]) );
}
#####
}
#####
-# Usage: &setFactInfo($faqtoid, $type, $what);
-sub setFactInfo {
- &dbSet("factoids", "factoid_key", $_[0], $_[1], $_[2]);
-}
-
+# Usage: &delFactoid($faqtoid);
sub delFactoid {
my ($faqtoid) = @_;
&dbDel("factoids", "factoid_key",$faqtoid);
- &status("DELETED $faqtoid");
+ &status("DELETED '$faqtoid'");
+
+ return 1;
+}
+#####
+#
+sub checkTables {
+ &FIXME("pgsql: checkTables(@_);");
return 1;
}
--- /dev/null
+#
+# db_mysql.pl: {my,pg}SQL database frontend.
+# Author: dms
+# Version: v0.1 (20010908)
+# Created: 20010908
+#
+
+package main;
+
+if (&IsParam("useStrict")) { use strict; }
+
+sub SQLDebug {
+ return unless (&IsParam("SQLDebug"));
+
+ return unless (fileno SQLDEBUG);
+
+ print SQLDEBUG $_[0]."\n";
+}
+
+1;
if (&IsParam("VERBOSITY")) {
if ($statcountfix) {
- printf $_red."!%5d!".$ob." ", $statcount;
+ printf $_red."!%6d!".$ob." ", $statcount;
} else {
- printf $_green."[%5d]".$ob." ", $statcount;
+ printf $_green."[%6d]".$ob." ", $statcount;
}
# three uberstabs to Derek Moeller.
&showProc(" (DBI // mysql)");
&status(" using MySQL support.");
+ require "$bot_src_dir/db_sql.pl";
require "$bot_src_dir/db_mysql.pl";
$moduleAge{"$bot_src_dir/db_mysql.pl"} = time();
&showProc(" (Pg // postgreSQLl)");
&status(" using PostgreSQL support.");
+ require "$bot_src_dir/db_sql.pl";
require "$bot_src_dir/db_pgsql.pl";
+
} elsif ($param{'DBType'} =~ /^dbm$/i) {
&status(" using Berkeley DBM 1.85/2.0 support.");
- &ERROR("dbm support is broken... you want it, you fix it!");
+ &ERROR("dbm support is broken... if you want it, fix it yourself!");
&shutdown();
exit 1;
projects / infobot.git / commitdiff