take a few more things literally

[infobot.git] / src / Modules / Debian.pl

diff --git a/src/Modules/Debian.pl b/src/Modules/Debian.pl
index 45d7834cd50e96c222500d08063ce97d6f5ab268..6d0e3965405df4c521ff2efacdc4d950ff4bfa43 100644 (file)
--- a/src/Modules/Debian.pl
+++ b/src/Modules/Debian.pl
@@ -8,24 +8,23 @@
 package Debian;
 
 use strict;
-no strict 'refs'; # FIXME dstats aborts if set
+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    = "us"; # well .config it yourself then. ;-)
-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",
-       "oldstable"     => "potato",
-       "incoming"      => "incoming",
+       'unstable'      => 'sid',
+       'testing'       => 'lenny',
+       'stable'        => 'etch',
+       'oldstable'     => 'sarge',
+       'incoming'      => 'incoming',
 );
 
 my %urlcontents = (
@@ -135,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++;
@@ -176,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.');
        }
     }
 
@@ -211,7 +210,7 @@ sub searchContents {
        $grepRE = "$query*\[ \t]";
     }
 
-    # fix up grepRE for "*".
+    # fix up grepRE for '*'.
     $grepRE =~ s/\*/.*/g;
 
     my @files;
@@ -314,7 +313,7 @@ sub searchContents {
 
     my $prefix = "Debian Search of '$query' ";
     if (scalar @list) {        # @list.
-       &::pSReply( &::formListReply(0, $prefix, @list) );
+       &::performStrictReply( &::formListReply(0, $prefix, @list) );
        return;
     }
 
@@ -324,15 +323,15 @@ sub searchContents {
 
     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]'.");
-       &infoPackages("info", $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) );
     }
 }
 
@@ -383,13 +382,13 @@ sub searchAuthor {
 
        } elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
            my($name,$email) = ($1,$2);
-           if ($package eq "") {
+           if ($package eq '') {
                &::DEBUG("deb: sA: package == NULL.");
                next;
            }
            $maint{$name}{$email} = 1;
            $pkg{$name}{$package} = 1;
-           $package = "";
+           $package = '';
 
        } else {
            chop;
@@ -422,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;
     }
 
@@ -436,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) );
 }
 
 ####
@@ -493,13 +492,13 @@ sub searchDesc {
            next unless (eval { $desc =~ /$regex/i });
            return unless &checkEval($@);
 
-           if ($package eq "") {
+           if ($package eq '') {
                &::WARN("sD: package == NULL?");
                next;
            }
 
            $desc{$package} = $desc;
-           $package = "";
+           $package = '';
 
        } else {
            chop;
@@ -547,7 +546,7 @@ sub generateIncoming {
            print IDX "$1\n";
            print PKG "Package: $1\n";
            print PKG "Version: $2\n";
-           print PKG "Architecture: ", (defined $4) ? $4 : "all", "\n";
+           print PKG "Architecture: ", (defined $4) ? $4 : 'all', "\n";
        }
        print PKG "Filename: $file\n";
        print PKG "Size: $ftp{$file}\n";
@@ -659,7 +658,7 @@ sub infoPackages {
     # download packages file.
     # hrm...
     my %urls = &fixDist($dist, %urlpackages);
-    if ($dist ne "incoming") {
+    if ($dist ne 'incoming') {
        &::DEBUG("deb: download 3.") if ($debug);
 
        if (!&DebianDownload($dist, %urls)) {   # no good download.
@@ -672,7 +671,7 @@ sub infoPackages {
     my @files = &validPackage($package, $dist);
     if (!scalar @files) {
        &::status("Debian: no valid package found; checking incoming.");
-       @files = &validPackage($package, "incoming");
+       @files = &validPackage($package, 'incoming');
 
        if (scalar @files) {
            &::status("Debian: cool, it exists in incoming.");
@@ -691,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';
     }
 
@@ -710,10 +709,10 @@ sub infoPackages {
     }
     my %pkg = &getPackageInfo($package, $file);
 
-    $query = "info" if ($query eq "dinfo");
+    $query = 'info' if ($query eq 'dinfo');
 
     # 'fm'-like output.
-    if ($query eq "info") {
+    if ($query eq 'info') {
        if (scalar keys %pkg <= 5) {
            &::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).").");
            &debianCheck();
@@ -743,27 +742,27 @@ sub infoPackages {
        }
     }
 
-    if ($dist eq "incoming") {
+    if ($dist eq 'incoming') {
        $pkg{'info'} .= "Version: \002$pkg{'version'}\002";
        $pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
        $pkg{'info'} .= ", is in incoming!!!";
     }
 
     if (!exists $pkg{$query}) {
-       if ($query eq "suggests") {
+       if ($query eq 'suggests') {
            $pkg{$query} = "has no suggestions";
-       } elsif ($query eq "conflicts") {
+       } elsif ($query eq 'conflicts') {
            $pkg{$query} = "does not conflict with any other package";
-       } elsif ($query eq "depends") {
+       } elsif ($query eq 'depends') {
            $pkg{$query} = "does not depend on anything";
-       } elsif ($query eq "maint") {
+       } elsif ($query eq 'maint') {
            $pkg{$query} = "has no maintainer";
        } else {
            $pkg{$query} = "has nothing about $query";
        }
     }
 
-    &::pSReply("$package: $pkg{$query}");
+    &::performStrictReply("$package: $pkg{$query}");
 }
 
 # Usage: &infoStats($dist);
@@ -827,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, ".
@@ -968,7 +967,7 @@ sub searchPackage {
     unlink $file if ( -z $file );
 
     while (!open IN, $file) {
-       if ($dist eq "incoming") {
+       if ($dist eq 'incoming') {
            &::DEBUG("deb: sP: dist == incoming; calling gI().");
            &generateIncoming();
        }
@@ -1016,7 +1015,7 @@ sub searchPackage {
 sub getDistro {
     my $dist = $_[0];
 
-    if (!defined $dist or $dist eq "") {
+    if (!defined $dist or $dist eq '') {
        &::DEBUG("deb: gD: dist == NULL; dist = defaultdist.");
        $dist = $defaultdist;
     }
@@ -1078,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) );
     }
 }
 
@@ -1111,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++;
@@ -1144,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]);
+       &infoPackages('info', $list[0]);
     } else {                           # list > 1.
        my $prefix = "Debian Desc Search of '$query' ";
-       &::pSReply( &::formListReply(0, $prefix, @list) );
+       &::performStrictReply( &::formListReply(0, $prefix, @list) );
     }
 }