#!/usr/local/bin/perl5 -w
# 
# usage: virlhtml booklist > booklist.html
# HTMLizes a tagged list of books w/ libsffs.so conventions.
# you can redefine the tags.
#
# eub 6/99
#

#use strict;

$au = "_au";# author (last-comma-first-space-middle-etc.)
    $ed = "_ed";# editor
    $co = "_co";# co-author
    $ps = "_ps";# is-pseudonym-for truename
    $ti = "_ti";# title of work
    $om = "_om";# title of omnibus book
    $tagprefix = "_";

# tags must occur at the beginning of the line.
# after that, indentation is irrelevant.
# author blocks are separated by blank lines.
#
# either $au or $ed is required, and is referred to below as "author".
# books are listed by author's last name.
# pseudonyms are a little surprising: $ps is truename, $au is nym.
#    there is no way to note a pseudonym while listing under truename.
# $co acts on the next title only.
#    coauthored books should be in the booklist only once.
#    every coauthor must appear as an author, if only with a blank record.
# $ti is the title.  there is no sorting on titles.
# $om, describing the physical binding of logical titles, is presently ignored.
# 
# _au Diggler, Dirk
# _ps Tikkitikkitembonosarembocharibariruchipippipippipembo, Dave
# _om   The Tao of Stuff
# _ti     The Tao of Buttered-Popcorn-Flavored Jelly Beans
# _co McElwaine, Robert
# _co Plutonium, Ludwig
# _ti     The Tao of PLUTONIUMIUM BAR-CODE-$CANNER$
#
# _au Plutonium, Ludwig
# _ps Ludwid van Ludwig
# _ti   The Plutonium Atom Totality

# no luser-serviceable parts below.  relaxen und watchen das blinkenlichten.

my %autable;
# authorname => list of bookrec
# bookrec{$ti} is title
# bookrec{$co} is list of coauthors

my %autruename;                 # authorname => non-pseudo, if any.

my %cotable;
# same as %autable, but indexed by co-author name.
# except right now it has no bookrec{co} field because I don't care that much.
# you know, frankly, I don't care about books with more than two authors.

sub slurpblock(*\%\%);		# reads from filehandle, puts block in autable.
sub xreference(\%\%\%);		# cross-reference autable into cotable.
sub spewhtml(*\%\%\%);		# HTML into outfile from autable, cotable.

sub dumptable(\%)
{
    my $tab = shift;

    foreach $author (keys %$tab)  {
        print "$author:\n";
        if ($autruename{$author})  {
            print "(aka $autruename{$author})\n";
        }
        foreach $bookrec (@{$tab->{$author}})  {
            print "\t$bookrec->{$ti}\n";
            $colist = $bookrec->{$co};
            foreach $coauth (@$colist)  {
                print "\t\t$coauth\n";
                if ($autruename{$coauth})  {
                    print "\t\t(aka $autruename{$coauth})\n";
                }
            }
        }
    }
}

# main()

open SRC, $ARGV[0]  or die "Can't open input file.\n";
while (1)  {
    last if !slurpblock(\*SRC, %autable, %autruename);
}
close SRC;

xreference(%autable, %autruename, %cotable);
#dumptable(%autable);
#dumptable(%cotable);

open OUT, ">$ARGV[1]"  or die "Can't open output file.\n";
spewhtml(\*OUT, %autable, %autruename, %cotable);
close OUT;

# main() ends

sub slurpblock(*\%\%)
# reads from filehandle, puts block in table.
{
    my ($src, $autab, $autrue) = @_;

    my ($author, $pseudo_for, @coauthor, $title);
    my @aubookrecs;

    my $s = $au;# what we're expecting
        while (<$src>)  {
            chomp;

            if (/^\s*$/)  {
                return 1 if ($s eq $au);   # extra newline before an author block
                $autab->{$author} = [@aubookrecs];
                return 1;
            }

            next if not /^$tagprefix/;

            $au eq $s  &&  do {
                /^$au\s*(.*)/ and $author = $1;
                /^$ed\s*(.*)/ and $author = $1 . " (ed.)";
                $author or die "can't find the author in \"$_\".\n";
                $s = $ps;
                next;
            };

            $ps eq $s  &&  do {
                $s = $ti;
                /^$ps\s*(.*)/ or redo;   # reread this line as a title.
                $autrue->{$author} = $1;
                next;
            };

            $ti eq $s  &&  do {
                next if /^$om/;# ignore omnibus tags.

                    if (/^$co\s*(.*)/)  {
                        push @coauthor, $1;
                        next;
                    }

                /^$ti\s*(.*)/ or die "can't find the title in \"$_\".\n";
                $title = $1;
                push @aubookrecs, {$ti => $title, $co => [@coauthor]};
                @coauthor = ();
                next;
            };

            die "I can't be here.";
        }

# out of input
    $autab->{$author} = [@aubookrecs] if ($s ne $au);
    return 0;
}

sub xreference(\%\%\%)
# cross-reference autable into cotable.
{
    my ($autab, $autrue, $cotab) = @_;

    for $auth (keys %$autab)  {
        for $bookrec (@{$autab->{$auth}})  {
            $title = $bookrec->{$ti};
            for $coauth (@{$bookrec->{$co}})  {
                push @{$cotab->{$coauth}}, {$ti => $title, $co => []};
            }
        }
    }
}

sub spewhtml(*\%\%\%)
# HTML into outfile from autable, cotable.
{
    my ($out, $autab, $autrue, $cotab) = @_;

    html_alphajump($out);

    my $firstletter = "-";
    for $auth (sort namesortfn (keys %$autab))  {
        $auth =~ m/^(.)/;
        html_anchor($out, $firstletter = $1) if ($1 ne $firstletter);

        html_open_author($out, $auth, $autrue);

        for $bookrec (@{$autab->{$auth}})  {
            html_list_book($out, $bookrec, $autrue);
        }
        for $bookrec (@{$cotab->{$auth}})  {
            html_list_coauth($out, $bookrec);
        }

        html_close_author($out);
    }
}

sub html_alphajump(*)
{
    my ($out) = @_;

    for ($c = "A"; $c ne "AA"; ++$c)  {
        print $out "<a href=\"#$c\">$c</a> &nbsp;\n";
    }

    print $out "\n<hr>\n\n";
}

sub html_anchor(*$)
{
    my ($out, $tag) = @_;

    print $out "<a name=\"$tag\"></a>\n";
}

sub html_open_author(*$\%)
{
    my ($out, $auth, $autrue) = @_;

    my $hash = anchorize_name($auth);
    my $truename = $autrue->{$auth} ? " ($autrue->{$auth})" : "";
    print $out "<a name=\"$hash\"> <h3>$auth$truename</h3> </a>\n";
    print $out "<ul>\n";
}

sub html_close_author(*)
{
    my $out = shift;

    print $out "</ul>\n\n";
}

sub html_list_book(*\%\%)
{
    my ($out, $bookrec, $autrue) = @_;

    my $title = $bookrec->{$ti};
    my $cotext = join("; ", @{$bookrec->{$co}});

    print $out "   <li><strong>$title</strong>";
    print $out " (with $cotext)" if $cotext;
    print $out "\n";
}

sub html_list_coauth(*\%)
{
    my ($out, $bookrec) = @_;

    my $title = $bookrec->{$ti};
    print $out "   <li><strong>$title</strong>";
    print $out " (coauthor)\n";
}

sub anchorize_name($)
{
    my ($name) = @_;

    $name =~ s/\W//g;
    return $name;
}

sub smashname($)
# ignores upper/lower, and treats Mac and Mc as M'.
# (the theory being that the difference is hard to hear/remember, so smash it.)
{
    $_ = shift;

    s/^Mc/M\'/;
    s/^Mac/M\'/;                # should we use ^Mac\u ?
                                # how can we tell "Macaulay" from "Macy"?
    return uc($_);
}

sub namesortfn($$)
{
    return (smashname($a) cmp smashname($b));
}