#!/import/perl/bin/perl
# toctitles2html.pl ../ascii/dt.tunetoc ../ascii/dt.toc > DigiTradTitles.html

# read tune table first
$tocfile = shift;
open(TOC,$tocfile) || die;

while (<TOC>) {
    chop;
    ($tuneid,$line,$start,$end,$title)=split(/;/);
    $tuneid =~ tr/ //d;
    $TuneExists{$tuneid} = 1;
    $TuneUsed{$tuneid} = 0;
    $TuneTitle{$tuneid} = $title;
}
close(TOC);

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

warn "------------------------\n";
warn "play.exe references to non-existant tunes:\n";
warn "\nsong id     missing tune  song title\n";
warn   "-------     ------------  ----------\n";

while (<>) {
    chop;
    ($songid, $songnum, $line, $start, $end, $tunecodes, $title, $cats) = split(/;/);
    $songid =~ tr/ //d;
    if ($songid eq "") {
	warn "************** ignoring entry with no song id: $_***************\n";
	next;
    }
    $SongTitles{$songid} = $title;
    $tunecodes =~ s/^%//;
    $tunecodes =~ tr/ //d;
    $sameid = 0;
    foreach $tuneid (split(/%/,$tunecodes)) {
	if ($TuneUsed{$tuneid}++ ne "") {
	    $sameid = 1 if $songid eq $tuneid;
	} else {
	    warn sprintf("%-12s %-12s %s\n", $songid, $tuneid, $title);
	}
    }
    if (! $sameid && $TuneExists{$songid}) {
	$tunecodes .= "%" if $tunecodes;
	$tunecodes .= "$songid";
	$AddedSame .= sprintf("%-12s  %s  (%s)\n", $songid, $TuneTitle{$songid}, $title);
    }
    $SongTunes{$songid} = $tunecodes if $tunecodes ne "";

    $stitle = $title;
    $stitle =~ tr/a-z/A-Z/;
    $stitle =~ s/^THE |^A |^AN //i;
    push(@SortEntries, $stitle . "|" . $songid);
}


warn "\n------------------------\n";
warn   "songs that do not reference existing tune with same id:\n";
warn   "(link added to tune table of contents)\n\n";
warn   "song/tune id  tune title  (song title)\n";
warn   "------------  ------------------------\n", $AddedSame;


foreach $tuneid (keys(TuneUsed)) {
    delete $TuneUsed{$tuneid} if $TuneUsed{$tuneid};
}

warn "\n------------------------\n";
warn   "tunes not referenced from any song:\n";
warn   "(* = song with same id exists, as listed above)\n";
warn "\ntune id      tune title\n";
warn   "-------      ----------\n";
foreach $tuneid (sort keys(TuneUsed)) {
    $title = $TuneTitle{$tuneid};
    $flag = $SongTitles{$tuneid} ? "*" : " ";
    warn sprintf("%-10s %s %-12s %s\n", $tuneid, $flag, $title);
}


########### generate start of top level html table of contents file #############

print <<EOF;
<TITLE>Digital Tradition Folk Song Titles</TITLE>
<H1>Digital Tradition Folk Song Titles</H1>
<P>
Select a first letter to see song titles,
or go to the
<A HREF="AboutDigiTrad.html">Digital Tradition</A>
Database to
<A HREF="/digitrad/titles">Search Titles</A>
or <A HREF="/digitrad">Search Full Text</A>.
<UL>
EOF

foreach $stitle (sort @SortEntries) {
    warn "INVALID STITLE: $stitle\n" unless $stitle =~ /(.*)\|(.*)/;
    ($flet, $songid) = ($1,$2);
    $flet =~ /^(....[\S]*)/;
    $fword = $1;
    $fword =~ s/,$//;
    $fword =~ tr/a-z/A-Z/;
    $flet = substr($flet,0,1);
    $flet =~ tr/a-z/A-Z/;
    $flet = "0-9" if $flet =~ /[0-9]/;

    if ($flet ne $letter) {
	&finish if defined $fname;
	$letter = $flet;
	$saveword = $fword;
	$fname = "dt-titles-$letter.html";
	 if ($repeated{$flet}++) {
	     warn "Out of order title: $stitle\n";
	    open(OUT,">>$fname") || die;
	print OUT <<EOF;
<MENU>
EOF
	} else {
	    open(OUT,">$fname") || die;
	print OUT <<EOF;
<TITLE>Digital Tradition Titles starting with $letter</TITLE>
<H1>Digital Tradition Titles starting with $letter</H1>
<P>
Select a song,
or go to the <A HREF="/digitrad/titles">Digital Tradition Database</A>
to enter a search pattern.
(* indicates songs with tunes available.)
<MENU>
EOF
	}
    }
    $prevword = $fword;
    $title = $SongTitles{$songid};
    if (! $title) {
    	warn sprintf("invalid song id in index: %-8s\n", $songid);
	print OUT "<LI>$stitle";
    } else {
	print OUT "<LI><A HREF=\"/digitrad/song=$songid\">$title</A>";
    }
    @tunes = split(/%/, $SongTunes{$songid});
    foreach $tuneid (@tunes) {
	print OUT " <A HREF=\"/digitrad/tune=$tuneid\">*</A>";
    }
    print OUT "\n";
}

&finish;
print "</UL>\n";


sub finish {
    print(OUT "</MENU>\n");
    close(OUT);
    print "<LI><A HREF=\"$fname\">$saveword .. $prevword</A>\n";
}

