portald

#!/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__