2 # Freshmeat.pl: Frontend to www.freshmeat.net
4 # Version: v0.7d (20000923)
11 use vars qw(@cols @data $string %pkg $i $locktime);
14 'public' => 'http://www.freshmeat.net/backend/fm-projects.rdf.bz2',
15 # 'private' => 'http://feed.freshmeat.net/appindex/appindex.txt',
19 # Usage: &Freshmeat($string);
22 my $refresh = &::getChanConfDefault("freshmeatRefreshInterval",
23 "", 24) * 60 * 60 * 7;
25 my $last_refresh = &::dbGet("freshmeat", "latest_version", "projectname_short=".&::dbQuote('_'));
28 if (defined $last_refresh and $last_refresh =~ /^\d+$/) {
29 $renewtable++ if (time() - $last_refresh > $refresh);
33 $renewtable++ if (&::countKeys("freshmeat") < 1000);
36 if ($$ == $::bot_pid) {
37 &::Forker("freshmeat", sub {
38 &Freshmeat($sstr) if &downloadIndex();
40 # both parent/fork runs here, in case the following looks weird.
45 return if ($$ == $::bot_pid);
48 if (!&showPackage($sstr)) { # no exact match.
49 my $start_time = &::timeget();
52 # search by key/NAME first.
53 foreach (&::searchTable("freshmeat", "projectname_short", "projectname_short",$sstr)) {
54 $hash{$_} = 1 unless exists $hash{$_};
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);
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]);
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);
77 s/([\,\;]+)/\037$1\037/g;
80 &::performStrictReply( &::formListReply(1, "Freshmeat ", @list) );
86 my %fm = &::dbGetColNiceHash("freshmeat", "*", "projectname_short=".&::dbQuote($pkg));
88 if (scalar keys %fm) { #1: perfect match of name.
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'}";
102 if ($retval = packageText($pkg)) {
103 &::performStrictReply($retval);
111 my @fm = &::randKey("freshmeat","*");
112 return &packageText($fm[0]);
116 my $start_time = &::timeget(); # set the start time.
117 my $idx = "$::param{tempDir}/fm-projects.rdf.bz2";
119 if (!&::loadPerlModule("XML::Parser")) {
120 &::WARN("don't have xml::parser...");
123 my $p = new XML::Parser(Style => 'Objects');
132 &::msg($::who, "Updating freshmeat index... please wait");
134 if (&::isStale($idx, 1)) {
135 &::status("Freshmeat: fetching data.");
137 foreach (keys %urls) {
138 $urls{$_} =~ /^.*\/(.*)$/;
139 $idx = "$::param{tempDir}/$1";
140 my $retval = &::getURLAsFile($urls{$_}, $idx);
141 next if ($retval =~ /^(403|500)$/);
143 &::DEBUG("FM: last! retval => '$retval'.");
147 &::status("Freshmeat: local file hack.");
151 &::msg($::who, "the freshmeat butcher is closed.");
155 if ( -s $idx < 100000) {
156 &::DEBUG("FM: index too small?");
158 &::msg($::who, "internal error?");
162 if ($idx =~ /bz2$/) {
163 open(IN, "bzcat $idx |");
164 } elsif ($idx =~ /gz$/) {
165 open(IN, "gzcat $idx |");
170 # delete the table before we redo it.
171 &::deleteTable("freshmeat");
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" }
181 # &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
182 @cols = &::dbGetColInfo("freshmeat");
186 # this mess is to not dump IN to memory.
197 next unless (/<\/project>/);
199 # XML::Parser's parse() doesn't like the following.
200 # but parsefile() does... why!
215 s/\cN//g; # fucking openbsd morons.
220 s/\cM/ /g; # stupid windows morons
231 if (0 and $str =~ s/\&(\S+?);//g) {
232 &::DEBUG("fm: sarred $1 to ''.");
235 $p->parse($str, ProtocolEncoding => 'ISO-8859-1');
240 # &::dbRaw("UNLOCK", "UNLOCK TABLES");
242 my $delta_time = &::timedelta($start_time);
243 &::status(sprintf("Freshmeat: %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
245 my $count = &::countKeys("freshmeat");
246 &::status("Freshmeat: $count entries loaded.");
250 sub freshmeatAnnounce {
251 my $file = "$::param{tempDir}/fm_recent.txt";
254 ### if file exists, lets read it.
264 my @array = &::getURL("http://core.freshmeat.net/backend/recentnews.txt");
268 my($what,$date,$url) = splice(@array,0,3);
272 ### if file does not exist, write new.
284 for(my $i=0; $i<scalar(@old); $i++) {
285 last if ($now[$i] eq $old[0]);
286 push(@new, $now[$i]);
290 &::DEBUG("fA: no new items.");
301 return "Freshmeat update: ".join(" \002::\002 ", @new);
307 return if ($t =~ /^\s*$/);
313 my($expat,$text) = @_;
315 $pkg{$text} = $string;
317 if ($expat->depth == 0) {
321 for (my $j=0; $j<scalar @cols; $j++) {
322 $data[$j] = $pkg{ $cols[$j] };
326 &::dbSetRow("freshmeat", [@data], "DELAY");
334 $data{$_} = $pkg{$_} if ($pkg{$_});
336 &::dbReplace("freshmeat", "projectname_short", %data);
342 if ($i % 200 == 0 and $i != 0) {
344 &::status("FM: unlocking and locking ($i): ".
345 &::Time2String( time() - $locktime ) );
348 # I think the following leaks 120k of memory each time it's
349 # called... the wonders of libmysql-perl leaking!
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");