#!/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; 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; # 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; while( @data ) { $item = shift @data; unless( $item =~ /^\s*%/ ) # ignore a line starting with % { chomp $item; $index = shift @data; chomp $index; $link = shift @data; chomp $link; # Get the first letter or number of the current item $letter = get_first_letter $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"; }