portald

#!/usr/bin/perl -w
# This code is a part of Slash, and is released under the GPL.
# Copyright 1997-2001 by Open Source Development Network. See README
# and COPYING for more information, or see http://slashcode.com/.
# $Id$

###############################################################################
# portald  - this is the "daemon" responsible for retrieving portal and site
# block content
###############################################################################

=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;
# this needs to be a global here so we can add to it from externally
# called scripts (see portald-site)
use vars qw(%savedBlocks);
use File::Spec::Functions;
use LWP::UserAgent;
use HTTP::Request;
use URI::Escape;
use XML::RSS;

use Slash;
use Slash::Utility;

my $virtual_user = $ARGV[0];
createEnvironment($ARGV[0]);
my $constants = getCurrentStatic();
my $slashdb = getCurrentDB();
my $totalChangedStories = 1;

################################################################################
sub geturl {
	my $ua = new LWP::UserAgent;
	my $request = new HTTP::Request('GET', $_[0]);
	$ua->proxy(http => $constants->{http_proxy}) if $constants->{http_proxy};
	$ua->timeout(30);
	my $result = $ua->request($request);

	if ($result->is_success) {
		return $result->content;
	} else {
		return 0;
	}
}


################################################################################

sub getTop10Comments {
	my $A =	$slashdb->getTop10Comments();

	my $block;
	foreach (@$A) {
		my($sid, $title, $cid, $subj, $d, $nickname, $points) = @$_;
		$block .= <<EOT;

<LI><B><A HREF="$constants->{rootdir}/comments.pl?sid=$sid&cid=$cid">$subj</A>
	($points points) by $nickname</B> on $d <FONT SIZE="1">attached to
	<A HREF="$constants->{rootdir}/article.pl?sid=$sid">$title</A></FONT>
EOT
	}
	setblock("top10comments", $block);

}



#################################################################
sub getSlashdotPoll {
	setblock("poll", pollbooth("", 1));
}


#################################################################
sub portaldLog {
	doLog('portald', \@_);
}

=head2 Fortune

The fortune command.

=cut


#################################################################
sub getUptime {
	my $x = `/usr/bin/uptime`;
	$x = "<B>time:</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($today, $yesterday) = $slashdb->getAccesLogCountTodayAndYestarday();
	my $th = $slashdb->getVar('totalhits', 'value');
	my $tc = $slashdb->getVar('totalComments', 'value');

	$stats .= "<B>yesterday:</B> $yesterday<BR>
		<B>today:</B> $today<BR>
		<B>ever:</B> $th<BR>";

	setblock('uptime', $stats);
}


#################################################################
sub setblock {
	my($bid, $block) = @_;
	$savedBlocks{$bid} = $block;
	portaldLog("updated $bid");
}


#################################################################
sub getRDF {
	#gets an RDF file, and formats it as a /. block

	my($bid, $url, $other) = @_;
	my $rss = new XML::RSS;

	my $d = geturl($url);
	if (!$d) {
		portaldLog("failed to get $bid: $@");
		return;
	}
	$d =~ s/&(?!#?[a-zA-Z0-9]+;)/&amp;/g;

	eval { $rss->parse($d) };

	if ($@) {
		portaldLog("$bid did not parse properly:$@");
		return;
	} else {
		my $str;
		foreach my $item (@{$rss->{items}}) {
			# hopefully this xmldecode() will break nothing
			my($link, $title) = map { xmldecode($_) } @{$item}{'link', 'title'};
			$str .= qq!<LI><A HREF="$link">$title</A></LI>\n!;
		}
		setblock($bid, "$str$other");
		return 1;
	}
}

#################################################################
# obsoleted by the Slashd task refresh_sectionindex.pl
#sub getSectionMenu2 {
#
#	my $menu = "\n\n<!-- begin section index block -->\n\n";
#	my $section_menu = $slashdb->getSectionMenu2();
#	for (@$section_menu) {
#		my $s = $_->[0];
#		my($month, $day, $count) = $slashdb->getSectionMenu2Info($s);
#
#		$menu .= "\n$month/$day" if $month && $day;
#		$menu .= " ($count)" if $count > 1;
#		$menu .= <<EOT;
#<BR>
#<B><A HREF="$constants->{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
doLogInit('portald');

portaldLog("Launching Portald");

$|++;

my $p_site = catfile($constants->{datadir}, 'sbin', 'portald-site');
if (-e $p_site) {
	portaldLog("requiring $p_site");
	require $p_site;
}

portaldLog("Updating Portal Box Thingees");

# Obsoleted by slashd Task refresh_sectionindex.pl
#getSectionMenu2();

# loop through all the RDF sites
my $RDFlist = $slashdb->getSitesRDF();

for (@{$RDFlist}) {
	my($bid, $url, $rdf) = ($_->[0], $_->[1], $_->[2]);
	getRDF($bid, $rdf);
}

getTop10Comments();
setblock("rand", $slashdb->randomBlock());
getSlashdotPoll();
getUptime();

foreach (keys %savedBlocks) {
	$slashdb->setBlock($_, { block => $savedBlocks{$_} });
}

# from 'portald-site'
newSemiRandomBlock($slashdb) if defined &newSemiRandomBlock;

portaldLog("Sucessfully Saved Portals");

# Clean up
doLogExit('portald');

__END__