Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

executable file 353 lines (275 sloc) 8.76 kB
#!/usr/bin/perl -w
###############################################################################
# portald - this is the "daemon" responsible for retrieving portal and site
# block content
#
# Copyright (C) 1997 Rob "CmdrTaco" Malda
# malda@slashdot.org
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
#
# $Id$
###############################################################################
=head1 Welcome to Portald
portald is the script that sucks down headlines from assorted
places on the internet, and puts them in the boxes for use on
Slashdot. Exciting? Nope.
=cut
use strict;
use vars '%I';
use Slash;
use LWP::UserAgent;
use HTTP::Request;
use URI::Escape;
use XML::Parser;
*I = getSlashConf();
my %savedBlocks;
#my ($basedir,$datadir)=getvars("basedir","datadir");
sub makeTmp {
if (-f "$I{datadir}/logs/portald.pid") {
my $log = `tail -n 3 $I{datadir}/logs/portald.log`;
#sendEmail($siteadmin,'portal - frickin - d',"Portald has failed. You may want to fix it in the near future. Here are the last 3 lines of the log:\n$log");
} else {
open LOCK, "> $I{datadir}/logs/portald.pid"
or die "Can't open $I{datadir}/logs/portald.pid: $!";
print LOCK "$$";
close LOCK;
}
}
sub deleteTmp {
unlink "$I{datadir}/logs/portald.pid" or warn "Can't unlink $I{datadir}/logs/portald.pid: $!";
}
################################################################################
sub geturl {
my $ua = new LWP::UserAgent;
my $request = new HTTP::Request('GET', $_[0]);
$ua->proxy(http => $I{http_proxy}) if $I{http_proxy};
$ua->timeout(30);
my $result = $ua->request($request);
if ($result->is_success) {
return $result->content;
} else {
return 0;
}
}
################################################################################
sub getTop10Comments {
my $c=sqlSelectMany("stories.sid, title,
cid, subject,".
getDateFormat("date","d").",
nickname,comments.points",
"comments,stories,users",
"comments.points >= 4
AND users.uid=comments.uid
AND comments.sid=stories.sid
ORDER BY date DESC limit 10");
my $A = $c->fetchall_arrayref;
$c->finish;
my $block;
foreach (@$A) {
my($sid, $title, $cid, $subj, $d, $nickname, $points) = @$_;
$block .= <<EOT;
<LI><B><A HREF="$I{rootdir}/comments.pl?sid=$sid&cid=$cid">$subj</A>
($points points) by $nickname</B> on $d <FONT SIZE="1">attached to
<A HREF="$I{rootdir}/article.pl?sid=$sid">$title</A></FONT>
EOT
}
setblock("top10comments", $block);
}
################################################################################
sub randomBlock {
my $c = sqlSelectMany("blocks.bid,title,url,block",
"blocks,sectionblocks",
"blocks.bid=sectionblocks.bid
AND sectionblocks.section='index'
AND portal=1
AND ordernum < 0");
my $A = $c->fetchall_arrayref;
$c->finish;
my $R = $A->[rand @$A];
my($bid, $title, $url, $block) = @$R;
sqlUpdate("sectionblocks", {
title => "rand($title);",
url => $url
}, "bid='rand'");
setblock("rand", $block);
}
#################################################################
sub getSlashdotPoll {
setblock("poll", pollbooth("", 1));
}
#################################################################
sub portaldLog {
my $dir = "$I{datadir}/logs";
unless (-e $dir) {
mkdir $dir, 0755 or die "Can't mkdir $dir: $!";
}
open LOG, ">>$dir/portald.log"
or die "Can't append to $dir/portald.log: $!";
select((select(LOG), $|++)[0]); # unbuffer LOG
print LOG localtime() . "\t", join("\t", @_), "\n";
close LOG;
}
=head2 Fortune
The fortune command.
=cut
#################################################################
sub getUptime {
my $x = `/usr/bin/uptime`;
$x = "<B>date:</B> $x";
$x =~ s/up/\n<BR><B>uptime:<\/B>/g;
$x =~ s/load average:/\n<BR><B>load average:<\/B>/;
my $ps = `/bin/ps aux | /usr/bin/wc -l`;
$ps--;
$x .= "<BR><B>processes:</B> $ps <BR>";
my $stats = $x;
my $c = sqlSelectMany("count(*), to_days(now()) - to_days(ts) as d",
"accesslog","","GROUP by d order by d asc");
my($today) = $c->fetchrow;
my($yesterday) = $c->fetchrow;
my($th, $tc) = getvars("totalhits", "totalComments");
$stats .= "<B>yesterday:</B> $yesterday<BR>
<B>today:</B> $today<BR>
<B>ever:</B> $th<BR>";
$c->finish;
setblock('uptime', $stats);
}
#################################################################
sub setblock {
my($bid, $block) = @_;
$savedBlocks{$bid} = $block;
#sqlUpdate("blocks",{ block => $block }, "bid=" . $I{dbh}->quote($bid) );
portaldLog("updated $bid");
}
my($title, $link, $snatchtitle, $snatchlink, $str);
# "globals" needed for XML parsing
#################################################################
sub start_handler {
my($p, $data) = @_;
if ($data =~ /\blink\b/i) {
$link = "";
$snatchlink = 1;
} elsif ($data =~ /\btitle\b/i) {
$title = "";
$snatchtitle = 1;
} elsif ($data =~ /\bitem\b/i) {
$str .= "<LI>";
}
}
#################################################################
sub char_handler {
my($p, $data) = @_;
$data =~ s/\s/ /g;
if ($snatchtitle) {
$title .= $data;
} elsif ($snatchlink) {
$link .= $data;
}
}
#################################################################
sub end_handler {
my($p, $data) = @_;
if ($data =~ /\blink\b/i) {
$snatchlink = 0;
} elsif ($data =~ /\btitle\b/i) {
$snatchtitle = 0;
} elsif ($data =~ /\bitem\b/i) {
$str .= qq!<A HREF="$link">$title</A></LI>\n!;
}
}
#################################################################
sub getRDF {
#gets an RDF file, and formats it as a /. block
eval {
my($bid, $url, $other) = @_;
($title, $link, $snatchtitle, $snatchlink, $str) = ("", "", 0, 0, "");
my $p = new XML::Parser (ErrorContext => 2);
$p->setHandlers(Char => \&char_handler,
End => \&end_handler,
Start => \&start_handler
);
my $d = geturl($url);
if (!$d) {
portaldLog("failed to get $bid");
return;
}
$d =~ s/&(?!#?[a-zA-Z0-9]+;)/&amp;/g; #s/&/&amp;/g;
$p->parse($d) or portaldLog("$bid did not parse properly");
setblock($bid, "$str$other");
};
portaldLog("Error getting $_[0]: $@") if $@;
}
#################################################################
sub getSectionMenu2 {
my $menu = "\n\n<!-- begin section index block -->\n\n";
my $c = sqlSelectMany("section","sections",
"isolate=0 and (section != '' and section != 'articles')
ORDER BY section");
while (my($s) = $c->fetchrow) {
my($month, $day) = $I{dbh}->selectrow_array(
"select month(time), dayofmonth(time) from stories where " .
"section='$s' and time < now() and displaystatus > -1 order by ".
"time desc limit 1");
my @count = $I{dbh}->selectrow_array(
"select count(*) from stories where section='$s' and " .
"to_days(now()) - to_days(time) <= 2 and time < now() and " .
"displaystatus > -1");
$menu .= "\n$month/$day" if $month && $day;
$menu .= " ($count[0])" if $count[0] > 1;
$menu .= <<EOT;
<BR>
<B><A HREF="$I{rootdir}/index.pl?section=$s">$s</A></B><BR>
EOT
}
$menu .= "\n\n<!-- end section index block -->\n\n";
setblock("sectionindex", $menu);
}
#################################################################
# wow, now it's time to actually do something
makeTmp();
portaldLog("Launching Portald");
$|++;
$I{dbh} ||= sqlconnect();
require 'portald-site' if -e 'portald-site';
portaldLog("Updating Portal Box Thingees");
getSectionMenu2();
# loop through all the RDF sites
my $columns = "bid,url,rdf,retrieve";
my $tables = "sectionblocks";
my $where = "rdf != '' and retrieve=1";
my $other = "";
my $RDFlist = sqlSelectAll($columns, $tables, $where, $other);
for (@{$RDFlist}) {
my($bid, $url, $rdf) = ($_->[0], $_->[1], $_->[2]);
getRDF($bid, $rdf);
}
getTop10Comments();
randomBlock();
getSlashdotPoll();
getUptime();
# Clean up
deleteTmp();
# $I{dbh}->do("LOCK TABLES blocks WRITE");
foreach (keys %savedBlocks) {
sqlUpdate("blocks", { block => $savedBlocks{$_} },
"bid=" . $I{dbh}->quote($_)
);
}
# $I{dbh}->do("UNLOCK TABLES");
# from 'portald-site'
newSemiRandomBlock() if defined &newSemiRandomBlock;
portaldLog("Sucessfully Saved Portals");
__END__
Jump to Line
Something went wrong with that request. Please try again.