pae2xml.pl.orig

   1 #!/usr/bin/perl
   2
   3
   4 # Copyright (C) 2003 Rainer Typke
   5 #pae2xml is licensed under the terms of the GNU General Public License Version
   6 #2 as published by the <a href="http://www.fsf.org/" target="_top">Free Software Foundation</a>.
   7 #This gives you legal permission to copy, distribute and/or modify <em>pae2xml</em> under
   8 #certain conditions. Read
   9 #the <a href="http://www.gnu.org/copyleft/gpl.html" target="_top">online version of the license</a>
  10 #for more details. pae2xml is provided AS IS with NO WARRANTY OF ANY KIND,
  11 #INCLUDING THE WARRANTY OF DESIGN, MERCHANTABILITY, AND FITNESS FOR A PARTICULAR PURPOSE.
  12
  13
  14
  15 $divisions = 960;
  16 $old_duration = $divisions;
  17 $old_octave = 4;
  18
  19 ($mday, $mon, $year) = (localtime()) [3..5];
  20 $encoding_date = sprintf("%4d-%02d-%02d", $year + 1900, $mon+1, $mday);
  21
  22 $TIE = 0;
  23
  24 foreach $a (@ARGV) {
  25   $p = read_file($a);
  26   $toprint = "";
  27   $p =~ s/\s*\=\=+\s*(.*?)\s*\=\=+\s*/$1/sg;
  28   $p =~ s/\s*included.*?-------------*\s*(.*?)\s*/$1/s;
  29
  30   ($q, $r) = ($p, $p);
  31   if ($q !~ /^.*1\.1\.1.*$/gsx && $r =~ /^.*plain.*$/gsx) {
  32     print_error("$a contains 'plain', but not 1.1.1!\n");
  33   } else {
  34     if ($p =~ /^\s*([^\n]+)\n(.*?)\n((\d+\.\d+\.\d.*?plain.*?\n)+)(.*?)\n?([^\n]+)\n([^\n]+)\s*$/gs)    {
  35       my ($comp, $title, $incipits, $sonst, $libsig, $rismsig) = ($1, $2, $3, $5, $6, $7);
  36
  37       $toprint .= "
  38 COMPOSER:   $comp
  39 TITLE:      $title
  40 INCIPIT(S): $incipits
  41 OTHER INFO: $sonst
  42 LIB. SIGN.: $libsig
  43 RISM SIGN.: $rismsig\n\n";
  44       parse_incipits($incipits, $comp, $title, $sonst, $libsig, $rismsig);
  45     }
  46     else { if (index($p,"plain&easy") > -1) {
  47       print_error("Ignoring the following text:\n\n\n$p\n\n\n");
  48            }
  49          }
  50   }
  51 }
  52
  53
  54 sub parse_incipits {
  55   my ($incipits, $comp, $title, $sonst, $libsig, $rismsig) = @_;
  56
  57   $toprint .= "parsing:   $incipits\n";
  58
  59   while ($incipits =~ /^(\d+\.\d+\..+?)(\d+\.\d+\..*)$/gs) {
  60     my ($inc1) = $1;
  61     $incipits = $2;
  62     parse_pe($inc1, $comp, $title, $sonst, $libsig, $rismsig);
  63   }
  64   parse_pe($incipits, $comp, $title, $sonst, $libsig, $rismsig);
  65 }
  66
  67 sub parse_pe {
  68   my ($pe, $comp, $title, $sonst, $libsig, $rismsig) = @_;
  69
  70   $pe =~ s/@ü/@0ü/gs; # make missing time signature explicit
  71   while ($pe =~ s/([^\-])(\d+)(\'|\,)(A|B|C|D|E|F|G)/$1$3$2$4/gs) {};  # octave first, then duration. Truly global.
  72
  73   if ($pe =~ /^\s*(\d+\.\d+\.\d)(\.|:)\s*(.*?)\nplain&easy:\s*(%([\w\-\d]+))?(@([\d\w\/]+))?\s*&?\s*(\$([^ü]+))?ü(.*)$/gs) {
  74     my ($inr, $instr, $clef, $timesig, $keysig, $rest) = ($1, $3, $5, $7, $9, $10);
  75
  76     my $filename="$rismsig-$inr.xml";
  77     $filename =~ s/RISM\s*A\/II\s*:?\s*//gs;
  78     print "Writing $filename...\n";
  79
  80     open(OUT, ">$filename");
  81
  82     if ($clef =~ /^(\w)\-(\d)$/) {
  83       ($clefsign, $clefline) = ($1, $2);
  84     } else {
  85       ($clefsign, $clefline) = ("G", 2);
  86     }
  87
  88     $timesig = timesignature($timesig);
  89
  90     my %fif=("", 0, "xF", 1, "xFC", 2, "xFCG",3, "xFCGD",4, "xFCGDA",5, "xFCGDAE",6, "xFCGDAEB",7, "bB",-1, "bBE",-2, "bBEA",-3, "bBEAD",-4, "bBEADG",-5, "bBEADGC",-6, "bBEADGCF",-7);
  91     $keysig =~ s/(\s+)|&//gs;  # it is unclear what the & means, so we'll ignore it for now.
  92     $keysig =~ s/\[|\]//gs; # IGNORING brackets around a key sig.
  93     $fifths = $fif{$keysig};
  94     if ($fifths eq "") { $fifths = "0";
  95                        print_error("Strange key signature '$keysig'.\n");}
  96
  97     foreach $_ ($rismsig,$title,$inr,$instr,$comp,$encoding_date,$libsig,$sonst)
  98     {
  99         s/
 100 //;
 101     }
 102     print OUT '<?xml version="1.0" encoding="iso-8859-1" standalone="no"?>
 103 <!DOCTYPE score-partwise PUBLIC "-//Recordare//DTD MusicXML 0.6 Partwise//EN" "file:/c:/Program Files/MusicXML/partwise.dtd">
 104 <score-partwise>
 105         <work>
 106                 <work-number>'.$rismsig.'</work-number>
 107                 <work-title>'.$title.'</work-title>
 108         </work>
 109         <movement-number>'.$inr.'</movement-number>
 110         <movement-title>'.$instr.'</movement-title>
 111         <identification>
 112                 <creator type="composer">'.$comp.'</creator>
 113                 <encoding>
 114                         <software>pae2xml by R. Typke</software>
 115                         <encoding-date>'.$encoding_date.'</encoding-date>
 116                 </encoding>
 117                 <source>'.$libsig.'</source>
 118         </identification>
 119         <part-list>
 120                 <score-part id="P1">
 121                         <part-name>'.$sonst.'</part-name>
 122                 </score-part>
 123         </part-list>
 124         <part id="P1">
 125                 <measure number="1">
 126                         <attributes>
 127                                 <divisions>'.$divisions.'</divisions>
 128                                 <key>
 129                                         <fifths>'.$fifths.'</fifths>
 130                                 </key>
 131                                 '.$timesig.'
 132                                 <clef>
 133                                         <sign>'.$clefsign.'</sign>
 134                                         <line>'.$clefline.'</line>
 135                                 </clef>
 136                         </attributes>
 137 ';
 138
 139
 140     $toprint .= "
 141 INCIPIT NO.:  $inr
 142 INSTR.:       $instr
 143 CLEF:         $clef
 144 KEY SIG.:     $keysig
 145 TIME SIG.:    $timesig
 146 REST:         $rest\n";
 147     parse_notes($rest, $keysig);
 148   }
 149   else { print_error("could not parse $pe\n"); }
 150   print OUT "   </part>
 151 </score-partwise>\n";
 152   close OUT;
 153 }
 154
 155
 156 sub parse_notes {
 157   my ($notes, $keysig) = @_;
 158   my $qq = 0; # in group of cue notes
 159
 160   my $meas = 2;   # measure number
 161   my $mopen = 1;  # measure tag still open
 162
 163   if ($notes =~ /^\s*(.*?)\s*$/) {
 164     $notes = $1;
 165   }
 166
 167   $notes =~ s/!([^!]*)!/$1$1/gs;  # write out repetitions
 168   $notes =~ s/\{([^\}]*)\}/$1/gs; # ignore beamings
 169
 170   $notes =~ s/(\d+)\(([^;]+\))/\($1$2/gs;       # pull note lengths into fermatas or triplets
 171   $notes =~ s/(xx|x|bb|b|n)\(/\($1/gs;       # pull accidentals into tuplets or fermatas:
 172   $notes =~ s/(\d+)(xx|x|bb|b|n)(A|B|C|D|E|F|G)/$2$1$3/gs;  # accidentals first, then duration
 173
 174 #  $notes =~ s/x\(/\(x/gs;       # pull accidentals into tuplets or fermatas
 175 #  $notes =~ s/bb\(/\(bb/gs;       # pull accidentals into tuplets or fermatas
 176 #  $notes =~ s/b\(/\(b/gs;       # pull accidentals into tuplets or fermatas
 177 #  $notes =~ s/n\(/\(n/gs;       # pull accidentals into tuplets or fermatas
 178   #  $notes =~ s/(\'+|\,+)\(/\($1/g;       # pull octave marks into tuplets or fermatas
 179
 180   $notes =~ s/(\.|\d|\,|\')qq/qq$1/gs; # pull beginning mark of group of grace notes in front of corresponding notes
 181   $notes =~ s/(xx|x|bb|b|n)qq/qq$1/gs;  # qq first, then parts of notes
 182
 183   $notes =~ s/\=(\d)/$1/gs; # replace multibar rests #n with just n
 184
 185   while ($notes ne "") {
 186     if ($notes =~ /^(\'+|\,+)(.*)$/) {
 187       ($oct, $notes) = ($1, $2);
 188       octave($oct);
 189     } elsif ($notes =~ /^qq(.*)$/) {
 190       $notes = $1;
 191       $qq = 1;
 192     } elsif ($notes =~ /^r(.*)$/) {
 193       $notes = $1;
 194       $qq = 0;
 195     } elsif ($notes =~ /^(\d+|\=)(\/.*)$/) {
 196       $measrest = $1;
 197       $notes = $2;
 198       if ($measrest eq '=') {
 199         $measrest = 1;
 200       }
 201       $toprint .= "$measrest measures of rest.\n";
 202       for $n (1..$measrest) {
 203         print OUT '                     <note>
 204                                 <rest />
 205                                 <duration>'.($beats*$divisions*4/$beattype).'</duration>
 206 '.#                             <type>quarter</type>
 207 '
 208                         </note>
 209 ';
 210         if ($n < $measrest) {
 211           print OUT "           </measure>\n";
 212           if ($notes ne "") {
 213             print OUT '         <measure number="'.$meas.'">
 214 ';
 215             $meas++;
 216           }
 217         }
 218       }
 219     } elsif ($notes =~ /^((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*)$/) {  # a note
 220       ($note, $notes) = ($1,$6);
 221       parse_note($note, $keysig, "", "", $qq);
 222     } elsif ($notes =~ /^(\((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?\))(.*)$/) {  # one note with a fermata
 223       ($note, $notes) = ($1,$6);
 224       parse_note($note, $keysig, "", "", $qq);
 225     } elsif ($notes =~ /^(\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?){3}\))(.*)$/) {  # a triplet
 226       ($triplet, $notes) = ($1,$7);
 227       #      print "TRIPLET: ".$triplet." -> ";
 228       $triplet =~ /^\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*)\)$/gs;
 229       ($note, $triplet) = ($1,$6);
 230       #print "$note $triplet\n";
 231       parse_note($note, $keysig, '<tuplet type="start"/>', '                            <time-modification>
 232                                         <actual-notes>3</actual-notes>
 233                                         <normal-notes>2</normal-notes>
 234                                 </time-modification>', $qq);
 235       $triplet =~ /^((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*)$/gs;
 236       ($note, $triplet) = ($1,$6);
 237       #print "$note $triplet\n";
 238       parse_note($note, $keysig,  '', '                         <time-modification>
 239                                         <actual-notes>3</actual-notes>
 240                                         <normal-notes>2</normal-notes>
 241                                 </time-modification>', $qq);
 242       parse_note($triplet,  $keysig, '<tuplet type="stop"/>',  '                                <time-modification>
 243                                         <actual-notes>3</actual-notes>
 244                                         <normal-notes>2</normal-notes>
 245                                 </time-modification>', $qq);
 246     } elsif ($notes =~ /^((\d+)\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)+\;(\d+)\))(.*)$/)  {  # an n-tuplet
 247       ($tuplet, $notes) = ($1,$9);
 248       #      print "N-TUPLET: ".$tuplet." -> ";
 249       $tuplet =~ /^(\d+)\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.*);(\d)\)$/gs;
 250       ($combdur, $note, $tuplet, $numval) = ($1,$2,$7,$8);
 251       #print "i=$combdur, n=$numval; $note / $tuplet\n";
 252       my $ind_dur = duration($combdur)/$numval;
 253       # my $norm_notes =
 254       my $act_notes = $numval;
 255       parse_note($note, $keysig, '<tuplet type="start"/>', '                            <time-modification>
 256                                         <actual-notes>'.$act_notes.'</actual-notes>
 257                                         <normal-notes>1</normal-notes>
 258                                 </time-modification>', $qq);
 259       while ($tuplet =~ /^((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)(.+)$/gs) {
 260         ($note, $tuplet) = ($1,$6);
 261         #print "$note / $tuplet\n";
 262         parse_note($note, $keysig,  '', '                               <time-modification>
 263                                         <actual-notes>'.$act_notes.'</actual-notes>
 264                                         <normal-notes>1</normal-notes>
 265                                 </time-modification>', $qq);
 266       }
 267       parse_note($tuplet,  $keysig, '<tuplet type="stop"/>',  '                         <time-modification>
 268                                         <actual-notes>'.$act_notes.'</actual-notes>
 269                                         <normal-notes>1</normal-notes>
 270                                 </time-modification>', $qq);
 271     } elsif ($notes =~ /^(%\w-\d)(.*)$/) {
 272       ($clef,$notes) = ($1,$2);
 273       $clef =~ /^%(\w)\-(\d)$/;
 274       ($clefsign, $clefline) = ($1, $2);
 275       print OUT '                       <attributes>
 276                                 <clef>
 277                                         <sign>'.$clefsign.'</sign>
 278                                         <line>'.$clefline.'</line>
 279                                 </clef>
 280                         </attributes>
 281 ';
 282     } elsif ($notes =~ /^@(\d\/\d|c\/?)\s*(.*)$/) {
 283       # print "$notes\n";
 284       ($timesig,$notes) = ($1,$2);
 285       #print "-> $timesig / $notes\n"; exit;
 286       $timesig = timesignature($timesig);
 287       print OUT "                       <attributes>\n$timesig
 288                         </attributes>\n";
 289     } elsif ($notes =~ /^\/(.*)$/) {
 290       $notes = $1;
 291       if ($notes =~ /^\/(.*)$/) {
 292         $notes = $1;
 293         print OUT '       <barline location="right">
 294                                 <bar-style>light-light</bar-style>
 295
 296                         </barline>
 297 ';
 298       }
 299       print OUT "               </measure>\n";
 300       if ($notes ne "") {
 301         print OUT '             <measure number="'.$meas.'">
 302 '.$clefattr;
 303         $meas++;
 304       } else {
 305         $mopen = 0;
 306       }
 307       $toprint .= "bar line\n";
 308     } #elsif ($notes =~ /^(\d*\.*\-)(.*)$/) {
 309       #($rst, $notes) = ($1, $2);
 310       #$toprint .= "rest: $rst\n";
 311       #$rst =~ /^(\d*)(\.*)\-$/;
 312       #($rst, $dots) =($1,$2);
 313       #print OUT '                      <note>
 314         #                       <rest />
 315         #                       <duration>'.duration($rst, $dots).'</duration>
 316 #'.#                            <type>quarter</type>
 317 #'
 318 #                       </note>
 319 #';
 320     elsif ($notes =~ /^\((\=)\)(.*)$/) {  # a bar of rest with a fermata
 321       ($rst, $notes) = ($1, $2);
 322       $toprint .= "rest: $rst\n";
 323       print OUT '                       <note>
 324                                 <rest />
 325                                 <duration>'.($beats*$divisions*4/$beattype).'</duration>
 326 '.#                             <type>quarter</type>
 327 '                               <notations>
 328                                         <fermata type="upright"/>
 329                                 </notations>
 330                         </note>
 331 ';
 332     }
 333     elsif ($notes =~ s/(\d+\.*)\(((\,|\')*(x|xx|b|bb|n)?\d*\.*(g|q)?(\-|A|B|C|D|E|F|G)t?\+?)\)/\($1$2\)/gs) { # pull duration into fermata parentheses
 334       #      print "after replacement: $notes\n"; exit;
 335     }
 336     else {
 337       print_error("got stuck with $notes\n");
 338       $notes = "";
 339     }
 340   }
 341   if ($mopen) {
 342     print OUT "         </measure>\n";
 343   }
 344 }
 345
 346
 347 sub parse_note {
 348   my($note, $keysig, $notation, $addition, $in_qq_group) = @_;
 349
 350   my ($fermata) = (0);
 351   my ($actualnotes, $normalnotes) = (1,1);
 352
 353   if ($addition =~ /^\s*<time-modification>\s*<actual-notes>\s*(\d+)\s*<\/actual-notes>\s*<normal-notes>\s*(\d+)\s*<\/normal-notes>\s*<\/time-modification>\s*$/) {
 354     ($actualnotes, $normalnotes) = ($1, $2);
 355   }
 356
 357   if ($note =~ /^\((.*)\)$/) {
 358     $note = $1;
 359     $fermata = 1;
 360   }
 361
 362   $note =~ /^((\,|\')*)(x|xx|b|bb|n)?(\d*)(\.*)(g|q)?(\-|A|B|C|D|E|F|G)(t?)(\+?)$/;
 363   my ($oct, $acc, $dur, $dot, $gracecue, $pitch, $trill, $tie) = ($1, $3, $4, $5, $6, $7, $8, $9);
 364
 365   print OUT '                   <note>
 366 ';
 367   if ($gracecue eq "g") {
 368     print OUT '         <grace steal-time-following="33"/>
 369 ';
 370   }
 371   if ($gracecue eq "q" || $in_qq_group) {
 372     print OUT '         <cue/>
 373 ';
 374   }
 375   if ($pitch eq "-") {
 376     print OUT "                 <rest />\n";
 377   } else {
 378     print OUT '                         <pitch>
 379                                         <step>'.$pitch.'</step>
 380 '.
 381    alter($pitch, $acc, $keysig).'
 382                                         <octave>'.octave($oct).'</octave>
 383                                 </pitch>
 384 ';
 385   }
 386   if ($gracecue ne "g") {
 387     print OUT '                         <duration>'.(duration($dur, $dot)*$normalnotes/$actualnotes).'</duration>
 388 ';
 389   }
 390 #                               <type>quarter</type>
 391
 392   if ($tie eq "+") {
 393     if (!$TIE) {
 394       $TIE = 1;
 395       print OUT '<tie type="start"/>
 396 ';
 397     }
 398   } else {
 399     if ($TIE) {
 400       print OUT '<tie type="stop"/>
 401 ';
 402       $TIE = 0;
 403     }
 404   }
 405
 406   print OUT $addition;
 407
 408   my $notationbracket = $fermata || ($trill eq "t") || ($notation ne "");
 409   if ($notationbracket) {
 410     print OUT "                         <notations>\n";
 411   }
 412   if ($fermata) { print OUT '
 413                                         <fermata type="upright"/>'."\n"; }
 414   if ($trill eq "t") { print OUT '                                      <ornaments>
 415                                                 <trill-mark/>
 416                                         </ornaments>
 417 ';
 418                      }
 419   if ($notation ne "") {
 420     print OUT "                         $notation\n";
 421   }
 422   if ($notationbracket) {
 423     print OUT "                         </notations>\n";
 424   }
 425
 426   print OUT '                   </note>
 427 ';
 428
 429   $toprint .= "note: oct. $oct/acc. $acc/dur. $dur/dots $dot/grace,cue $gracecue/pitch $pitch\n";
 430 }
 431
 432 sub alter {
 433   my ($pitch, $acc, $keysig) = @_;
 434
 435   my $alt = 0;
 436
 437   if (index ($keysig,$pitch) > -1) {
 438     $keysig =~ /^(.).*$/gs;
 439     if ($1 eq 'x') {
 440       $alt = 1;
 441     } else {$alt = -1;}
 442   }
 443
 444   my %acc_alt = ("n", 0, "b", -1, "bb", -2, "x", 1, "xx", 2);
 445   if ($acc_alt{$acc} ne "") {
 446     $alt = $acc_alt{$acc};
 447   }
 448
 449   if ($alt != 0) {
 450     return "<alter>$alt</alter>\n";
 451   }
 452   return "";
 453 }
 454
 455 sub duration {
 456   my ($duration, $dots) = @_;
 457
 458   if ($duration.$dots ne "") {
 459     my %du=("1",4*$divisions,"2",2*$divisions,"4",$divisions,
 460             "8",$divisions/2,"6",$divisions/4,"3",$divisions/8,
 461             "5",$divisions/16,"7",$divisions/32,
 462             "9",$divisions*8,"0",$divisions*16); # breve/long
 463     $old_duration = $du{$duration};
 464     if ($old_duration eq "") {
 465       print_error("strange duration '$duration'\n");
 466     }
 467     my $add = $old_duration;
 468     while ($dots ne "") {
 469       $add /= 2;
 470       $old_duration += $add;
 471       $dots =~ /^.(.*)$/gs;
 472       $dots = $1;
 473     }
 474   }
 475   return $old_duration;
 476 }
 477
 478 sub octave {
 479   my ($octave) = @_;
 480
 481   if ($octave ne "") {
 482     $octave =~ /^(.)(.*)$/gs;
 483     if ($1 eq ",") {
 484       $old_octave = 4 - length $octave;
 485     } else {
 486       $old_octave = 3 + length $octave;
 487     }
 488   }
 489   return $old_octave;
 490 }
 491
 492 sub timesignature {
 493   my ($timesig) = @_;
 494
 495   if ($timesig eq "c3") {
 496     $timesig = "3/2";  # it would be better to display it as "C". Example: 451.023.814
 497   }
 498   if ($timesig =~ /^c(\d+)\/(\d+)$/gs) {
 499     $timesig = "$1/$2";  # it would be better to show the "C"
 500   }
 501
 502   if ($timesig eq "0" || $timesig eq "") {  # unclear how to handle absence of time signature.
 503     $timesig ='<time symbol="common">
 504       <beats>4</beats>
 505       <beat-type>4</beat-type>
 506     </time>
 507 ';  # using 4/4 for now.
 508     ($beats, $beattype) = (4,4);
 509   } elsif ($timesig =~ /^c(\/?)$/gi) {
 510     if ($1 eq "/") {
 511       $timesig = '<time symbol="cut">
 512       <beats>2</beats>
 513       <beat-type>2</beat-type>
 514     </time>
 515 ';
 516       ($beats, $beattype) = (2,2);
 517     } else {
 518       $timesig = '<time symbol="common">
 519       <beats>4</beats>
 520       <beat-type>4</beat-type>
 521     </time>
 522 ';
 523       ($beats, $beattype) = (4,4);
 524     }
 525   } elsif ($timesig =~ /^(\d+)\/(\d+)$/gs) {
 526     ($beats, $beattype) = ($1, $2);
 527     $timesig = '<time>
 528       <beats>'.$beats.'</beats>
 529       <beat-type>'.$beattype.'</beat-type>
 530     </time>
 531 ';
 532   } else {
 533     print_error("Time signature '$timesig' looks strange.\n");
 534     #   $timesig = "";   we assume 4/4 just to  get something legible:
 535     ($beats, $beattype) = (4,4);
 536     $timesig = '<time>
 537       <beats>'.$beats.'</beats>
 538       <beat-type>'.$beattype.'</beat-type>
 539     </time>
 540 ';
 541   }
 542   return $timesig;
 543 }
 544
 545 sub print_error {
 546   my ($msg) = @_;
 547
 548   print "\nAn error occurred; context:\n\n$toprint\n
 549 Error: $msg\n";
 550 }
 551
 552 sub read_file {
 553   my ($fn) = @_;
 554   if (!(open FH, $fn))
 555     {
 556       return "";
 557     }
 558   my $res = "";
 559   while (<FH>) { $res .= $_; } # read all lines
 560   close (FH);
 561   return $res;
 562 }