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) {
# 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);
}
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) {
"saying\002:\002 '$seen[4]'.";
}
- &performStrictReply($reply);
+ &pSReply($reply);
return;
}
}
foreach (keys %opts) {
- next unless ($opts{$_} > 1);
+ next unless ($opts{$_} > 2);
&DEBUG(" opts{$_} => $opts{$_}");
}
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",
sub setFactInfo {
&dbSet("factoids",
{ factoid_key => $_[0] },
- { $_[1] => $_[2] }
+ { $_[1] => $_[2] } # dbquote done in dbset!
);
}
# 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++) {
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) ) {
if (!$done) {
&status("factArgs: SARing '$_' to '$vals[$i]'.");
- $result =~ s/\Q$_\E/$vals[$i]/;
+ $result =~ s/\Q$_\E/$vals[$i]/g;
}
$i++;
}
$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;
$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;
$reply =~ s/\$rand/$rand/g;
}
- $reply =~ s/\$factoid/$lhs/g;
$reply =~ s/\$ident/$ident/g;
if ($reply =~ /\$startTime/) {
# 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;
&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");
}
}
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) );
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) );
### run NAMES again and flush it.
}
- next unless (!defined $limit);
if (defined $limit and $limit == $newlimit) {
$cache{chanlimitChange}{$chan} = time();
next;
my ($s1,$s2);
if (@_) {
- &ScheduleThis(30, "netsplitCheck");
+ &ScheduleThis(15, "netsplitCheck");
return if ($_[0] eq "2");
}
### 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, (
sub ircCheck {
if (@_) {
- &ScheduleThis(60, "ircCheck");
+ &ScheduleThis(15, "ircCheck");
return if ($_[0] eq "2"); # defer.
}
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);
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;
$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);
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]} };
$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;
}
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.
}
$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) {
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;
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;
{ "latest_version" => time() }
);
- &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
+# &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
@cols = &::dbGetColInfo("freshmeat");
$locktime = time();
}
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);
}
$i++;
- &::dbSetRow("freshmeat", @data);
+ &::dbSetRow("freshmeat", [@data], "DELAY");
undef @data;
undef %pkg;
# 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");
}
}
}
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"
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 = $_;
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.
return;
}
+ $cache{confvars}{$what} = $val;
+ &rehashConfVars();
+
foreach (@chans) {
&chanSet($cmd, $_, $what, $val);
}
$chanconf{$_}{$args} = $val;
}
delete $chanconf{_default}{$args};
+ $cache{confvars}{$args} = 0;
+ &rehashConfVars();
return;
}
&DEBUG("delete chanconf{$_}{$args};");
delete $chanconf{$_}{$args};
}
+ $cache{confvars}{$args} = 0;
+ &rehashConfVars();
return;
}
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 {
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 {
# &performReply( &getRandom(keys %{ $lang{'moron'} }) );
$count{'Moron'}++;
- &performReply("You are moron #".$count{'Moron'}."!");
+ &performReply("You are moron \002#". $count{'Moron'} ."\002");
return;
}
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");
$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));
my $startString = scalar(localtime $^T);
my $upString = &Time2String(time() - $^T);
my $count = &countKeys("factoids");
+
$count{'Commands'} = 0;
foreach (keys %cmdstats) {
$count{'Commands'} += $cmdstats{$_};
"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;
}
&closeDCC();
&closePID();
+ &closeStats();
&seenFlush();
&quit($param{'quitMsg'}) if (&whatInterface() =~ /IRC/);
&writeUserFile();
### 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;
} else {
&ERROR("cannot connect to $param{'SQLHost'}.");
&ERROR("since mysql is not available, shutting down bot!");
- &shutdown();
&closePID();
+ &closeSHM($shm);
+ &closeLog();
+
exit 1;
}
}
&status("Closed MySQL connection to $param{'SQLHost'}.");
$dbh->disconnect();
+
return 1;
}
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 {
#####
# Usage: &dbSet($table, $primhash_ref, $hash_ref);
+# Note: dbSet does dbQuote.
sub dbSet {
my ($table, $phref, $href) = @_;
my $where = join(' AND ', map {
#####
# Usage: &dbUpdate($table, $primkey, $primval, %hash);
+# Note: dbUpdate does dbQuote.
sub dbUpdate {
my ($table, $primkey, $primval, %hash) = @_;
my (@array);
#####
# Usage: &dbInsert($table, $primkey, %hash);
+# Note: dbInsert does dbQuote.
sub dbInsert {
my ($table, $primkey, %hash, $delay) = @_;
my (@keys, @vals);
#####
# Usage: &dbReplace($table, %hash);
+# Note: dbReplace does optional dbQuote.
sub dbReplace {
my ($table, %hash) = @_;
my (@keys, @vals);
}
#####
-# 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 (".
#####
# Usage: &dbDel($table, $primkey, $primval, [$key]);
+# Note: dbDel does dbQuote
sub dbDel {
my ($table, $primkey, $primval, $key) = @_;
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 {
&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;
&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]);
#####
# 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]) );
}
#####
sub SQLDebug {
return unless (&IsParam("SQLDebug"));
- return if (!fileno SQLDEBUG);
+ return unless (fileno SQLDEBUG);
print SQLDEBUG $_[0]."\n";
}
&DEBUG("dbCT: file => $file");
next unless ( -f $file );
- &DEBUG("found!!!");
+ &DEBUG("dbCT: found!!!");
open(IN, $file);
while (<IN>) {
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'});
}
projects / infobot.git / commitdiff