#!/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 = ; 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"; }