#!/usr/local/bin/perl
use strict;
# Ronald J Kimball, rjk-perl(at)tamias.net
# based on Sean Burke's convert_mpron.pl
# http://www.netadventure.net/~sburke/bounce.cgi/mpron/
use Getopt::Std;
use vars qw/$opt_i $opt_s $opt_l/;
getopts('isl') or die "Error.\n";
my $IAMBIC = $opt_i;
my $NOSPACES = $opt_s;
my $LOWERCASE = $opt_l;
#if (@ARGV and $ARGV[0] eq '-i') {
# $IAMBIC = 1;
# shift @ARGV;
#}
if (@ARGV != 2) {
die "usage: $0 \n";
}
my($input, $output) = @ARGV;
my($word, $pron, $meter, $next_stress_flag);
my $Debug = 0;
# $/ = "\cm"; # may be necessary
my %vowel_remap = qw<
eI e
aI !
Oi ~
AU ^
oU o
[@] [
(@) (
>;
my $vowel_re = '(' . join('|', map quotemeta, keys %vowel_remap) . ')';
open(IN, "<$input" ) or die "Can't open $input: $!\n";
open(OUT, ">$output") or die "Can't open $output: $!\n";
while () {
next if $NOSPACES and /_/;
# skip words with spaces
chomp;
($word, $pron) = split(' ', $_, 2);
next unless $pron;
next if $LOWERCASE and $word =~ /[A-Z]/ and $word ne 'I' and $word ne 'O';
# skip words with uppercase letters (but allow I)
$meter = '';
$next_stress_flag = '0';
foreach my $x ($pron =~ m<[',]|[aeiouAEIOUyY\@\&-]+>g) {
if ($x eq ',') {
$next_stress_flag = '2'; # secondary stress
next;
} elsif ($x eq "'") {
$next_stress_flag = '1'; # primary stress
next;
}
$meter .= $next_stress_flag;
$next_stress_flag = '0';
}
next if $meter eq '';
# skip words with no vowels in their pronunciation, such as 'shh'
$meter =~ tr/0/2/ if $meter =~ m/^0+$/;
# add stress to stressless words/phrases
next if $IAMBIC and $meter =~ /1(?:..)*1/;
# skip words which don't fit an iambic pattern
$word =~ s,/.*,,;
# remove part of speech indicator
$pron =~ s/$vowel_re/$vowel_remap{$1}/go;
# remap vowel sounds to single characters
$pron =~ tr<', /_><>d;
# remove stress marks, word separators, and the slashes
sleep(0), printf "%10s %-20s %s\n", $meter, $word, $pron if $Debug;
print OUT join("\t", $word, $meter, $pron), "\n";
last if $Debug and $. > 1000;
}
close(OUT);
exit;
__END__