old/Freshmeat_I.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
  12 ### download compressed version instead?
  13
  14 my %urls = (
  15         'public'  => 'http://www.freshmeat.net/backend/appindex.txt',
  16         'private' => 'http://feed.freshmeat.net/appindex/appindex.txt',
  17 );
  18
  19 ####
  20 # Usage: &Freshmeat($string);
  21 sub Freshmeat {
  22     my $sstr    = lc($_[0]);
  23     my $refresh = &::getChanConfDefault("freshmeatRefreshInterval",
  24                         "", 24) * 60 * 60;
  25
  26     my $last_refresh = &::dbGet("freshmeat", "name","_","stable");
  27     my $renewtable   = 0;
  28
  29     if (defined $last_refresh) {
  30         $renewtable++ if (time() - $last_refresh > $refresh);
  31     } else {
  32         $renewtable++;
  33     }
  34     $renewtable++ if (&::countKeys("freshmeat") < 10);
  35
  36     if ($renewtable and $$ == $::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         return if ($$ == $::bot_pid);
  43     }
  44
  45     if (!&showPackage($sstr)) {         # no exact match.
  46         my $start_time = &::timeget();
  47         my %hash;
  48
  49         # search by key/NAME first.
  50         foreach (&::searchTable("freshmeat", "name","name",$sstr)) {
  51             $hash{$_} = 1 unless exists $hash{$_};
  52         }
  53
  54         # search by description line.
  55         foreach (&::searchTable("freshmeat", "name","oneliner", $sstr)) {
  56             $hash{$_} = 1 unless exists $hash{$_};
  57             last if (scalar keys %hash > 15);
  58         }
  59
  60         my @list = keys %hash;
  61         # search by value, if we have enough room to do it.
  62         if (scalar @list == 1) {
  63             &::status("only one match found; showing full info.");
  64             &showPackage($list[0]);
  65             return;
  66         }
  67
  68         # show how long it took.
  69         my $delta_time = &::timedelta($start_time);
  70         &::status(sprintf("freshmeat: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
  71
  72         for (@list) {
  73             tr/A-Z/a-z/;
  74             s/([\,\;]+)/\037$1\037/g;
  75         }
  76
  77         &::performStrictReply( &::formListReply(1, "Freshmeat ", @list) );
  78     }
  79 }
  80
  81 sub showPackage {
  82     my ($pkg)   = @_;
  83     my @fm      = &::dbGet("freshmeat", "name",$pkg,"*");
  84
  85     if (scalar @fm) {           #1: perfect match of name.
  86         my $retval;
  87         $retval  = "$fm[0] \002(\002$fm[11]\002)\002, ";
  88         $retval .= "section $fm[3], ";
  89         $retval .= "is $fm[4]. ";
  90         $retval .= "Stable: \002$fm[1]\002, ";
  91         $retval .= "Development: \002$fm[2]\002. ";
  92         $retval .= $fm[5] || $fm[6];             # fallback to 'download'.
  93         $retval .= " deb: ".$fm[8] if ($fm[8] ne ""); # 'deb'.
  94         &::performStrictReply($retval);
  95         return 1;
  96     } else {
  97         return 0;
  98     }
  99 }
 100
 101 sub randPackage {
 102     my @fm      = &::randKey("freshmeat","*");
 103
 104     if (scalar @fm) {           #1: perfect match of name.
 105         my $retval;
 106         $retval  = "$fm[0] \002(\002$fm[11]\002)\002, ";
 107         $retval .= "section $fm[3], ";
 108         $retval .= "is $fm[4]. ";
 109         $retval .= "Stable: \002$fm[1]\002, ";
 110         $retval .= "Development: \002$fm[2]\002. ";
 111         $retval .= $fm[5] || $fm[6];             # fallback to 'download'.
 112         $retval .= " deb: ".$fm[8] if ($fm[8] ne ""); # 'deb'.
 113
 114         return $retval;
 115     } else {
 116         return;
 117     }
 118 }
 119
 120 sub downloadIndex {
 121     my $start_time      = &::timeget(); # set the start time.
 122     my $idx             = "$::param{tempDir}/fm_index.txt";
 123
 124     &::msg($::who, "Updating freshmeat index... please wait");
 125
 126     if (&::isStale($idx, 1)) {
 127         &::status("Freshmeat: fetching data.");
 128         foreach (keys %urls) {
 129             my $retval = &::getURLAsFile($urls{$_}, $idx);
 130             next if ($retval =~ /^(403|500)$/);
 131
 132             &::DEBUG("FM: last! retval => '$retval'.");
 133             last;
 134         }
 135     } else {
 136         &::status("Freshmeat: local file hack.");
 137     }
 138
 139     if (! -e $idx) {
 140         &::msg($::who, "the freshmeat butcher is closed.");
 141         return;
 142     }
 143
 144     if ( -s $idx < 100000) {
 145         &::DEBUG("FM: index too small?");
 146         unlink $idx;
 147         &::msg($::who, "internal error?");
 148         return;
 149     }
 150
 151     if ($idx =~ /bz2$/) {
 152         open(IN, "bzcat $idx |");
 153     } elsif ($idx =~ /gz$/) {
 154         open(IN, "gzcat $idx |");
 155     } else {
 156         open(IN, $idx);
 157     }
 158
 159     # delete the table before we redo it.
 160     &::deleteTable("freshmeat");
 161
 162     ### lets get on with business.
 163     # set the last refresh time. fixes multiple spawn bug.
 164     &::dbSet("freshmeat", "name","_","stable",time());
 165
 166     my $i = 0;
 167     while (my $line = <IN>) {
 168         chop $line;
 169         $i++ if ($line eq "%%");
 170         last if ($i == 2);
 171     }
 172
 173     &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
 174     my @data;
 175     my @done;
 176     while (my $line = <IN>) {
 177         chop $line;
 178         if ($line ne "%%") {
 179             push(@data,$line);
 180             next;
 181         }
 182
 183         if ($i % 200 == 0 and $i != 0) {
 184             &::DEBUG("FM: unlocking and locking.");
 185             &::dbRaw("UNLOCK", "UNLOCK TABLES");
 186             ### another lame hack to "prevent" errors.
 187             select(undef, undef, undef, 0.2);
 188             &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
 189         }
 190
 191         if (grep /^\Q$data[0]\E$/, @done) {
 192             &::DEBUG("dupe? $data[0]");
 193             @data = ();
 194             next;
 195         }
 196
 197         $i++;
 198         pop @data;
 199         $data[1] ||= "none";
 200         $data[2] ||= "none";
 201         &::dbSetRow("freshmeat", @data);
 202         push(@done,$data[0]);
 203         @data = ();
 204     }
 205     close IN;
 206     &::DEBUG("FM: data ".scalar(@data) );
 207     &::dbRaw("UNLOCK", "UNLOCK TABLES");
 208
 209     my $delta_time = &::timedelta($start_time);
 210     &::status(sprintf("Freshmeat: %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
 211
 212     my $count = &::countKeys("freshmeat");
 213     &::status("Freshmeat: $count entries loaded.");
 214 }
 215
 216 sub freshmeatAnnounce {
 217     my $file = "$::param{tempDir}/fm_recent.txt";
 218     my @old;
 219
 220     ### if file exists, lets read it.
 221     if ( -f $file) {
 222         open(IN, $file);
 223         while (<IN>) {
 224             chop;
 225             push(@old,$_);
 226         }
 227         close IN;
 228     }
 229
 230     my @array = &::getURL("http://core.freshmeat.net/backend/recentnews.txt");
 231     my @now;
 232
 233     while (@array) {
 234         my($what,$date,$url) = splice(@array,0,3);
 235         push(@now, $what);
 236     }
 237
 238     ### if file does not exist, write new.
 239     if (! -f $file) {
 240         open(OUT, ">$file");
 241         foreach (@now) {
 242             print OUT "$_\n";
 243         }
 244         close OUT;
 245
 246         return;
 247     }
 248
 249     my @new;
 250     for(my $i=0; $i<scalar(@old); $i++) {
 251         last if ($now[$i] eq $old[0]);
 252         push(@new, $now[$i]);
 253     }
 254
 255     if (!scalar @new) {
 256         &::DEBUG("fA: no new items.");
 257         return;
 258     }
 259
 260     ### output new file.
 261     open(OUT, ">$file");
 262     foreach (@now) {
 263         print OUT "$_\n";
 264     }
 265     close OUT;
 266
 267     return "Freshmeat update: ".join(" \002::\002 ", @new);
 268 }
 269
 270 1;