#!/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 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; my @prefix = (); while( @data && ( $data[0] =~ /^\s*%prefix (.*)$/ ) ) { push @prefix, $1; shift @data; } # Create the prefix rule my $prefix = '('. join ("|", @prefix) . ')'; # Create the filter function sub filter($) { my $string = shift; $string =~ /^$prefix?[^\w]*([\w])/; my $letter = $2; $letter = "0-9" if ( $letter =~ /\d/ ); # group every numbers $string =~ s/^$prefix?\s?(.*)/$2, $1/ unless $prefix eq "()"; 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"; }