#!/usr/bin/perl -w
#
# ledctrl.pl -- LED sign control program...used in automation
#
# This will write to a named pipe to control ledsign.pl run with
# the --pipe parameter
#
use strict;
use Getopt::Long;
use Socket;

# Globals
my $PIPENAME = "/home/jason/prog/ledsign/ledfifo";
my $CURL = "/usr/local/bin/curl";
my $port = 0;		# tcp port

my %urls  = ( 'slashdot' => 'http://slashdot.org/slashdot.xml',
				'weather' => 'http://www.wunderground.com/auto/rss_full/OR/Portland.xml',
				'yahoo buzz overall' => 'http://buzz.yahoo.com/feeds/buzzoverl.xml',
				'yahoo buzz movers' => 'http://buzz.yahoo.com/feeds/buzzoverm.xml'
);

#my $SLASHURL = 
my $FORTUNE = "/usr/games/fortune";


sub showUsage {
	print 	"ledctrl.pl -- program usage:\n\n" .
			"  --socket <n> : connect to server on port <n>\n" .
			"  --help       : show this screen\n\n" .
			" (default behavior uses named pipe)\n\n";
}

# Pulls the weather.  Kinda custom.  Returns an associative array.
sub fetchWeather {
	my $weather_url = $urls{'weather'};
	my $descline = `curl -s '$weather_url' | grep 'Temp' | grep Wind`;

	# format looksl ike this:
	#<description>Temperature: 66&#176;F / 19&#176;C | Humidity: 73% | Pressure: 29.93in / 1013hPa | Conditions: Scattered Clouds | Wind Direction: NW | Wind Speed: 8mph / 13km/h

	# but they changed it, and it now looks like:
	# <description><![CDATA[Temperature: 49&#176;F / 9&#176;C | Humidity: 86% | Pressure: 30.04in / 1017hPa | Conditions: Overcast | Wind Direction: North | Wind Speed: 4mph / 6km/h]]>

	$descline =~ s/^\s+//;
	$descline =~ s/\s+$//;
	#$descline =~ s/\<.*\>//;
	$descline =~ s/\<description\>\<\!\[CDATA\[//;
	$descline =~ s/\]\]\>$//;

	my ($temp, $humid, $pres, $cond, $winddir, $windsp) = split /\s+?\|\s+?/, $descline;

	$humid = trimWS($humid); 
	$pres = trimWS($pres);
	$cond = trimWS($cond);
	$winddir = trimWS($winddir);
	$windsp = trimWS($windsp);

	$temp =~ s/Temperature: //;
	$temp =~ s/&#176;F.*/°F/;
	$humid =~ s/.*: //;
	$pres =~ s/.*: //; 
	$pres =~ s/in .*/in/;
	$cond =~ s/Conditions: //;
	$winddir =~ s/.*Direction: //;
	$windsp =~ s/.*Speed: //;
	$windsp =~ s/mph.*/mph/;

	my %ret = (temperature => $temp, humidity => $humid, pressure => $pres, 
			conditions => $cond, wind_direction => $winddir,
			wind_speed => $windsp);
	return \%ret;
}


# Gets the slashdot xml feed and shoves it into slashdot.xml
sub fetchSlash {
	# Silly and effective
	my $u = $urls{'slashdot'};
	`$CURL -s $u > slashdot.xml`;
#	print "Fetched new slashdot\n";
}

sub fetchYahoo {
	my $which = shift;
	# Similarly silly and effective
	my $u = $urls{$which};
	my $fname = $which;
	$fname =~ s/\s+/_/g;
	`$CURL -s $u > $fname.xml`;
}


# Gets the system uptime and returns a hashref
sub getUptime {
	my %ret;
	my $txt = `uptime`;
	$txt =~ s/\s+/ /g;
	$txt =~ s/load average: //;
	$txt =~ s/.*up (.*)/$1/;
	$txt =~ s/, /,/g;
	$txt =~ s/\s+/ /g;

	@_ = split /,/, $txt;
	$ret{"uptime"} = $_[0];
	$ret{"users"} = $_[2];
	$ret{"load1"} = $_[3];
	$ret{"load5"} = $_[4];
	$ret{"load15"} = $_[5];
	return \%ret;

}

sub sendCmd {
	my $cmd = shift;
	($cmd =~ /\n$/) or ($cmd .= "\n");

	if(0){				# TODO: Change for verbose/whatever
		print $cmd;
	}

	my $rc = print FH $cmd;
	if($port){
		# Read the response before returning...in socket mode only
		my $line = <FH>;
		return $rc;
	}
	return $rc;
}

sub trimWS {
	my $str = shift;
	$str =~ s/^\s+//;
	$str =~ s/\s+$//;
	return $str;
}


# automation - handles all automation for the sign and is the core
# of this process.
sub automation {
	my %times;

	if($port){		# open tcp/ip connection

		my ($remote, $iaddr, $paddr, $proto);

		$remote = 'localhost';		# TODO: change to support remote hosts

		if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
		die "No port" unless $port;
		$iaddr   = inet_aton($remote)               || die "no host: $remote";
		$paddr   = sockaddr_in($port, $iaddr);
		$proto   = getprotobyname('tcp');
		socket(FH, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
		connect(FH, $paddr)    || die "connect: $!";
	}
	else{
		open FH, "> $PIPENAME" or die "Could not open FIFO for writing";
	}

	# This sets autoflush to ON for the file handle.
	# As far as I can tell, it's required.
	my $old_fh = select(FH);
	$| = 1;
	select($old_fh);
	
	$times{"last"} = time;
	$times{"uptime"} = time;
	my %weather;
	$_ = fetchWeather();
	$_ and (%weather = %{$_});
#	print Dumper(\%weather);
	$times{"weather"} = time;
	$times{"slashdot"} = 0;
	$times{"slashdot update"} = 0;
	$times{"fortune"} = 0;
	
	while(1){

		# If we fail here, the server probably croaked
		sendCmd("time 1 1") or (sleep 1 and last);

		sleep 1;

		if(time - $times{"last"} > 60){ 				# Time to show weather

			sendCmd("lwipe Weather Update");

			# need to get weather again...
			if((not %weather) or (time - $times{"weather"} > 20*60)){		
#				print "DEBUG - FETCHING WEATHER AGAIN\n";
				$_ =  fetchWeather();
				$_ and %weather = %{$_};
				$times{"weather"} = time;
			}

			if (not %weather) {
				$times{"last"} = time;
				next;
			}

			sleep 2;

			sendCmd("rando 0.005");
			#doCmd("criu Current temp: " . $weather{"TemperatureF"} . "");
			#print ("DEBUG:\n");
			#print("mc Current temp: " . $weather{"TemperatureF"} . "\n");
			sendCmd("mc Current temp: " . $weather{"temperature"});# . pack("C", 176));
			sleep 5;
			sendCmd("rwipe Winds @ " . $weather{"wind_speed"} . " " . $weather{"wind_direction"});
			sleep 5;
			sendCmd("mwc " . $weather{"conditions"} . " humidity " . 
				$weather{"humidity"} . " pressure " . $weather{"pressure"}, $0.5);
			
			sendCmd("rando 0.005");

			$times{"last"} = time;

		}

		if(time - $times{"uptime"} > 60*3){		# Show uptime
			sendCmd("riu noisybox server uptime");
			sleep 3;
			my %uptime = %{ getUptime() };

			sendCmd("riu uptime: " . $uptime{"uptime"});
			sleep 3;
			sendCmd("riu Load average: " . $uptime{"load1"});
			sleep 3;
			sendCmd("riu " . $uptime{"users"} . " logged in");
			sleep 3;
			sendCmd("rou");
			
			$times{"uptime"} = time;
		}

		if(time - $times{"slashdot"} > 15*60){	# 15 minute slashdot interval

			if(time - $times{"slashdot update"} > 30*60){	# 30 minute slashdot fetching interval
				fetchSlash();
				$times{"slashdot update"} = time;
			}

			my @lines = `grep "<title>" slashdot.xml`;
			my $text;
			foreach(@lines){
				$_ =~ s/<title>//g;
				$_ =~ s/<\/title>//g;
				$_ =~ s/^\s+//;
				$_ =~ s/\s+$//;
				#print $_ . "\n";
				$text .= $_ . ", ";
			}
			$text =~ s/, $//;

			sendCmd("kriu Slashdot headlines:");
			sendCmd("i"); select undef, undef, undef, 0.15;
			sendCmd("i"); select undef, undef, undef, 0.15;
			sendCmd("i"); select undef, undef, undef, 0.15;
			sendCmd("i"); select undef, undef, undef, 0.15;
			sendCmd("msl " . $text);

			$times{"slashdot"} = time;
		}

		if(time - $times{"yahoo"} > 10*60){	# 10 minute yahoo buzz overall interval
			if(time - $times{"yahoo update"} > 60*60){	# 60 minute yahoo fetching interval
				fetchYahoo("yahoo buzz overall");
				fetchYahoo("yahoo buzz movers");
				$times{"yahoo update"} = time;
			}

			sendCmd("krid Y! Buzz :: ZEITGEIST");

			my @lines = `grep "<title>" yahoo_buzz_overall.xml`;
			foreach(@lines){
				$_ =~ s/(<title>)|(<description>)//g;
				$_ =~ s/(<\/title>)|(<\/description>)//g;
				$_ =~ s/^\s+//;
				$_ =~ s/\s+$//;
				next unless $_ =~ /^\d/;
				sendCmd("mc " . $_);
				select undef, undef, undef, 1.2;
			}
			sendCmd("rando");
			sendCmd("randi Y! Buzz Movers");
			select undef, undef, undef, 1.0;
			@lines = `egrep "(<title>)|(<description>)" yahoo_buzz_movers.xml`;
			my $i;
			for($i = 0; $i <= $#lines; $i += 2){
				my $item = $lines[$i];
				my $perc = $lines[$i+1];

				$item =~ s/(<title>)|(<description>)//g;
				$item =~ s/(<\/title>)|(<\/description>)//g;
				$item =~ s/^\s+//;
				$item =~ s/\s+$//;
				next unless $item =~ /^\d/;
				$perc =~ s/(<title>)|(<description>)//g;
				$perc =~ s/(<\/title>)|(<\/description>)//g;
				$perc =~ s/^\s+//;
				$perc =~ s/\s+$//;

				sendCmd("riu " . $item);
				select undef, undef, undef, 0.8;
				sendCmd("riu " . "(" . $perc . ")");
				select undef, undef, undef, 0.8;
			}
			sendCmd("mc ----------------------");
			select undef, undef, undef, 0.5;
			sendCmd("randi find anger!");
			select undef, undef, undef, 0.25;
			sendCmd("rando");
			$times{"yahoo"} = time;
		}# yahoo buzz overall

		if(time - $times{"fortune"} > 5*60){	# 5 minute randome fortune interval
			sendCmd("mc RANDOM FORTUNE TIME!"); select undef,undef,undef,1;
			sendCmd("sl 5"); select undef,undef,undef,0.2;
			foreach(1..15){
				sendCmd("sr 10"); select undef,undef,undef,0.16-($_/100.0);
				sendCmd("sl 10"); select undef,undef,undef,0.16-($_/100.0);
			}
			my @lines = `$FORTUNE -a -s`;
			my $text;
			foreach(@lines){
				$_ =~ s/,/ /g;		# commas jack us up
				$_ =~ s/^\s+//;
				$_ =~ s/\s+$//;
				$_ =~ s/\s+/ /g;
				$_ =~ s/"//g;		# quotes look silly in mwc mode
				# TODO: Probably need to trim each word length
				$text .= $_ . " ";
			}
			$text =~ s/^\s+//;
			$text =~ s/\s+$//;
			{
			# Debug block for troubleshooting!
				open DBG, ">/tmp/ledsign_last_fortune.txt";
				print DBG $text;
				print DBG "\n";
				close DBG;
			}
			#print $text . "\n";
			sendCmd("mwc " . $text . ", 0.5");
			$times{"fortune"} = time;
		}

	}

	close FH;
}


# TODO: Change these to support hostname in addition to port
my $help;
GetOptions( "socket=s" => \$port,
			"help" => \$help) 
			|| die "try --help for more information";


$help and showUsage() and exit;

$SIG{PIPE} = 'IGNORE';
print "Firing up automation...\n";
while(1){
	automation();
}