$questionWord = "where";
}
+ if (&IsChanConf("factoidArguments")) {
+ # to make it eleeter, split each arg and use "blah OR blah or BLAH"
+ # which will make it less than linear => quicker!
+ # todo: cache this, update cache when altered.
+ my @list = &searchTable("factoids", "factoid_key", "factoid_key", "CMD: ");
+
+ # from a design perspective, it's better to have the regex in
+ # the factoid key to reduce repetitive processing.
+
+ foreach (@list) {
+ s/^CMD: //;
+# &DEBUG("factarg: ''$query[0]' =~ /^$_\$/'");
+ my @vals;
+ my $arg = $_;
+
+ eval {
+ next unless ($query[0] =~ /^$arg$/i);
+
+ for ($i=1; $i<=5; $i++) {
+ $val = $$i;
+ last unless (defined $val);
+
+ push(@vals, $val);
+ }
+ };
+
+ if ($@) { # it failed!!!
+ &WARN("factargs: regex failed! '$query[0]' =~ /^$_\$/");
+ next;
+ }
+
+ &status("Question: factoid Arguments for '$query[0]'");
+ # todo: use getReply() - need to modify it :(
+ my $i = 0;
+ my $result = &getFactoid("CMD: $_");
+ $result =~ s/^\((.*?)\): //;
+
+ foreach ( split(',', $1) ) {
+ my $val = $vals[$i];
+ if (!defined $val) {
+ &status("factArgs: vals[$i] == undef; not SARing '$_' for '$query[0]'");
+ next;
+ }
+
+ &status("factArgs: SARing '$_' to '$vals[$i]'.");
+ $result =~ s/\Q$_\E/$vals[$i]/;
+ $i++;
+ }
+
+ # nasty hack to get partial &getReply() functionality.
+ $result =~ s/^\s*<action>\s*(.*)/\cAACTION $1\cA/i;
+ $result =~ s/^\s*<reply>\s*//i;
+
+ return $result;
+ }
+ }
+
my @link;
for (my$i=0; $i<scalar @query; $i++) {
$query = $query[$i];
# freshmeat
if (&IsChanConf("freshmeatForFactoid")) {
+ # todo: "name" is invalid for fm ][
if (&dbGet("freshmeat", "name", $lhs, "name")) {
&msg($who, "permission denied. (freshmeat)");
&status("alert: $who wanted to teach me something that freshmeat already has info on.");
}
}
+ if (&IsChanConf("factoidArguments") and $lhs =~ /\$/) {
+ &status("Update: Factoid Arguments found.");
+ &status("Update: orig lhs => '$lhs'.");
+ &status("Update: orig rhs => '$rhs'.");
+ $lhs =~ s/^/CMD: /;
+ my @list;
+ while ($lhs =~ s/\$(\S+)/(.*?)/) {
+ push(@list, "\$$1");
+ }
+ my $z = join(',',@list);
+ $rhs =~ s/^/($z): /;
+
+ &status("Update: new lhs => '$lhs'.");
+ &status("Update: new rhs => '$rhs'.");
+ }
+
# the fun begins.
my $exists = &getFactoid($lhs);
}
next unless (exists $ircPort{$host});
- my $retval = &irc($host, $ircPort{$host});
- &DEBUG("ircloop: after irc()");
-
+ my $retval = &irc($host, $ircPort{$host});
next unless (defined $retval and $retval == 0);
-
$error++;
if ($error % 3 == 0 and $error != 0) {
- &ERROR("CANNOT connect to this server; next!");
+ &status("IRC: Could not connect.");
+ &status("IRC: ");
next;
}
- if ($error >= 3*3) {
- &ERROR("CANNOT connect to any irc server; stopping.");
+ if ($error >= 3*2) {
+ &status("IRC: cannot connect to any IRC servers; stopping.");
+ &shutdown();
exit 1;
}
}
- &DEBUG("ircloop: end... going back.");
+ &status("IRC: ok, done one cycle of IRC servers; trying again.");
+
&loadIRCServers();
goto loop;
}
$irc = new Net::IRC;
- $conn = $irc->newconn(
+ my %args = (
Nick => $param{'ircNick'},
Server => $server,
Port => $port,
Ircname => $param{'ircName'},
- LocalAddr => $param{'ircHost'},
);
+ $args{'LocalAddr'} = $param{'ircHost'} if ($param{'ircHost'});
+
+ $conn = $irc->newconn(%args);
if (!defined $conn) {
&ERROR("irc: conn was not created!defined!!!");
# change internal timeout value for scheduler.
$irc->{_timeout} = 10; # how about 60?
+ # Net::IRC debugging.
+ $irc->{_debug} = 1;
$ircstats{'Server'} = "$server:$port";
sub quit {
my ($quitmsg) = @_;
&status("QUIT $param{'ircNick'} has quit IRC ($quitmsg)");
- $conn->quit($quitmsg);
+ if (defined $conn) {
+ $conn->quit($quitmsg);
+ } else {
+ &WARN("quit: could not quit!");
+ }
}
sub nick {
}
# !scalar @joinchan:
- if (exists $cache{joinTime}) {
- my $delta = time() - $cache{joinTime};
+ my @c = &getJoinChans();
+ if (exists $cache{joinTime} and scalar @c) {
+ my $delta = time() - $cache{joinTime} - 5;
my $timestr = &Time2String($delta);
- my $rate = sprintf("%.1f", $delta / &getJoinChans() );
+ my $rate = sprintf("%.1f", $delta / @c);
delete $cache{joinTime};
&DEBUG("time taken to join all chans: $timestr; rate: $rate sec/join");
}
- # chanserv check: global channels, in case we missed one.
+ # chanserv check: global channels, in case we missed one.
foreach ( &ChanConfList("chanServ_ops") ) {
&chanServCheck($_);
}
}
sub clearIRCVars {
-### &DEBUG("clearIRCVars() called!");
+# &DEBUG("clearIRCVars() called!");
undef %channels;
undef %floodjoin;
# sync time should be done in on_endofwho like in BitchX
if (exists $cache{jointime}{$chan}) {
- my $delta_time = sprintf("%.03f", &timeget() - $cache{jointime}{$chan});
+ my $delta_time = sprintf("%.03f", &timedelta($cache{jointime}{$chan}) );
$delta_time = 0 if ($delta_time < 0);
if ($delta_time > 100) {
&WARN("endofnames: delta_time > 100 ($delta_time)");
&status("$b_blue$chan$ob: [$chanstats]");
&chanServCheck($chan);
- &joinNextChan();
+ # schedule used to solve ircu (OPN) "target too fast" problems.
+ $conn->schedule(5, sub { &joinNextChan(); } );
}
sub on_init {
if (exists $netsplit{lc $who}) {
delete $netsplit{lc $who};
$netsplit = 1;
+ &netsplitCheck() if (time() != $sched{netsplitCheck}{TIME});
}
- if ($netsplit and !$netsplittime) {
+ if ($netsplit and !exists $cache{netsplit}) {
&DEBUG("on_join: ok.... re-running chanlimitCheck in 60.");
$conn->schedule(60, sub {
&chanlimitCheck();
- $netsplittime = undef;
+ delete $cache{netsplit};
} );
- $netsplittime = time();
+ $cache{netsplit} = time();
}
# how to tell if there's a netjoin???
# no need to go further.
return if ($netsplit);
+
# who == bot.
if ($who eq $ident or $who =~ /^$ident$/i) {
if (defined( my $whojoin = $cache{join}{$chan} )) {
if (exists $netsplit{lc $newnick}) {
&status("Netsplit: $newnick/$nick came back from netsplit and changed to original nick! removing from hash.");
delete $netsplit{lc $newnick};
+ &netsplitCheck() if (time() != $sched{netsplitCheck}{TIME});
}
my ($chan,$mode);
$netsplit{lc $nick} = time();
if (!exists $netsplitservers{$1}{$2}) {
- &status("netsplit detected between $1 and $2.");
+ &status("netsplit detected between $1 and $2 at [".scalar(localtime)."]");
$netsplitservers{$1}{$2} = time();
}
}
&ERROR("^^^ THIS SHOULD NEVER HAPPEN (10).");
}
+ # does this work?
if ($nick !~ /^\Q$ident\E$/ and $nick =~ /^\Q$param{'ircNick'}\E$/i) {
&status("nickchange: own nickname became free; changing.");
&nick($param{'ircNick'});
$cache{sleepTime} = time();
}
- } else {
- if (!exists $cache{TargetTooFast}) {
- &DEBUG("on_ttf: failed: $why");
- $cache{TargetTooFast}++;
- }
+ return;
+ }
+
+ if (!exists $cache{TargetTooFast}) {
+ &DEBUG("on_ttf: failed: $why");
+ $cache{TargetTooFast}++;
}
}
if ($ver =~ /bitchx/i) {
$ver{bitchx}{$nick} = $ver;
+
} elsif ($ver =~ /xc\!|xchat/i) {
$ver{xchat}{$nick} = $ver;
+
} elsif ($ver =~ /irssi/i) {
$ver{irssi}{$nick} = $ver;
+
} elsif ($ver =~ /epic/i) {
$ver{epic}{$nick} = $ver;
+
} elsif ($ver =~ /mirc/i) {
&DEBUG("verstats: mirc: $nick => '$ver'.");
$ver{mirc}{$nick} = $ver;
+
} elsif ($ver =~ /ircle/i) {
$ver{ircle}{$nick} = $ver;
+
} elsif ($ver =~ /ircII/i) {
$ver{ircII}{$nick} = $ver;
+
} elsif ($ver =~ /sirc /i) {
$ver{sirc}{$nick} = $ver;
+
} elsif ($ver =~ /kvirc/i) {
$ver{kvirc}{$nick} = $ver;
+
} elsif ($ver =~ /eggdrop/i) {
$ver{eggdrop}{$nick} = $ver;
+
} elsif ($ver =~ /xircon/i) {
$ver{xircon}{$nick} = $ver;
+
} else {
&DEBUG("verstats: other: $nick => '$ver'.");
$ver{other}{$nick} = $ver;
sub on_chanfull {
my ($self, $event) = @_;
my @args = $event->args;
+
&DEBUG("on_chanfull: args => @args");
&joinNextChan();
}
sub on_inviteonly {
my ($self, $event) = @_;
my @args = $event->args;
+
&DEBUG("on_inviteonly: args => @args");
&joinNextChan();
}
sub on_banned {
my ($self, $event) = @_;
my @args = $event->args;
+
&DEBUG("on_banned: args => @args");
&joinNextChan();
}
sub on_badchankey {
my ($self, $event) = @_;
my @args = $event->args;
+
&DEBUG("on_badchankey: args => @args");
&joinNextChan();
}
return if ($_[0] eq "2");
}
+ $cache{chanlimitCheck}++;
+ &DEBUG("clC: chanlimitCheck => $cache{chanlimitCheck}");
+
foreach $chan ( &ChanConfList("chanlimitcheck") ) {
next unless (&validChan($chan));
return if ($_[0] eq "2");
}
- &DEBUG("running netsplitCheck...");
+ $cache{'netsplitCache'}++;
+ &DEBUG("running netsplitCheck... $cache{netsplitCache}");
foreach $s1 (keys %netsplitservers) {
&DEBUG("nsC: s1 => $s1");
if (time() - $netsplitservers{$s1}{$s2} > 3600) {
&status("netsplit between $s1 and $s2 appears to be stale.");
delete $netsplitservers{$s1}{$s2};
+ &chanlimitCheck();
}
}
&DEBUG("nsC: netsplitservers: ".scalar(keys %netsplitservers) );
&DEBUG("nsC: netsplit: ".scalar(keys %netsplit) );
+ if (!scalar %netsplit and scalar %netsplitservers) {
+ &DEBUG("ok hash netsplit is NULL; purging hash netsplitservers");
+ undef %netsplitservers;
+ }
+
if ($count and !scalar keys %netsplit) {
&DEBUG("nsC: netsplit is hopefully gone. reinstating chanlimit check.");
&chanlimitCheck();
my $prefix = "broken factoid ";
return &formListReply(1, $prefix, @list);
+ } elsif ($type =~ /^total$/i) {
+ &status("factstats(total): starting...");
+ my $start_time = &timeget();
+ my @list;
+ my $str;
+ my($i,$j);
+ my %hash;
+
+ ### lets do it.
+ # total factoids requests.
+ $i = &sumKey("factoids", "requested_count");
+ push(@list, "total requests - $i");
+
+ # total factoids modified.
+ $str = &countKeys("factoids", "modified_by");
+ push(@list, "total modified - $str");
+
+ # total factoids modified.
+ $j = &countKeys("factoids", "requested_count");
+ $str = &countKeys("factoids", "factoid_key");
+ push(@list, "total non-requested - ".($str - $i));
+
+ # average request/factoid.
+ # i/j == total(requested_count)/count(requested_count)
+ $str = sprintf("%.01f", $i/$j);
+ push(@list, "average requested per factoid - $str");
+
+ # total prepared for deletion.
+ $str = scalar( &searchTable("factoids", "factoid_key", "factoid_value", " #DEL") );
+ push(@list, "total prepared for deletion - $str");
+
+ # total unique authors.
+ foreach ( &dbRawReturn("SELECT created_by FROM factoids WHERE created_by IS NOT NULL") ) {
+ /^(\S+)!/;
+ my $nick = lc $1;
+ $hash{$nick}++;
+ }
+ push(@list, "total unique authors - ".(scalar keys %hash) );
+ undef %hash;
+
+ # total unique requesters.
+ foreach ( &dbRawReturn("SELECT requested_by FROM factoids WHERE requested_by IS NOT NULL") ) {
+ /^(\S+)!/;
+ my $nick = lc $1;
+ $hash{$nick}++;
+ }
+ push(@list, "total unique requesters - ".(scalar keys %hash) );
+ undef %hash;
+
+ ### end of "job".
+
+ my $delta_time = &timedelta($start_time);
+ &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
+ $start_time = &timeget();
+
+ # bail out on no results.
+ if (scalar @list == 0) {
+ return 'no broken factoids... wooohoo.';
+ }
+
+ # parse the results.
+ my $prefix = "General factoid stiatistics ";
+ return &formListReply(1, $prefix, @list);
+
} elsif ($type =~ /^deadredir$/i) {
my @list = &searchTable("factoids", "factoid_key",
"factoid_value", "^<REPLY> see ");
$locMsg = sprintf("%1.12f", $locMsg);
$locMsg =~ s/\.?0+$//;
- if (length($locMsg) > 30) {
+ if (length $locMsg > 30) {
$locMsg = "a number with quite a few digits...";
}
} else {
if (defined $locMsg) {
&DEBUG("math: locMsg => '$locMsg'... FIXME");
} else {
- $locMsg = "undefined";
+ &status("math: could not really compute.");
+ $locMsg = "";
}
}
} else {
$locMsg = "";
}
- if ($locMsg ne $message) {
+ if (defined $logMsg and $locMsg ne $message) {
return $locMsg;
} else {
return '';
} elsif ($what =~ /^(latest|new)(\s+(.*))?$/i) {
&latest($3 || $chan, 1);
+# $::cmdstats{'News latest'}++;
+
+ } elsif ($what =~ /^stats?$/i) {
+ &stats();
} elsif ($what =~ /^list$/i) {
&list();
if (defined $x and ($x == 0 or $x == -1)) {
&::DEBUG("not updating time for $::who.");
} else {
+ if (!scalar keys %{ $::news{$chan} }) {
+ &DEBUG("news: should not add $chan/$::who to cache!");
+ }
+
$::newsuser{$chan}{$::who} = time();
}
}
if (!$flag) {
return unless ($unread);
- my $reply = "There are unread news in $chan ($unread unread, $total total). /msg $::ident news latest";
+ my $reply = "There are unread news in $chan ($unread unread, $total total). /msg $::ident news $::chan latest";
$reply .= " If you don't want further news notification, /msg $::ident news unnotify" if ($unread == $total);
&::notice($::who, $reply);
&::DEBUG("do_set: TODO...");
}
+sub stats {
+ &::DEBUG("News: stats called.");
+ &::msg($::who, "check my logs/console.");
+ my($i,$j) = (0,0);
+
+ # total request count.
+ foreach $chan (keys %::news) {
+ foreach (keys %{ $::news{$chan} }) {
+ $i += $::news{$chan}{$_}{Request_Count};
+ }
+ }
+ &::DEBUG("news: stats: total request count => $i");
+ $i = 0;
+
+ # total user cached.
+ foreach $chan (keys %::newsuser) {
+ $i += $::newsuser{$chan}{$_};
+ }
+ &::DEBUG("news: stats: total user cache => $i");
+ $i = 0;
+
+ # average latest time read.
+ my $t = time();
+ foreach $chan (keys %::newsuser) {
+ $i += $t - $::newsuser{$chan}{$_};
+ $j++;
+ }
+ &::DEBUG("news: stats: average latest time read: total time: $i");
+ &::DEBUG("... count: $j");
+ &::DEBUG(" average: ".sprintf("%.02f", $i/($j||1))." sec/user");
+ $i = $j = 0;
+}
+
1;
my %new;
foreach (keys %userstats) {
next unless (exists $userstats{$_}{'Count'});
+ if ($userstats{$_}{'Count'} =~ /^\D+$/) {
+ &WARN("userstats{$_}{Count} is non-digit.");
+ next;
+ }
+
$new{$_} = $userstats{$_}{'Count'};
}
- my($count) = (sort { $b <=> $a } keys %new)[0];
+ my($count) = (sort { $a <=> $b } keys %new)[0];
if ($count) {
$reply .= ". \002$count\002 has said the most with a total of \002$new{$count}\002 messages";
}
&status("parent caught SIG$sig (pid $$).") if (defined $sig);
&status("--- Start of quit.");
+ $ident ||= "blootbot"; # lame hack.
&closeDCC();
&closePID();
$shm = &openSHM();
&openSQLDebug() if (&IsParam("SQLDebug"));
&openDB($param{'DBName'}, $param{'SQLUser'}, $param{'SQLPass'});
+ &checkTables();
&status("Setup: ". &countKeys("factoids") ." factoids.");
&News::readNews() if (&ChanConfList("news"));
# reverse order of &setup().
&DEBUG("shutdown called.");
+ $ident ||= "blootbot"; # hack.
+
# opened files must be written to on shutdown/hup/whatever
# unless they're write-only, like uptime.
&writeUserFile();
#####
#####
-# Usage: &countKeys($table);
+# Usage: &countKeys($table, [$col]);
sub countKeys {
- my ($table) = @_;
+ my ($table, $col) = @_;
+ $col ||= "*";
+
+ return (&dbRawReturn("SELECT count($col) FROM $table"))[0];
+}
- return (&dbRawReturn("SELECT count(*) FROM $table"))[0];
+# Usage: &sumKey($table, $col);
+sub sumKey {
+ my ($table, $col) = @_;
+
+ return (&dbRawReturn("SELECT sum($col) FROM $table"))[0];
}
##### NOT USED.
print SQLDEBUG $_[0]."\n";
}
+sub dbCreateTable {
+ my($table) = @_;
+ my(@path) = (".","..","../..");
+ my $found = 0;
+ my $data;
+
+ foreach (@path) {
+ my $file = "$_/setup/$table.sql";
+ &DEBUG("dbCT: file => $file");
+ next unless ( -f $file );
+
+ &DEBUG("found!!!");
+
+ open(IN, $file);
+ $data = <IN>;
+
+ $found++;
+ last;
+ }
+
+ if (!$found) {
+ return 0;
+ } else {
+ &dbRaw("create($table)", $data);
+ return 1;
+ }
+}
+
+sub checkTables {
+ # retrieve a list of db's from the server.
+ my %db;
+ foreach ($dbh->func('_ListTables')) {
+ $db{$_} = 1;
+ }
+
+ # create database.
+ if (!scalar keys %db) {
+ &status("Creating database $param{'DBName'}...");
+ $query = "CREATE DATABASE $param{'DBName'}";
+ &dbRaw("create(db $param{'DBName'})", $query);
+ }
+
+ foreach ("factoids", "freshmeat", "karma", "rootwarn", "seen",
+ ) {
+ next if (exists $db{$_});
+ &status(" creating new table $_...");
+
+ &dbCreateTable($_);
+ }
+}
+
1;
projects / infobot.git / commitdiff