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