#!/usr/bin/perl -w

$DEBUGGING = 0;

our ($stAll, $offset, $title, $subtitle, $composer, $source, $date, $editor, $footnote, $musicFile);

$ft2PageNum = 316;		#Offset to ft2 page # string header
$ft3PageNum = 364;		#Offset to ft3 page # string header
$ft2FirstPageOnly = 302;	#Offset to footnote first page only boolean
$ft3FirstPageOnly = 348;	#Offset to footnote first page only boolean

if ($#ARGV != 0)
    {
    print "Usage: cft <tab-separated database file>\n";
    exit 1;
    }
print "$ARGV[0]\n";
open DBF, "< $ARGV[0]" or die "$ARGV[0]: $!";# open database file for reading.

while ($stData = <DBF>)
    {
    my $stIn = "";
    $stData =~ s/"//g;		# Weirdly, Excel sometimes inserts quotes
    ($title, $subtitle, $composer, $lastFirst, $source, $date, $editor, $footnote, $musicFile) = split /	/, $stData;
    $title = clean($title);	# Get rid of any leading or trailing whitespace.
    $subtitle = clean($subtitle);
    $composer = clean($composer);
    $lastFirst = clean($lastFirst);
    $source = clean($source);
    $date = clean($date);
    $editor = clean($editor);
    $footnote = clean($footnote);
    $musicFile = clean($musicFile);
    if ($musicFile !~ /\.ft[23]$/)
	{
	print "$musicFile: illegal suffix\n";
	next;
	} 
    if (! -e $musicFile)
	{
	print "$musicFile: nonexistent\n";
	next;
	}
    if (! -r $musicFile)
	{
	print "$musicFile: not readable\n";
	next;
	}
    if (! -w $musicFile)
	{
	print "$musicFile: not writable\n";
	next;
	}

    if ($musicFile =~ /\.ft2$/)
        {
	next if (! open TMP, "< $musicFile");
	$stAll = join('', <TMP>);
	close TMP;
	ModFt2($musicFile);
	}
      else
        {
	if (! open TMP, "zcat -S .ft3 $musicFile |")
	    {
	    print "$musicFile: cannot decompress";
	    next;
	    }
	$stAll = join('', <TMP>);
	close TMP;
	ModFt3($musicFile);
	}
    }


sub ShowBug {
    my ($errStr) = @_;
    if ($DEBUGGING == 0) {
	return undef;
	}
    print $errStr, "\n";
    }

sub ModFt2
{
my $newNote;
my ($file) = @_;
if ($editor ne "")			# construct footnote
    {
    $newNote = "$source   $editor";
    }
  else
    {
    $newNote = $source;
    }
if ($subtitle ne "")
    {
    if ($subtitle =~ /^\(/)		# A comment
	{
	if ($editor ne "")		# insert into the footnote.
	    {
	    $newNote = "$source $subtitle   $editor";
	    }
	  else
	    {
	    $newNote = "$source $subtitle";
	    }
	}
    elsif ($subtitle =~ /^[2-9][0-9]*\./)	# A later movement
      {
      $title = $subtitle;			# make it the title
      }
    else
      {
      $title = "$title--$subtitle";		# Append it to the title
      }
    }

substr($stAll, $ft2FirstPageOnly, 1) = pack "c", 1; # footnote 1st page only
$offset = $ft2PageNum;		# move to beginning of page number string
my $pageNumString = getBstr();	# Discard page # string and set offset;
SubstStr($newNote);		# substitute in new footnote.
$offset = index($stAll, "CPiece", $offset) + 14;
SubstStr($title);		# substitute in title
SubstStr($composer);		# substitute in composer

open TMP, "> $file" or die "$file: Cannot open for writing.\n";
print TMP $stAll;
close TMP;
} # ModFt2

sub ModFt3
{
my ($file) = @_;
my $error = "";
my $newNote = "$source   $editor";
substr($stAll, $ft3FirstPageOnly, 1) = pack "c", 1; # footnote 1st page only
$offset = $ft3PageNum;
my $pageNumString = getBstr();	#Discard page # string.
SubstStr($newNote);
$offset = index($stAll, "CPiece", $offset) + 14;
InsFt3($title);
InsFt3($subtitle);
InsFt3($composer);
open TMP, "| gzip > $file" or die "$file: Cannot open for writing.\n";
print TMP $stAll;
close TMP;
} # ModFt3

sub InsFt3
{
my ($stIn) =  @_;
my $strLen = ord(get(1));
if ($strLen > 0)
    {
    --$offset;			# Correct for get having incremented it

    if (substr($stAll, $offset + 1, 100) !~ /^\{\\rtf/)
	{
	SubstStr($stIn);
	}
      else
	{
	my $insertPoint = index($stAll, "\\f0\\fs", $offset);
	$insertPoint = index($stAll, " ", $insertPoint) + 1;
	my $currEndPoint = index($stAll, "\\", $insertPoint);
	my $oldLen = $currEndPoint - $insertPoint;
	substr($stAll, $insertPoint, $oldLen) = $stIn;
	my $newLen = $strLen - $oldLen + (length($stIn));
	substr ($stAll, $offset, 1) = pack "C", $newLen;
	$offset += $newLen + 1;
	}
    }
}  # InsFt3

sub clean {
    my($x) = @_;
    $x =~ s/[\r\n]*$//g;
    $x =~ s/^[\t ]*//g;
    $x =~ s/[\t ]*$//;
#    $x =~ s/[\t ]+/ /g;
    return $x;
}

sub getBstr
    {
    return get(ord(get(1)));
    }

sub get {
    my($numChars) = @_;
    return "" if ($numChars == 0);
    my $x = substr($stAll, $offset, $numChars);
    $offset += $numChars;
    return $x;
}

sub SubstStr
    {
    my ($newStr) = @_;
    my $oldLen = ord(get(1));
    --$offset;
    my $newLen = length($newStr);
    my $firstChar = pack "C", $newLen;
    substr($stAll, $offset, 1) = $firstChar;	# add length character
    ++$offset;					# update offset
    substr($stAll, $offset, $oldLen) = $newStr;	# substitute new string
    $offset += $newLen;				# update offset
    }