#!/usr/bin/perl # # Programmer: Craig Stuart Sapp # Creation Date: Mon Mar 21 17:06:33 PDT 2016 # Last Modified: Mon Mar 21 19:12:56 PDT 2016 # Filename: lyrics # Syntax: perl 5 # # Description: This script extracts lyrics from **text spines in # Humdrum files and merges syllables into words. # # Options: -h print as HTML table # -b print HTML table with full HTML page # -v indicate verse numbers. # # Usage: lyrics [-h [-b]] file(s) > output # lyrics file(s) | fmt > output # # Example lyrics -vhb jrp://Ano3001 > index.html # use strict; use Getopt::Long; my $htmlQ = 0; # display as html my $bodyQ = 0; # embed HTML code in full page my $verseQ = 0; # display verse numbers my $titleQ = 0; # display the title Getopt::Long::Configure("bundling"); GetOptions ( 'h|html' => \$htmlQ, 'b|body' => \$bodyQ, 'v|verse' => \$verseQ ); if (@ARGV == 0) { print "Options:\n"; print "\t-h\tEmbed output in HTML file\n"; print "\t-b\tEmbed output in HTML element\n"; print "\t-v\tShow verse numbers\n"; print "\t-t\tShow title\n"; print "\n"; exit(1); } my @files = @ARGV; printHeader() if $bodyQ; printStyle() if $htmlQ; foreach my $file (@files) { if (@files > 1) { if ($htmlQ) { print "\n

$file

\n"; } else { print "\n========= Lyrics for $file\n\n"; } } printFileLyrics($file); } printFooter() if $bodyQ; exit(0); ########################################################################### ############################## ## ## printFileLyrics -- ## sub printFileLyrics { my ($file) = @_; my $line; my $counter = 0; my $tcounter = 0; my @contents = `humcat $file | extractx -r | serialize`; for (my $i=0; $i<@contents; $i++) { $line = $contents[$i]; chomp $line; if (!$counter && !$tcounter) { if ($line =~ /^\!\!\!OTL[^\s]*:\s*(.*)\s*$/) { my $title = $1; if ($titleQ) { if ($htmlQ) { print "

$title

\n"; } else { print "TITLE: $title\n\n"; } } $tcounter++; } } if ($line eq "**kern") { if (!$counter) { print "\n\n" if $htmlQ; $counter++; } processPart($i, @contents); } } print "\n
\n" if $htmlQ; } ############################## ## ## processPart -- ## sub processPart { my ($index, @contents) = @_; my $i = $index + 1; my $vcount = 1; chomp $contents[$i]; while (($i < @contents) && ($contents[$i] !~ /\*\*kern/)) { if ($contents[$i] =~ /^\*I"(.*)/) { if ($htmlQ) { print "\n$1\n"; } else { print "\n== $1 =="; } $i++; chomp $contents[$i]; next; } if ($contents[$i] eq "**text") { if ($htmlQ) { print "\n\nverse $vcount\n\t"; } elsif ($verseQ) { print "\n" if $vcount == 1; print "\n\tverse $vcount: "; } else { print "\n" if $vcount == 1; print "\n\t"; } $vcount++; $i = processVerse($i, @contents); $i--; if ($htmlQ) { print "\n"; } } return if $contents[$i] =~ /\*\*kern/; return if $i == @contents; $i++; return if $i == @contents; chomp $contents[$i]; return if $contents[$i] =~ /\*\*kern/; } print "\n"; } ############################## ## ## processVerse -- ## sub processVerse { my ($index, @contents) = @_; my $i = $index + 1; my $hasdash = 0; my $line = $contents[$i]; chomp $line; my $output = ""; while (($i < @contents) && ($line ne "**kern") && ($line ne "**text")) { if ($line eq "**text") { printVerse($output); return $i; } if ($line eq "**kern") { printVerse($output); return $i; } if ($line =~ /^[*!=]/) { $i++; $line = $contents[$i]; chomp $line; next; } if ($line eq ".") { $i++; $line = $contents[$i]; chomp $line; next; } if (!$hasdash) { $output .= " "; if ($line =~ /^-/) { $output .= "-"; } } if ($line =~ s/-$//) { $hasdash = 1; } else { $hasdash = 0; } $line =~ s/^-//; $output .= $line; $i++; $line = $contents[$i]; chomp $line; } printVerse($output); return $i; } ############################## ## ## printVerse -- ## sub printVerse { my ($verse) = @_; $verse =~ s//>/g; print $verse; print "\n"; } ############################## ## ## printStyle -- ## sub printStyle { my $visibility = " visibility: hidden;"; $visibility = "" if $verseQ; print<<"EOT"; EOT } ############################## ## ## printHeader -- ## sub printHeader { print <<"EOT"; Lyrics EOT } ############################## ## ## printFooter -- ## sub printFooter { print <<"EOT"; EOT }