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