Engine for LaTeX songbooks http://www.patacrep.com
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

99 lines
2.1 KiB

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