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",
 187         { "projectname_short" => "_" },
 188         { "latest_version" => time() }
 189     );
 190
 191     &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
 192     @cols       = &::dbGetColInfo("freshmeat");
 193
 194     $locktime   = time();
 195
 196     # this mess is to not dump IN to memory.
 197     $_ = <IN>;
 198     $_ = <IN>;
 199     $_ = <IN>;
 200
 201     my $str;
 202     while (<IN>) {
 203         chop;
 204
 205         $str .= $_;
 206
 207         next unless (/<\/project>/);
 208
 209         # XML::Parser's parse() doesn't like the following.
 210         # but parsefile() does... why!
 211         for ($str) {
 212                 s/&reg;/_/g;
 213                 s/&ocirc;//g;
 214                 s/&quot;//g;
 215                 s/&eacute;/e/g;
 216                 s/&agrave;/a/g;
 217                 s/&iacute;/i/g;
 218                 s/&shy;/_/g;    # ???
 219                 s/&acute;/a/g;
 220                 s/&raquo;/_/g;  # ???
 221                 s/&laquo;/_/g;  # ???
 222                 s/&copy;/[C]/g;
 223                 s/&deg;/deg/g;
 224                 s/&AElig;/A/g;
 225                 s/\cN//g;               # fucking openbsd morons.
 226                 s/&nbsp;/-/g;
 227                 s/&ouml;/o/g;
 228                 s/&para;//g;    # ???
 229                 s/&atilde;//g;
 230                 s/\cM/ /g;              # stupid windows morons
 231                 s/&sup2;/square/g;
 232                 s/&uuml;/?/g;
 233                 s/&micro;/u/g;
 234                 s/&aelig;/a/g;
 235                 s/&oslash;/o/g;
 236                 s/&eth;/e/g;
 237                 s/&szlig;//g;
 238                 s/&middot;//g;
 239         }
 240
 241         if (0 and $str =~ s/\&(\S+?);//g) {
 242             &::DEBUG("fm: sarred $1 to ''.");
 243         }
 244
 245         $p->parse($str, ProtocolEncoding => 'ISO-8859-1');
 246         $str = "";
 247     }
 248     close IN;
 249
 250     &::dbRaw("UNLOCK", "UNLOCK TABLES");
 251
 252     my $delta_time = &::timedelta($start_time);
 253     &::status(sprintf("Freshmeat: %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
 254
 255     my $count = &::countKeys("freshmeat");
 256     &::status("Freshmeat: $count entries loaded.");
 257 }
 258
 259 sub freshmeatAnnounce {
 260     my $file = "$::param{tempDir}/fm_recent.txt";
 261     my @old;
 262
 263     ### if file exists, lets read it.
 264     if ( -f $file) {
 265         open(IN, $file);
 266         while (<IN>) {
 267             chop;
 268             push(@old,$_);
 269         }
 270         close IN;
 271     }
 272
 273     my @array = &::getURL("http://core.freshmeat.net/backend/recentnews.txt");
 274     my @now;
 275
 276     while (@array) {
 277         my($what,$date,$url) = splice(@array,0,3);
 278         push(@now, $what);
 279     }
 280
 281     ### if file does not exist, write new.
 282     if (! -f $file) {
 283         open(OUT, ">$file");
 284         foreach (@now) {
 285             print OUT "$_\n";
 286         }
 287         close OUT;
 288
 289         return;
 290     }
 291
 292     my @new;
 293     for(my $i=0; $i<scalar(@old); $i++) {
 294         last if ($now[$i] eq $old[0]);
 295         push(@new, $now[$i]);
 296     }
 297
 298     if (!scalar @new) {
 299         &::DEBUG("fA: no new items.");
 300         return;
 301     }
 302
 303     ### output new file.
 304     open(OUT, ">$file");
 305     foreach (@now) {
 306         print OUT "$_\n";
 307     }
 308     close OUT;
 309
 310     return "Freshmeat update: ".join(" \002::\002 ", @new);
 311 }
 312
 313
 314 sub xml_text {
 315     my ($e,$t) = @_;
 316     return if ($t =~ /^\s*$/);
 317
 318     $string = $t;
 319 }
 320
 321 sub xml_end {
 322     my($expat,$text) = @_;
 323
 324     $pkg{$text} = $string;
 325
 326     if ($expat->depth == 0) {
 327         for (my $j=0; $j<scalar @cols; $j++) {
 328             $data[$j] = $pkg{ $cols[$j] };
 329         }
 330         $i++;
 331
 332         &::dbSetRow("freshmeat", @data);
 333         undef @data;
 334         undef %pkg;
 335
 336         if ($i % 200 == 0 and $i != 0) {
 337             &::showProc();
 338             &::status("FM: unlocking and locking ($i): ".
 339                 &::Time2String( time() - $locktime ) );
 340             $locktime = time();
 341
 342             # I think the following leaks 120k of memory each time it's
 343             # called... the wonders of libmysql-perl leaking!
 344
 345             &::dbRaw("UNLOCK", "UNLOCK TABLES");
 346             ### another lame hack to "prevent" errors.
 347             select(undef, undef, undef, 0.2);
 348             &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
 349         }
 350     }
 351 }
 352
 353 1;