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