-
Reinhold Kainhofer authoredReinhold Kainhofer authored
pae2xml.pl.orig 16.11 KiB
#!/usr/bin/perl
# Copyright (C) 2003 Rainer Typke
#pae2xml is licensed under the terms of the GNU General Public License Version
#2 as published by the <a href="http://www.fsf.org/" target="_top">Free Software Foundation</a>.
#This gives you legal permission to copy, distribute and/or modify <em>pae2xml</em> under
#certain conditions. Read
#the <a href="http://www.gnu.org/copyleft/gpl.html" target="_top">online version of the license</a>
#for more details. pae2xml is provided AS IS with NO WARRANTY OF ANY KIND,
#INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY, AND FITNESS FOR A PARTICULAR PURPOSE.
$divisions = 960;
$old_duration = $divisions;
$old_octave = 4;
($mday, $mon, $year) = (localtime()) [3..5];
$encoding_date = sprintf("%4d-%02d-%02d", $year + 1900, $mon+1, $mday);
$TIE = 0;
foreach $a (@ARGV) {
$p = read_file($a);
$toprint = "";
$p =~ s/\s*\=\=+\s*(.*?)\s*\=\=+\s*/$1/sg;
$p =~ s/\s*included.*?-------------*\s*(.*?)\s*/$1/s;
($q, $r) = ($p, $p);
if ($q !~ /^.*1\.1\.1.*$/gsx && $r =~ /^.*plain.*$/gsx) {
print_error("$a contains 'plain', but not 1.1.1!\n");
} else {
if ($p =~ /^\s*([^\n]+)\n(.*?)\n((\d+\.\d+\.\d.*?plain.*?\n)+)(.*?)\n?([^\n]+)\n([^\n]+)\s*$/gs) {
my ($comp, $title, $incipits, $sonst, $libsig, $rismsig) = ($1, $2, $3, $5, $6, $7);
$toprint .= "
COMPOSER: $comp
TITLE: $title
INCIPIT(S): $incipits
OTHER INFO: $sonst
LIB. SIGN.: $libsig
RISM SIGN.: $rismsig\n\n";
parse_incipits($incipits, $comp, $title, $sonst, $libsig, $rismsig);
}
else { if (index($p,"plain&easy") > -1) {
print_error("Ignoring the following text:\n\n\n$p\n\n\n");
}
}
}
}
sub parse_incipits {
my ($incipits, $comp, $title, $sonst, $libsig, $rismsig) = @_;
$toprint .= "parsing: $incipits\n";
while ($incipits =~ /^(\d+\.\d+\..+?)(\d+\.\d+\..*)$/gs) {
my ($inc1) = $1;
$incipits = $2;
parse_pe($inc1, $comp, $title, $sonst, $libsig, $rismsig);
}
parse_pe($incipits, $comp, $title, $sonst, $libsig, $rismsig);
}
sub parse_pe {
my ($pe, $comp, $title, $sonst, $libsig, $rismsig) = @_;
$pe =~ s/@/@0/gs; # make missing time signature explicit