#! /usr/bin/perl
#
# DEFECT WORKING TO GET IT RIGHT
if(grep(/^(\-h|\-\-help)$/, @ARGV))
{
print << "ENDOFHELPTEXT";
Combine the CGN text-grids to a "master" textgrid
and add IDcodes for DBMS

Use:
./CombineCGNLabelFiles.pl type ... [language ...] [--root=<dir>] 2> error.txt

Options:
language 
  'nl' or 'vl'. Default is both.

--root=<dir>
  CGN annotation text root directory. 
  Default is "../data/annot/text"

-l
--license
  License text
  
-h
--help
  This help text

Processing:
Files are read from "\$CGNrootDir/<type>".
The output TextGrids are placed in "\$CGNrootDir/dbl/"
the filename will be extended with a list
of the types included in that .dbl file

E.g., [ort, awd, plk] -> *.ort.awd.plk.dbl

Eg
./CombineCGNLabelFiles.pl ort awd plk vl 2> error.txt

Possible types:
ort fon awd wrd pro1 pro2 plk syn
Individual tiers get the type of origin attached, if needed.

DBMS item ID codes:
Every item in the text-grids is given a unique ID code.
The codes are hierarchically organized. For example, a certain
phoneme, the last consonant, 'r', from 'zeker',
has ID code: FN000002N00023AO6TC1

This is build up like:
<file><speaker/tier><chunk><word><syllable><part><phoneme>

In the example: FN000002-N00023-AO-6-T-C-1
FN000002: File (../dbl/comp-l/nl/fn000002.ort.awd.plk.dbl)
N00023:   Speaker Dutch 23 (from tiername, can be UKNOWN)
AO:       Position of the chunk in the tier (41), 
          starting with 'A',..,'Z','AA',...
6:        Position of the word in the chunk
T:        Syllable, starting with 'S', 'T', 'U',...
          Ie, second syllable
C:        Coda position, can be Onset, Kernel, or Coda
1:        Position of the phoneme in the syllable part
          Ie, the first phoneme of the coda
Note that there are no sub-part separators. The ID codes are build
from <alpha><digit> sequences. Insertions are entered with the
old item sub-code, a hyphen '-', and a new counter code (eg, 'AO-A',
a single chunk added after chunk 'AO', or '6-1', a new word entered
after word '6'). Note that a silent pauze counts as an item. Ranges
are indicated by combining the first and last item with a '+'. Eg,
words 4 to 9 are indicated with:  'FN000002N00023AO4+9'.

The corresponding codes for the syllable, word and chunk are obtained
by removing the rightmost parts. So this phoneme is found in syllable
FN000002N00023AO6T of word FN000002N00023AO6 from 
chunk FN000002N00023AO.

These ID codes are unique for each recorded segment. So, the ID codes
of the corresponding items in awd, wrd, POS, lem, pro1acc, and pro2wrd
are ALL the same. This allows all the DBMS tables to be easily linked.

ENDOFHELPTEXT
exit;
};
if(grep(/\-?\-l(icense)?/, @ARGV))
{
print << "ENDOFLICENSETEXT";
###############################################################################
#
# Copyright R.J.J.H. van Son © 2006
#
# Author Rob van Son
# Institute of Phonetic Sciences & ACLC
# University of Amsterdam
# Herengracht 338
# NL-1016CG Amsterdam, The Netherlands
# Email: R.J.J.H.vanSon\@uva.nl
# WWW  : http://www.fon.hum.uva.nl/rob/
# mail:  Institute of Phonetic Sciences
#        University of Amsterdam
#        Herengracht 338
#        NL-1016CG Amsterdam
#        The Netherlands
#        tel +31 205252183
#        fax +31 205252197
#
# License for use and disclaimers
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
#
#######################################################
ENDOFLICENSETEXT
exit;
};
#
require "SentenceLabel.pl";
require "CGN_phonemes.pl";

my $CGNrootDir = "../";
if(grep(/\-\-root\=/, @ARGV))
{
    my ($Option) = grep(/\-\-root\=/i, @ARGV);
    $Option =~ s/\-\-root\=//isg;
    $CGNrootDir = $Option;
    @ARGV = grep(!/\-\-root\=/i, @ARGV);
};

# In what order should the file types be read
my %PreferedOrder = (
"ort" => 1, 
"fon" => 2, 
"awd" => 3, 
"wrd" => 4, 
"pro1" => 5, 
"pro2" => 6, 
"plk" => 7, 
"syn" => 8
);
# Languages
my @Languages = ("vl", "nl");

# Tag the file formats
my %CGNfileFormat = (
"dbl" => "TextGrid short",
"ort" => "TextGrid short",
"awd" => "TextGrid short",
"wrd" => "TextGrid short",
"fon" => "TextGrid short",
"plk" => "plk",
"pro" => "TextGrid short",
"syn" => "FORMAT 3"
);
# Link directory names to file types
my %CGNfileType = (
"dbl" => "dbl",
"ort" => "ort",
"awd" => "awd",
"wrd" => "wrd",
"fon" => "fon",
"plk" => "plk",
"pro1" => "pro",
"pro2" => "pro",
"syn" => "syn"
);
# What TextGrids to read (and in what order) to construct 
# a TextGrid type
my %CGNfileRequirements = (
"dbl" => [ort, awd],
"ort" => [ort],
"awd" => [ort, awd],
"wrd" => [ort, wrd],
"fon" => [ort, fon],
"plk" => [awd, plk], #[awd, plk],
"pro1" => [wrd, pro1],
"pro2" => [wrd, pro2],
"syn" => [wrd, syn]
);
my %CGNIDtier = (
"dbl" => "awd",
"ort" => "ort",
"awd" => "awd",
"wrd" => "wrd",
"fon" => "ort",
"plk" => "awd",
"pro1" => "ort",
"pro2" => "ort",
"syn" => "wrd"
);

my %CGNharmonicity = ("_" => -1);
my $Harmonicity = scalar(@CGN_phonemeOrder);
foreach my $phoneme (@CGN_phonemeOrder)
{
    $CGNharmonicity{$phoneme} = $Harmonicity;
    --$Harmonicity;
};

my $OutputType = "dbl";

# Construct a new IDcode from a range of IDcodes
sub combineIDcodes   # (IDcode1, IDcode2) -> CombinedIDcode
{
    my $FirstIDcode = shift || return "";
    my $LastIDcode = shift || return $FirstIDcode;
    
    # Identical, don't bother
    return $FirstIDcode if($FirstIDcode eq $LastIDcode);
    
    # construct new ID code from first and last word ID
    my $NewIDcode = "";
    while($FirstIDcode && $LastIDcode)
    {
        if($FirstIDcode =~ /^([A-Z\-\+]+|[0-9\-\+]+)/i)
        {
            $FirstHead = $1;
            $FirstTail = $';
        };
        if($LastIDcode =~ /^([A-Z\-\+]+|[0-9\-\+]+)/i)
        {
            $LastHead = $1;
            $LastTail = $';
        };
        
        if($FirstHead eq $LastHead)
        {
            $NewIDcode .= $FirstHead;
            $FirstIDcode = $FirstTail;
            $LastIDcode = $LastTail;
        }
        else
        {
            $NewIDcode .= "${FirstIDcode}+$LastIDcode";
            $FirstIDcode = "";
            $LastIDcode = "";
        };
    };
    
    return $NewIDcode;
};

# Determine the Syllable Part wrt next item
# ´CouldBeCoda´  is generally not decidable on this level
sub currentSyllPart # ($currentTierValue, $nextTierValue) -> (relative)SyllablePart
{
    my $currentTierValue = shift;
    my $nextTierValue = shift;
    
    my $SyllablePart = 'X';
    
    # Special, cut and dried cases
    if($currentTierValue !~ /[^\s]/)
    {
        $SyllablePart = 'Silence';
    }
    # Horrible, the space between a shared phoneme 'd_d'
    elsif($currentTierValue !~ /[^\_]/)
    {
        $SyllablePart = 'O';
    }
    elsif(isVowel($currentTierValue))
    {
        $SyllablePart = 'K';
    }
    # A 'N' is always a coda position
#    elsif($currentTierValue eq 'N')
#    {
#        $SyllablePart = 'C';
#    }
    elsif(isVowel($nextTierValue))
    {
        $SyllablePart = 'O';
    }
    # A consonant before a silence is ALWAYS syllable final
    elsif($nextTierValue  !~ /[^\s\_]/)
    {
        $SyllablePart = 'C';
    }
    # A consonant before a 'h' is ALWAYS syllable final
    elsif($nextTierValue  eq 'h')
    {
        $SyllablePart = 'C';
    }
    # More intricate stuff
    # A 's' is special, it can mix around plosives
    elsif($currentTierValue eq 's')
    {
        if(isPlosive($nextTierValue))
        {
            $SyllablePart = 'CouldBeCoda';
        }
        else
        {
            $SyllablePart = 'O';
        };
    }
    # Handle Plosives, if the next phoneme is a
    # plosive or fricative, don´t bother. Else it is
    # an Onset
    elsif(isPlosive($currentTierValue))
    {
        if(isPlosive($nextTierValue))
        {
            # Mostly ´t<plos>´
            $SyllablePart = 'CouldBeCoda';
        }
        elsif($nextTierValue eq 's')
        {
            # If <plos>s is allowed, s<plos> is too
            $SyllablePart = 'CouldBeCoda';
        }
        elsif(isFricative($nextTierValue))
        {
            # ´s´ has been handled, the other fricatives
            # can never be preceded by a stop in the same
            # syllable (but in an Onset, we can´t help it)
            $SyllablePart = 'C';
        }
        else
        {
            # If a plosive preceeds none of the above, it must be an
            # onset
            $SyllablePart = 'O';
        };
    }
    # You cannot have the same manner (category) twice in an onset
    # or coda, unless of course it involves a plosive or an ´s´
    elsif(sameCategory($currentTierValue, $nextTierValue))
    {
        # This should be a coda, but if we are in an Onset
        # it obviously can´t be
        $SyllablePart = 'C';
    }
    # 
    # All special cases have been handled, use Harmonicity
    elsif($CGNharmonicity{$currentTierValue} < $CGNharmonicity{$nextTierValue})
    {
        $SyllablePart = 'O';
    }
    elsif($CGNharmonicity{$currentTierValue} > $CGNharmonicity{$nextTierValue})
    {
        $SyllablePart = 'C';
    }
    else
    {
        $SyllablePart = 'CouldBeCoda';
    }; 
    
    return $SyllablePart;
};                   

# Get going
# Get the formats that have to be combined
my @CombinedTypes = ();
foreach my $Type (@ARGV)
{
    if(exists($CGNfileType{$Type}))
    {
        die "$Type is unknown\n" unless exists($CGNfileRequirements{$Type});
        my @AddedTypes = @{$CGNfileRequirements{$Type}};
        foreach my $newType (@AddedTypes)
        {
            push(@CombinedTypes, $newType) unless grep(/^$newType$/, @CombinedTypes);
        };
    }
    # Get the subdirectories (language)
    elsif(grep(/^$Type$/, @Languages))
    {
        push(@CurrentLanguages, $Type) unless grep(/^$Type$/, @CurrentLanguages);
    }
    else
    {
        die "$Type is unknown\n";
    };
};

# Add required types until you have them all
my $TypesNotPresent = 1;
while($TypesNotPresent)
{
    $TypesNotPresent = 0;
    my @OldCombinedTypes = @CombinedTypes;
    foreach my $Type (@OldCombinedTypes)
    {
        my @AddedTypes = @{$CGNfileRequirements{$Type}};
        foreach my $newType (@AddedTypes)
        {
            unless(grep(/^$newType$/, @CombinedTypes))
            {
                ++$TypesNotPresent;
                push(@CombinedTypes, $newType);
            };
        };
    };
};

# Default types
@CombinedTypes = @{$CGNfileRequirements{"awd"}} unless @CombinedTypes;
# Sort the file types to prefered order
@CombinedTypes = sort {$PreferedOrder{$a} <=> $PreferedOrder{$b}} @CombinedTypes;

# No languages == all languages
@CurrentLanguages = @Languages unless @CurrentLanguages;

# Construct list of File id's
my %FileIds = ();
foreach my $Type (@CombinedTypes)
{
    my $FileExtension = $CGNfileType{$Type};
        foreach my $Lang (@CurrentLanguages)
        {
            foreach my $File (glob("$CGNrootDir/$Type/$Lang/*.$FileExtension.gz"))
            {
                $File =~ m!/([\w]+)\.$FileExtension\.gz$!;
                ++$FileIds{"$Lang/$1"} if -s $File;
            };
        };
};

# Remove all Files that are incompletely represented
foreach my $File (keys(%FileIds))
{
   delete($FileIds{$File}) unless $FileIds{$File} == scalar(@CombinedTypes);
};

# Process all files
foreach my $partPath (keys(%FileIds))
{
    $partPath =~ m!^([\w\-]+)/([\w\-]+)/([\w\-]+)$!;
    my $Language = $2;
    my $currentFileID = $3;
    my $OutputFileName = "$CGNrootDir/dbl/$partPath";
    my $currentBaseName = $currentFileID;
    # Make sure the directories exist
    mkdir "$CGNrootDir/dbl" unless -d "$CGNrootDir/dbl";
    mkdir "$CGNrootDir/dbl" unless -d "$CGNrootDir/dbl";
    mkdir "$CGNrootDir/dbl/$Language" unless -d "$CGNrootDir/dbl/$Language";
    
    my $Label = new SentenceLabel;
    
    foreach my $Type (@CombinedTypes)
    {
        # Update the output filename
        $OutputFileName .= ".$Type";
        # Get all the components of the input files
        my $FileExtension = $CGNfileType{$Type};
        my $InputFileName = "$CGNrootDir/$Type/$partPath.$FileExtension.gz";
        my $NewLabel =  new SentenceLabel;
        
        # Copy the Tiers from the New Label to the existing one
        # Praat TextGrids
        if($CGNfileFormat{$FileExtension} eq "TextGrid short")
        {
            my $UnknownSpeakers = 0;
            $NewLabel->ReadLabelFile($InputFileName);
            my @NewTierList = @{$NewLabel->{TIERORDER}};
            foreach my $Tier (@NewTierList)
            {
                # All Tiernames get their type appended
                my $NewTier = "${Tier}$Type";
                if($NewTier =~ /^(UNKNOWN)/)
                {
                    ++$UnknownSpeakers;
                    $NewTier =~ s/^(UNKNOWN)/$1${UnknownSpeakers}/ig;
                };
                $Label->createTier($NewTier);
                # Copy lists of SourceTier wholesale (this is an optimization)
                foreach my $TierComponent ("TIER", "ID", "START", "END")
                {
                    my @tmplist = @{$NewLabel->{$TierComponent}{$Tier}};
                    @{$Label->{$TierComponent}{$NewTier}}  = @tmplist;   # Values
                }
                # Set current item of new tier
                $Label->currentItem($NewTier, $NewLabel->currentItem($Tier));
            };
        }
        # PLK (POS, Lexeem etc.)
        elsif($CGNfileFormat{$FileExtension} eq "plk")
        {
            my $UnknownSpeakers = 0;
            # Get the total duration of the file
            my $TotalDuration = $Label->duration($Label->{TIERORDER}[0]);
            
            # Just Read the data in Some usefull format
            if($InputFileName =~ /\.gz$/)
            {
                open(PLKIN, "gunzip -c $InputFileName|") || die "gunzip -c $InputFileName|: $!\n";
            }
            else
            {
                open(PLKIN, "<$InputFileName") || die "<$InputFileName: $!\n";
            };
            
            my ($currentID, $currentSpeaker, $currentStartTime) = (0, "", 0);
            my $Tier = "";
            my $startItem = 0;
            my $WordTier = "";
            my $OrtTier = "";
            my $StopProcessing = 1; # Only process if there is a valid chunk
            my $firstword = 1;
            my $multiwordProcessed = 0;
            while(<PLKIN>)
            {
                next unless /\S/;
                # Remove newlines
                s/[\010-\016]+$/\n/s;
                chomp;
                #
                # Get Item header line
                if(/\<\s*au\s+([^\>]+)\>/i)
                {
                    my $Arguments = $1;
                    ++$ChunkFiles{$currentFileID};
                    
                    if($Arguments =~ /id\s*\=\s*([\"\'])([^\"\']+)[\"\']/i)
                    {
                        $currentID = $2;
                    };
                    if($Arguments =~ /s\s*\=\s*([\"\'])([^\"\']+)[\"\']/i)
                    {
                        $currentSpeaker = $2;
                        if($currentSpeaker =~ /^(UNKNOWN)/)
                        {
                            ++$UnknownSpeakers;
                            $currentSpeaker =~ s/^(UNKNOWN)/$1${UnknownSpeakers}/ig;
                        };
                    };
                    if($Arguments =~ /tb\s*\=\s*([\"\'])([^\"\']+)[\"\']/i)
                    {
                        $currentStartTime = $2;
                    };
                    
                    # Tier names
                    $OrtTier = "${currentSpeaker}ort";
                    $WordTier = "${currentSpeaker}awd";
                    
                    # Create a Tier if necessary
                    $Tier = "${currentSpeaker}plk";
                    unless($Label->existsTier("${Tier}pos"))
                    {
                        $Label->copyTier("${Tier}awd", $WordTier);
                        $Label->copyTier("${Tier}pos", $WordTier);
                        $Label->copyTier("${Tier}kmr", $WordTier);
                        $Label->copyTier("${Tier}lem", $WordTier);
                        $Label->copyTier("${Tier}lex", $WordTier);
                        $Label->copyTier("${Tier}mwt", $WordTier);
                        
                        $Label->presetItem($OrtTier);
                        $Label->presetItem($WordTier);
                    };
                    
                    # Position word tier at correct time
                    # Locate the OrtTier (go on where we left off)
                    while($Label->currentStart($OrtTier) < $currentStartTime)
                    {
                        last unless $Label->nextItem($OrtTier) > -1;
                    };
                    # $currentStartTime == 0 case
                    $Label->firstItem($OrtTier) unless $Label->currentItem($OrtTier) > -1;
                    
                    # Current word is before the ort chunk, locate first word inside the chunk
                    if($Label->currentEnd($WordTier) < $currentStartTime)
                    {
                        $Label->nextEndininterval($WordTier, $OrtTier);
                        # Step one back
                        $Label->previousItem($WordTier);
                    }
                    # Panic, we are beyond the end of the correct ort chunk, 
                    # locate first word inside the chunk and hope this is the correct word
                    elsif($Label->currentStart($WordTier) >= $Label->currentEnd($OrtTier))
                    {
                        $Label->presetItem($WordTier);
                        $Label->nextEndininterval($WordTier, $OrtTier);
                        # Step one back
                        $Label->previousItem($WordTier);
                    };
                    # Is this the correct word, or should we go one further?
                    # The original chunking was done rather rough. Words do 
                    # not have to ling up very well.
                    # Step on if the current word is a silence or if the overlap
                    # with the start time is too small
                    # Note, we already stepped one item BACK
                    if($Label->readNextValue($WordTier) !~ /[^\s\_]/
                        || (abs($Label->nextEnd($WordTier) - $currentStartTime)
                        < abs($Label->nextStart($WordTier) - $currentStartTime)))
                    {
                        $Label->nextItem($WordTier);
                    };
                    
                    # Mark that we are starting here
                    $firstword = 1;
                    # Start processing again
                    $StopProcessing = 0;
                    
                    next;
                };
                
                if(/\<mu\s+/)
                {
                    my $Arguments = $';
                    if($Arguments =~ /s\s*\=\s*([\"\'])([^\"\']+)[\"\']/i)
                    {
                        $currentSpeaker = $2;
                    };
                    # Stop processing
                    $StopProcessing = 1;
                    next;
                };
				
                # Ignore background and other problems
                next if $StopProcessing;
                    
                # Parse the POS etc values
                my ($currentWord, $currentPOS, $currentLem, $currentLex, $currentMWT) = split(/\t/, $_);
                
                my $currentKmr = "";
                if($currentPOS =~ /^([^\(]+)\(([^\)]*)\)/)
                {
                    $currentPOS = $1;
                    $currentKmr = $2;
                };

                # Skip punctuation
                next if $currentWord !~ /[^\.\?\!\,\;\:\s\_]/;
                # Remove punctuation
                my $currentCleanWord = $currentWord;
                $currentCleanWord =~ s/[\.\?\!\,\;\:\_]//g;
                
                # Get next value
                while($Label->nextItem($WordTier) > -1 
                        && $Label->currentValue($WordTier) !~ /[^\s\_]/){};
                my $currentItem = $Label->currentItem($WordTier);
                my $currentWordTierValue = $Label->currentValue($WordTier);
                my $currentCleanWordTierValue = $currentWordTierValue;
                $currentCleanWordTierValue =~ s/[\.\?\!\,\;\:\_]//isg;
                
                # This is a multiword utterance io a word. Do not proceed
                # and wait for the next utterance
                if($currentCleanWordTierValue ne $currentCleanWord && $currentWordTierValue =~ /^!/)
                {
                    $multiword = $currentWordTierValue;
                    $multiword =~ s/[^a-zA-Z]+$//g; # Remove puntuation etc
                    $multiword =~ s/^\s*[\!]//g;
                    # Mark current words
                    $currentWord = "!".$currentWord;
                    $currentPOS = "!".$currentPOS;
                    $currentLem = "!".$currentLem;
                    $currentLex = "!".$currentLex;
                    $currentMWT = "!".$currentMWT;
                    
                    my @multiwordlist = split(' ', $multiword);
                    # Remove current word
                    shift(@multiwordlist);
                    
                    # Now, bleed all words in the PLK file
                    while(@multiwordlist && (my $newLine = <PLKIN>))
                    {
                        next unless $newLine =~ /\S/is;
                        next unless $newLine =~ s/[\010-\016]+$/\n/s;
                        chomp($newLine);
                        next if $newLine =~ /^\s*\</is;
                        
                        my ($newWord, $newPOS, $newLem, $newLex, $newMWT) = split(/\t/, $newLine);
                        # Skip punctuation
                        next if $newWord !~ /[^\.\?\!\,\;\:\s\_]/;
                        
                        $currentWord .= " ".$newWord;
                        $currentPOS .= " ".$newPOS;
                        $currentLem .= " ".$newLem;
                        $currentLex .= " ".$newLex;
                        $currentMWT .= " ".$newMWT;
                        
                        # Chop of the part we just processed
                        shift(@multiwordlist);                        
                    };
                    
                    # Mark that we are starting here
                    $firstword = 1;
                    $multiwordProcessed = 1;
                    $currentCleanWord = $currentWord;
                    $currentCleanWord =~ s/[\.\?\!\,\;\:\_]//g;
                };
                
                # Locate the correct word
                # The first word is unequal, locate the correct one there is an equal one
                if($firstword && $currentCleanWord ne $currentCleanWordTierValue
                    && ($Label->currentValue($OrtTier)) =~ /\Q$currentCleanWord\E/)
                {
                    # Step through the chunk
                    while($Label->currentStart($WordTier) >= $Label->currentStart($OrtTier)
                            && $Label->currentEnd($WordTier) <= $Label->currentEnd($OrtTier)
                            && $Label->currentValue($WordTier) ne $currentWord)
                    {
                        last unless $Label->nextItem($WordTier) > -1;
                    };

                    if($Label->currentValue($WordTier) eq $currentWord
                        && $Label->currentStart($WordTier) >= $Label->currentStart($OrtTier)
                        && $Label->currentEnd($WordTier) <= $Label->currentEnd($OrtTier))
                    {
                        $currentItem = $Label->currentItem($WordTier);
                        $currentWordTierValue = $Label->currentValue($WordTier);
                        $currentCleanWordTierValue = $currentWordTierValue;
                    }
                    else # Not found, reset
                    {
                        $currentItem = $Label->currentItem($WordTier, $currentItem);
                    };
                    # Do this only ONCE
                    $firstword = 0;
                    if($multiwordProcessed)
                    {
                        $firstword = 1;
                        $multiwordProcessed = 0;
                    };
                };
                # Not the same word, check surrounding words (ignoring silence)
                my $append = 0;
                unless($currentCleanWord eq $currentCleanWordTierValue)
                {
                    my $prevItem = 1;
                    my $prevCleanValue;
                    $prevCleanValue;
                    while(($prevCleanValue = $Label->readPreviousValue($WordTier, $prevItem)) !~ /[^\s\_]/ && $prevItem < 4)
                    {++$prevItem;};
                    $prevCleanValue =~ s/[\.\?\!\,\;\:\_]//g;
                    my $nextItem = 1;
                    my $nextCleanValue;
                    while(($nextCleanValue = $Label->readNextValue($WordTier, $nextItem)) !~ /[^\s\_]/ && $nextItem < 4)
                    {++$nextItem;};
                    $nextCleanValue = $Label->readNextValue($WordTier);
                    $nextCleanValue =~ s/[\.\?\!\,\;\:\_]//g;
                    if($prevCleanValue eq $currentCleanWord)
                    {
                        $Label->currentItem($WordTier, $currentItem-$prevItem);
                    }
                    elsif($nextCleanValue eq $currentCleanWord)
                    {
                        $Label->currentItem($WordTier, $currentItem+$nextItem);
                    }
                    elsif($currentCleanWord eq "'s" && $prevCleanValue =~ /\'s\s*$/)
                    {
                        $Label->currentItem($WordTier, $currentItem-$prevItem);
                        $append = 1;
                    };

                    # New values
                    $currentItem = $Label->currentItem($WordTier);
                    $currentWordTierValue = $Label->currentValue($WordTier);
                    $currentCleanWordTierValue = $currentWordTierValue;
                    $currentCleanWordTierValue =~ s/[\.\?\!\,\;\:\s\_]//isg;
                };

                # Construct the next item
++$TotalWords;
unless($currentCleanWord eq $currentCleanWordTierValue || 
        ($currentCleanWordTierValue eq "da's" && $currentCleanWordTierValue =~ /\Q$currentCleanWord\E/))
{
	++$ErrorWords;
        ++$ErrorFiles{$currentFileID} unless $currentSpeaker =~ /UNKNOWN/is;
        print STDERR "$Component>$currentFileID: $WordTier-$currentItem: '$currentWord' ne '", 
            $Label->currentValue($WordTier), "' at ", $Label->currentIDcode($WordTier), 
            "\t", scalar(keys(%ErrorFiles)), " : ", scalar(keys(%ChunkFiles)), " = ", 
            100*scalar(keys(%ErrorFiles))/scalar(keys(%ChunkFiles)), "% - $ErrorWords/$TotalWords=", 
	    100*$ErrorWords/$TotalWords, "% words\n";
	    
	    
	    # Something is wrong, step one back to allow corrections later
	    # This also localizes all errors into a single stretch (sentence)
	    $Label->previousItem($WordTier);
};
                # We are definitely not at the first word anymore
                $firstword = 0;
                
                # Now, position the tiers
                $Label->currentItem("${Tier}awd", $currentItem);
                $Label->currentItem("${Tier}pos", $currentItem);
                $Label->currentItem("${Tier}kmr", $currentItem);
                $Label->currentItem("${Tier}lem", $currentItem);
                $Label->currentItem("${Tier}lex", $currentItem);
                $Label->currentItem("${Tier}mwt", $currentItem);
                
                # Fill the tiers
                unless($append)
                {
                    $Label->currentValue("${Tier}awd", $currentWord);
                    $Label->currentValue("${Tier}pos", $currentPOS);
                    $Label->currentValue("${Tier}kmr", $currentKmr);
                    $Label->currentValue("${Tier}lem", $currentLem);
                    $Label->currentValue("${Tier}lex", $currentLex);
                    $Label->currentValue("${Tier}mwt", $currentMWT);
                }
                else # Some split word case, append it
                {
                    $Label->currentValue("${Tier}awd", ($Label->currentValue("${Tier}awd"))." ".$currentWord);
                    $Label->currentValue("${Tier}pos", ($Label->currentValue("${Tier}pos"))." ".$currentPOS);
                    $Label->currentValue("${Tier}kmr", ($Label->currentValue("${Tier}kmr"))." ".$currentKmr);
                    $Label->currentValue("${Tier}lem", ($Label->currentValue("${Tier}lem"))." ".$currentLem);
                    $Label->currentValue("${Tier}lex", ($Label->currentValue("${Tier}lex"))." ".$currentLex);
                    $Label->currentValue("${Tier}mwt", ($Label->currentValue("${Tier}mwt"))." ".$currentMWT);
                };
                    
            };
            close(PLKIN);
        };
        # Now process each type in turn
        my @currentTierOrder = (@{$Label->{TIERORDER}});
        if($Type eq "ort")
        {    
            # Enter the ID codes
            my $charcode = 'A';
            foreach my $Tier (@currentTierOrder)
            {
                # Add ID codes
                my $IDprefix = "$currentBaseName${Tier}";
                # Strip $Type from the end of the tiercode (superfluous)
                $IDprefix =~ s/$Type$//ig;
                $IDprefix .= "0" unless $IDprefix =~ /\d$/;

                $Label->presetItem($Tier);
                my $FirstItem = -1;
                my $charcode = 'A';
                while($Label->nextItem($Tier) > -1)
                {            
                    my $currentID = $IDprefix . $charcode;
                    $Label->currentIDcode($Tier, uc($currentID));
                    ++$charcode;
                };
            };
    
        }
        elsif($Type eq "fon")
        {
            # Enter the ID codes
            foreach my $Tier (@currentTierOrder)
            {
                next unless $Tier =~ /$Type$/;

                # Master Tier name
                $IDTier = $Tier;
                $IDTier =~ s/$Type$/$CGNIDtier{$Type}/g;
                 
                $Label->presetItem($Tier);
                my $FirstItem = -1;
                while($Label->nextItem($Tier) > -1)
                {
                   # Locate corresponding ORT tier
                    $Label->currentItem($IDTier, $FirstItem);
                    my $ChkStartAligned = $Label->nextStartininterval($IDTier, $Tier);
                    my $newIDcode = $Label->currentIDcode($IDTier);
                    $Label->currentIDcode($Tier, $newIDcode);
                    $FirstItem = $ChkStartAligned - 1;
                };
            };
        }
        # Word streams: 'awd' is automatically segemented, 'wrd' is hand-corrected
        elsif($Type eq "awd" || $Type eq "wrd")
        {
            # Copy the ort tiers for alignment
            foreach my $Tier (@currentTierOrder)
            {
                next unless $Tier =~ /([a-z]+[\d]+)ort$/i;
                my $NewTierName = $1."ack$Type";
                $Label->copyTier($NewTierName, $Tier);
            };
            # Align the ack (automatically aligned chunks)
            # Realign Chunk boundaries
            my @NewTierOrder = (@{$Label->{TIERORDER}});
            foreach my $Tier (@NewTierOrder)
            {
                next unless $Tier =~ /ack$Type$/;

                my $WordTier = $`."$Type" if $Tier =~ /ack$Type$/;
                # Start at 2, skip the first item
                $Label->firstItem($Tier);
                my $FirstItem = 0;
                while($Label->nextItem($Tier) > -1)
                {
                    # Store current position
                    my $currentStart = $Label->currentStart($Tier);
                    my $previousEnd = $Label->previousEnd($Tier);
                    my $currentEnd = $Label->currentEnd($Tier);
                    my $nextStart = $Label->nextStart($Tier);
                    my $currentValue = $Label->currentValue($Tier);
                    my $previousValue = $Label->readPreviousValue($Tier);

                    # Locate first word in current item. Start were we left off last time
                    my $ChkStartInWordItem = $Label->currentItem($WordTier, $FirstItem);

                    # Backward (if necessary)
                    while($ChkStartInWordItem > 0 
                          && $Label->currentEnd($WordTier) > $currentStart)
                    {
                        $ChkStartInWordItem = $Label->previousItem($WordTier);
                    };
                    # Foreward
                    while($ChkStartInWordItem > -1 
                          && $Label->currentEnd($WordTier) < $currentStart)
                    {
                        $ChkStartInWordItem = $Label->nextItem($WordTier);
                    };
                    # Store
                    $FirstItem = $Label->currentItem($WordTier);    # Start for next round
                    my $currentWordStart = $Label->currentStart($WordTier);
                    my $previousWordEnd = $Label->previousEnd($WordTier);
                    my $currentWordEnd = $Label->currentEnd($WordTier);
                    my $nextWordStart = $Label->nextStart($WordTier);
                    my $currentWordValue = $Label->currentValue($WordTier);

                    my $RelativePosition = ($currentWordEnd -$currentWordStart) > 0
                                            ? ($currentStart - $currentWordStart)/($currentWordEnd -$currentWordStart) : 0;

                    # Catch silences and match them
                    # Both are silences, align chunk with word
                    if($currentValue !~ /\S/ && $currentWordValue !~ /\S/)
                    {
                         $Label->previousEnd($Tier, $currentWordStart);
                         $Label->currentStart($Tier, $currentWordStart);
                    }
                    # Previous Chunk is a silence, align chunk with end of word
                    elsif($previousValue !~ /\S/ && $currentWordValue !~ /\S/)
                    {
                         $Label->previousEnd($Tier, $currentWordEnd);
                         $Label->currentStart($Tier, $currentWordEnd);
                    }
                    # Previous Chunk is NOT a silence, merge silence with chunk
                    elsif($previousValue =~ /\S/ && $currentWordValue !~ /\S/)
                    {
                         $Label->previousEnd($Tier, $currentWordStart);
                         $Label->currentStart($Tier, $currentWordStart);
                    }
                    # No silence, pick the word that overlaps the most
                    elsif($RelativePosition <= 0.5)
                    {
                         $Label->previousEnd($Tier, $currentWordStart);
                         $Label->currentStart($Tier, $currentWordStart);
                    }
                    else
                    {
                         $Label->previousEnd($Tier, $currentWordEnd);
                         $Label->currentStart($Tier, $currentWordEnd);
                    };
                    
                };

            };
            
            # Split off starting silences from aligned chunks
            # Realign Chunk boundaries
            my @NewTierOrder = (@{$Label->{TIERORDER}});
            foreach my $Tier (@NewTierOrder)
            {
                next unless $Tier =~ /ack$Type$/;

                # Construct Word tier name
                my $WordTier = $`."$Type" if $Tier =~ /ack$Type$/;
                # Start at 2, skip the first item
                $Label->firstItem($Tier);
                my $FirstItem = 0;
                while($Label->nextItem($Tier) > -1)
                {
                    # Skip silences
                    next if $Label->currentValue($Tier) !~ /\S/;

                    # Store current position
                    my $currentStart = $Label->currentStart($Tier);
                    my $currentEnd = $Label->currentEnd($Tier);

                    # Locate first word in current item. Start were we left off last time
                    my $ChkStartInWordItem = $Label->currentItem($WordTier, $FirstItem);

                    # Note that the Ack tier should be aligned to the word tier!
                    # Backward (if necessary) 
                    while($ChkStartInWordItem > 0 
                          && $Label->currentStart($WordTier) >= $currentStart)
                    {
                        $ChkStartInWordItem = $Label->previousItem($WordTier);
                    };
                    # Foreward
                    while($ChkStartInWordItem > -1 
                          && $Label->Startisaligned($Tier, $WordTier) < 0
                          && $Label->currentStart($WordTier) < $currentEnd)
                    {
                        $ChkStartInWordItem = $Label->nextItem($WordTier);
                    };
                    next unless $Label->Startisaligned($Tier, $WordTier) > -1;

                    $FirstItem = $Label->currentItem($WordTier);    # Start for next round

                    # If the first word is a silence, split the chunk
                    if($Label->currentValue($WordTier) !~ /\S/)
                    {
                        my $oldItem = $Label->currentItem($Tier);              
                        $Label->splitTier($Tier, 2);
                        $Label->currentItem($Tier, $oldItem);
                        $Label->currentEnd($Tier, $Label->currentEnd($WordTier));
                        $Label->nextStart($Tier, $Label->currentEnd($WordTier));
                        $Label->currentValue($Tier, "");
                        $Label->currentIDcode($Tier, $Label->readPreviousIDcode($Tier)."-A");
                        # Don't forget to go to the NEXT item!
                        $Label->nextItem($Tier);  
                    };
                };
            };
            
            # Add Word/FON tier ID codes. Use ack tier as IDtier
            my @NewTierOrder = (@{$Label->{TIERORDER}});
            foreach my $Tier (@NewTierOrder)
            {
                # Only the word tiers
                next unless $Tier =~ /([\d]+)(_FON)?$Type$/i;

                my $MasterTier = $Tier;
                my $IDnumber = 0;
                my $OldIDprefix = "";
                my $PostFix = "";
                # Watch out, there are other extras
                $MasterTier =~ s/([a-z\_\-]*)$Type$/ack$Type/ig;

                my $startItem = 0;
                $Label->presetItem($Tier);
                while($Label->nextItem($Tier) > -1)
                {
                    # Get current values
                    my $currentTierItem = $Label->currentItem($Tier);
                    my $currentStart = $Label->currentStart($Tier);
                    my $currentEnd = $Label->currentEnd($Tier);

                    my $ParentItemStartI = $Label->parentItemStart($Tier, $MasterTier, $startItem);
                    my $ParentItemStartDiff = $currentStart - $Label->currentEnd($MasterTier);
                    my $ParentItemEndI = $Label->parentItemEnd($Tier, $MasterTier, $startItem);
                    my $ParentItemEndDiff = $currentEnd - $Label->currentStart($MasterTier);
                    # Store start of next round;
                    $startItem = $ParentItemStartI < $ParentItemEndI ? $ParentItemStartI : $ParentItemEndI;
                    --$startItem;

                    # Select the correct master tier item
                    my $CurrentIDprefix = "";
                    if($ParentItemStartI == $ParentItemEndI)
                    {
                        $Label->currentItem($MasterTier, $ParentItemStartI);
                        $CurrentIDprefix = $Label->currentIDcode($MasterTier);
                    }
                    elsif($ParentItemStartDiff > $ParentItemEndDiff)
                    {
                        $Label->currentItem($MasterTier, $ParentItemStartI);
                        $CurrentIDprefix = $Label->currentIDcode($MasterTier);
                    }
                    else
                    {
                        $Label->currentItem($MasterTier, $ParentItemEndI);
                        $CurrentIDprefix = $Label->currentIDcode($MasterTier);
                    };
                    if($Label->currentValue($Tier) =~ /[^\s\_]/)
                    {
                        ++$IDnumber;
                        $PostFix = "";
                    }
                    # Silence
                    else
                    {
                        $PostFix = 0 unless $PostFix > 0;
                        ++$PostFix;
                    };

                    # Reset the ID number
                    if($CurrentIDprefix ne $OldIDprefix)
                    {
                         $IDnumber = 1;
                         $OldIDprefix = $CurrentIDprefix;
                    };

                    # Construct new ID
                    my $NewID = "$CurrentIDprefix$IDnumber";
                    $NewID .= "-$PostFix" if $PostFix > 0;
                    
                    # Write new ID
                    $Label->currentItem($Tier, $currentTierItem);
                    $Label->currentIDcode($Tier, $NewID);
                };
            };
    
            # Handle the SEG tier.
            # Add Word/FON tier ID codes. Use ack tier as IDtier
            # The SEG id codes use syllable and syllable part components.
            # Syllable segmentation cannot be handled on this level.
            # So the syllable boundaries will just be guesses.
            my @NewTierOrder = (@{$Label->{TIERORDER}});
            foreach my $Tier (@NewTierOrder)
            {
                # Skip the Segment Tier for now
                next unless $Tier =~ /_SEG$Type$/;
                # Skip tiers that do NOT contains (speaker) numbers
                next unless $Tier =~ /[\d]+/i;
                # Only the word tiers
                next unless $Tier =~ /$Type$/i;

                my $MasterTier = $Tier;
                my $PreviousHarmonicity = -1;
                my $PreviousSyllablePart = "";
                my $PreviousPhoneme = "";
                my $SyllableNumber = "S";
                my $SyllablePart = "O";
                my $IDnumber = 0;
                my $OldIDprefix = "";
                # Get the word tier
                $MasterTier =~ s/(_SEG)$Type$/$Type/ig;
                my $startItem = 0;
                $Label->presetItem($Tier);
                while($Label->nextItem($Tier) > -1)
                {
                    # Get current values
                    my $currentTierItem = $Label->currentItem($Tier);
                    my $currentTierValue = $Label->currentValue($Tier);
                    my $nextTierValue = $Label->readNextValue($Tier);
                    my $currentStart = $Label->currentStart($Tier);
                    my $currentEnd = $Label->currentEnd($Tier);

                    # Parenttier
                    my $ParentItemStartI = $Label->parentItemStart($Tier, $MasterTier, $startItem);
                    my $ParentItemStartDiff = $currentStart - $Label->currentEnd($MasterTier);
                    my $ParentItemEndI = $Label->parentItemEnd($Tier, $MasterTier, $startItem);
                    my $ParentItemEndDiff = $currentEnd - $Label->currentStart($MasterTier);
                    
                    # Store start of next round;
                    $startItem = $ParentItemStartI < $ParentItemEndI ? $ParentItemStartI : $ParentItemEndI;
                    --$startItem;

                    # Add insert code
                    # Select the correct master tier item
                    my $CurrentIDprefix = "";
                    if($ParentItemStartI == $ParentItemEndI)
                    {
                        $Label->currentItem($MasterTier, $ParentItemStartI);
                        $CurrentIDprefix = $Label->currentIDcode($MasterTier);
                    }
                    elsif($ParentItemStartDiff > $ParentItemEndDiff)
                    {
                        $Label->currentItem($MasterTier, $ParentItemStartI);
                        $CurrentIDprefix = $Label->currentIDcode($MasterTier);
                    }
                    else
                    {
                        $Label->currentItem($MasterTier, $ParentItemEndI);
                        $CurrentIDprefix = $Label->currentIDcode($MasterTier);
                    };
                    my $currentParentValue = $Label->currentValue($MasterTier);
                    my $currentParentID = $Label->currentIDcode($MasterTier);
                    # Is the next SEG item inside the current word?
                    my $nextParentID = $Label->nextEnd($Tier) <= ($Label->currentEnd($MasterTier) + 0.001)
                                        ? $currentParentID : $Label->readNextIDcode($MasterTier);
                                        
                    # Is the Phoneme a vowel?
                    $SyllablePart = isVowel($currentTierValue) ? 'K' : '*';
                    
                    # New word, reset the ID number
                    if($CurrentIDprefix ne $OldIDprefix)
                    {
                         $PreviousSyllablePart = 'O';
                         $PreviousHarmonicity = -1;
                         $SyllableNumber = 'S';
                         $IDnumber = 0;
                         $OldIDprefix = $CurrentIDprefix;
                    };
                    
                    # Finite State Machine to split syllables and parts
                    
                    # If the next phoneme is in a different word, remove it (Insert Silence)
                    $nextTierValue = " " unless $currentParentID eq $nextParentID;
                    # Get the relation between the current and the nex value
                    $SyllablePart = currentSyllPart($currentTierValue, $nextTierValue);
                    
                    # A pause is always NEW
                    if($SyllablePart eq 'Silence')
                    {
                         $PreviousSyllablePart = 'O';
                         $SyllableNumber = 'S';
                         $SyllablePart = 'O';
                         $IDnumber = 0;
                    }
                    # Onset
                    elsif($PreviousSyllablePart eq 'O')
                    {
                        if($SyllablePart eq 'CouldBeCoda')
                        {
                            $SyllablePart = $PreviousSyllablePart;
                        }
                        elsif($SyllablePart eq 'K')
                        {
                            $IDnumber = 0;
                        }
                        elsif($SyllablePart eq 'C')
                        {
                            # Actually, this is wrong, however, it allows us
                            # to spot problems
                            $IDnumber = 0;
                        };                 
                    }
                    # Kernel
                    elsif($PreviousSyllablePart eq 'K')
                    {
                        if($SyllablePart eq 'CouldBeCoda')
                        {
                            $SyllablePart = 'C';
                            $IDnumber = 0;
                        }
                        elsif($SyllablePart eq 'K')
                        {
                            $IDnumber = 0;
                            ++$SyllableNumber;
                        }
                        elsif($SyllablePart eq 'C')
                        {      
                            $IDnumber = 0;
                        }                
                        elsif($SyllablePart eq 'O')
                        {      
                            $IDnumber = 0;
                            ++$SyllableNumber;
                        };                 
                    }
                    # Coda
                    elsif($PreviousSyllablePart eq 'C')
                    {
                        if($SyllablePart eq 'CouldBeCoda')
                        {
                            $SyllablePart = $PreviousSyllablePart;
                        }
                        elsif($SyllablePart eq 'K')
                        {
                            $IDnumber = 0;
                            ++$SyllableNumber;
                        }
                        elsif($SyllablePart eq 'C')
                        {      
                        }                 
                        elsif($SyllablePart eq 'O')
                        {      
                            $IDnumber = 0;
                            ++$SyllableNumber;
                        };                 
                    };
                    
                    # To next id number
                    ++$IDnumber;
                    
                    # Update for next round
                    $PreviousSyllablePart = $SyllablePart;
                    $PreviousPhoneme = $currentTierValue;
                    
                    # Handle rediculously long words
                    $SyllableNumber = 'SA' if $SyllableNumber eq 'AA';
                    
                    # Set new ID code
                    $Label->currentItem($Tier, $currentTierItem);
                    $Label->currentIDcode($Tier, "$CurrentIDprefix$SyllableNumber$SyllablePart$IDnumber");
                    
                    # Reset
                    $OldIDprefix = $CurrentIDprefix;
                };
            };
            
            # Construct Syllables Tier
            my @NewTierOrder = (@{$Label->{TIERORDER}});
            foreach my $Tier (@NewTierOrder)
            {
                # Skip the Segment Tier for now
                next unless $Tier =~ /_SEG$Type$/;
                # Skip tiers that do NOT contains (speaker) numbers
                next unless $Tier =~ /[\d]+/i;
                # Only the word tiers
                next unless $Tier =~ /$Type$/i;
                
                # All Tiernames get their type appended
                my $NewTier = "${`}_SYLL$Type" if $Tier =~ /_SEG$Type$/i;
                $Label->createTier($NewTier);
                $Label->presetItem($Tier);
                my $NewValue = "";
                my $SyllableIDcode = "";
                my $NewStart = 0;
                my $NewEnd = 0;
                $Label->presetItem($Tier);
                while($Label->nextItem($Tier) > -1)
                {
                    $NewEnd = $Label->currentStart($Tier);
                    # New ID, write down items
                    unless($Label->currentIDcode($Tier) =~ /^$SyllableIDcode[OKC][\d]+$/)
                    {
                        # Push the new IPU
                        $Label->pushItem($NewTier, $NewValue, $SyllableIDcode, $NewStart, $NewEnd) if $NewStart < $NewEnd;

                        # Reset Values
                        $NewValue = $Label->currentValue($Tier);
                        $SyllableIDcode = $Label->currentIDcode($Tier);
                        $SyllableIDcode =~ s/[OKC][\d]+$//g;
                        $NewStart = $Label->currentStart($Tier);
                        $NewEnd = $Label->currentEnd($Tier);
                    }
                    else
                    {
                        # Update values
                        $NewValue .= $Label->currentValue($Tier);
                        $NewEnd = $Label->currentEnd($Tier);                
                    };
                };
                # Write out last value
                if($NewStart <  $NewEnd)
                {
                    $Label->pushItem($NewTier, $NewValue, $SyllableIDcode, $NewStart, $NewEnd);
                };

            };            

            # Construct Inter Pausal Units from the word tier
            # Note that if there is a segment, it should be pause too
            my @NewTierOrder = @{$Label->{TIERORDER}};
            foreach my $Tier (@NewTierOrder)
            {
                # Only the word tiers
                next unless $Tier =~ /([\d]+)$Type$/i;

                my $SegTier = $Tier;
                $SegTier =~ s/$Type$/_SEG$Type/ig;
                $SegTier = "" unless $Label->existsTier($SegTier);
                my $NewTier = $Tier;
                $NewTier =~ s/$Type$/IPU$Type/ig;
                $Label->createTier($NewTier);
                my $NewValue = "";
                my $FirstIDcode = "";
                my $LastIDcode = "";
                my $NewStart = 0;
                my $NewEnd = 0;
                $Label->presetItem($Tier);
                while($Label->nextItem($Tier) > -1)
                {
                    $NewEnd = $Label->currentStart($Tier);
                    # Silence, write down items
                    unless($Label->currentValue($Tier) =~ /[^\s]/)
                    {
                        # construct new ID code from first and last word ID
                        my $NewIDcode = combineIDcodes($FirstIDcode, $LastIDcode);
                        # Push the new IPU
                        $Label->pushItem($NewTier, $NewValue, $NewIDcode, $NewStart, $NewEnd) if $NewStart < $NewEnd;
                        # Push the Pause
                        $Label->pushItem($NewTier, "", $Label->currentIDcode($Tier), 
                                        $Label->currentStart($Tier), $Label->currentEnd($Tier));

                        # Reset Values
                        $NewValue = "";
                        $FirstIDcode = "";
                        $LastIDcode = $FirstIDcode;
                        $NewStart = $Label->currentEnd($Tier);
                        $NewEnd = $NewStart;
                    }
                    else
                    {
                        # Update values
                        $NewValue .= " " unless $NewValue =~ /\s$/;
                        $NewValue .= $Label->currentValue($Tier);
                        $FirstIDcode = $Label->currentIDcode($Tier) unless $FirstIDcode =~ /\S/;
                        $LastIDcode = $Label->currentIDcode($Tier);
                        $NewEnd = $Label->currentEnd($Tier);                
                    };
                };
                # Write out last value
                if($NewStart <  $NewEnd)
                {
                    my $NewIDcode = combineIDcodes($FirstIDcode, $LastIDcode);
                    $Label->pushItem($NewTier, $NewValue, $NewIDcode, $NewStart, $NewEnd);
                };

            };
            
            # Do awd/wrd specific stuff
            if($Type eq "awd")
            {
            }
            elsif($Type eq "wrd")
            {

            };
            
        }
        elsif($Type =~ /^pro[\d]+/)
        {
            # Add ID codes to the items
            # Split items on word level into a new Tier
            my @NewTierOrder = @{$Label->{TIERORDER}};
            foreach my $Tier (@currentTierOrder)
            {
                next unless $Tier =~ /([\d+])$Type$/;
                my $TierInit = "$`$1";
                
                my $WordTier = "${TierInit}wrd";
                my $NewTier = "${Tier}wrd";
                $Label->copyTier($NewTier, $WordTier);
                
                # Convert all word markers
                my $startChunk = 0;
                my $startWord = 0;
                $Label->presetItem($Tier);
                while($Label->nextItem($Tier) > -1)
                {   
                    my $currentStart = $Label->currentStart($Tier);
                    my $currentEnd = $Label->currentEnd($Tier);
                    my $currentValue = $Label->currentValue($Tier);

                    # Handle the boundary markers
                    $currentValue =~ s/\s+([\|]+)\s+/\1 \1/ig;
		    # Insert Chunk Boundary Markers (A and F)
		    $currentValue =~ s/^\s+//g;
		    $currentValue =~ s/\s+$//g;
		    $currentValue = "[${currentValue}]";
                    
                    my @wordList = split(' ', $currentValue);
                    
                    # Locate the correct item on the word tier
                    $startWord = $Label->parentItemStart($Tier, $NewTier, $startWord);
                    --$startWord;   # Start somewhat early
                    my $FirstIDcode = $Label->currentIDcode($NewTier);
                    my $LastIDcode = $FirstIDcode;
                    $Label->previousItem($NewTier);
                    while((($Label->nextItem($NewTier)) > -1) && (($Label->currentEnd($NewTier)) <= $currentEnd))
                    {
                        $LastIDcode = $Label->currentIDcode($NewTier);
                        next unless $Label->currentValue($NewTier) =~ /[^\s\_]/;
                        $Label->currentValue($NewTier, shift(@wordList));
                    };
                    # Construct new (combined) ID code
                    my $newIDcode = combineIDcodes($FirstIDcode, $LastIDcode);
                    $Label->currentIDcode($Tier, $newIDcode);
                };
                
                # Construct and boundary/acccent Tier
                my $AccentTier = "${Tier}acc";
                $Label->copyTier($AccentTier, $NewTier);
                $Label->presetItem($AccentTier);
                while($Label->nextItem($AccentTier) > -1)
                {
                    my $NewValue = $Label->currentValue($AccentTier);
                    next unless $NewValue =~ /[^\s\_]/;
                
                    # Determine Syllable accent
                    my $VowelDict = 'euioaEUIOAÀÁÂÃÄÅÆÈÉÊËÌÍÎÏÒÓÔÕÖØÙÚÛÜÝàáâãäåæèéêëìíîïñòóôõöøùúûüýÿ';
                    my $trema = 'ÄËÏÖÜäëïöÿ';
                    my $AccentNum = 0;
                    my $LengthNum = 0;
                    if($NewValue =~ /[\^\%]/)
                    {
                        my $Vowels = $NewValue;
                        
                        # Handle Trema's 
                        $Vowels =~ s/([${trema}])/_\1/ig;
                        # Marks
                        $Vowels =~ s/\*\S+$//g;
                        # Abreviations, change into "syllable kernels"
                        # Won't work with things like NATO or BAMA
                        if($Vowels !~ /[a-z]/ || $Vowels =~ /[\^\%][^${VowelDict}]+[\^\%]/)
                        {
                            $Vowels =~ s/([\^\%]?)[A-Z]([\^\%]?)/_\1A\2_/ig;   
                        };

                        $Vowels =~ s/[^${VowelDict}\^\%]+/ /ig;
                        my @VowelList = split(' ', $Vowels);
                        my $i = 0;
                        foreach my $Vowel (@VowelList)
                        {
                            ++$i;
                            $AccentNum = $i if $Vowel =~ /\^/;
                            $LengthNum = $i if $Vowel =~ /\%/;
                            last if $Vowel =~ /[\^\%]/;
                        };
                        
                    };
                    my $AccentValue = $AccentNum ? "+$AccentNum" : '-';
                    
                    # Enter Boundaries
                    $NewValue =~ s/[^\|\[\]]/_/g;
                    $NewValue =~ s/\s*\[/A/g;	# Chunk start
                    $NewValue =~ s/\]\s*/F/g;	# Chunk end
                    $NewValue =~ s/\|\|\s*$/EE/g;	# Heavy end boundary
                    $NewValue =~ s/\|\s*$/e/g;	# Light end boundary
                    $NewValue =~ s/^\s*\|\|/BB/g;	# Heavy start boundary
                    $NewValue =~ s/^\s*\|/b/g;	# Light start boundary
                    $NewValue =~ s/[\s\_]+//g;	# Get rid of rest
                    $NewValue .= " $AccentValue";
                    $NewValue .= " l$LengthNum" if $LengthNum;
                    
                    $Label->currentValue($AccentTier, $NewValue);
                };
                
                # Add the syllable Accent, boundary and lengthening
                
            };
            
        }
        elsif($Type eq "plk")
        {
        }
        elsif($Type eq "syn")
        {
        }
                
    };
    
    
    # Write new labelfile
    my @NewTierList = @{$Label->{TIERORDER}};
    $Label->FoldedIDcodes(@NewTierList);
    $Label->print("$OutputFileName.dbl", reverse(@NewTierList));
};
