mirror of https://github.com/patacrep/patacrep.git
Alexandre Dupas
16 years ago
committed by
Alexandre Dupas
1 changed files with 119 additions and 0 deletions
@ -0,0 +1,119 @@ |
|||
#!/usr/bin/perl -w |
|||
# |
|||
# Generate html index for the Crep's chorbook. |
|||
# |
|||
# Usage: make-html [options] source |
|||
# source should be an .sg or .sbd file |
|||
# |
|||
|
|||
use warnings; |
|||
use strict; |
|||
use utf8; |
|||
|
|||
sub uppercase($) |
|||
{ |
|||
my $letter = shift; |
|||
$letter =~ tr/a-zàéèëê/A-ZAEEEE/; |
|||
return $letter; |
|||
} |
|||
|
|||
# Create the latex-proof function |
|||
sub latex2utf8($) |
|||
{ |
|||
my $result = shift; |
|||
|
|||
$result =~ s/\\'e/é/g; |
|||
$result =~ s/\\¨e/ë/g; |
|||
$result =~ s/\\`e/è/g; |
|||
$result =~ s/\\\^e/ê/g; |
|||
$result =~ s/\\\^o/ô/g; |
|||
$result =~ s/\\\^a/â/g; |
|||
$result =~ s/\\\^i/î/g; |
|||
$result =~ s/\\`a/à/g; |
|||
$result =~ s/\\`u/ù/g; |
|||
$result =~ s/\\&/&/g; |
|||
$result =~ s/\\oe\s*{}/oe/g; |
|||
|
|||
return ($result); |
|||
} |
|||
#' |
|||
|
|||
sub usage () |
|||
{ |
|||
die "usage: make-html [options] source", "\n"; |
|||
} |
|||
|
|||
sub defaultoptions() |
|||
{ |
|||
return ( |
|||
titleprefix => "", |
|||
); |
|||
} |
|||
|
|||
my %options; |
|||
sub getoptions () |
|||
{ |
|||
%options = defaultoptions(); |
|||
eval q{use Getopt::Long}; |
|||
Getopt::Long::Configure('pass_through'); |
|||
GetOptions( |
|||
# "verbose|v!" => \$options{verbose}, |
|||
"titleprefix|p=s" => \$options{titleprefix}, |
|||
) || usage(); |
|||
} |
|||
|
|||
getoptions(); |
|||
|
|||
my $prefix = '(('.$options{titleprefix}.')[\s\'])'; |
|||
|
|||
# Filter function |
|||
sub process_titleprefix($) |
|||
{ |
|||
my $string = shift; |
|||
if( $string =~ /^$prefix\W*(\w)/ ) |
|||
{ |
|||
my $letter = uppercase $3; |
|||
$string =~ s/^$prefix\W*\w(.*)/$letter$3, $1/; |
|||
} |
|||
return $string; |
|||
} |
|||
|
|||
# Process command line |
|||
usage() unless @ARGV; |
|||
my $file = shift; |
|||
|
|||
# Open file and store date before closing the file |
|||
open( FILE, $file ) or die("unable to open $file"); |
|||
|
|||
# Process data |
|||
my %table; |
|||
my $author; |
|||
my $title; |
|||
|
|||
while( <FILE> ) |
|||
{ |
|||
if( $_ =~ /\\beginsong{(.*)}\[.*by=(.*)\]/ ) |
|||
{ |
|||
$author = latex2utf8 $2; |
|||
$title = latex2utf8 $1; |
|||
$title = process_titleprefix $title unless $options{titleprefix} eq ""; |
|||
# Create empty data index if needed |
|||
$table{$author} = [] unless exists $table{$author}; |
|||
push @{$table{$author}}, $title; |
|||
} |
|||
} |
|||
|
|||
close( FILE ); |
|||
|
|||
# Format output |
|||
print '<ul>'; |
|||
foreach my $author ( sort keys %table ) |
|||
{ |
|||
print '<li><strong>', $author, '</strong><ul>'; |
|||
foreach my $title ( sort @{$table{$author}} ) |
|||
{ |
|||
print '<li>',$title,'</li>' |
|||
} |
|||
print '</ul></li>'; |
|||
} |
|||
print '</ul>'; |
Loading…
Reference in new issue