#!/usr/bin/perl
# fetch_notebook_data, Boone, 03/10/00
# Transfer notebook data in BRS format from the LISTSERV host
#
# Modifications:
# 03/10/00 Boone      Initial coding
# 03/29/02 Boone      Reorg now takes minutes on new hardware; do it
#                     every load for screaming performance
# 07/31/08 Boone      Take a lock, so that long-runners don't ball up
#                     the BRS system
# 03/24/09 Boone      Modified for .deb packaging in fai/cf install
#                     scenario
# 06/29/09 Boone      Path name of input file to brsload is apparently
#                     broken, though I'm sure this worked at one point?!
# End Modifications

# Libraries

	use LWP::UserAgent;
	use HTTP::Request;
	use Getopt::Std;

# Setup

	$lockfile = "/usr/local/brs-lsvn-loader/.loadlock";
	open(LOCK, ">$lockfile") ||
		die "fetch_notebook_data: unable to take lock";
	flock(LOCK, LOCK_EX);

	chdir("/usr/local/brs-lsvn-loader");

	$sizelim = 250000000;
	getopts("si");
	if ($opt_s =~ /^\d+$/) { $sizelim = $opt_s; }

	$rundate = time;
	open(LOG, ">>logs/LOG.$rundate");
	$cursel = select LOG; $| = 1; select $cursel;
	$seq = 1;

# Create an HTTP session

	$ua = new LWP::UserAgent;
	$ua -> agent("fnb/1.0 " . $ua -> agent);

# Get list of files

	$req = new HTTP::Request(GET => 'http://h-net.msu.edu/brsxfer/');
	$res = $ua -> request($req);
	$s = $res -> as_string;
	@s = split(/\n/, $s);
	@h = grep(/[a-zA-Z0-9.-]\.\d+\.(PUB|PRV|DEL)/, @s);
	foreach $i (@h)
	{
		($fn) = ($i =~ /([a-zA-Z0-9.-]+\.\d+\.(PUB|PRV|DEL))/);
		push (@flist, $fn);
	}
	print LOG "Files to be transferred:\n\t",
		join("\n\t", @flist), "\n";
	print LOG "Total of ", scalar(@flist), " files\n";

# Fetch each file

	$cnt = 0;
	foreach $f (@flist)
	{
		$cnt++;
		($ext) = ($f =~ /(PUB|PRV|DEL)$/);
		$url = "http://h-net.msu.edu/brsxfer/$f";
		$of = "loadqueue/$ext.$rundate.$seq";
		$req = new HTTP::Request(GET => $url);
		$res = $ua -> request($req, $ext);
		if (! $res -> is_success)
		{
			print LOG "$cnt. Transfer of $f failed: ",
				$res -> status_line, "\n";
		}
		else
		{
			print LOG "$cnt. Transfer of $f succeeded.  Size ",
				$res -> content_length, "\n";
			&cat($ext, $of);
			($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$fsize,$atime,
				$mtime,$ctime,$blksize,$blocks) = stat($of);
			$req = new HTTP::Request(DELETE => $url);
			$req -> authorization_basic("brsxfer", "HB-RNSet");
			$res = $ua -> request($req);
			print LOG "Results of delete: ", $res -> status_line, "\n";
			print LOG "File size $fsize; sizelim $sizelim\n";
			if ($fsize > $sizelim)
			{
				&load($of);
				$seq++;
			}
		}
	}
	do									# Clean up the remains
	{
		print LOG "Loading remaining undersize files\n";
		&cat("PUB", "loadqueue/PUB.$rundate.$seq");
		&load("loadqueue/PUB.$rundate.$seq");
		&cat("PRV", "loadqueue/PRV.$rundate.$seq");
		&load("loadqueue/PRV.$rundate.$seq");
	} unless (defined $opt_i);

# Reorg is cheap now, so do it each run

	&reorg;

# Done

	flock(LOCK, LOCK_UN);
	close(LOCK);
	unlink($lockfile);
	exit(0);

# Subs

	# Load a file which has reached size

	sub load
	{
		$fn = shift;

		print LOG "Loading $fn\n";
		if ($fn =~ /PUB/)
		{
			$dbname = "LSVN";
		}
		elsif ($fn =~ /PRV/)
		{
			$dbname = "LSVP";
		}
		elsif ($fn =~ /DEL/)
		{
			unlink($fn);
			return;
		}
		else
		{
			return;
		}
		$now = `date`;
		print LOG $now;
		print LOG "Loading $fn\n";
		print LOG "/usr/local/brs/Bin/brsload $dbname -add -file $fn\n";
		$rc = system("/usr/local/brs/Bin/brsload $dbname -add -file $fn >> logs/LOG.$rundate 2>&1");
		seek(LOG, 0, 2);
		$now = `date`;
		print LOG $now;
		if (($rc / 256) == 0)
		{
			print LOG "Success; deleting load file $fn\n";
			unlink($fn);
		}
		else
		{
			print LOG "Exit code $rc from brsload; leaving load file $fn\n";
		}
		$seq++;
	}

	sub cat
	{
		my ($ext, $fn) = @_;

		open(CATI, $ext) || 
			print LOG "unable to cat $ext, open input failed: $!\n";
		open(CATO, -f $fn ? ">>$fn" : ">$fn") ||
			print LOG "unable to cat $ext, open output failed: $!\n";
		while (<CATI>) { print CATO $_; }
		close(CATO);
		close(CATI);
		unlink($ext);
	}

	sub reorg
	{
		$now = `date`;
		print LOG $now;
		print LOG "Reorganizing databases\n";
		$rc = system("/usr/local/brs-lsvn-loader/reorg");
	}

__END__

