src/Modules/Freshmeat.pl

   1 #
   2 # Freshmeat.pl: Frontend to www.freshmeat.net
   3 #       Author: dms
   4 #      Version: v0.7d (20000923)
   5 #      Created: 19990930
   6 #
   7
   8 package Freshmeat;
   9
  10 use strict;
  11 use vars qw(@cols @data $string %pkg $i $locktime);
  12
  13 my %urls = (
  14         'public'  => 'http://www.freshmeat.net/backend/fm-projects.rdf.bz2',
  15 #       'private' => 'http://feed.freshmeat.net/appindex/appindex.txt',
  16 );
  17
  18 ####
  19 # Usage: &Freshmeat($string);
  20 sub Freshmeat {
  21     my $sstr    = lc($_[0]);
  22     my $refresh = &::getChanConfDefault("freshmeatRefreshInterval",
  23                         "", 24) * 60 * 60 * 7;
  24
  25     my $last_refresh = &::dbGet("freshmeat", "latest_version", "projectname_short='_'");
  26     my $renewtable   = 0;
  27
  28     if (defined $last_refresh and $last_refresh =~ /^\d+$/) {
  29         $renewtable++ if (time() - $last_refresh > $refresh);
  30     } else {
  31         $renewtable++;
  32     }
  33     $renewtable++ if (&::countKeys("freshmeat") < 1000);
  34
  35     if ($renewtable) {
  36         if ($$ == $::bot_pid) {
  37             &::Forker("freshmeat", sub {
  38                 &downloadIndex();
  39                 &Freshmeat($sstr);
  40             } );
  41             # both parent/fork runs here, in case the following looks weird.
  42         } else {
  43             &downloadIndex();
  44         }
  45
  46         return if ($$ == $::bot_pid);
  47     }
  48
  49     if (!&showPackage($sstr)) {         # no exact match.
  50         my $start_time = &::timeget();
  51         my %hash;
  52
  53         # search by key/NAME first.
  54         foreach (&::searchTable("freshmeat", "projectname_short", "projectname_short",$sstr)) {
  55             $hash{$_} = 1 unless exists $hash{$_};
  56         }
  57
  58         # search by description line.
  59         foreach (&::searchTable("freshmeat", "projectname_short", "desc_short", $sstr)) {
  60             $hash{$_} = 1 unless exists $hash{$_};
  61             last if (scalar keys %hash > 15);
  62         }
  63
  64         my @list = keys %hash;
  65         # search by value, if we have enough room to do it.
  66         if (scalar @list == 1) {
  67             &::status("only one match found; showing full info.");
  68             &showPackage($list[0]);
  69             return;
  70         }
  71
  72         # show how long it took.
  73         my $delta_time = &::timedelta($start_time);
  74         &::status(sprintf("freshmeat: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
  75
  76         for (@list) {
  77             tr/A-Z/a-z/;
  78             s/([\,\;]+)/\037$1\037/g;
  79         }
  80
  81         &::performStrictReply( &::formListReply(1, "Freshmeat ", @list) );
  82     }
  83 }
  84
  85 sub showPackage {
  86     my ($pkg)   = @_;
  87     my @fm      = &::dbGet("freshmeat", "*",
  88                         "projectname_short=".&dbQuote($pkg) );
  89
  90     if (scalar @fm) {           #1: perfect match of name.
  91         my $retval;
  92         $retval  = "$fm[0] \002(\002$fm[5]\002)\002, ";
  93 #       $retval .= "section $fm[3], ";
  94         $retval .= "is $fm[2]. ";
  95         $retval .= "Version: \002$fm[1]\002, ";
  96 #       $retval .= "Development: \002$fm[2]\002. ";
  97         $retval .= $fm[4];
  98 ### ???
  99 #       $retval .= " deb: ".$fm[3] if ($fm[3] ne ""); # 'deb'.
 100         &::performStrictReply($retval);
 101         return 1;
 102     } else {
 103         return 0;
 104     }
 105 }
 106
 107 sub randPackage {
 108     my @fm      = &::randKey("freshmeat","*");
 109
 110     if (scalar @fm) {           #1: perfect match of name.
 111         my $retval;
 112         $retval  = "$fm[0] \002(\002$fm[5]\002)\002, ";
 113 #       $retval .= "section $fm[3], ";
 114         $retval .= "is $fm[2]. ";
 115         $retval .= "Version: \002$fm[1]\002, ";
 116 #       $retval .= "Development: \002$fm[2]\002. ";
 117         $retval .= $fm[4];
 118 ### ???
 119 #       $retval .= " deb: ".$fm[3] if ($fm[3] ne ""); # 'deb'.
 120
 121         return $retval;
 122     } else {
 123         return;
 124     }
 125 }
 126
 127 sub downloadIndex {
 128     my $start_time      = &::timeget(); # set the start time.
 129     my $idx             = "$::param{tempDir}/fm-projects.rdf.bz2";
 130
 131     if (!&::loadPerlModule("XML::Parser")) {
 132         &::WARN("don't have xml::parser...");
 133         return;
 134     }
 135     my $p = new XML::Parser(Style => 'Objects');
 136     my %pkg;
 137     my $string;
 138
 139     $p->setHandlers(
 140                 Char    => \&xml_text,
 141                 End     => \&xml_end,
 142     );
 143
 144     &::msg($::who, "Updating freshmeat index... please wait");
 145
 146     if (&::isStale($idx, 1)) {
 147         &::status("Freshmeat: fetching data.");
 148
 149         foreach (keys %urls) {
 150             $urls{$_}   =~ /^.*\/(.*)$/;
 151             $idx        = "$::param{tempDir}/$1";
 152             my $retval  = &::getURLAsFile($urls{$_}, $idx);
 153             next if ($retval =~ /^(403|500)$/);
 154
 155             &::DEBUG("FM: last! retval => '$retval'.");
 156             last;
 157         }
 158     } else {
 159         &::status("Freshmeat: local file hack.");
 160     }
 161
 162     if (! -e $idx) {
 163         &::msg($::who, "the freshmeat butcher is closed.");
 164         return;
 165     }
 166
 167     if ( -s $idx < 100000) {
 168         &::DEBUG("FM: index too small?");
 169         unlink $idx;
 170         &::msg($::who, "internal error?");
 171         return;
 172     }
 173
 174     if ($idx =~ /bz2$/) {
 175         open(IN, "bzcat $idx |");
 176     } elsif ($idx =~ /gz$/) {
 177         open(IN, "gzcat $idx |");
 178     } else {
 179         open(IN, $idx);
 180     }
 181
 182     # delete the table before we redo it.
 183     &::deleteTable("freshmeat");
 184
 185     ### lets get on with business.
 186     # set the last refresh time. fixes multiple spawn bug.
 187     &::dbSet("freshmeat",
 188         { "projectname_short" => "_" },
 189         { "latest_version" => time() }
 190     );
 191
 192 #    &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
 193     @cols       = &::dbGetColInfo("freshmeat");
 194
 195     $locktime   = time();
 196
 197     # this mess is to not dump IN to memory.
 198     $_ = <IN>;
 199     $_ = <IN>;
 200     $_ = <IN>;
 201
 202     my $str;
 203     while (<IN>) {
 204         chop;
 205
 206         $str .= $_;
 207
 208         next unless (/<\/project>/);
 209
 210         # XML::Parser's parse() doesn't like the following.
 211         # but parsefile() does... why!
 212         for ($str) {
 213                 s/&reg;/_/g;
 214                 s/&ocirc;//g;
 215                 s/&quot;//g;
 216                 s/&eacute;/e/g;
 217                 s/&agrave;/a/g;
 218                 s/&iacute;/i/g;
 219                 s/&shy;/_/g;    # ???
 220                 s/&acute;/a/g;
 221                 s/&raquo;/_/g;  # ???
 222                 s/&laquo;/_/g;  # ???
 223                 s/&copy;/[C]/g;
 224                 s/&deg;/deg/g;
 225                 s/&AElig;/A/g;
 226                 s/\cN//g;               # fucking openbsd morons.
 227                 s/&nbsp;/-/g;
 228                 s/&ouml;/o/g;
 229                 s/&para;//g;    # ???
 230                 s/&atilde;//g;
 231                 s/\cM/ /g;              # stupid windows morons
 232                 s/&sup2;/square/g;
 233                 s/&uuml;/?/g;
 234                 s/&micro;/u/g;
 235                 s/&aelig;/a/g;
 236                 s/&oslash;/o/g;
 237                 s/&eth;/e/g;
 238                 s/&szlig;//g;
 239                 s/&middot;//g;
 240         }
 241
 242         if (0 and $str =~ s/\&(\S+?);//g) {
 243             &::DEBUG("fm: sarred $1 to ''.");
 244         }
 245
 246         $p->parse($str, ProtocolEncoding => 'ISO-8859-1');
 247         $str = "";
 248     }
 249     close IN;
 250
 251 #    &::dbRaw("UNLOCK", "UNLOCK TABLES");
 252
 253     my $delta_time = &::timedelta($start_time);
 254     &::status(sprintf("Freshmeat: %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
 255
 256     my $count = &::countKeys("freshmeat");
 257     &::status("Freshmeat: $count entries loaded.");
 258 }
 259
 260 sub freshmeatAnnounce {
 261     my $file = "$::param{tempDir}/fm_recent.txt";
 262     my @old;
 263
 264     ### if file exists, lets read it.
 265     if ( -f $file) {
 266         open(IN, $file);
 267         while (<IN>) {
 268             chop;
 269             push(@old,$_);
 270         }
 271         close IN;
 272     }
 273
 274     my @array = &::getURL("http://core.freshmeat.net/backend/recentnews.txt");
 275     my @now;
 276
 277     while (@array) {
 278         my($what,$date,$url) = splice(@array,0,3);
 279         push(@now, $what);
 280     }
 281
 282     ### if file does not exist, write new.
 283     if (! -f $file) {
 284         open(OUT, ">$file");
 285         foreach (@now) {
 286             print OUT "$_\n";
 287         }
 288         close OUT;
 289
 290         return;
 291     }
 292
 293     my @new;
 294     for(my $i=0; $i<scalar(@old); $i++) {
 295         last if ($now[$i] eq $old[0]);
 296         push(@new, $now[$i]);
 297     }
 298
 299     if (!scalar @new) {
 300         &::DEBUG("fA: no new items.");
 301         return;
 302     }
 303
 304     ### output new file.
 305     open(OUT, ">$file");
 306     foreach (@now) {
 307         print OUT "$_\n";
 308     }
 309     close OUT;
 310
 311     return "Freshmeat update: ".join(" \002::\002 ", @new);
 312 }
 313
 314
 315 sub xml_text {
 316     my ($e,$t) = @_;
 317     return if ($t =~ /^\s*$/);
 318
 319     $string = $t;
 320 }
 321
 322 sub xml_end {
 323     my($expat,$text) = @_;
 324
 325     $pkg{$text} = $string;
 326
 327     if ($expat->depth == 0) {
 328         for (my $j=0; $j<scalar @cols; $j++) {
 329             $data[$j] = $pkg{ $cols[$j] };
 330         }
 331         $i++;
 332
 333         &::dbSetRow("freshmeat", [@data], "DELAY");
 334         undef @data;
 335         undef %pkg;
 336
 337         if ($i % 200 == 0 and $i != 0) {
 338             &::showProc();
 339             &::status("FM: unlocking and locking ($i): ".
 340                 &::Time2String( time() - $locktime ) );
 341             $locktime = time();
 342
 343             # I think the following leaks 120k of memory each time it's
 344             # called... the wonders of libmysql-perl leaking!
 345
 346 #           &::dbRaw("UNLOCK", "UNLOCK TABLES");
 347             ### another lame hack to "prevent" errors.
 348 #           select(undef, undef, undef, 0.2);
 349 #           &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
 350         }
 351     }
 352 }
 353
 354 1;