fix freshmeat for dbm, (should not break others)

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

diff --git a/src/Modules/Freshmeat.pl b/src/Modules/Freshmeat.pl
index c33685f34adf723cd43afdf6c7ddaa1a63d1a4f6..f543c544e507e74a260171f16daa323b74f66074 100644 (file)
--- a/src/Modules/Freshmeat.pl
+++ b/src/Modules/Freshmeat.pl
@@ -22,7 +22,7 @@ sub Freshmeat {
     my $refresh        = &::getChanConfDefault("freshmeatRefreshInterval",
                        "", 24) * 60 * 60 * 7;
 
-    my $last_refresh = &::dbGet("freshmeat", "latest_version", "projectname_short='_'");
+    my $last_refresh = &::dbGet("freshmeat", "latest_version", "projectname_short=".&::dbQuote('_'));
     my $renewtable   = 0;
 
     if (defined $last_refresh and $last_refresh =~ /^\d+$/) {
@@ -35,8 +35,7 @@ sub Freshmeat {
     if ($renewtable) {
        if ($$ == $::bot_pid) {
            &::Forker("freshmeat", sub {
-               &downloadIndex();
-               &Freshmeat($sstr);
+               &Freshmeat($sstr) if &downloadIndex();
            } );
            # both parent/fork runs here, in case the following looks weird.
        } else {
@@ -82,21 +81,25 @@ sub Freshmeat {
     }
 }
 
-sub showPackage {
+sub packageText {
     my ($pkg)  = @_;
-    my @fm     = &::dbGet("freshmeat", "*",
-                       "projectname_short=".&::dbQuote($pkg) );
+    my %fm     = &::dbGetColNiceHash("freshmeat", "*", "projectname_short=".&::dbQuote($pkg));
 
-    if (scalar @fm) {          #1: perfect match of name.
+    if (scalar keys %fm) {             #1: perfect match of name.
        my $retval;
-       $retval  = "$fm[0] \002(\002$fm[5]\002)\002, ";
-#      $retval .= "section $fm[3], ";
-       $retval .= "is $fm[2]. ";
-       $retval .= "Version: \002$fm[1]\002, ";
-#      $retval .= "Development: \002$fm[2]\002. ";
-       $retval .= $fm[4];
-### ???
-#      $retval .= " deb: ".$fm[3] if ($fm[3] ne ""); # 'deb'.
+       $retval  = "$fm{'projectname_short'} \002(\002$fm{'desc_short'}\002)\002, ";
+       $retval .= "is $fm{'license'}. ";
+       $retval .= "Version: \002$fm{'latest_version'}\002, $fm{'url_homepage'}";
+       return $retval;
+    } else {
+       return;
+    }
+}
+
+sub showPackage {
+    my ($pkg) = @_;
+    my ($retval);
+    if ($retval = packageText($pkg)) {
        &::performStrictReply($retval);
        return 1;
     } else {
@@ -105,23 +108,8 @@ sub showPackage {
 }
 
 sub randPackage {
-    my @fm     = &::randKey("freshmeat","*");
-
-    if (scalar @fm) {          #1: perfect match of name.
-       my $retval;
-       $retval  = "$fm[0] \002(\002$fm[5]\002)\002, ";
-#      $retval .= "section $fm[3], ";
-       $retval .= "is $fm[2]. ";
-       $retval .= "Version: \002$fm[1]\002, ";
-#      $retval .= "Development: \002$fm[2]\002. ";
-       $retval .= $fm[4];
-### ???
-#      $retval .= " deb: ".$fm[3] if ($fm[3] ne ""); # 'deb'.
-
-       return $retval;
-    } else {
-       return;
-    }
+    my @fm = &::randKey("freshmeat","*");
+    return &packageText($fm[0]);
 }
 
 sub downloadIndex {
@@ -130,7 +118,7 @@ sub downloadIndex {
 
     if (!&::loadPerlModule("XML::Parser")) {
        &::WARN("don't have xml::parser...");
-       return;
+       return 0;
     }
     my $p = new XML::Parser(Style => 'Objects');
     my %pkg;
@@ -161,14 +149,14 @@ sub downloadIndex {
 
     if (! -e $idx) {
        &::msg($::who, "the freshmeat butcher is closed.");
-       return;
+       return 0;
     }
 
     if ( -s $idx < 100000) {
        &::DEBUG("FM: index too small?");
        unlink $idx;
        &::msg($::who, "internal error?");
-       return;
+       return 0;
     }
 
     if ($idx =~ /bz2$/) {
@@ -187,7 +175,7 @@ sub downloadIndex {
     &::dbSet("freshmeat", 
        { "projectname_short"   => "_" },
        { "latest_version"      => time(),
-         "desc_short"          => "" }
+         "desc_short"          => "dummy project to track date" }
     );
 
 #    &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
@@ -256,6 +244,7 @@ sub downloadIndex {
 
     my $count = &::countKeys("freshmeat");
     &::status("Freshmeat: $count entries loaded.");
+    return 1;
 }
 
 sub freshmeatAnnounce {
@@ -342,7 +331,7 @@ sub xml_end {
        $i++;
        my %data;
        foreach(@cols) {
-           $data{$_} = $pkg{$_};
+           $data{$_} = $pkg{$_} if ($pkg{$_});
        }
        &::dbReplace("freshmeat", "projectname_short", %data);
        undef %data;

diff --git a/src/db_dbm.pl b/src/db_dbm.pl
index e1ff747ba49904062e1809d8abeceab845472994..b40e6e5c6795259417ed18a2cfb4ea59c76426c1 100644 (file)
--- a/src/db_dbm.pl
+++ b/src/db_dbm.pl
@@ -12,7 +12,6 @@ if (&IsParam('useStrict')) { use strict;}
 
 use vars qw(%factoids %freshmeat %seen %rootwarn);     # db hash.
 
-
 {
     my %formats = (
        'factoids', [
@@ -29,18 +28,11 @@ use vars qw(%factoids %freshmeat %seen %rootwarn);  # db hash.
            'locked_time'
        ],
        'freshmeat', [
-           'name',
-           'stable',
-           'devel',
-           'section',
+           'projectname_short',
+           'latest_version',
            'license',
-           'homepage',
-           'download',
-           'changelog',
-           'deb',
-           'rpm',
-           'link',
-           'oneliner'
+           'url_homepage',
+           'desc_short'
        ],
        'rootwarn', [
            'nick',
@@ -144,14 +136,14 @@ sub dbGet {
        return(@retval);
     }
 
-    &DEBUG("dbGet: select => '$select'.");
+    &DEBUG("dbGet: select=>'$select'.");
     my @array = split "$;", ${"$table"}{lc $val};
     unshift(@array,$key);
     for (0 .. $#format) {
        my $str = $format[$_];
        next unless (grep /^$str$/, split(/\,/, $select));
        $array[$_] ||= '';
-       &DEBUG("dG: pushing $format[$_]=>'$array[$_]'.");
+       &DEBUG("dG: '$format[$_]'=>'$array[$_]'.");
        push(@retval, $array[$_]);
     }
 
@@ -210,13 +202,13 @@ sub dbInsert {
        $array[$i - 1]=$hash{$col};
        $array[$i - 1]='' unless $array[$i - 1];
        delete $hash{$col};
-       &DEBUG("dbI: setting $table->$primkey\{$col\} => '$array[$i - 1]'.");
+       &DEBUG("dbI: '$col'=>'$array[$i - 1]'");
     }
 
     if (scalar keys %hash) {
        &ERROR("dbI: not added...");
        foreach (keys %hash) {
-           &ERROR("dbI:   '$_' => '$hash{$_}'");
+           &ERROR("dbI: '$_'=>'$hash{$_}'");
        }
        return 0;
     }
@@ -227,7 +219,7 @@ sub dbInsert {
 }
 
 sub dbUpdate {
-    &FIXME("STUB: &dbUpdate(@_); => somehow use dbInsert!");
+    &FIXME("STUB: &dbUpdate(@_);=>somehow use dbInsert!");
 }
 
 #####
@@ -296,6 +288,7 @@ sub dbSet {
     my $where = $key . "=" . $phref->{$key};
 
     my %hash = &dbGetColNiceHash($table, "*", $where);
+    $hash{$key}=$phref->{$key};
     foreach (keys %{$href}) {
        &DEBUG("dbSet: setting $_=${$href}{$_}");
        $hash{$_} = ${$href}{$_};
@@ -327,7 +320,22 @@ sub getKeys {
 }
 
 sub randKey {
-    &FIXME("STUB: &randKey(@_);");
+    &DEBUG("STUB: &randKey(@_);");
+    my @format = &dbGetColInfo($table);
+    if (!scalar @format) {
+       return;
+    }
+
+    my $rand = int(rand(&countKeys($table) - 1));
+    my @keys = keys %{$table};
+    &dbGet($table, '*', "@format[0]=@keys[$rand]");
+}
+
+#####
+# Usage: &deleteTable($table);
+sub deleteTable {
+    my ($table) = @_;
+    &FIXME("STUB: deleteTable($table)");
 }
 
 ##### $select is misleading???