Here it is folks, my first perl program. To make matters worse, I had to run it on the Macintosh and learn about saving scripts as droplets, and dragging the file to activate the script. At least it is fast and elegant.
#!/bin/perl #
# Concatenate all dropped files into a single output file # (save this script from MacPerl as a droplet)
require "GUSI.ph" ; # $output = &MacPerl'Choose(
# &GUSI'AF_FILE, 0, "", "", # &GUSI'CHOOSE_NEW + &GUSI'CHOOSE_DEFAULT, "cat output"); # $lastcode is used to store the music category of the previos record # and when it changes, the old file is closed and a new file opened # 7777 is not found on the file, so the first time record will trigger # a new file $lastcode = 7777; #
$firstrec ="Y"; #
$lastline ="<HR> <a href=bindex.htm>Return to Index</A> \n"; while (<>) {
($bwv, $bwv2, $mcode, $title, $y1, $y2, $mkey, $occasion, $author, $scoring, $manus, $remarks, $recommended, $mycat) =
split(/\t/, $_); if (($firstrec eq "y") || ($lastcode ne $mcode)) {
if ($firstrec eq "y") {
$firstrec =""; } else {
print OUT "$lastine"; close(OUT); }
open(OUT,">bwv".$mcode.".html") ; &MacPerl'SetFileInfo("ALFA", "TEXT", $output) ; select(OUT) ; $lastcode = $mcode; #
# I need some code to put in a decent description of the category # rather than just the number. Oh well, next release #
print OUT "<title>J S Bach Catalogue for category $mcode </title> \n <HR> \n"; }
print OUT "<strong>$title</strong> (BWV $bwv$bwv2) "; if ($recommended ne "") { print OUT "<strong>Recommended</strong>"; }
print OUT " <BR> \n "; if ($key ne "") { print OUT "<em>Key:</em> $key \n"; }
if ($scoring ne "") { print OUT " <em>Scoring:</em> $scoring \n"; }
if ($y1 ne "") { print OUT "<em>Year written:</em> $y1 $y2\n"; }
if ($occasion ne "") { print OUT " <em>Occasion:</em> $occasion \n"; }
if ($author ne "") { print OUT "<BR> <em>Text author:</em> $author <BR> \n"; }
if ($manuscript ne "") { print OUT "<BR> <em>Manuscript</em> $manus \n"; }
if ($remarks ne "") { print OUT "<BR> $remarks \n"; }
print OUT "<p>\n"; } ; # end of file reached so close the file print OUT "$lastline"; close(OUT) ;