irishsongs/utils/make-html

#!/usr/bin/perl -w
#
# Generate html index for the Crep's chorbook.
#
# Usage: make-html [options] source 
#        source should be an .sg or .sbd file
#

use warnings;
use strict;
use utf8;

sub uppercase($)
{
    my $letter = shift;
    $letter =~ tr/a-zàéèëê/A-ZAEEEE/;
    return $letter;
}

# Create the latex-proof function
sub latex2utf8($)
{
    my $result = shift;

    $result =~ s/\\'e/é/g;
    $result =~ s/\\¨e/ë/g;
    $result =~ s/\\`e/è/g;
    $result =~ s/\\\^e/ê/g;
    $result =~ s/\\\^o/ô/g;
    $result =~ s/\\\^a/â/g;
    $result =~ s/\\\^i/î/g;
    $result =~ s/\\`a/à/g;
    $result =~ s/\\`u/ù/g;
    $result =~ s/\\&/&/g;
    $result =~ s/\\oe\s*{}/oe/g;

    return ($result);   
} 
#'

sub usage ()
{ 
    die "usage: make-html [options] source", "\n";
}

sub defaultoptions() 
{
    return (
	titleprefix => "",
    );
}

my %options;
sub getoptions ()
{
    %options = defaultoptions();
    eval q{use Getopt::Long};
    Getopt::Long::Configure('pass_through');
    GetOptions(
#	       "verbose|v!" => \$options{verbose},
	       "titleprefix|p=s" => \$options{titleprefix},
	       ) || usage();
}

getoptions();

my $prefix = '(('.$options{titleprefix}.')[\s\'])';

# Filter function
sub process_titleprefix($)
{
    my $string = shift;
    if( $string =~ /^$prefix\W*(\w)/ )
    {
	my $letter = uppercase $3;
	$string =~ s/^$prefix\W*\w(.*)/$letter$3, $1/;
    }
    return $string;	
}

# Process command line
usage() unless @ARGV;
my $file = shift;

# Open file and store date before closing the file
open( FILE, $file ) or die("unable to open $file");

# Process data
my %table;
my $author;
my $title;

while( <FILE> )
{
    if( $_ =~ /\\beginsong{(.*)}\[.*by=(.*),.*\]/ )
    {
	$author = latex2utf8 $2;
	$title = latex2utf8 $1;
	$title = process_titleprefix $title unless $options{titleprefix} eq "";
	# Create empty data index if needed
	$table{$author} = [] unless exists $table{$author};
	push @{$table{$author}}, $title;
    }
}

close( FILE );

# Format output
print '<ul>';
foreach my $author ( sort keys %table )
{
    print '<li><strong>', $author, '</strong><ul>';
    foreach my $title ( sort @{$table{$author}} )
    {
	print '<li>',$title,'</li>'
    }
    print '</ul></li>';
}
print '</ul>';