#!/usr/bin/perl

use LWP::UserAgent;
use HTTP::Request::Common;
use Getopt::Long;
use Parallel::ForkManager;
use lib "/usr/local/farm/lib";
use strict;

# Config variables
my ($max_procs,$max_units,$pkg,$func,$sleep_time,$timeout);
my ($help,$quiet,$options,$logfile,$bg,$parent_pid,@args);

# Version varables
my ($version,$print_version,$major,$minor,$bugfix);

# For the files, etc.
my ($infile,$outfile,$pidfile,$tmpfile,$data_dir,$data_in_dir,$pid_dir,$home_dir);
my ($data_out_dir,$etc_dir,$lib_dir,$url,$email,$config_file,$bin_dir);

# For control
my ($last_line,$last_count);

######################
# CONFIGURATION HERE #
######################

$max_units 	= 20;

# Default home directory
$home_dir = "/usr/local/farm";

#####################
# END CONFIGURATION #
#####################

@args = @ARGV;

# Get just the config file option
Getopt::Long::Configure("pass_through");
$options = GetOptions ("config|c=s" => \$config_file);

# Config file setup
$config_file = $config_file || $home_dir . "/etc/config";

# Get user settings first
&parse_config($config_file);

# Process more command line options, after config file sets defaults
Getopt::Long::Configure("default");
$options = GetOptions  ("email|e=s"  		=> \$email,
			"forks|f=i" 		=> \$max_procs,
			"help|h|?+" 		=> \$help,
			"timeout|t=i" 		=> \$timeout,
			"sleep|s=i" 		=> \$sleep_time,
			"background|bg|b!"	=> \$bg,

			"home_dir=s"		=> \$home_dir,

			"logfile|l=s"		=> \$logfile,
			"url|u=s"		=> \$url,
			"quiet|q+" 		=> \$quiet);

if ($options == 0) {
	&usage;
}


$|=1;

####################################
# COMMAND LINE ARGUMENT PROCESSING #
####################################

if ($help) {
	&usage;
}

$bin_dir 	= $bin_dir 	|| $home_dir . "/bin";
$lib_dir 	= $lib_dir 	|| $home_dir . "/lib";
$etc_dir	= $etc_dir 	|| $home_dir . "/etc";
$data_dir 	= $data_dir 	|| $home_dir . "/data";
$data_in_dir 	= $data_in_dir 	|| $data_dir . "/in";
$data_out_dir 	= $data_out_dir || $data_dir . "/out";
$pid_dir 	= $pid_dir	|| $data_dir . "/pids";

if (! (-d $data_in_dir) || ! (-d $data_out_dir)) {
	mydie("\aData dirs not configured properly!\n");
}

if ($email !~ /\@/) {
	print "Email address must be valid!\n";
	&usage;
}

open (VER, "< $home_dir/VERSION");
$version = <VER>;
chomp $version;
close (VER);

$version =~ /(\d)(\d)(\d\d)/;
$major = $1;
$minor = $2,
$bugfix = int($3);
$print_version = sprintf("%01.1s\.%01.1s\.%s",$major,$minor,$bugfix);

$url 		= $url		|| "http://www.booksamillion.com/ncom/packetserver";
$sleep_time 	= $sleep_time 	|| 120;
$timeout 	= $timeout 	|| 45;
$max_procs 	= $max_procs 	|| 5;

$max_procs 	= int($max_procs);
if ($max_procs < 1) {
	&usage;
}

############################
# NORMAL PROCESSING BEGINS #
############################

# Let's check to see if we're already running
checkpid("MASTER") || die("It appears farmathome is already running!\n");

# Let's print the header
&hello;

if ($bg) {
	# Let's go into the background
	fork and exit;
}

# Let's create a PID file
makepid("MASTER");
$parent_pid = $$;

# Let's clean up the PID file on exit
$SIG{TERM} 	= \&handler;
$SIG{QUIT} 	= \&handler;
$SIG{INT} 	= \&handler;

# Check to see if an incoming packet needs processing
# Maybe it was interrupted, and we need to reprocess
{
	# Skip dotfiles
	my (@files,$sn);
	opendir(DIR, $data_in_dir) || mydie("Can't open data directory $data_in_dir!\n");
	@files = grep { /^[^\.]/ && -f "$data_in_dir/$_" } readdir(DIR);
	closedir DIR;
	
	# Getting the last one listed, hoping to fix problem with multiple out files
	$sn = pop @files;

	if ($sn) {
		# Process the work unit
		$infile = $data_in_dir . "/" . $sn;
		$outfile = $data_out_dir . "/" . $sn;
		process_workunit($infile,$outfile);
	}
}

########################
# MAIN PROCESSING LOOP #
########################

MAIN: while (1) {
	my ($ack,$wu_in,$wu_out,$request,$sn,$work_to_do,$res,@files,$ua,$lines);

	# See if I'm supposed to be in SLEEP mode
	while (-f $data_dir . "/SLEEP") {
		info("Now entering SLEEP mode");
		sleep $sleep_time;
	}

	# Check to see if an outgoing packet is ready
	# Skip dotfiles
	opendir(DIR, $data_out_dir) || mydie("Can't open data directory $data_out_dir!");
	@files = grep { /^[^\.]/ && -f "$data_out_dir/$_" } readdir(DIR);
	closedir DIR;

	# Getting the last one listed, hoping to fix problem with multiple out files
	$sn = pop @files;

	# Prepare results if we have an outgoing serial number
	if ($sn) {
		# Read tmpfile
		$outfile = $data_out_dir . "/" . $sn;
		open (OUT, "< $outfile") || mydie("Can't open output file $outfile!\n");

		# Make it slurp the whole file into one scalar
		undef $/;
		$wu_out = <OUT>;
		close (OUT);
		
		# Reset to normal input record separator behavior
		$/ = "\n";
	}

	if ($wu_out) {
		info("Sending Workunit $sn");
	}

	# Put/Get Work Unit
	$ua = LWP::UserAgent->new;
	$res = $ua->request (POST $url, 
		[ email => $email,
		  version => $version, 
		  sn => $sn, 
		  wu => $wu_out
		] );

	# Test for success -- will retry on failure
	if ($res->is_success) {
		$wu_in = $res->content;
		$wu_in =~ s/^(.*?\n)//;
		$sn = $1;
		chomp $sn;

		if ($sn =~ m/^error( (\d+) (.*))?$/i) {
			my ($enum,$error,$big_sleep);
			$enum = $2;
			$error = $3;
			if (! $enum) {
				$enum = "999";
				$error = "Unknown server error.";
			}
			info("ERROR: $enum $error");
			$big_sleep = $sleep_time * 2;

			info("Sleeping $big_sleep seconds...");

			sleep $big_sleep;
			next MAIN;
		}
		$ack = ($sn =~ s/^ack	//i);
		if ($ack && $wu_out) {

			info("Workunit acknowleged.");
			info("Deleting workunit $outfile");

			system ("rm $outfile");
		}

		if ($sn =~ /sleep/i) {
			info("Sleeping $sleep_time seconds...");
			sleep $sleep_time;
			next;
		}

		if ($sn =~ /^PATCH (.*?) (.*)/i) {
			info("Auto-patching version $1 to $2");
			chdir $home_dir;
			open (PATCH, "| patch -p1");
			print PATCH $wu_in;
			close(PATCH);

			delpid();

			# RESPAWN this daemon here...
			info("Respawning program...");
			my ($program) = $bin_dir . "/farmathome";
			exec $program, @args;
			
			# This will only happen on failure
			#info("Exec of farmathome failed!!");
			#next;
		}

		if ($wu_in) {
			info("Received workunit $sn");

			$lines = count_lines(\$wu_in);
			$max_units = int($lines / $max_procs / 2);
			$max_units = 1 if ($max_units == 0);

			$infile = $data_in_dir . "/" . $sn;
			open (IN, "> $infile") || mydie("Can't open input file $infile!\n");
			print IN $wu_in;
			close (IN);
			# Process the work unit
			$outfile = $data_out_dir . "/" . $sn;
			process_workunit($infile,$outfile);
		} else {
			info("Sleeping $sleep_time seconds...");
			sleep $sleep_time;
		}
	} else {
		# Sleep for 2 minutes
		info("Sleeping $sleep_time seconds...");
		sleep $sleep_time;
	}
}

exit;

##################################################################
#  S  U  B  R  O  U  T  I  N  E  S
##################################################################

#######################
# WORKUNIT PROCESSING #
#######################

sub process_workunit {
	my ($infile,$outfile) = @_;
	my (@records,@unit,$chunk,$row,$pm,$tmp_outfile,@pids);

	$tmp_outfile = $outfile;
	$tmp_outfile =~ s#([0-9]+)$#/\.$1#;
	
	info("Processing Workunit");

	# Clean up in case this workunit has already been partially processed
	system ("rm -f $tmp_outfile");

	# Make the parallel manager object
	$pm = new Parallel::ForkManager($max_procs);

	# Open the file of records, one per line
	open (IN, "< $infile") || mydie("Can't open input file $infile!\n");

	# Iterate over each ISBN
	while (<IN>) {
		my ($site,$master_list_price,$isbn,$record);

		# Grab the row and verify that it's valid
		chomp;

		($site,$isbn,$master_list_price) = split("\t",$_);

		if ($isbn !~ /^[0-9]{9}[0-9X]{1}/) {
			next;
		}

		# Get the package filename needed
		$site = lc($site);
		$site =~ s/[^a-z]//g;
		$pkg = uc($site) . ".pm";
		
		if (! (-e $lib_dir . "/" . $pkg)) {
			# Invalid package
			next;
		}
		# Valid package -- require it
		require $pkg;

		$$record{'isbn'} = $isbn;
		$$record{'site'} = $site;
		$$record{'list'} = $master_list_price;

		push @records, $record;
	}
	# Close the input file of ISBN's
	close(IN);

	# Each fork will do $max_units worth of work
	while ( @unit = splice(@records,0,$max_units) ) {
		# See if I'm supposed to be in FREEZE mode
		$chunk++;
		info("Processing Chunk: $chunk");

		#############################
		# BEGIN PARALLEL PROCESSING #
		#############################
		# Fork this process	
		$pm->start and next;

		# Let's create a PID file
		makepid($chunk);

		UNIT: foreach $row (@unit) {
			my (@results);

			while (-f $data_dir . "/FREEZE") {
				info("Now entering FREEZE mode");
				sleep $sleep_time;
			}

			# Run the appropriate package/subroutine per site
			$func = uc($row->{'site'}) . "::fetch";
			no strict 'refs';
			@results = &{$func}($row->{'isbn'},$row->{'list'},$timeout);
			use strict 'refs';

			if (! $results[0]) {
				my ($errorstring) = "Failed GET!";
				#my ($date) = scalar(localtime(time));		# There's a timestamp in info(),
				#$errorstring     .= "\tDate: $date";		# so this is unnecessary.
				$errorstring     .= "\tSite: " . $row->{'site'};
				$errorstring     .= "\tISBN: " . $row->{'isbn'};
				info($errorstring);
				next UNIT;
			} else {
				store ($tmp_outfile,@results);
			}
		}

		# Let's create a PID file
		delpid($chunk);

		# Exit this child process
		$pm->finish;

		###########################
		# END PARALLEL PROCESSING #
		###########################
	}

	# Reap all the children that are still processing
	$pm->wait_all_childs;
	
	info("Deleting infile:  $infile");
	system ("rm $infile");
	system ("mv $tmp_outfile $outfile");

	return 1;
}

sub store {
	my ($outfile,@params) = @_;
	my ($line);

	$line = join("\t",@params);
	open (OUT, ">> $outfile") || mydie("Can't open output file $outfile!\n");

	# Make sure this child is the only process writing
	flock (OUT, 2);

	print OUT $line . "\n";
	close (OUT);

	# Clear lock
	flock (OUT, 8);
}

sub usage {
	my ($string);

	$string =<<EOF;

Usage:  $0 --email=user\@host [OPTION]...

Required:
  -e, --email=EMAIL              Valid email address (required)

Optional:
  -c, --config                   Configuration file location
                                   Default: '/usr/local/farm/etc/config'

  -b, --bg, --background         Put process into the background.
  -f, --forks=INTEGER            Max number of forks (default: 5).
  -l, --logfile=PATH             Path to logfile.  If no "/" in PATH,
                                   use data dir.  Appends.
  -q, --quiet                    Be quiet -- don't print informational messages.
  -s, --sleep=SECONDS            Interval to sleep when no work is available.
  -t, --timeout=SECONDS          HTTP request timeout (default: 45 seconds).
  -?, -h, --help                 Prints usage information.

Directory Setup:
  --home_dir                     Default: '/usr/local/farm'

EOF
;
	mydie($string);
}

sub hello {
	my ($bg_str,$date,$logstr,$msg);

	return if ($quiet);

	$bg_str = ($bg > 0) ? "Yes" : "No";
	$logstr = ($logfile) ? $logfile : "<none>";
	$date = scalar(localtime(time));

$msg =<<EOF;

#
#  P R I C E F A R M E R . C O M
#    Farm\@Home Client Toolkit
#
#  Version:  $print_version
#     Date:  $date
#
#    email:  $email
#    forks:  $max_procs
#  timeout:  $timeout
#    sleep:  $sleep_time
#  logfile:  $logstr
#
EOF
;
	info($msg,'nostamp');
}

sub count_lines {
	my ($ref) = shift;

	my $i = 0;
	my $count = 0;
	while (index($$ref,"\n",$i) > -1) {
		$i = index($$ref,"\n",$i) + 1;
		$count++;
	}
	return $count
}

sub info {
	my ($line,$nostamp) = @_;
	my ($full_line, $filename);
	
	if ($line eq $last_line) {
		if ($last_count >= 10) {
			$line = "Last message repeated 10 times...";
			$last_count = 0;
		} else {
			$last_count++;
			return;
		}
	} else {
		if ( $last_count > 0 ) {
			print "Last message repeated $last_count times...";
		}
		$last_count = 0;
		$last_line = $line;	
	}

	if (! $nostamp) {
		$full_line = scalar(localtime(time)) . "\t";
	}
	$full_line .= $line . "\n";

	if (! $quiet) {
		# Check to see if this is to go to a log or STDOUT
		if ($logfile) {
			# Check to see if it's got path info
			# If so, take it as a literal file path
			if ($logfile =~ m#/#) {
				$filename = $logfile;

			# Otherwise, consider it a file in the data directory
			} else {
				$filename = $data_dir . "/" . $logfile;
			}
			open (LOG, ">> $filename");
			print LOG $full_line;
			close LOG;
		} else {
			print $full_line;
		}
	}
}

sub handler { 
	if ($$ == $parent_pid) {
		info("[" . $$ . "] Parent Exiting...") ;
	} else {
		info("[" . $$ . "] Child Exiting...") ;
	}
	delpid();
	exit;
}

sub mydie {
	my ($line) = shift;
	delpid();
	die $line;
}

sub checkpid {
	my ($id) = shift;

	$pidfile = $pid_dir . "/" . $id;
	if (-e $pidfile) {
		return 0;
	} else {
		return 1;
	}
}

sub makepid {
	my ($id) = shift;

	return if ($id eq '');
	$pidfile = $pid_dir . "/" . $id;

	# Create a PID file
	open (OUT, "> $pidfile");
	print OUT $$;
	close (OUT);
}

sub delpid {
	my ($id) = shift;
	return if ($pidfile eq '');
	system("rm -f $pidfile")
}

sub parse_config {
	my ($config_file) = shift;
	my ($arg,@args,$config);
#	if (! $config_file) {
#		$config = $etc_dir . "/config";
#	}
	return if (! -e $config_file);
	open (CONF, "< $config_file");
	while (<CONF>) {
		chomp;
		# comments
		s/\#.*$//;

		# leading spaces
		s/^\s+//;
		
		# trailing spaces
		s/\s+$//;
		
		# extra spaces
		s/\s+/ /g;

		if ($_ eq '') {
			next;
		} elsif ($_  =~ /^\-/) {
# print "$_\n";
			push @args, $_;
		} else {
			mydie("Configuration file error! Check $config_file");
		}
	}
	close (CONF);
	push @args, @ARGV;
	@ARGV = @args;
}

