- added CR's here and there; minor reformatting

- finally found out why netsplitservers was bugging out
- added debugging info to factoid delete backup code.

git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@481 c11ca15a-4712-0410-83d8-924469b57eb5

diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl
index 951991855d1d7853027f2ba959742f87974218d4..de238bb28135671ba08716578e87ffe378fe3c94 100644 (file)
--- a/src/IRC/IrcHooks.pl
+++ b/src/IRC/IrcHooks.pl
@@ -357,6 +357,9 @@ sub on_endofnames {
     if (exists $cache{jointime}{$chan}) {
        my $delta_time = sprintf("%.03f", &timeget() - $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: sync in ${delta_time}s.");
     }

diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl
index 4566df6872f2047dba1554a33480900108d3858f..25544e9f4edb62df9befc5b2857aaf5faffecf4a 100644 (file)
--- a/src/IRC/Schedulers.pl
+++ b/src/IRC/Schedulers.pl
@@ -37,7 +37,7 @@ sub setupSchedulers {
     &freshmeatLoop(2);
     &kernelLoop(2);
     &wingateWriteFile(2);
-    &factoidCheck(2);
+    &factoidCheck(1);
     &newsFlush(1);
 
 #    my $count = map { exists $sched{$_}{TIME} } keys %sched;
@@ -294,7 +294,7 @@ sub newsFlush {
        my $i           = 0;
        my $total       = scalar(keys %{ $::news{$chan} });
 
-       &DEBUG("newsFlush: chan => $chan");
+       &DEBUG("newsFlush: chan => $chan (total => $total)");
 
        foreach $item (keys %{ $::news{$chan} }) {
            my $t = $::news{$chan}{$item}{Expire};
@@ -341,6 +341,9 @@ sub newsFlush {
            delete $::newsuser{$chan}{$_};
            $duser++;
        }
+
+       my $i = scalar(keys %{ $::newsuser{$chan} });
+       delete $::newsuser{$chan} unless ($i);
     }
 
     if ($delete or $duser) {
@@ -433,6 +436,9 @@ sub netsplitCheck {
                delete $netsplitservers{$s1}{$s2};
            }
        }
+
+       my $i = scalar(keys %{ $netsplitservers{$s1} });
+       delete $netsplitservers{$s1} unless ($i);
     }
 
     # %netsplit hash checker.
@@ -1025,7 +1031,7 @@ sub wingateWriteFile {
 
 sub factoidCheck {
     if (@_) {
-       &ScheduleThis(1440, "factoidCheck");
+       &ScheduleThis(720, "factoidCheck");
        return if ($_[0] eq "2");       # defer.
     }
 
@@ -1035,6 +1041,7 @@ sub factoidCheck {
 
     foreach (@list) {
        my $age = &getFactInfo($_, "modified_time");    
+       &DEBUG("fC: _ => '$_'; age => $age");
 
        if (!defined $age or $age !~ /^\d+$/) {
            if (scalar @list > 50) {
@@ -1045,16 +1052,18 @@ sub factoidCheck {
                }
            }
 
-           &WARN("old cruft (no time): $_");
+           &WARN("del factoid: old cruft (no time): $_");
            &delFactoid($_);
            next;
        }
 
+       &DEBUG("del factoid: delta => ".($time - $age) );
        next unless ($time - $age > $stale);
 
        my $fix = $_;
        $fix =~ s/ #DEL#$//g;
-       &DEBUG("safedel: Removing $fix ($_) for good.");
+       my $agestr = &Time2String($time - $age);
+       &DEBUG("safedel: Removing '$_' for good. [$agestr old]");
 
        &delFactoid($_);
     }

diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl
index 331493e5462302b7781b34f2d1545f9c7c58e891..2ae82cf6bfb41f6dc3ad2579be0d0bc1da58dd46 100644 (file)
--- a/src/Modules/Debian.pl
+++ b/src/Modules/Debian.pl
@@ -14,7 +14,7 @@ my $announce  = 0;
 my $defaultdist        = "sid";
 my $refresh = &::getChanConfDefault("debianRefreshInterval",7)
                        * 60 * 60 * 24;
-my $debug      = 1;
+my $debug      = 0;
 
 ### ... old
 #my %dists     = (
@@ -185,7 +185,7 @@ sub searchContents {
     } else {
        my %urls = &fixDist($dist, %urlcontents);
        # download contents file.
-       &::DEBUG("deb: download 1.");
+       &::DEBUG("deb: download 1.") if ($debug);
        if (!&DebianDownload($dist, %urls)) {
            &::WARN("Debian: could not download files.");
        }
@@ -200,10 +200,10 @@ sub searchContents {
     my $grepRE;
     ### TODO: search properly if /usr/bin/blah is done.
     if ($query =~ s/\$$//) {
-       &::DEBUG("search-regex found.");
+       &::DEBUG("deb: search-regex found.");
        $grepRE = "$query\[ \t]";
     } elsif ($query =~ s/^\^//) {
-       &::DEBUG("front marker regex found.");
+       &::DEBUG("deb: front marker regex found.");
        $front = 1;
        $grepRE = $query;
     } else {
@@ -315,7 +315,7 @@ sub searchContents {
        &::pSReply( &::formListReply(0, $prefix, @list) );
 
     } else {           # !@list.
-       &::DEBUG("ok, !\@list, searching desc for '$query'.");
+       &::DEBUG("deb: ok, !\@list, searching desc for '$query'.");
        my @list = &searchDesc($query);
 
        if (!scalar @list) {
@@ -323,7 +323,7 @@ sub searchContents {
            &::pSReply( &::formListReply(0, $prefix, ) );
 
        } elsif (scalar @list == 1) {   # list = 1.
-           &::DEBUG("list == 1; showing package info of '$list[0]'.");
+           &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
            &infoPackages("info", $list[0]);
 
        } else {                                # list > 1.
@@ -337,7 +337,7 @@ sub searchContents {
 # Usage: &searchAuthor($query);
 sub searchAuthor {
     my ($dist, $query) = &getDistroFromStr($_[0]);
-    &::DEBUG("searchAuthor: dist => '$dist', query => '$query'.");
+    &::DEBUG("deb: searchAuthor: dist => '$dist', query => '$query'.") if ($debug);
     $query =~ s/^\s+|\s+$//g;
 
     # start of search.
@@ -360,7 +360,7 @@ sub searchAuthor {
        $files .= " ".$_;
     }
 
-    &::DEBUG("good = $good, bad = $bad...");
+    &::DEBUG("deb: good = $good, bad = $bad...");
 
     if ($good == 0 and $bad != 0) {
        my %urls = &fixDist($dist, %urlpackages);
@@ -381,7 +381,7 @@ sub searchAuthor {
        } elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
            my($name,$email) = ($1,$2);
            if ($package eq "") {
-               &::DEBUG("sA: package == NULL.");
+               &::DEBUG("deb: sA: package == NULL.");
                next;
            }
            $maint{$name}{$email} = 1;
@@ -422,7 +422,7 @@ sub searchAuthor {
        return 1;
     }
 
-    &::DEBUG("showing all packages by '$list[0]'...");
+    &::DEBUG("deb: showing all packages by '$list[0]'...");
 
     my @pkg = sort keys %{ $pkg{$list[0]} };
 
@@ -439,7 +439,7 @@ sub searchAuthor {
 # Usage: &searchDesc($query);
 sub searchDesc {
     my ($dist, $query) = &getDistroFromStr($_[0]);
-    &::DEBUG("searchDesc: dist => '$dist', query => '$query'.");
+    &::DEBUG("deb: searchDesc: dist => '$dist', query => '$query'.");
     $query =~ s/^\s+|\s+$//g;
 
     # start of search.
@@ -462,14 +462,14 @@ sub searchDesc {
        $files .= " ".$_;
     }
 
-    &::DEBUG("good = $good, bad = $bad...");
+    &::DEBUG("deb(2): good = $good, bad = $bad...");
 
     if ($good == 0 and $bad != 0) {
        my %urls = &fixDist($dist, %urlpackages);
-       &::DEBUG("deb: download 2c.");
+       &::DEBUG("deb: download 2c.") if ($debug);
 
        if (!&DebianDownload($dist, %urls)) {
-           &::ERROR("Debian(sD): could not download files.");
+           &::ERROR("deb: sD: could not download files.");
            return;
        }
     }
@@ -516,7 +516,7 @@ sub generateIncoming {
     my $stale   = 0;
     $stale++ if (&::isStale($pkgfile.".gz", $refresh));
     $stale++ if (&::isStale($idxfile, $refresh));
-    &::DEBUG("gI: stale => '$stale'.");
+    &::DEBUG("deb: gI: stale => '$stale'.");
     return 0 unless ($stale);
 
     ### STATIC URL.
@@ -724,9 +724,9 @@ sub infoPackages {
                }
            }
        } else {
-           &::DEBUG("running debianCheck() due to problems (".scalar(keys %pkg).").");
+           &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).").");
            &debianCheck();
-           &::DEBUG("end of debianCheck()");
+           &::DEBUG("deb: end of debianCheck()");
 
            &::msg($::who,"Debian: Package appears to exist but I could not retrieve info about it...");
            return;
@@ -762,7 +762,7 @@ sub infoStats {
     $dist      = &getDistro($dist);
     return unless (defined $dist);
 
-    &::DEBUG("infoS: dist => '$dist'.");
+    &::DEBUG("deb: infoS: dist => '$dist'.");
 
     # download packages file if needed.
     my %urls = &fixDist($dist, %urlpackages);
@@ -778,16 +778,16 @@ sub infoStats {
     my $file;
     foreach $file (keys %urlpackages) {
        $file =~ s/##DIST/$dist/g;      # won't work for incoming.
-       &::DEBUG("file => '$file'.");
+       &::DEBUG("deb: file => '$file'.");
        if (exists $stats{$file}{'count'}) {
-           &::DEBUG("hrm... duplicate open with $file???");
+           &::DEBUG("deb: hrm... duplicate open with $file???");
            next;
        }
 
        open(IN,"zcat $file 2>&1 |");
 
        if (! -e $file) {
-           &::DEBUG("iS: $file does not exist.");
+           &::DEBUG("deb: iS: $file does not exist.");
            next;
        }
 
@@ -835,8 +835,6 @@ sub infoStats {
     return;
 }
 
-
-
 ###
 # HELPER FUNCTIONS FOR INFOPACKAGES...
 ###
@@ -853,9 +851,9 @@ sub generateIndex {
     foreach (@dists) {
        my $dist = &getDistro($_); # incase the alias is returned, possible?
        my $idx  = "debian/Packages-$dist.idx";
-       &::DEBUG("gI: dist => $dist.");
-       &::DEBUG("gI: idx  => $idx.");
-       &::DEBUG("gI: r    => $refresh.");
+       &::DEBUG("deb: gI: dist => $dist.");
+       &::DEBUG("deb: gI: idx  => $idx.");
+       &::DEBUG("deb: gI: r    => $refresh.");
 
        # TODO: check if any of the Packages file have been updated then
        #       regenerate it, even if it's not stale.
@@ -864,17 +862,17 @@ sub generateIndex {
        next unless (&::isStale($idx, $refresh));
 
        if (/^incoming$/i) {
-           &::DEBUG("gIndex: calling generateIncoming()!");
+           &::DEBUG("deb: gIndex: calling generateIncoming()!");
            &generateIncoming();
            next;
        }
 
        if (/^woody$/i) {
-           &::DEBUG("Copying old index of woody to -old");
+           &::DEBUG("deb: Copying old index of woody to -old");
            system("cp $idx $idx-old");
        }
 
-       &::DEBUG("gIndeX: calling DebianDownload($dist, ...).");
+       &::DEBUG("deb: gIndex: calling DebianDownload($dist, ...).");
        &DebianDownload($dist, %urlpackages);
 
        &::status("Debian: generating index for '$dist'.");
@@ -918,7 +916,7 @@ sub validPackage {
     my $olddist        = $dist;
     $dist = &getDistro($dist);
 
-    &::DEBUG("D: validPackage($package, $dist) called.") if ($debug);
+    &::DEBUG("deb: validPackage($package, $dist) called.") if ($debug);
 
     my $error = 0;
     while (!open(IN, "debian/Packages-$dist.idx")) {
@@ -967,7 +965,7 @@ sub searchPackage {
 
     while (!open(IN, $file)) {
        if ($dist eq "incoming") {
-           &::DEBUG("sP: dist == incoming; calling gI().");
+           &::DEBUG("deb: sP: dist == incoming; calling gI().");
            &generateIncoming();
        }
 
@@ -977,7 +975,7 @@ sub searchPackage {
        }
 
        $error++;
-       &::DEBUG("should we be doing this?");
+       &::DEBUG("deb: should we be doing this?");
        &generateIndex(($dist));
     }
 
@@ -988,10 +986,10 @@ sub searchPackage {
            $file = $1;
 
            if (&::isStale($file, $refresh)) {
-               &::DEBUG("STALE $file! regen.");
+               &::DEBUG("deb: STALE $file! regen.");
                &generateIndex(($dist));
 ###            @files = searchPackage("$query $dist");
-               &::DEBUG("EVIL HACK HACK HACK.");
+               &::DEBUG("deb: EVIL HACK HACK HACK.");
                last;
            }
 
@@ -1015,12 +1013,12 @@ sub getDistro {
     my $dist = $_[0];
 
     if (!defined $dist or $dist eq "") {
-       &::DEBUG("gD: dist == NULL; dist = defaultdist.");
+       &::DEBUG("deb: gD: dist == NULL; dist = defaultdist.");
        $dist = $defaultdist;
     }
 
     if ($dist =~ /^(slink|hamm|rex|bo)$/i) {
-       &::DEBUG("Debian: deprecated version ($dist).");
+       &::DEBUG("deb: deprecated version ($dist).");
        &::msg($::who, "Debian: deprecated distribution version.");
        return;
     }
@@ -1109,10 +1107,10 @@ sub debianCheck {
 
        my $exit = system("gzip -t '$dir/$file'");
        next unless ($exit);
-       &::DEBUG("hmr... => ".(time() - (stat($file))[8])."'.");
+       &::DEBUG("deb: hmr... => ".(time() - (stat($file))[8])."'.");
        next unless (time() - (stat($file))[8] > 3600);
 
-       &::DEBUG("dC: exit => '$exit'.");
+       &::DEBUG("deb: dC: exit => '$exit'.");
        &::WARN("dC: '$dir/$file' corrupted? deleting!");
        unlink $dir."/".$file;
        $retval++;
@@ -1133,7 +1131,7 @@ sub checkEval {
 }
 
 sub searchDescFE {
-    &::DEBUG("FE called for searchDesc");
+    &::DEBUG("deb: FE called for searchDesc");
     my ($query)        = @_;
     my @list = &searchDesc($query);
 
@@ -1141,7 +1139,7 @@ sub searchDescFE {
        my $prefix = "Debian Desc Search of '$query' ";
        &::pSReply( &::formListReply(0, $prefix, ) );
     } elsif (scalar @list == 1) {      # list = 1.
-       &::DEBUG("list == 1; showing package info of '$list[0]'.");
+       &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
        &infoPackages("info", $list[0]);
     } else {                           # list > 1.
        my $prefix = "Debian Desc Search of '$query' ";

diff --git a/src/Process.pl b/src/Process.pl
index 1862e7a61040812f35ac91d38ec6705d3ad03735..fffba84f174ca5451b43f80e6e179fc2aa285fd2 100644 (file)
--- a/src/Process.pl
+++ b/src/Process.pl
@@ -399,25 +399,33 @@ sub FactoidStuff {
            return 'locked factoid' if (&IsLocked($faqtoid) == 1);
 
            if (&IsParam("factoidDeleteDelay")) {
-               if ($faqtoid =~ /#DEL#/ and !&IsFlag("o")) {
+               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#");
+               &DEBUG("Process: check => '$check'.");
+
                if (!$check) {
-                   if ($faqtoid !~ /#DEL#/) {
+                   if ($faqtoid !~ / #DEL#$/) {
+                       &DEBUG("Process: backing up $faqtoid to '$new'.");
                        my $new = $faqtoid." #DEL#";
+                       # this looks weird but does it work?
                        &setFactInfo($faqtoid, "factoid_key", $new);
                        &setFactInfo($new, "modified_by", $who);
                        &setFactInfo($new, "modified_time", time());
+
                    } else {
                        &status("not backing up $faqtoid.");
                    }
+
                } else {
                    &status("forget: not overwriting backup!");
                }
+
            } else {
                &status("forget: <$who> '$faqtoid' =is=> '$result'");
            }

diff --git a/src/UserExtra.pl b/src/UserExtra.pl
index 5a117a978b1d3159702a05e3c242c9852fb15443..2672304ae90728e9999c00bd476c881a96030fbe 100644 (file)
--- a/src/UserExtra.pl
+++ b/src/UserExtra.pl
@@ -678,21 +678,26 @@ sub userCommands {
 
        # utime(13) + stime(14).
        my $cpu_usage   = sprintf("%.01f", ($data[13]+$data[14]) / 100 );
+       # cutime(15) + cstime (16).
+       my $cpu_usage2  = sprintf("%.01f", ($data[15]+$data[16]) / 100 );
        my $time        = time() - $^T;
        my $raw_perc    = $cpu_usage*100/$time;
+       my $raw_perc2   = $cpu_usage2*100/$time;
        my $perc;
+       my $perc2;
 
        if ($raw_perc > 1) {
            $perc       = sprintf("%.01f", $raw_perc);
+           $perc2      = sprintf("%.01f", $raw_perc2);
        } elsif ($raw_perc > 0.1) {
            $perc       = sprintf("%.02f", $raw_perc);
+           $perc2      = sprintf("%.02f", $raw_perc2);
        } else {                        # <=0.1
            $perc       = sprintf("%.03f", $raw_perc);
+           $perc2      = sprintf("%.03f", $raw_perc2);
        }
 
-       &pSReply("Total CPU usage: $cpu_usage s ... Percentage CPU used: $perc %");
-       &DEBUG("15 => $data[15] (cutime)");
-       &DEBUG("16 => $data[16] (cstime)");
+       &pSReply("Total CPU usage: $cpu_usage s ... Percentage CPU used: $perc % (+childs: $perc2 %)");
 
        return;
     }