patacrep/make-index

#!/usr/bin/perl -w
#
# Generate indexes files for the Crep's chorbook compilation. This is a much 
# simplified version from the original C programm that parse the input.
#
# Usage: mk-idx.pl SRC
#        SRC should be an .sxd file generated by the latex songs package
#

use warnings;
use strict;
use utf8;

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

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

my %options;

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

getoptions();

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

# Open file and store data before closing the file
open( FILE, $file ) or die("unable to open $file");
my @data = <FILE>;
close( FILE );

# Process data
my %table;

# Get the type of the index. Not used but we have it.
my $type = shift @data;

# Parse data and create the index table
my $item;
my $index;
my $link;
my $letter;
my $ref;

my @prefix = ();

while( @data &&  ( $data[0] =~ /^\s*%prefix (.*)$/ ) )
{
    push @prefix, $1;
    shift @data;
}

# Create the prefix rule
my $prefix = '(('. join ("|", @prefix) . ')[\s])';

# Create the filter function
sub filter($)
{
    my $string = shift;
    $string =~ /^$prefix?[^\w]*([\w])/;
    
    my $letter = uppercase $3;
    $string =~ s/^$prefix\W*\w(.*)/$letter$3, $1/;

    $letter = "0-9" if ( $letter =~ /\d/ ); # group every numbers

    return (uppercase $letter, $string);	
}

# Process data
while( @data )
{
    $item = shift @data;
    # entry goes on three lines
    chomp $item;
    $index = shift @data;
    chomp $index;
    $link = shift @data;
    chomp $link;
    
    # Get the first letter or number of the current item
    ($letter, $item) = filter $item;
    
    # Create empty data index if needed
    $table{$letter} = {} unless exists $table{$letter};
    $table{$letter}{$item} = [] unless exists $table{$letter}{$item};
    
    # Create reference for the current item
    $ref = { num => $index, link => $link };
    
    # Add the reference to the index
    push @{$table{$letter}{$item}}, $ref;
}

# Create the index formated file
my @refs;

foreach $letter ( sort keys %table )
{
    print '\begin{idxblock}{'.$letter."}\n";	
    foreach $item ( sort keys %{$table{$letter}} )
    {
	print '\idxentry{';
	print $item;
	print '}{';
	@refs = @{$table{$letter}{$item}};
	print join ("\\\\", map { "\\hyperlink{$_->{link}}{$_->{num}}" } @refs);
	print '}'."\n";
    }
    print '\end{idxblock}'."\n";
}