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", "*", "projectname_short='$pkg'");
  88
  89     if (scalar @fm) {           #1: perfect match of name.
  90         my $retval;
  91         $retval  = "$fm[0] \002(\002$fm[5]\002)\002, ";
  92 #       $retval .= "section $fm[3], ";
  93         $retval .= "is $fm[2]. ";
  94         $retval .= "Version: \002$fm[1]\002, ";
  95 #       $retval .= "Development: \002$fm[2]\002. ";
  96         $retval .= $fm[4];
  97 ### ???
  98 #       $retval .= " deb: ".$fm[3] if ($fm[3] ne ""); # 'deb'.
  99         &::performStrictReply($retval);
 100         return 1;
 101     } else {
 102         return 0;
 103     }
 104 }
 105
 106 sub randPackage {
 107     my @fm      = &::randKey("freshmeat","*");
 108
 109     if (scalar @fm) {           #1: perfect match of name.
 110         my $retval;
 111         $retval  = "$fm[0] \002(\002$fm[5]\002)\002, ";
 112 #       $retval .= "section $fm[3], ";
 113         $retval .= "is $fm[2]. ";
 114         $retval .= "Version: \002$fm[1]\002, ";
 115 #       $retval .= "Development: \002$fm[2]\002. ";
 116         $retval .= $fm[4];
 117 ### ???
 118 #       $retval .= " deb: ".$fm[3] if ($fm[3] ne ""); # 'deb'.
 119
 120         return $retval;
 121     } else {
 122         return;
 123     }
 124 }
 125
 126 sub downloadIndex {
 127     my $start_time      = &::timeget(); # set the start time.
 128     my $idx             = "$::param{tempDir}/fm-projects.rdf.bz2";
 129
 130     if (!&::loadPerlModule("XML::Parser")) {
 131         &::WARN("don't have xml::parser...");
 132         return;
 133     }
 134     my $p = new XML::Parser(Style => 'Objects');
 135     my %pkg;
 136     my $string;
 137
 138     $p->setHandlers(
 139                 Char    => \&xml_text,
 140                 End     => \&xml_end,
 141     );
 142
 143     &::msg($::who, "Updating freshmeat index... please wait");
 144
 145     if (&::isStale($idx, 1)) {
 146         &::status("Freshmeat: fetching data.");
 147
 148         foreach (keys %urls) {
 149             $urls{$_}   =~ /^.*\/(.*)$/;
 150             $idx        = "$::param{tempDir}/$1";
 151             my $retval  = &::getURLAsFile($urls{$_}, $idx);
 152             next if ($retval =~ /^(403|500)$/);
 153
 154             &::DEBUG("FM: last! retval => '$retval'.");
 155             last;
 156         }
 157     } else {
 158         &::status("Freshmeat: local file hack.");
 159     }
 160
 161     if (! -e $idx) {
 162         &::msg($::who, "the freshmeat butcher is closed.");
 163         return;
 164     }
 165
 166     if ( -s $idx < 100000) {
 167         &::DEBUG("FM: index too small?");
 168         unlink $idx;
 169         &::msg($::who, "internal error?");
 170         return;
 171     }
 172
 173     if ($idx =~ /bz2$/) {
 174         open(IN, "bzcat $idx |");
 175     } elsif ($idx =~ /gz$/) {
 176         open(IN, "gzcat $idx |");
 177     } else {
 178         open(IN, $idx);
 179     }
 180
 181     # delete the table before we redo it.
 182     &::deleteTable("freshmeat");
 183
 184     ### lets get on with business.
 185     # set the last refresh time. fixes multiple spawn bug.
 186     &::dbSet("freshmeat", "projectname_short", "_", "latest_version", time());
 187
 188     &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
 189     @cols       = &::dbGetColInfo("freshmeat");
 190
 191     $locktime   = time();
 192
 193     # this mess is to not dump IN to memory.
 194     $_ = <IN>;
 195     $_ = <IN>;
 196     $_ = <IN>;
 197
 198     my $str;
 199     while (<IN>) {
 200         chop;
 201
 202         $str .= $_;
 203
 204         next unless (/<\/project>/);
 205
 206         # XML::Parser's parse() doesn't like the following.
 207         # but parsefile() does... why!
 208         for ($str) {
 209                 s/&reg;/_/g;
 210                 s/&ocirc;//g;
 211                 s/&quot;//g;
 212                 s/&eacute;/e/g;
 213                 s/&agrave;/a/g;
 214                 s/&iacute;/i/g;
 215                 s/&shy;/_/g;    # ???
 216                 s/&acute;/a/g;
 217                 s/&raquo;/_/g;  # ???
 218                 s/&laquo;/_/g;  # ???
 219                 s/&copy;/[C]/g;
 220                 s/&deg;/deg/g;
 221                 s/&AElig;/A/g;
 222                 s/\cN//g;               # fucking openbsd morons.
 223                 s/&nbsp;/-/g;
 224                 s/&ouml;/o/g;
 225                 s/&para;//g;    # ???
 226                 s/&atilde;//g;
 227                 s/\cM/ /g;              # stupid windows morons
 228                 s/&sup2;/square/g;
 229                 s/&uuml;/?/g;
 230                 s/&micro;/u/g;
 231                 s/&aelig;/a/g;
 232                 s/&oslash;/o/g;
 233                 s/&eth;/e/g;
 234                 s/&szlig;//g;
 235                 s/&middot;//g;
 236         }
 237
 238         if ($str =~ s/\&(\S+);//g) {
 239             &::DEBUG("fm: sarred $1 to ''.");
 240         }
 241
 242         $p->parse($str, ProtocolEncoding => 'ISO-8859-1');
 243         $str = "";
 244     }
 245     close IN;
 246
 247     &::dbRaw("UNLOCK", "UNLOCK TABLES");
 248
 249     my $delta_time = &::timedelta($start_time);
 250     &::status(sprintf("Freshmeat: %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
 251
 252     my $count = &::countKeys("freshmeat");
 253     &::status("Freshmeat: $count entries loaded.");
 254 }
 255
 256 sub freshmeatAnnounce {
 257     my $file = "$::param{tempDir}/fm_recent.txt";
 258     my @old;
 259
 260     ### if file exists, lets read it.
 261     if ( -f $file) {
 262         open(IN, $file);
 263         while (<IN>) {
 264             chop;
 265             push(@old,$_);
 266         }
 267         close IN;
 268     }
 269
 270     my @array = &::getURL("http://core.freshmeat.net/backend/recentnews.txt");
 271     my @now;
 272
 273     while (@array) {
 274         my($what,$date,$url) = splice(@array,0,3);
 275         push(@now, $what);
 276     }
 277
 278     ### if file does not exist, write new.
 279     if (! -f $file) {
 280         open(OUT, ">$file");
 281         foreach (@now) {
 282             print OUT "$_\n";
 283         }
 284         close OUT;
 285
 286         return;
 287     }
 288
 289     my @new;
 290     for(my $i=0; $i<scalar(@old); $i++) {
 291         last if ($now[$i] eq $old[0]);
 292         push(@new, $now[$i]);
 293     }
 294
 295     if (!scalar @new) {
 296         &::DEBUG("fA: no new items.");
 297         return;
 298     }
 299
 300     ### output new file.
 301     open(OUT, ">$file");
 302     foreach (@now) {
 303         print OUT "$_\n";
 304     }
 305     close OUT;
 306
 307     return "Freshmeat update: ".join(" \002::\002 ", @new);
 308 }
 309
 310
 311 sub xml_text {
 312     my ($e,$t) = @_;
 313     return if ($t =~ /^\s*$/);
 314
 315     $string = $t;
 316 }
 317
 318 sub xml_end {
 319     my($expat,$text) = @_;
 320
 321     $pkg{$text} = $string;
 322
 323     if ($expat->depth == 0) {
 324         for (my $j=0; $j<scalar @cols; $j++) {
 325             $data[$j] = $pkg{ $cols[$j] };
 326         }
 327         $i++;
 328
 329         &::dbSetRow("freshmeat", @data);
 330         undef @data;
 331         undef %pkg;
 332
 333         if ($i % 200 == 0 and $i != 0) {
 334             &::showProc();
 335             &::status("FM: unlocking and locking ($i): ".
 336                 &::Time2String( time() - $locktime ) );
 337             $locktime = time();
 338
 339             # I think the following leaks 120k of memory each time it's
 340             # called... the wonders of libmysql-perl leaking!
 341
 342             &::dbRaw("UNLOCK", "UNLOCK TABLES");
 343             ### another lame hack to "prevent" errors.
 344             select(undef, undef, undef, 0.2);
 345             &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
 346         }
 347     }
 348 }
 349
 350 1;