ProtoElf to ProtoHuman

#!/bin/env perl

# Voiceless Aspirated Stops
my @AspiratedStop = qw(pʰ tʰ t͡sʰ t͡ʃʰ ʈ͡ʂʰ t͡ɕʰ kʲʰ kʰ kʷʰ);
my @NonAspirant = qw(ɸ θ t͡s t͡ʃ ʈ͡ʂ t͡ɕ xʲ x xʷ);
# Plain Voiceless Stops
my @VoicelessStop = qw(p t t͡s t͡ʃ ʈ͡ʂ t͡ɕ kʲ k kʷ);
# Voiced Stops
my @VoicedStop = qw(b d d͡z d͡ʒ ɖ͡ʐ d͡ʑ gʲ g gʷ);

# Shibilants
my @AbstractShibilant = qw(t͡ʃʰ t͡ʃ d͡ʒ ʃ ʒ ḻ ṉ r̠);
my @PalatalShibilant = qw(t͡ɕʰ t͡ɕ d͡ʑ ɕ ʑ ʎ ɲ ɺʲ);
my @RetroflexShibilant = qw(ʈ͡ʂʰ ʈ͡ʂ ɖ͡ʐ ʂ ʐ ɭ ɳ ɻ);
my @Sibilant = qw(t͡sʰ t͡s d͡z s z l n r);

# Fricatives for Lenition
my @LenitableStop = qw(b d g gʷ gʲ);
my @VoicedFricative = qw(β ð ɣ ɣʷ j);
my @VoicelessFricative = qw(ɸ θ x xʷ ç);

my $Consonant = join "|",@Sibilant,@VoicelessStop;@VoicedStop;

# Vowels
my $PelfFrontVowel = join "|",qw(æ e ø i y);
my $PelfBackVowel = join "|",qw(a ə o ɨ u);
my $PhumVowels = join "|",qw(ɑ ɑː e eː ɛː ɔː i u iː uː iu̯ ui̯ eu̯ ɑi̯ ɑu̯);

my @Stop = ();
push @Stop, @VoicelessStop, @VoicedStop;

my $Consonant = join "|", @S, @Z;

# Boundaries
my $V = "a|ə|e|o|i|u|ø|y";

use warnings;
use strict;

# Open the filer̠
open(my $fh, "<", $ARGV[0]);

# Read line by line
while(<$fh>)
{
  # apply early transformations here
  # Abstract -> Palatal 1
  for(my $i = 0; $i < @AbstractShibilant; $i++) {
    # retrieve the source
    my $item = @AbstractShibilant[$i];
    # and replacement
    my $rplc = @PalatalShibilant[$i];

    # replace the source by replacement inside the boundaries
    s/((?:$PelfFrontVowel)+)$item/$1$rplc/gi

  }
  # Abstract -> Retroflex 1
  for(my $i = 0; $i < @AbstractShibilant; $i++) {
    # retrieve the source
    my $item = @AbstractShibilant[$i];
    # and replacement
    my $rplc = @RetroflexShibilant[$i];

    # replace the source by replacement inside the boundaries
    s/((?:$PelfBackVowel)+)$item/$1$rplc/gi

  }
  # Abstract -> Palatal 2
  for(my $i = 0; $i < @AbstractShibilant; $i++) {
    # retrieve the source
    my $item = @AbstractShibilant[$i];
    # and replacement
    my $rplc = @PalatalShibilant[$i];

    # replace the source by replacement inside the boundaries
    s/$item((?:$PelfFrontVowel)+)/$rplc$1/gi

  }
  # Abstract -> Retroflex 2
  for(my $i = 0; $i < @AbstractShibilant; $i++) {
    # retrieve the source
    my $item = @AbstractShibilant[$i];
    # and replacement
    my $rplc = @RetroflexShibilant[$i];

    # replace the source by replacement inside the boundaries
    s/$item((?:$PelfBackVowel)+)/$rplc$1/gi

  }
  # Nasal Rhotacism /n̠/ > /r̠/
  s/"n̠"/"r̠"/gi
  #Major vowel shift!
  s/"aə̯"/"ɑː"/gi
  s/"aɪ̯"/"ɑi̯"/gi
  s/"aʏ̯"/"ɑu̯"/gi
  s/"aʊ̯"/"ɑu̯"/gi
  s/"aʁ"/"ɑː"/gi
  s/"aʕʷ"/"ɑː"/gi
  s/"æə̯"/"ɑː"/gi
  s/"æɪ̯"/"ɛː"/gi
  s/"æʏ̯"/"eu̯"/gi
  s/"æʊ̯"/"ɑu̯"/gi
  s/"æʁ"/"ɑː"/gi
  s/"æʕʷ"/"ɑː"/gi
  s/"əɪ̯"/"eː"/gi
  s/"əʏ̯"/"eu̯"/gi
  s/"əʊ̯"/"eu̯"/gi
  s/"əʁ"/"ɛː"/gi
  s/"əʕʷ"/"ɑː"/gi
  s/"eə̯"/"eː"/gi
  s/"eɪ̯"/"eː"/gi
  s/"eʏ̯"/"eu̯"/gi
  s/"eʊ̯"/"eu̯"/gi
  s/"eʁ"/"ɛː"/gi
  s/"eʕʷ"/"ɑː"/gi
  s/"oə̯"/"ɑː"/gi
  s/"oɪ̯"/"ɑi̯"/gi
  s/"oʏ̯"/"ɑu̯"/gi
  s/"oʊ̯"/"ɑu̯"/gi
  s/"oʁ"/"ɑː"/gi
  s/"oʕʷ"/"ɑː"/gi
  s/"øə̯"/"ɑː"/gi
  s/"øɪ̯"/"ɑi̯"/gi
  s/"øʏ̯"/"ɑu̯"/gi
  s/"øʊ̯"/"ɑu̯"/gi
  s/"øʁ"/"ɑː"/gi
  s/"øʕʷ"/"ɑː"/gi
  s/"ɨə̯"/"iː"/gi
  s/"ɨʏ̯"/"iu̯"/gi
  s/"ɨʊ̯"/"iu̯"/gi
  s/"ɨʁ"/"ɛː"/gi
  s/"ɨʕʷ"/"ɛː"/gi
  s/"iə̯"/"iː"/gi
  s/"iʏ̯"/"iu̯"/gi
  s/"iʊ̯"/"iu̯"/gi
  s/"iʁ"/"ɛː"/gi
  s/"iʕʷ"/"ɛː"/gi
  s/"uə̯"/"uː"/gi
  s/"uɪ̯"/"ui̯"/gi
  s/"uʁ"/"ɔː"/gi
  s/"uʕʷ"/"ɔː"/gi
  s/"yə̯"/"uː"/gi
  s/"yɪ̯"/"ui̯"/gi
  s/"yʁ"/"ɔː"/gi
  s/"yʕʷ"/"ɔː"/gi
  s/"a"/"ɑ"/gi
  s/"æ"/"ɑ"/gi
  s/"ə"/"e"/gi
  s/"e"/"e"/gi
  s/"o"/"ɑ"/gi
  s/"ø"/"ɑ"/gi
  s/"ɨ"/"i"/gi
  s/"i"/"i"/gi
  s/"u"/"u"/gi
  s/"y"/"u"/gi
  s/"ʁ"((?:$Consonant)+|\b)/"ɑ"$1/gi
  s/"ʁ"/"r"/gi
  s/"ʕʷ"/""/gi
  #Aspirated -> Fricative
  for(my $i = 0; $i < @AspiratedStop; $i++) {
    # retrieve the source
    my $item = @AspiratedStop[$i];
    # and replacement
    my $rplc = @NonAspirant[$i];

    # replace the source by replacement inside the boundaries
    s/$item/$rplc/gi

  }
 #Depaaltalization
 s/"ʲ"/""/gi
 s/"t͡ɕ"/"ç"/gi
 s/"ɕ"/"ç"/gi
 s/"d͡ʑ"/"j"/gi
 s/"ʑ"/"j"/gi
 s/"ʎ"/"j"/gi
  for(my $i = 0; $i < @RetroflexShibilant; $i++) {
    # retrieve the source
    my $item = @RetroflexShibilant[$i];
    # and replacement
    my $rplc = @Sibilant[$i];

    # replace the source by replacement inside the boundaries
    s/$item/$rplc/gi

  }
  for(my $i = 0; $i < @PalatalShibilant; $i++) {
    # retrieve the source
    my $item = @PalatalShibilant[$i];
    # and replacement
    my $rplc = @Sibilant[$i];

    # replace the source by replacement inside the boundaries
    s/$item/$rplc/gi

  }
  # Go through each "source" => "replacement"
  for(my $i = 0; $i < @LenitableStop; $i++) {
    # retrieve the source
    my $item = @LenitableStop[$i];
    # and replacement
    my $rplc = @VoicedFricative[$i];

    # replace the source by replacement inside the boundaries
    s/$item((?:$PhumVowels)+|\b)/$rplc$1/gi

  }
   #Intervocalic voicing of voiceless fricatives
    s/((?:$PhumVowels)+)"z"((?:$PhumVowels)+)/$1"z"$2/gi
  # Go through each "source" => "replacement"
  for(my $i = 0; $i < @VoicelessFricative; $i++) {
    # retrieve the source
    my $item = @VoicelessFricative[$i];
    # and replacement
    my $rplc = @VoicedFricative[$i];

    # replace the source by replacement inside the boundaries
    s/((?:$PhumVowels)+)$item((?:$PhumVowels)+)/$1$rplc$2/gi

  }

  s/"ŋ"((?:$Consonant)+|\b)/"n"$1/gi
 s/"ŋ"/"ɣ"/gi
  # insert any other transformations here
  s/"g"/"ɣ"/gi
  s/"nɣ"/"ng"/gi

  # print the line after modifications
  print;
}

close($fh);