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 latex during a first compilation
#        of the file.
#

use warnings;
use strict;

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

sub get_first_letter($)
{
    my $string = shift;
    $string =~ /([\w\d])/;
    my $letter = $1;
    $letter = "0-9" if ( $letter =~ /\d/ ); # group every numer into one category
    return uppercase $letter;	
}

#sub get_first_letter_wo_article($)
#{
#    my $string = shift;
#    my $letter;
#    if( $string =~ /^(The |L\'|Les |Le |La |Une |Un )/ ) # if there is an article before the name
#    {
#	$string =~ /$1([\w\d])/;
#	$letter = $1;
#    }
#    else
#    {
#	$string =~ /([\w\d])/;
#	$letter = $1;
#    }
#    $letter = "0-9" if ( $letter =~ /\d/ ); # group every numer into one category
#    return uppercase $letter;	
#}

sub usage 
{ 
    print "usage: make-index source\n";
    exit 1;
}

# 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;

my $type = shift @data; # first line determines the type of the index (AUTHOR or TITLE)

if( $type =~ /AUTHOR/ )
{
    ;
}
elsif( $type =~ /TITLE/ )
{
    shift @data; # ignore the second line (in my test cases, it contains "%prefix" which should probably be ignored.
}

while( @data )
{
    my $item = shift @data;
    chomp $item;
    my $index = shift @data;
    chomp $index;
    my $link = shift @data;
    chomp $link;
    
    # Get the first letter or number of the current item
    my $first_letter = get_first_letter $item;
    
    $table{$first_letter} = {} unless exists $table{$first_letter};
    
    my $ref = { num => $index, link => $link };
    
    $table{$first_letter}{$item} = [] unless exists $table{$first_letter}{$item};
    
    push @{$table{$first_letter}{$item}}, $ref;
}

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