]> git.donarmstrong.com Git - infobot.git/blobdiff - src/Modules/Debian.pl
undo simonrvn default arch change
[infobot.git] / src / Modules / Debian.pl
index 3492165f2f1c4379885160b8152d16f647144426..69c7b21c70cc5395d21cd28e43460f5ce904f103 100644 (file)
@@ -8,23 +8,23 @@
 package Debian;
 
 use strict;
+no strict 'refs'; # FIXME: dstats aborts if set
 
 my $announce   = 0;
-my $defaultdist        = "sid";
-my $refresh = &::getChanConfDefault("debianRefreshInterval",7)
-                       * 60 * 60 * 24;
+my $defaultdist        = 'sid';
+my $refresh = &::getChanConfDefault('debianRefreshInterval', 7, $::chan) * 60 * 60 * 24;
 my $debug      = 0;
-my $debian_dir = "$::bot_state_dir/debian";
-my $country    = "ca";
-my $protocol   = "http";
+my $debian_dir = $::bot_state_dir . 'debian';
+my $country    = 'us'; # well .config it yourself then. ;-)
+my $protocol   = 'http';
 
 # format: "alias=real".
 my %dists      = (
-       "unstable"      => "sid",
-       "testing"       => "sarge",
-       "stable"        => "woody",
-       "old-stable"    => "potato",    # this still works?
-       "incoming"      => "incoming",
+       'unstable'      => 'sid',
+       'testing'       => 'etch',
+       'stable'        => 'sarge',
+       'oldstable'     => 'woody',
+       'incoming'      => 'incoming',
 );
 
 my %urlcontents = (
@@ -121,7 +121,7 @@ sub DebianDownload {
                $bad++;
                next;
            }
-       
+
        } else {
            &::ERROR("Debian: invalid format of url => ($url).");
            $bad++;
@@ -134,12 +134,12 @@ sub DebianDownload {
            next;
        }
 
-       my $exit = CORE::system("/bin/gzip -t $file >/dev/null 2>&1");
-       if ($exit) {
-           &::WARN("deb: $file is corrupted :/");
-           unlink $file;
-           next;
-       }
+#      my $exit = system("/bin/gzip -t $file");
+#      if ($exit) {
+#          &::WARN("deb: $file is corrupted ($exit) :/");
+#          unlink $file;
+#          next;
+#      }
 
        &::DEBUG("deb: download: good.") if ($debug);
        $good++;
@@ -175,19 +175,19 @@ sub searchContents {
     $query =~ s/^\s+|\s+$//g;
 
     if (!&::validExec($query)) {
-       &::msg($::who, "search string looks fuzzy.");
+       &::msg($::who, 'search string looks fuzzy.');
        return;
     }
 
-    if ($dist eq "incoming") {         # nothing yet.
-       &::DEBUG("sC: dist = 'incoming'. no contents yet.");
+    if ($dist eq 'incoming') {         # nothing yet.
+       &::DEBUG('sC: dist = "incoming". no contents yet.');
        return;
     } else {
        my %urls = &fixDist($dist, %urlcontents);
        # download contents file.
-       &::DEBUG("deb: download 1.") if ($debug);
+       &::DEBUG('deb: download 1.') if ($debug);
        if (!&DebianDownload($dist, %urls)) {
-           &::WARN("Debian: could not download files.");
+           &::WARN('Debian: could not download files.');
        }
     }
 
@@ -313,17 +313,17 @@ sub searchContents {
 
     my $prefix = "Debian Search of '$query' ";
     if (scalar @list) {        # @list.
-       &::pSReply( &::formListReply(0, $prefix, @list) );
+       &::performStrictReply( &::formListReply(0, $prefix, @list) );
        return;
     }
 
     # !@list.
     &::DEBUG("deb: ok, !\@list, searching desc for '$query'.") if ($debug);
-    my @list = &searchDesc($query);
+    @list = &searchDesc($query);
 
     if (!scalar @list) {
        my $prefix = "Debian Package/File/Desc Search of '$query' ";
-       &::pSReply( &::formListReply(0, $prefix, ) );
+       &::performStrictReply( &::formListReply(0, $prefix, ) );
 
     } elsif (scalar @list == 1) {      # list = 1.
        &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
@@ -331,7 +331,7 @@ sub searchContents {
 
     } else {                           # list > 1.
        my $prefix = "Debian Desc Search of '$query' ";
-       &::pSReply( &::formListReply(0, $prefix, @list) );
+       &::performStrictReply( &::formListReply(0, $prefix, @list) );
     }
 }
 
@@ -421,7 +421,7 @@ sub searchAuthor {
     my @list = keys %hash;
     if (scalar @list != 1) {
        my $prefix = "Debian Author Search of '$query' ";
-       &::pSReply( &::formListReply(0, $prefix, @list) );
+       &::performStrictReply( &::formListReply(0, $prefix, @list) );
        return 1;
     }
 
@@ -435,7 +435,7 @@ sub searchAuthor {
 
     my $email  = join(', ', keys %{ $maint{$list[0]} });
     my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 ";
-    &::pSReply( &::formListReply(0, $prefix, @pkg) );
+    &::performStrictReply( &::formListReply(0, $prefix, @pkg) );
 }
 
 ####
@@ -690,7 +690,7 @@ sub infoPackages {
 
     if (! -f $files[0]) {
        &::WARN("files[0] ($files[0]) doesn't exist.");
-       &::msg($::who, "WARNING: $files[0] does not exist? FIXME");
+       &::msg($::who, "FIXME: $files[0] does not exist?");
        return 'NULL';
     }
 
@@ -709,6 +709,8 @@ sub infoPackages {
     }
     my %pkg = &getPackageInfo($package, $file);
 
+    $query = "info" if ($query eq "dinfo");
+
     # 'fm'-like output.
     if ($query eq "info") {
        if (scalar keys %pkg <= 5) {
@@ -738,7 +740,7 @@ sub infoPackages {
                &::ERROR("iP: pkg $query is in incoming but we couldn't get any info?");
            }
        }
-    } 
+    }
 
     if ($dist eq "incoming") {
        $pkg{'info'} .= "Version: \002$pkg{'version'}\002";
@@ -760,7 +762,7 @@ sub infoPackages {
        }
     }
 
-    &::pSReply("$package: $pkg{$query}");
+    &::performStrictReply("$package: $pkg{$query}");
 }
 
 # Usage: &infoStats($dist);
@@ -781,7 +783,7 @@ sub infoStats {
     }
 
     my %stats;
-    my %total = (maint => 0, isize => 0, csize => 0);
+    my %total = (count => 0, maint => 0, isize => 0, csize => 0);
     my $file;
     foreach $file (keys %urlpackages) {
        $file =~ s/##DIST/$dist/g;      # won't work for incoming.
@@ -791,10 +793,10 @@ sub infoStats {
            next;
        }
 
-       open(IN, "zcat $file 2>&1 |");
+       open(IN, "zcat $debian_dir/$file 2>&1 |");
 
-       if (! -e $file) {
-           &::DEBUG("deb: iS: $file does not exist.");
+       if (! -e "$debian_dir/$file") {
+           &::DEBUG("deb: iS: $debian_dir/$file does not exist.");
            next;
        }
 
@@ -824,7 +826,7 @@ sub infoStats {
 
     ### TODO: don't count ppl with multiple email addresses.
 
-    &::pSReply(
+    &::performStrictReply(
        "Debian Distro Stats on $dist... ".
        "\002$total{'count'}\002 packages, ".
        "\002".scalar(keys %{ $total{'maint'} })."\002 maintainers, ".
@@ -1075,13 +1077,13 @@ sub DebianFind {
     my @results = sort &searchPackage($str);
 
     if (!scalar @results) {
-       &::Forker("debian", sub { &searchContents($str); } );
+       &::Forker("Debian", sub { &searchContents($str); } );
     } elsif (scalar @results == 1) {
        &::status("searchPackage returned one result; getting info of package instead!");
-       &::Forker("debian", sub { &infoPackages("info", "$results[0] $dist"); } );
+       &::Forker("Debian", sub { &infoPackages("info", "$results[0] $dist"); } );
     } else {
        my $prefix = "Debian Package Listing of '$query' ";
-       &::pSReply( &::formListReply(0, $prefix, @results) );
+       &::performStrictReply( &::formListReply(0, $prefix, @results) );
     }
 }
 
@@ -1108,13 +1110,13 @@ sub debianCheck {
     while (defined($file = readdir DEBIAN)) {
        next unless ($file =~ /(gz|bz2)$/);
 
-       # todo: add bzip2 support (debian doesn't do .bz2 anyway)
-       my $exit = system("/bin/gzip -t '$debian_dir/$file'");
-       next unless ($exit);
+       # TODO: add bzip2 support (debian doesn't do .bz2 anyway)
+       #my $exit = system("/bin/gzip -t '$debian_dir/$file'");
+       #next unless ($exit);
        &::DEBUG("deb: hmr... => ".(time() - (stat($file))[8])."'.");
        next unless (time() - (stat($file))[8] > 3600);
 
-       &::DEBUG("deb: dC: exit => '$exit'.");
+       #&::DEBUG("deb: dC: exit => '$exit'.");
        &::WARN("dC: '$debian_dir/$file' corrupted? deleting!");
        unlink $debian_dir."/".$file;
        $retval++;
@@ -1141,13 +1143,13 @@ sub searchDescFE {
 
     if (!scalar @list) {
        my $prefix = "Debian Desc Search of '$query' ";
-       &::pSReply( &::formListReply(0, $prefix, ) );
+       &::performStrictReply( &::formListReply(0, $prefix, ) );
     } elsif (scalar @list == 1) {      # list = 1.
        &::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
        &infoPackages("info", $list[0]);
     } else {                           # list > 1.
        my $prefix = "Debian Desc Search of '$query' ";
-       &::pSReply( &::formListReply(0, $prefix, @list) );
+       &::performStrictReply( &::formListReply(0, $prefix, @list) );
     }
 }