Skip to content
Snippets Groups Projects
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