}
# google searching. Simon++
- if ($message =~ /^(?:search\s+)?(\S+)\s+for\s+['"]?(.*?)['"]?\s*\?*$/i) {
+ if ($message =~ /^(?:search\s+)?(\S+)\s+for\s+['"]?(.*?)["']?\s*\?*$/i) {
return unless (&hasParam("wwwsearch"));
&Forker("wwwsearch", sub { &W3Search::W3Search($1,$2); } );
my $arg = $3;
if (!defined $arg or $arg =~ /^\s*$/) {
- # this is fucking ugly but it works :-)
+ # this is way fucking ugly.
my $x = (&dbRawReturn("SELECT SUM(counter) FROM stats WHERE type=".&dbQuote($type) ))[0];
my %hash = &dbGetCol("stats", "nick,counter", "type=".&dbQuote($type).
- " ORDER BY nick DESC LIMIT 3", 1);
+ " ORDER BY counter DESC LIMIT 3", 1);
my $i;
my @top;
+
# unfortunately we have to sort it again!
# todo: make dbGetCol return hash and array? too much effort.
foreach $i (sort { $b <=> $a } keys %hash) {
next;
}
+ if (!defined $nick) {
+ &WARN("invalid line: $_");
+ next;
+ }
+
# nice little hack.
if ($what eq "HOSTS") {
$users{$nick}{$what}{$val} = 1;
$msgsize = length $msg;
}
- if ($msgType =~ /private/i) { # hack.
- $conn->privmsg($nick, $msg);
-
- } else {
- &DEBUG("msg: msgType is unknown!");
- }
+ $conn->privmsg($nick, $msg);
}
}
}
if ($netsplit and !exists $cache{netsplit}) {
- &DEBUG("on_join: ok.... re-running chanlimitCheck in 60.");
+ &VERB("on_join: ok.... re-running chanlimitCheck in 60.",2);
$conn->schedule(60, sub {
&chanlimitCheck();
delete $cache{netsplit};
&DEBUG("on_quit: nick $nick was not found in any chan.");
}
- &delUserInfo($nick, keys %channels);
-
- if (exists $nuh{lc $nick}) {
- delete $nuh{lc $nick};
- } else {
- # well.. it's good but weird that this has happened - lets just
- # be quiet about it.
- }
- delete $userstats{lc $nick} if (&IsChanConf("seenStats"));
- delete $chanstats{lc $nick};
-
# should fix chanstats inconsistencies bug #2.
if ($reason =~ /^($mask{host})\s($mask{host})$/) { # netsplit.
$reason = "NETSPLIT: $1 <=> $2";
# chanlimit code.
- my @l = &getNickInChans($nick);
- &DEBUG("on_quit: l => ".scalar(@l) );
-
foreach $chan ( &getNickInChans($nick) ) {
next unless ( &IsChanConf("chanlimitcheck") );
next unless ( exists $channels{$_}{'l'} );
&ERROR("^^^ THIS SHOULD NEVER HAPPEN (10).");
}
+ ###
+ ### ok... lets clear out the cache
+ ###
+ &delUserInfo($nick, keys %channels);
+ if (exists $nuh{lc $nick}) {
+ delete $nuh{lc $nick};
+ } else {
+ # well.. it's good but weird that this has happened - lets just
+ # be quiet about it.
+ }
+ delete $userstats{lc $nick} if (&IsChanConf("seenStats"));
+ delete $chanstats{lc $nick};
+ ###
+
# does this work?
if ($nick !~ /^\Q$ident\E$/ and $nick =~ /^\Q$param{'ircNick'}\E$/i) {
&status("nickchange: own nickname became free; changing.");
if (scalar keys %netsplitservers) {
if (defined $limit) {
- &DEBUG("chanlimit: removing it for $chan.");
+ &status("chanlimit: netsplit; removing it for $chan.");
&rawout("MODE $chan -l");
$cache{chanlimitChange}{$chan} = time();
}
return;
}
+ my $age = "New";
if ( -e "$file~" ) {
- $backup++ if ((stat $file)[9] - (stat "$file~")[9] > $time);
+ $backup++ if ((stat $file)[9] - (stat "$file~")[9] > $time);
+ my $delta = time() - (stat "$file~")[9];
+ $age = &Time2String($delta);
} else {
$backup++;
}
- return unless ($backup);
- # should delta be time(file) - time(file~)?
- my $delta = time() - (stat "$file~")[9];
- my $age = &Time2String($delta);
+ return unless ($backup);
### TODO: do internal copying.
&status("Backup: $file ($age)");
my $grepRE;
### TODO: search properly if /usr/bin/blah is done.
if ($query =~ s/\$$//) {
- &::DEBUG("deb: search-regex found.");
+ &::DEBUG("deb: search-regex found.") if ($debug);
$grepRE = "$query\[ \t]";
} elsif ($query =~ s/^\^//) {
- &::DEBUG("deb: front marker regex found.");
+ &::DEBUG("deb: front marker regex found.") if ($debug);
$front = 1;
$grepRE = $query;
} else {
my @list;
my $total = 0;
my $users = 0;
- foreach $rate (sort { $b <=> $a } keys %hash) {
+ foreach $rate (sort { $a <=> $b } keys %hash) {
my $f = join(", ", sort keys %{ $hash{$rate} });
- push(@list, "$f - ".&Time2String($rate));
+ my $str = "$f - ".&Time2String($rate);
+ $str =~ s/\002//g;
+ push(@list, $str);
}
my $prefix = "Rank of top factoid rate (time/req): ";
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;
}
sub checkTables {
+ my $database_exists = 0;
+ foreach (&dbRawReturn("SHOW DATABASES")) {
+ $database_exists++ if ($_ eq $param{'DBName'});
+ }
+
+ unless ($database_exists) {
+ &status("Creating database $param{DBName}...");
+ $query = "CREATE DATABASE $param{DBName}";
+ &dbRaw("create(db $param{DBName})", $query);
+ }
+
# retrieve a list of db's from the server.
my %db;
foreach ($dbh->func('_ListTables')) {
# create database.
if (!scalar keys %db) {
- &status("Creating database $param{'DBName'}...");
- $query = "CREATE DATABASE $param{'DBName'}";
- &dbRaw("create(db $param{'DBName'})", $query);
+# &status("Creating database $param{'DBName'}...");
+# $query = "CREATE DATABASE $param{'DBName'}";
+# &dbRaw("create(db $param{'DBName'})", $query);
}
foreach ("factoids", "freshmeat", "rootwarn", "seen", "stats",
);
### THIS IS NOT LOADED ON RELOAD :(
BEGIN {
- @myModulesLoadNow = ('topic', 'uptime', 'news');
+ @myModulesLoadNow = ('topic', 'uptime', 'news', 'rootWarn');
@myModulesReloadNot = ('IRC/Irc.pl','IRC/Schedulers.pl');
}
sub loadCoreModules {
- if (!opendir(DIR, $bot_src_dir)) {
- &ERROR("can't open source directory $bot_src_dir: $!");
- exit 1;
- }
+ my @mods = &getPerlFiles($bot_src_dir);
- my @mods;
- while (defined(my $file = readdir DIR)) {
- next unless $file =~ /\.pl$/;
- next unless $file =~ /^[A-Z]/;
- push(@mods, $file);
- }
- closedir DIR;
&status("Loading ".scalar(@mods)." CORE modules...");
foreach (sort @mods) {
}
sub loadFactoidsModules {
- &status("Loading Factoids modules...");
-
if (!&IsParam("factoids")) {
&status("Factoid support DISABLED.");
return;
}
- if (!opendir(DIR, "$bot_src_dir/Factoids")) {
- &ERROR("can't open source directory Factoids: $!");
- exit 1;
- }
+ &status("Loading Factoids modules...");
+
+ foreach ( &getPerlFiles("$bot_src_dir/Factoids") ) {
+ my $mod = "$bot_src_dir/Factoids/$_";
- while (defined(my $file = readdir DIR)) {
- next unless $file =~ /\.pl$/;
- next unless $file =~ /^[A-Z]/;
- my $mod = "$bot_src_dir/Factoids/$file";
- ### TODO: use eval and exit gracefully?
eval "require \"$mod\"";
if ($@) {
- &WARN("lFM: $@");
+ &ERROR("lFM: $@");
exit 1;
}
$moduleAge{$mod} = (stat $mod)[9];
- &showProc(" ($file)") if (&IsParam("DEBUG"));
+ &showProc(" ($_)") if (&IsParam("DEBUG"));
}
- closedir DIR;
}
sub loadIRCModules {
- &status("Loading IRC modules...");
if (&whatInterface() =~ /IRC/) {
+ &status("Loading IRC modules...");
+
eval "use Net::IRC";
if ($@) {
&ERROR("libnet-irc-perl is not installed!");
return;
}
- if (!opendir(DIR, "$bot_src_dir/IRC")) {
- &ERROR("can't open source directory Factoids: $!");
- exit 1;
- }
+ foreach ( &getPerlFiles("$bot_src_dir/IRC") ) {
+ my $mod = "$bot_src_dir/IRC/$_";
+
+ eval "require \"$mod\"";
+ if ($@) {
+ &ERROR("lIRCM => $@");
+ &shutdown();
+ exit 1;
+ }
- while (defined(my $file = readdir DIR)) {
- next unless $file =~ /\.pl$/;
- next unless $file =~ /^[A-Z]/;
- my $mod = "$bot_src_dir/IRC/$file";
- ### TODO: use eval and exit gracefully?
- require $mod;
$moduleAge{$mod} = (stat $mod)[9];
- &showProc(" ($file)") if (&IsParam("DEBUG"));
+ &showProc(" ($_)") if (&IsParam("DEBUG"));
}
- closedir DIR;
}
sub loadMyModulesNow {
next;
}
- &loadMyModule($myModules{$_});
+ # weird hack to get rootwarn to work.
+ # it may break on other cases though, any ideas?
+ &loadMyModule( $myModules{$_} || $myModules{lc $_} );
$loaded++;
}
### rename to moduleReloadAll?
sub reloadAllModules {
-### &status("Module: reloading all.");
- foreach (map { substr($_,2) } keys %moduleAge) {
+ &VERB("Module: reloading all.",2);
+
+ # obscure usage of map and regex :)
+ foreach (map { s/.*?\/?src/src/; $_ } keys %moduleAge) {
&reloadModule($_);
}
-### &status("Module: reloading done.");
+
+ &VERB("Module: reloading done.",2);
}
### rename to modulesReload?
$modulename = $tmp;
}
}
- my $modulefile = "$bot_src_dir/Modules/$modulebase";
+ $modulefile = "$bot_src_dir/Modules/$modulebase";
# call reloadModule() which checks age of file and reload.
if (grep /\/$modulebase$/, keys %INC) {
}
}
+sub getPerlFiles {
+ my($dir) = @_;
+
+ if (!opendir(DIR, $dir)) {
+ &ERROR("cannot open source directory $dir: $!");
+ exit 1;
+ }
+
+ my @mods;
+ while (defined(my $file = readdir DIR)) {
+ next unless $file =~ /\.pl$/;
+ next unless $file =~ /^[A-Z]/;
+ push(@mods, $file);
+ }
+ closedir DIR;
+
+ return reverse sort @mods;
+}
+
1;
projects / infobot.git / commitdiff