#! /usr/bin/perl
#
# Package to manipulate and handle praat (short) label files
# for the Spoken Language Corpus.
#
# use: require 'SentenceLabel.pl';
#
# calling:
# >perl SentenceLabel.pl --help
# will print out a list of all subroutines with their comments.
#
#
###############################################################################
#
# Copyright Nederlandse Taalunie © 2000, 2001
#
# 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
#
# SentenceLabels is a Perl 5 package that allows the handling
# and manipulation of Praat Labelfiles.
#
# 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.
#
#
#######################################################
#
#
package SentenceLabel;

sub new
{
    my $type = shift;
    my $self = {};
    $self->{'TIER'} = {};       # The tier content
    $self->{'ID'} = {};         # The tier ID codes
    $self->{'START'} = {};      # The tier Start times
    $self->{'END'} = {};        # The tier End times
    $self->{'TIERPOINTER'} = {};        # The current position in the tiers
    $self->{'RESETPOINTER'} = {};       # The current position in the tiers
    $self->{'CURRENTTIER'} = "";        # The default Tier
    $self->{'FoldedIDcodes'} = [];      # Print folded ID codes?
    $self->{'IDcodeTiers'} = [];        # Print ID codes in separate tiers
    $self->{'SentenceIDcode'} = "";     # The MASTER sentence ID code
    $self->{'TIERORDER'} = [];          # The order in which the Tiers are created
        
    #
    return bless($self);
};

########################################################################
#
# Some simple methods for handling tiers
# (use: perl SentenceLabel.pl --help to print all subroutines)
#
# Tier level functions:
# NumberOfTiers ()  -> Number
# existsTier (Tier) -> 1/0
# createTier ($Tier) -> $Tier or -1 (if unsuccesfull)
# TierLength  (Tier) -> number_of_items
# duration (Tier) -> duration in seconds (or "")
#
# Position and move around a tier, if a new position is
# not inside the tier, all functions return a -1:
# currentItem (Tier) -> current_index_number
# currentValue (Tier) -> current_value
# currentIDcode (Tier) -> current_IDcode
# currentParentIDcode (Tier) -> current_parent_IDcode
# currentStart (Tier) -> current_StartTime
# currentEnd (Tier) -> current_EndTime
# setItem (Tier, Index) -> new_index_number
# nextItem (Tier) -> next_index_number
# previousItem (Tier) -> previous_index_number
# presetItem (Tier) -> -1
# firstItem (Tier) -> 0
# lastItem (Tier) -> LastItem
#
# Delete and insert:
# removeItem ($Tier) -> Current item
# pushItem ($Tier, $Value, $IDcode, $Start, $End) -> Index of new item
# insertItemAfter ($Tier, $Value, $ID, $EndTime) -> current_index_number
# insertItemBefore ($Tier, $Value, $ID, $StartTime) -> current_index_number
#
# Find specific items by "value":
# locateID ($Tier, $IDcode) -> SpecificItem (or -1 if not found)
# nextParentID($Tier, $ParentIDcode) -> SpecificItem (or -1 if not found)
# previousParentID($Tier, $ParentIDcode) -> SpecificItem (or -1 if not found)
# grepnextValue ($Tier, $RegExpPattern) -> Index or -1
# grepnextID ($Tier, $RegExpPattern) -> Index or -1
# grepprevValue ($Tier, $RegExpPattern) -> Index or -1
# grepprevID ($Tier, $RegExpPattern) -> Index or -1
#
########################################################################
#
# Return the number of tiers
sub NumberOfTiers       # () -> Number
{
    my $self = shift;
    return scalar(keys(%{$self->{TIER}}));
}

# Tier exists
sub existsTier  # (Tier) -> 1/0
{
    my $self = shift;
    my $Tier = shift || return 0;

    # Check existence
    my $TierExists = exists($self->{TIER}{$Tier});

    # Set new default tier
    $self->{CURRENTTIER} = $Tier if $TierExists;

    # Does Tier actually exist?
    return $TierExists;
}

# Create a new Tier.
# Returns -1 if Tier already exists.
sub createTier  # ($Tier) -> $Tier or -1 (if unsuccesfull)
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;

    return -1 if $self->existsTier($Tier);

    # Create and empty tier
    $self->{TIER}{$Tier} = [];
    $self->{ID}{$Tier} = [];
    $self->{START}{$Tier} = [];
    $self->{END}{$Tier} = [];
    $self->{TIERPOINTER}{$Tier} = -1;
    $self->{RESETPOINTER}{$Tier} = [];
    push(@{$self->{TIERORDER}}, $Tier);
    $self->{TOLERANCE} = 0.0005;         # Tolerance for alignment

    return $Tier;
}

# Copy a tier
# Returns -1 if Tier already exists.
sub copyTier    # ($NewTier, $SourceTier) -> $Tier or -1 (if unsuccesfull)
{
    my $self = shift;
    my $NewTier = shift || return -1;
    my $SourceTier = shift || $self->{CURRENTTIER} || return -1;

    return -1 if $self->existsTier($NewTier);
    return -1 unless $self->existsTier($SourceTier);

    # Create and empty tier
    $self->createTier($NewTier);
    
    # Copy lists of SourceTier wholesale (this is an optimization)
    @{$self->{TIER}{$NewTier}} = @{$self->{TIER}{$SourceTier}};    # Values
    @{$self->{ID}{$NewTier}} = @{$self->{ID}{$SourceTier}};        # ID codes
    @{$self->{START}{$NewTier}} = @{$self->{START}{$SourceTier}};  # Start time
    @{$self->{END}{$NewTier}} = @{$self->{END}{$SourceTier}};      # End time
    # Set current item of new tier
    $self->currentItem($NewTier, $self->currentItem($SourceTier));
            
    # Return new tier
    return $NewTier;
}

# Copy the IDcode of a tier. 
# Returns -1 if Tier doesn't exists. Both tiers must be EQUAL in all respects
sub copyIDcodes    # ($TargetTier, $SourceTier) -> $TargetTier or -1 (if unsuccesfull)
{
    my $self = shift;
    my $TargetTier = shift || return -1;
    my $SourceTier = shift || $self->{CURRENTTIER} || return -1;

    return -1 unless $self->existsTier($TargetTier);
    return -1 unless $self->existsTier($SourceTier);
    return -1 unless $self->TierLength($TargetTier) == $self->TierLength($SourceTier);

    # Copy the list of ID codes
    @{$self->{'ID'}{$TargetTier}} = @{$self->{'ID'}{$SourceTier}};
            
    # Return new tier
    return $TargetTier;
}

# Length of a tier
sub TierLength  # (Tier) -> number_of_items
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    return scalar(@{$self->{TIER}{$Tier}});
}

# Total duration of a tier
sub duration    # (Tier) -> duration in seconds (or "")
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;

    # Does Tier actually exist?
    return "" unless $self->existsTier($Tier) && $self->TierLength($Tier) > 0;

    my $duration = $self->{END}{$Tier}[$self->TierLength($Tier)-1]
           - $self->{START}{$Tier}[0];
        
    return $duration;
}

# Current Item index. Also checks the upper boundary.
sub currentItem # (Tier [, $Index]) -> current_index_number
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # Set a new value if there is a second argument
    if(@_)
    {
        $self->{TIERPOINTER}{$Tier} = shift || 0;
    };

    # Has someone messed around with the Tier (check boundaries)?
    $self->{TIERPOINTER}{$Tier} = -1 if $self->{TIERPOINTER}{$Tier} < -1;
    $self->{TIERPOINTER}{$Tier} = -1 unless $self->{TIERPOINTER}{$Tier} < $self->TierLength($Tier);

    return $self->{TIERPOINTER}{$Tier};
}

# Current Item value
sub currentValue        # (Tier [, $Value]) -> current_value
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) && $self->currentItem($Tier) >= 0;

    # Set a new value if there is a second argument
    if(@_)
    {
        $self->{TIER}{$Tier}[$self->currentItem($Tier)] = shift || "";
    };

    return $self->{TIER}{$Tier}[$self->currentItem($Tier)];
}

# next Item value (no steps) Second argument is distance tot read ([1])
sub readNextValue       # (Tier [,Diff]) -> next_value
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";
    my $DiffItem = shift || 1;

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) && $self->currentItem($Tier)+$DiffItem < $self->TierLength($Tier);

    return $self->{TIER}{$Tier}[$self->currentItem($Tier)+$DiffItem];
}

# previous Item value (no steps) Second argument is distance tot read ([1])
sub readPreviousValue   # (Tier [,Diff]) -> previous_value
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";
    my $DiffItem = shift || 1;

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) && $self->currentItem($Tier) > 0;

    return $self->{TIER}{$Tier}[$self->currentItem($Tier)-$DiffItem];
}

# Current Item ID
sub currentIDcode       # (Tier [, $IDcode]) -> current_IDcode
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) && $self->currentItem($Tier) >= 0;

    # Set a new value if there is a second argument
    if(@_)
    {
        $self->{ID}{$Tier}[$self->currentItem($Tier)] = shift || 0;
    };

    return $self->{ID}{$Tier}[$self->currentItem($Tier)];
}

# next Item ID code (no steps) Second argument is distance tot read ([1])
sub readNextIDcode      # (Tier [,Diff]) -> next_value
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";
    my $DiffItem = shift || 1;

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) && $self->currentItem($Tier)+$DiffItem < $self->TierLength($Tier);

    return $self->{ID}{$Tier}[$self->currentItem($Tier)+$DiffItem];
}

# previous Item ID code (no steps) Second argument is distance tot read ([1])
sub readPreviousIDcode  # (Tier [,Diff]) -> previous_value
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";
    my $DiffItem = shift || 1;

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) && $self->currentItem($Tier) > 0;

    return $self->{ID}{$Tier}[$self->currentItem($Tier)-$DiffItem];
}

# Get the name of the next Tier
sub nextTierName # (Tier) -> NameOfNextTier
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";
    
    my $i=0;
    for($i; $self->{TIERORDER}[$i] ne $Tier; ++$i) {};
    ++$i;
    
    my $nextTierName = "";
    
    $nextTierName = $self->{TIERORDER}[$i] if $i < $self->NumberOfTiers;
 
    return $nextTierName;
}

# Get the name of the previous Tier
sub previousTierName # (Tier) -> NameOfNextTier
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";
    
    my $i=0;
    for($i; $self->{TIERORDER}[$i] ne $Tier; ++$i) {};
    --$i;
    
    my $previousTierName = "";
    
    $previousTierName = $self->{TIERORDER}[$i] unless $i < 0;
 
    return $previousTierName;
}

# Current Item ID (needs a ParentIDcode() function)
sub currentParentIDcode # (Tier) -> current_parent_IDcode
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) && $self->currentItem($Tier) >= 0;

    return &ParentIDcode($self->{ID}{$Tier}[$self->currentItem($Tier)]);
}

# Current Start time
sub currentStart        # (Tier [, $Start]) -> current_StartTime
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) && $self->currentItem($Tier) >= 0;

    # Set a new value if there is a second argument
    if(@_)
    {
        $self->{START}{$Tier}[$self->currentItem($Tier)] = shift || 0;
    };

    return $self->{START}{$Tier}[$self->currentItem($Tier)];
}

# Current End time
sub currentEnd  # (Tier [, $End]) -> current_EndTime
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) && $self->currentItem($Tier) >= 0;

    # Set a new value if there is a second argument
    if(@_)
    {
        $self->{END}{$Tier}[$self->currentItem($Tier)] = shift || 0;
    };
    return $self->{END}{$Tier}[$self->currentItem($Tier)];
}

# Start time of next item
sub nextStart   # (Tier [, $Start]) -> current_StartTime
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) 
    && $self->currentItem($Tier) < $self->TierLength($Tier);

    # Set a new value if there is a second argument
    if(@_)
    {
        $self->{START}{$Tier}[$self->currentItem($Tier)+1] = shift || 0;
    };

    return $self->{START}{$Tier}[$self->currentItem($Tier)+1];
}

# End time of next item
sub nextEnd     # (Tier [, $End]) -> current_EndTime
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) 
    && $self->currentItem($Tier) < $self->TierLength($Tier);

    # Set a new value if there is a second argument
    if(@_)
    {
        $self->{END}{$Tier}[$self->currentItem($Tier)+1] = shift || 0;
    };
    return $self->{END}{$Tier}[$self->currentItem($Tier)+1];
}

# Current Start time
sub previousStart       # (Tier [, $Start]) -> current_StartTime
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) 
    && $self->currentItem($Tier) > 0;

    # Set a new value if there is a second argument
    if(@_)
    {
        $self->{START}{$Tier}[$self->currentItem($Tier)-1] = shift || 0;
    };

    return $self->{START}{$Tier}[$self->currentItem($Tier)-1];
}

# Current End time
sub previousEnd # (Tier [, $End]) -> current_EndTime
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return "";

    # Does Tier actually exist?
    return "" unless
    $self->existsTier($Tier) 
    && $self->currentItem($Tier) > 0;

    # Set a new value if there is a second argument
    if(@_)
    {
        $self->{END}{$Tier}[$self->currentItem($Tier)-1] = shift || 0;
    };
    return $self->{END}{$Tier}[$self->currentItem($Tier)-1];
}

#
# Set the Item index to a specific Index
sub setItem   # ($Tier, $Index) -> New_Item
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $Index = shift || 0;

    # Note: currentItem checks for  boundaries!!!
    return $self->currentItem($Tier, $Index);
}

#
# Store the current Item index (push it on an unlimited stack)
sub storeItem   # ($Tier) -> New_Item
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $Index = shift || 0;

    # Store the index
    push(@{$self->{RESETPOINTER}{$Tier}}, $self->currentItem($Tier));

    # Note: currentItem checks for  boundaries!!!
    return $self->currentItem($Tier);
}

#
# Set the Item index to a stored Index (and pop it from the stack)
sub restoreItem   # ($Tier, $Index) -> New_Item
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $Index = shift || 0;

    # Note: currentItem checks for  boundaries!!!
    return $self->currentItem($Tier, pop(@{$self->{RESETPOINTER}{$Tier}}));
}

# Step through a tier. -1 Is outside Tier
# Forwards
sub nextItem    # (Tier) -> next_index_number
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;

    # Note: currentItem checks for boundaries!!!
    return $self->currentItem($Tier, $self->currentItem($Tier) + 1);
}

# Backwards
sub previousItem        # (Tier) -> previous_index_number
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;

    my $CurrentItem = $self->currentItem($Tier);

    $CurrentItem = $self->TierLength($Tier) if $CurrentItem < 0;
    --$CurrentItem;

    return $self->currentItem($Tier, $CurrentItem);
}

# Start BEFORE the first item or after the last one
# (this is needed to start functions that use nextItem and previousItem
# on the correct item)
sub presetItem  # (Tier) -> -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;

    return $self->currentItem($Tier, -1);
}

# Start at first item
sub firstItem   # (Tier) -> 0
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;

    return $self->currentItem($Tier, 0);
}

# Jump to last item
sub lastItem    # (Tier) -> LastItem
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;

    return $self->currentItem($Tier, $self->TierLength($Tier) - 1);
}

# Remove the current item. The start of the next item
# will be set to the start of the removed item ($Align==0,
# default) or the end of the removed item ($Align>0). 
# If $Align < 0, the boundaries are shifted to the center of the item.
# If the prefered alignment is impossible because the
# removed item is the first or last item, the other
# alignment is used.
# Will move to the next item or -1 if there is no next item
#
sub removeItem     # ($Tier, $Align) -> Current item
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $Align = shift || 0;

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # If shift next and not the LAST item in the tier
    my $IsLast = 0;
    if(($Align == 0 && $self->TierLength($Tier) > $self->currentItem($Tier))
        || ($Align > 0 && $self->currentItem($Tier) <= 0))
    {
        # Adjust the start of the next item
        $self->{START}{$Tier}[$self->currentItem($Tier)+1] =
        $self->currentStart($Tier);
    }
    # If shift previous and not the FIRST item in the tier
    elsif(($Align > 0 && $self->currentItem($Tier) > 0)
         || ($Align == 0 && $self->TierLength($Tier) <= $self->currentItem($Tier)))
    {
        # Adjust the end of the previous item
        $self->{END}{$Tier}[$self->currentItem($Tier)-1] =
        $self->currentEnd($Tier);
    }
    # If shift to center of item
    elsif($Align < 0)
    {
        # Adjust the start of the next item
        $self->{START}{$Tier}[$self->currentItem($Tier)+1] =
        ($self->currentStart($Tier) + $self->currentEnd(Tier))/2;
        # Adjust the end of the previous item
        $self->{END}{$Tier}[$self->currentItem($Tier)-1] =
        ($self->currentStart($Tier) + $self->currentEnd(Tier))/2;
    };

    # Remove item
    die "Attempt to remove an uncreatable item from '$Tier': ", $self->currentItem($Tier), "\n"
    if $self->currentItem($Tier) < 0;

    splice(@{$self->{TIER}{$Tier}}, $self->currentItem($Tier), 1);
    splice(@{$self->{ID}{$Tier}}, $self->currentItem($Tier), 1);
    splice(@{$self->{START}{$Tier}}, $self->currentItem($Tier), 1);
    splice(@{$self->{END}{$Tier}}, $self->currentItem($Tier), 1);

    return $self->currentItem($Tier);
}

#
# Remove all items in the Tier NOT aligned to the target tier.
# The target tier defaults to the previous (daughter) tier
# (assumes hiearchically, tree-like, arraged tiers)
sub removeUnlinked      # ($Tier, $TargetTier)
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $TargetTier = shift || $self->previousTierName($Tier);
    
    # Count removed items
    my $RemovedItems = 0;

    #
    $self->presetItem($Tier);
    while($self->nextItem($Tier) > -1)
    {
        my $ItemStart = $self->StartAlignedinTier($Tier, $TargetTier);
        my $ItemEnd = $self->EndAlignedinTier($Tier, $TargetTier);

        if($ItemStart < 0)
        {
                # Remove the item, right aligned
                $self->removeItem($Tier, 1);
                $self->previousItem($Tier);     # Step back
                ++$RemovedItems;
        }
        elsif($ItemEnd < 0)
        {
                # Remove the item, left aligned
                $self->removeItem($Tier, 0);
                $self->previousItem($Tier);     # Step back
                ++$RemovedItems;
        };
    };
    
    # Ready
    return $RemovedItems;
}

#
# Push a new item on the end of a Tier. Does NOT do any
# sanity checks! Also does NOT alter the current Item pointer,
# i.e., $self->currentItem($Tier) will NOT change.
#
sub pushItem     # ($Tier, $Value, $IDcode, $Start, $End) -> Index of new item
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my ($Value, $IDcode, $Start, $End) = @_;

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # Push item
    push(@{$self->{TIER}{$Tier}}, $Value);
    push(@{$self->{ID}{$Tier}}, $IDcode);
    push(@{$self->{START}{$Tier}}, $Start);
    push(@{$self->{END}{$Tier}}, $End);

    # Ready
    return $self->TierLength($Tier) - 1;
}

# Insert a new item after the current item.
# The start point of the new item will be the end point of
# the current item. The start point of the NEXT
# item will be the end point of the inserted item.
# IT IS AN ERROR (-1) IF THE NEW END POINT IS BEYOND THE END
# OF THE NEXT ITEM. THE OPERATION IS ABORTED IN THIS CASE.
# Returns the Index of the new item, which will be the currentItem, or -1.
#
# If the currentItem == -1, the new item will become the first item of the
# tier.
sub insertItemAfter     # ($Tier, $Value, $ID, $EndTime, $Align) -> current_index_number
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my ($Value, $IDcode, $End, $Align) = @_;

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # If not the LAST item in the tier
    if($self->TierLength($Tier) > $self->currentItem($Tier))
    {
        # Is the new End not beyond the next item
        return -1
             unless $self->{END}{$Tier}[$self->currentItem($Tier) + 1] > $End;
        # Adjust the start of the next item
        $self->{START}{$Tier}[$self->currentItem($Tier)+1] = $End;
    };

    # Insert item
    splice(@{$self->{TIER}{$Tier}}, $self->currentItem($Tier)+1, 0, $Value);
    splice(@{$self->{ID}{$Tier}}, $self->currentItem($Tier)+1, 0, $IDcode);
    splice(@{$self->{START}{$Tier}}, $self->currentItem($Tier)+1, 0,
                                        $self->currentEnd($Tier));
    splice(@{$self->{END}{$Tier}}, $self->currentItem($Tier)+1, 0, $End);

    return $self->nextItem($Tier);
}

# Insert a new item before the current item.
# The end point of the new item will be the start point of
# the current item. The end point of the PREVIOUS item will be
# the start point of the current item.
# IT IS AN ERROR (-1) IF THE NEW START POINT IS BEYOND THE START
# OF THE PREVIOUS ITEM. THE OPERATION IS ABORTED IN THIS CASE.
# Returns the Index of the new item, which will be the currentItem, or -1.
#
# If the currentItem == -1, the operation is aborted.
#
sub insertItemBefore    # ($Tier, $Value, $ID, $StartTime) -> current_index_number
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my ($Value, $IDcode, $Start) = @_;

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier) && $self->currentItem($Tier) > -1;

    # If not the FIRST item in the tier
    if($self->currentItem($Tier) > 0)
    {
        # Is the new Start not beyond the previous item
        return -1
            unless $self->{START}{$Tier}[$self->currentItem($Tier) -1 ] < $Start;
        # Adjust the END of the previous item
        $self->{END}{$Tier}[$self->currentItem($Tier) - 1] = $Start;
    };

    # Insert item
    splice(@{$self->{TIER}{$Tier}}, $self->currentItem($Tier), 0, $Value);
    splice(@{$self->{ID}{$Tier}}, $self->currentItem($Tier), 0, $IDcode);
    my $OldStart = $self->currentStart($Tier);
    splice(@{$self->{START}{$Tier}}, $self->currentItem($Tier), 0, $Start);
    splice(@{$self->{END}{$Tier}}, $self->currentItem($Tier), 0, $OldStart);

    return $self->currentItem($Tier);
}

#
# Split the current item in n equal parts, default is n=2
# If $n is a reference to a list (\@list), the values
# in the list are used and $n = scalar(@list);.
# If $InitialCode] is given, it is appended to the 
# Original ID and $InitialCode++ is incremented.
# All items get the contents of the original item
# if $n is just a number.
# The new current item is the first "new" item
sub splitTier   # (Tier, $n|\@list [, $InitialCode])->current Item or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $n = shift || 2;
    my $InitialCode = shift || "";
    my @newValues = ();
    if(ref($n) eq 'ARRAY')
    {
    	@newValues = @$n;
	$n = scalar(@newValues);
    };
    return -1 unless $n > 0;
    
    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # Its the current item inside the tier?
    my $OrigItem = $self->currentItem($Tier);
    return unless $OrigItem > -1;
    
    my $OrigStart = $self->currentStart($Tier);
    my $OrigEnd = $self->currentEnd($Tier);
    # Check for decent start and end
    return -1 unless $OrigStart < $OrigEnd;
    
    my $OrigValue = $self->currentValue($Tier);
    my $OrigID = $self->currentIDcode($Tier);
    
    my $Delta = ($OrigEnd - $OrigStart) / $n;
    
    # Split the item
    # Insert items
    splice(@{$self->{TIER}{$Tier}}, $OrigItem, 1, (1..$n));
    splice(@{$self->{ID}{$Tier}}, $OrigItem, 1, (1..$n));
    splice(@{$self->{START}{$Tier}}, $OrigItem, 1, (1..$n));
    splice(@{$self->{END}{$Tier}}, $OrigItem, 1, (1..$n));
    
    # Iterate over items
    my $i;
    for($i=$OrigItem; $i<$OrigItem+$n; ++$i)
    {
        $self->{TIER}{$Tier}->[$i] = @newValues ? shift(@newValues) : $OrigValue;
        $self->{ID}{$Tier}->[$i] = $OrigID.$InitialCode;
	++$InitialCode if length($InitialCode);
        $self->{START}{$Tier}->[$i] = $OrigStart + ($i-$OrigItem)*$Delta;
        $self->{END}{$Tier}->[$i] =  $OrigStart + ($i-$OrigItem+1)*$Delta;
    };
    $self->{END}{$Tier}->[$OrigItem+$n-1] = $OrigEnd;
    
    # Reset pointer
    return $self->currentItem($Tier, $OrigItem);    
}

#
# Patch the reference Tier with the diff uitput
#
# Use $Align = &$InitialInsert($Insert, $self->readPreviousValue('PHONEMES'),
#                                       $self->currentValue('PHONEMES'));
# To determine whether (1) or not (0) an inserted phoneme can be syllable/word
# inital.
# 
#       diff            : @$diff[0] = diff reference ([<=|] <line>: <value>)
#                         @$diff[1] = diff pattern   ([>=|] <line>: <value>)
#                         $diff[2]  = Total cost;
#
sub patchTier    # ($Tier, \@diff [, \&InitialInsert])
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;;
    my $diffref = shift || die "No diff list\n";
    my $InitialInsert = shift || 0;
    
    #
    # Initialize position
    $self->firstItem($Tier);
    my $i;
    for($i = 0; $i < scalar(@{$$diffref[0]}); ++$i)
    {
        my $RefPatch = $$diffref[0][$i];
        my $PattPatch = $$diffref[1][$i];
        
        # Do Nothing
        if($RefPatch =~ /^\=/)
        {
            $self->nextItem($Tier);
        }
        # Insert item before the current one
        elsif($RefPatch =~ /^\|/)
        {
            if($PattPatch =~ /^\s*\>\s+\d+\:\s/)
            {
                my $Insert = $';
                my $Align = 0;
                if(ref($InitialInsert) eq 'CODE')
                {
                        $Align = &$InitialInsert($Insert, 
                                                $self->readPreviousValue('PHONEMES'),
                                                $self->currentValue('PHONEMES'));
                };
                
                
                # New item gets BEGIN of current item (insert Initial)
                if($Align)
                {
                        my $End = 
                        ($self->currentStart($Tier) + $self->currentEnd($Tier))/2;
                        $self->previousItem($Tier);
                        $self->insertItemAfter($Tier, $Insert, '', $End);
                }
                # New item gets END of previous item (insert Final)
                else
                {
                        my $Begin = 
                        ($self->currentStart($Tier) + $self->previousStart($Tier))/2;

                        $self->insertItemBefore($Tier, $Insert, '', $Begin);
                };
                $self->nextItem($Tier);
            };
        }
        # Substitute or remove current item
        elsif($RefPatch =~ /^\</)
        {
            # Substitute
            if($PattPatch =~ /^\s*\>\s+\d+\:\s/)
            {
                $self->currentValue($Tier, $');
                $self->nextItem($Tier);
            }
            # Remove
            else
            {
                # Deterimine whether the end is aligned or not
                $Align = $self->EndAlignedinTier($Tier, 'SYLLABLES') > -1 ? 1 : 0;
                $Align = 0 if $self->StartAlignedinTier($Tier, 'SYLLABLES') > -1;

                # Remove the item, and arrange the boundaries
                $self->removeItem($Tier, $Align);

            };
        };
    };
    
    # Ready
    return $self;
}

#
# Calculate the mean absolute time difference between the reference Tier with the diff output.
# use:
# \%Result = $Label->diffTimeTier('PHONEMES', $PattLabel, \@diff);
# 
#       diff            : @$diff[0] = diff reference ([<=|] <line>: <value>)
#                         @$diff[1] = diff pattern   ([>=|] <line>: <value>)
#                         $diff[2]  = Total cost;
#
sub diffTimeTier    # ($Tier, $PattLabel, \@diff) -> \%diffStats
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;;
    my $PattLabel = shift || die "No reference sentenceLabel\n";
    my $diffref = shift || die "No diff list\n";
    # Initialize Accumulators
    my $AbsoluteDiff = 0;
    my $SumDiff = 0;
    my $SumSquareDiff = 0;
    my $DiffCount = 0;
    my $CountSubstitution = 0;
    my $CountInsDel = 0;
    my @AbsList = ();
    
    #
    # Initialize position
    $self->firstItem($Tier);
    $PattLabel->firstItem($Tier);
    my $i;
    for($i = 0; $i < scalar(@{$$diffref[0]}); ++$i)
    {
        my $RefPatch = $$diffref[0][$i];
        my $PattPatch = $$diffref[1][$i];
	
	# Position tiers
	$RefPatch =~ /^\s*[\=\|\<\>]\s*(\d+)\:/;
	my $RefPos = $1;
	$PattPatch =~ /^\s*[\=\|\<\>]\s*(\d+)\:/;
	my $PattPos = $1;
	$self->currentItem($Tier, $RefPos);
	$PattLabel->currentItem($Tier, $PattPos);
        
        # And insertion/deletion pair
        if($RefPatch =~ /^\|/ || $PattPatch =~ /^\|/)
        {
    	    ++$CountInsDel;
	    next;    # Insertions and deletions are not aligned
        }
        # Substitute current item
        elsif($RefPatch =~ /^\s*\</ && $PattPatch =~ /^\s*\>/)
        {
            # Substitute
	    ++$CountSubstitution;
	};
	
	my $Diff = $self->currentStart($Tier) - $PattLabel->currentStart($Tier);
	# Skip absurd differences
	next if $Diff > 0.1;
	
	$AbsoluteDiff += abs($Diff);
	push(@AbsList, abs($Diff));
	$SumDiff += $Diff;
	$SumSquareDiff += $Diff*$Diff;
	++$DiffCount;
	    
    };
    
    # Ready
    my %Result = (
    'AbsoluteDiff' => $AbsoluteDiff,
    'SumDiff' => $SumDiff,
    'SumSquareDiff' => $SumSquareDiff,
    'CountSubstitution' => $CountSubstitution,
    'CountInsDel' => $CountInsDel,
    'DiffCount' => $DiffCount,
    );
    $Result{'AbsList'} = [@AbsList];
    return \%Result;
}

# Jump to specific ID (no ID -> start)
sub locateID    # ($Tier, $IDcode) -> SpecificItem (or -1 if not found)
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $IDcode = shift || "";

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # Locate ID
    return -1 if $self->firstItem < 0;
    return $self->currentItem($Tier) unless $IDcode;

    while($self->currentIDcode($Tier) ne $IDcode)
    {
        return -1 if $self->nextItem($Tier) < 0;  # NOT FOUND
    };

    return $self->currentItem($Tier);
}

# Jump to specific parent ID (no ID -> start)
sub locateParentID # ($Tier, $ParentIDcode) -> SpecificItem (or -1 if not found)
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $ParentIDcode = shift || "";

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # Locate ID
    return -1 if $self->firstItem < 0;
    return $self->currentItem($Tier) unless $ParentIDcode;

    while($self->currentParentID($Tier) ne $ParentIDcode)
    {
        return -1 if $self->nextItem($Tier) < 0;  # NOT FOUND
    };

    return $self->currentItem($Tier);
}

# Next item with specific Parent ID (no ID -> no change)
sub nextParentID # ($Tier, $ParentIDcode) -> SpecificItem (or -1 if not found)
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $ParentIDcode = shift || return $self->currentItem($Tier);

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # Locate ID
    while($self->nextItem($Tier) > 0)
    {
        return $self->currentItem($Tier)
        if $self->currentParentID($Tier) eq $ParentIDcode;
    };

    return -1;  # NOT FOUND
}

# Previous item with specific Parent ID (no ID -> no change)
sub previousParentID # ($Tier, $ParentIDcode) -> SpecificItem (or -1 if not found)
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $ParentIDcode = shift || return $self->currentItem($Tier);

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # Locate ID
    while($self->previousItem($Tier) > 0)
    {
        return $self->currentItem($Tier)
        if $self->currentParentID($Tier) eq $ParentIDcode;
    };

    return $self->currentItem($Tier);
}

# Locate next value with grep: $VALUE =~ /$RegExpPattern/
sub grepnextValue       # ($Tier, $RegExpPattern) -> Index or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $Pattern = shift || "";

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);
    # Locate Value
    while($self->nextItem($Tier) >= 0)
    {
        last if $self->currentValue($Tier) =~ /$Pattern/;  # FOUND
    };

    return $self->currentItem($Tier);
}

# Locate next IDcode with grep: $ID =~ /$RegExpPattern/
sub grepnextID  # ($Tier, $RegExpPattern) -> Index or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $Pattern = shift || "";

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # Locate Value
    while($self->nextItem($Tier) >= 0)
    {
        last if $self->currentIDcode($Tier) =~ /$Pattern/;  # FOUND
    };

    return $self->currentItem($Tier);
}

# Locate previous value with grep: $VALUE =~ /$RegExpPattern/
sub grepprevValue       # ($Tier, $RegExpPattern) -> Index or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $Pattern = shift || "";

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # Locate Value
    while($self->previousItem($Tier) >= 0)
    {
        last if $self->currentValue($Tier) =~ /$Pattern/;  # FOUND
    };

    return $self->currentItem($Tier);
}


# Locate previous IDcode with grep: $ID =~ /$RegExpPattern/
sub grepprevID  # ($Tier, $RegExpPattern) -> Index or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $Pattern = shift || "";

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    # Locate Value
    while($self->previousItem($Tier) >= 0)
    {
        last if $self->currentIDcode($Tier) =~ /$Pattern/;  # FOUND
    };

    return $self->currentItem($Tier);
}

#
# Determine whether the current item is inside a specified
# time window or item in another tier.
#

# The current START is inside a given time interval [$begin, $end> or Tier.
# Note that the interval is shifted by -$self->{TOLERANCE}. If the
# size of the interval is less than $self->{TOLERANCE}, the interval is
# expanded by $self->{TOLERANCE}.
# If $begin is an existing Tier name, the current start and end times
# of that tier are used. If there is no $end, $end == $begin.
sub Startisininterval   # ($Tier, $begin [, $end]) -> currentItem or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $begin = shift || 0;
    my $end = $begin;
    # Only give $end a value if it exists
    $end = shift(@_) if @_;

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    my $CurrentStart = $self->currentStart($Tier);

    # A tier
    if($self->existsTier($begin))
    {
        my $TargetTier = $begin;
        $begin = $self->currentStart($TargetTier);
        $end = $self->currentEnd($TargetTier);
    };
    $self->existsTier($Tier);  # Reset Default

    # Return value
    my $InsideInterval = 0;
    # Inside time window
    my $Tolerance = $self->{TOLERANCE};
    if(($end - $begin) > $Tolerance)
    {
        $InsideInterval = ($CurrentStart > $begin - $Tolerance)
        && ($CurrentStart < $end - $Tolerance);
    }
    else # Not a window, but a time point
    {
        $InsideInterval = ($CurrentStart > $begin - $Tolerance)
        && ($CurrentStart < $end + $Tolerance);
    };

    return $InsideInterval ? $self->currentItem($Tier) : -1;
}

# The current END is inside a given time interval <$begin, $end] or Tier.
# Note that the interval is shifted by +$self->{TOLERANCE}. If the
# size of the interval is less than $self->{TOLERANCE}, the interval is
# expanded by $self->{TOLERANCE}.
# If $begin is an existing Tier name, the current start and end times
# of that tier are used. If there is no $end, $end == $begin.
sub Endisininterval     # ($Tier, $begin [, $end]) -> currentItem or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $begin = shift || 0;
    my $end = $begin;
    # Only give $end a value if it exists
    $end = shift if @_;

    # Does Tier actually exist?
    return -1 unless $self->existsTier($Tier);

    my $CurrentEnd = $self->currentEnd($Tier);

    # A tier
    if($self->existsTier($begin))
    {
        my $TargetTier = $begin;
        $begin = $self->currentStart($TargetTier);
        $end = $self->currentEnd($TargetTier);
    };
    $self->existsTier($Tier);  # Reset Default

    # Return value
    my $InsideInterval = 0;
    # Inside time window
    my $Tolerance = $self->{TOLERANCE};
    if(($end - $begin) > $Tolerance)
    {
        $InsideInterval = ($CurrentEnd > $begin + $Tolerance)
        && ($CurrentEnd < $end + $Tolerance);
    }
    else # Not a window, but a time point
    {
        $InsideInterval = ($CurrentEnd > $begin - $Tolerance)
        && ($CurrentEnd < $end + $Tolerance);
    };

    return $InsideInterval ? $self->currentItem($Tier) : -1;
}

# The current START is aligned with a given time or Tier
# If $time is an existing Tier name, the current Start time
# of that tier is used.
# Uses Startisininterval.
sub Startisaligned      # ($Tier, $time) -> currentItem or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $time = shift || 0;

    my $TargetTier = $time;
    $time = $self->currentStart($TargetTier) if $self->existsTier($TargetTier);

    return $self->Startisininterval($Tier, $time, $time);
}

# The current END is aligned with a given time or Tier
# If $time is an existing Tier name, the current End time
# of that tier is used.
# Uses Endisininterval.
sub Endisaligned        # ($Tier, $time) -> currentItem or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $time = shift || 0;

    my $TargetTier = $time;
    $time = $self->currentEnd($TargetTier) if $self->existsTier($TargetTier);

    return $self->Endisininterval($Tier, $time, $time);
}

# Determine whether the item is linked to another tier and return
# its item number. The StartItem is used in cases where a Tier is
# temporarily invalid and has overlapping items.
sub StartAlignedinTier  # ($Tier, $TargetTier, $StartItem)
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $TargetTier = shift || $self->nextTierName($Tier);
    my $StartItem = shift || 0;
    
    # A tier is aligned with itself
    return $self->currentItem($Tier) if $Tier eq $TargetTier;
    
    my $Tolerance = $self->{TOLERANCE};
    my $CurrentStart = $self->currentStart($Tier);
   
    my $i;
    for($i=$StartItem; $i < $self->TierLength($TargetTier); ++$i)
    {
        $TargetStart = $self->{'START'}{$TargetTier}[$i];
        
        # Aligned
        return $i if  $TargetStart >= $CurrentStart - $Tolerance
        && $TargetStart <= $CurrentStart + $Tolerance;
        
        # Beyond the current item
        return -1 if $TargetStart > $CurrentStart + $Tolerance;
    };
    
    return -1;
}

sub EndAlignedinTier    # ($Tier, $TargetTier, $StartItem)
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $TargetTier = shift || $self->nextTierName($Tier);
    my $StartItem = shift || 0;
    
    # A tier is aligned with itself
    return $self->currentItem($Tier) if $Tier eq $TargetTier;
    
    my $Tolerance = $self->{TOLERANCE};
    my $CurrentEnd = $self->currentEnd($Tier);
   
    my $i;
    for($i=$StartItem; $i < $self->TierLength($TargetTier); ++$i)
    {
        $TargetEnd = $self->{'END'}{$TargetTier}[$i];
        
        # Aligned
        return $i if  $TargetEnd >= $CurrentEnd - $Tolerance
        && $TargetEnd <= $CurrentEnd + $Tolerance;
        
        # Beyond the current item
        return -1 if $TargetEnd > $CurrentEnd + $Tolerance;
    };
    
    return -1;
}
#
# Get the item in the parent tier that contains the current START.
# (the parent tier becomes the default tier)
# You can enter an optional start item (>0) in the parent tier 
# to start the search
sub parentItemStart   # (childTier, parentTier, [start_item]) -> parentIndex
{
    my $self = shift;
    my $childTier = shift || $self->{CURRENTTIER} || return -1;
    my $parentTier = shift || return -1;
    my $startItem = shift || 0;

    $self->presetItem($parentTier);
    $self->currentItem($parentTier, $startItem) if $startItem > 0;

    until($self->nextItem($parentTier) < 0)
    {
        last unless $self->Startisininterval($childTier, $parentTier) < 0;
    };

    return $self->currentItem($parentTier);
}

#
# Get the item in the parent tier that contains the current END.
# (the parent tier becomes the default tier)
# You can enter an optional start item (>0) in the parent tier 
# to start the search
sub parentItemEnd   # (childTier, parentTier, [start_item]) -> parentIndex
{
    my $self = shift;
    my $childTier = shift || $self->{CURRENTTIER} || return -1;
    my $parentTier = shift || return -1;
    my $startItem = shift || 0;

    $self->presetItem($parentTier);
    $self->currentItem($parentTier, $startItem) if $startItem > 0;

    until($self->nextItem($parentTier) < 0)
    {
        last unless $self->Endisininterval($childTier, $parentTier) < 0;
    };

    return $self->currentItem($parentTier);
}

# Locate the next/previous item with START or END
# within a given interval. If the end point of the
# interval is 0, the duration is used.
# If the first argument after the Tier is an
# existing tier, the current Start and End values
# of that Tier are used as begin and end.

# Locate next item with start inside interval:
# START >= $begin - $Tolerance && START < $end - $Tolerance
# $begin can be a Target Tiername.
sub nextStartininterval # ($Tier, $begin, $end) -> Index or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $begin = shift;
    my $end = shift;

    # Locate Value
    until($self->nextItem($Tier) < 0)
    {
        last if $self->Startisininterval($Tier, $begin, $end) > -1;  # FOUND
    };

    return $self->currentItem($Tier);
}

# Locate next item with end inside interval:
# END >= $begin - $Tolerance && END < $end - $Tolerance
# $begin can be a Target Tiername.
sub nextEndininterval   # ($Tier, $begin, $end) -> Index or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $begin = shift || 0;
    my $end = shift || $self->duration($Tier);

    # Locate Value
    until($self->nextItem($Tier) < 0)
    {
        last if $self->Endisininterval($Tier, $begin, $end) > -1;  # FOUND
    };

    return $self->currentItem($Tier);
}

# Locate previous item with start inside interval:
# START > $begin + $Tolerance && START <= $end + $Tolerance
# $begin can be a Target Tiername.
sub previousStartininterval     # ($Tier, $begin, $end) -> Index or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $begin = shift;
    my $end = shift;

    # Locate Value
    until($self->previousItem($Tier) < 0)
    {
        last unless $self->Startisininterval($Tier, $begin, $end) < 0;  # FOUND
    };

    return $self->currentItem($Tier);
}

# Locate previous item with end inside interval:
# END >= $begin - $Tolerance && END < $end - $Tolerance
# $begin can be a Target Tiername.
sub previousEndininterval       # ($Tier, $begin, $end) -> Index or -1
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $begin = shift;
    my $end = shift;

    # Locate Value
    until($self->previousItem($Tier) < 0)
    {
        last unless $self->Endisininterval($Tier, $begin, $end) < 0;  # FOUND
    };

    return $self->currentItem($Tier);
}

#
# Cut items through the target tiers. The item value is a RegExpr
# (without //) that will be used to match the items values.
# '^\*$' should match single '*' characters.
sub cutItems    # ($Tier, $Target, $ItemValue)
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return -1;
    my $Target = shift || $self->nextTier($Tier) || return -1;
    my $CutValue = shift || '*';
    
    my $NumberOfCuts = 0;
    
    #
    # Start, iterate over tier
    $self->presetItem($Tier);
    while($self->grepnextValue($Tier, $CutValue) > -1)
    {
        my $StartItem = $self->StartAlignedinTier($Tier, $Target);
        my $EndItem = $self->EndAlignedinTier($Tier, $Target);
        
        # Already aligned, don't bother
        next if $StartItem > -1 && $EndItem > -1;
        
        $CurrentValue = $self->currentValue($Tier);
        # Left aligned
        if($StartItem > -1)
        {
            $self->currentItem($Target, $StartItem-1);
            $self->insertItemAfter($Target, $CurrentValue, '', $self->currentEnd($Tier));
        }
        # Right aligned
        elsif($EndItem > -1)
        {
            $self->currentItem($Target, $EndItem+1);
            $self->insertItemBefore($Target, $CurrentValue, '', $self->currentStart($Tier));
        };
        
        # Increment number of cuts
        ++$NumberOfCuts;
    };
    
    # Ready
    return $NumberOfCuts;
        
}

#####################################################################
#
# Specific function needed for manipulating ID codes
#
#####################################################################
# A routine to construct element ID codes
sub IncreaseIDcode      #       ($IDSTRING [, $Lowest]) -> $NEW_IDSTRING
{
        my $ID = shift || 'A';
        my $Lowest = shift || (($ID =~ /[A-Z]/i) ? 'A' : '0');
        # ID ends in Alphabetic code
        my $Code = "";
        my $Rest = "";
        # Handle the fixed pronunciations
        my @FixedPronunciationLabels = ('ABC', 'NUM', 'VOW', 'HVDA', 'HVDB',
                'VCVA', 'VCVB', 'VCVC', 'VCVD', 'VCVE', 'VCVF', 'VCVG', 'VCVH');
        if($ID =~ /(FP[AB][12])([A-Z]+)$/)
        {
                my $CurrentFPlabel = $2;
                $ID = $`;
                $Code = $1;
                while(@FixedPronunciationLabels &&
              $CurrentFPlabel ne shift(@FixedPronunciationLabels)){};
                $Code .= shift(@FixedPronunciationLabels);
        }
        elsif($ID =~ /[A-Z\-\.\,]+(\_|$)/i)
        {
                $Code = $&;
                $ID = $`;
                $Rest = $';

                if($Code =~ /([A-Z]+)([\.,]*)$/)
                {
                        my $Increase = $1;
                        ++$Increase;
                        $Increase =~ s/A/$Lowest/g if $Lowest ne 'A';
                        $Code = "$`$Increase$2";
                };
        }
        # ID ends in Numerical code
        elsif($ID =~ /[\d\-\.\,]+(\_|$)/i)
        {
                $Code = $&;
                $ID = $`;
                $Rest = $';
                if($Code =~ /([\d]+)([\.,]*)$/)
                {
                        my $Increase = $1;
                        ++$Increase;
                        $Increase =~ s/\0/$Lowest/g if $Lowest ne '0';
                        $Code = "$`$Increase$2";
                };
        };
        $ID .= $Code;
        $ID .= "_$Rest" if $Rest;

        return $ID;
};

#
# The ID code of the parent of an ID code.
# That is, chop of the trailing code block which is either
# Alphabetic or numeric (either with [-,.]).
#
sub ParentIDcode        # ($IDcode) -> ParentIDcode (shortened)
{
    my $IDcode = shift || return "";

    my $ParentIDcode = "";

    # Remove trailing information
    $IDcode =~ s/[\_]+.*$//ig;

    # Special case for Syllable Parts
    if($IDcode =~ /^([FM][\d]+[A-Z]+[\d]+[A-Z]+[\d]+[A-Z]+[\d]+[S-Z\.\,\-][F]?)[OKC]$/i)
    {
        $ParentIDcode = $1;
    }
    elsif($IDcode =~ /[A-Z\.\,\-]+$/i)
    {
        $ParentIDcode = $`;
    }
    elsif($IDcode =~ /[\d\.\,\-]+$/i)
    {
        $ParentIDcode = $`;
    };

    return $ParentIDcode;

}

#
# Execute a piece of code on each element of a labeltier.
# $_ is set to point to the element (as in 'foreach $_ (@Tier) {}')
sub map    # ($Tier, $Code)
{
    my $self = shift;
          my $Tier = shift || $self->{CURRENTTIER} || return 0;
          my $Code = shift || return -1;
        
          #
          # Store current position in tier
          $self->storeItem($Tier);
        
          # Evaluate code with each element as $_
    $self->presetItem($Tier);
    while($self->nextItem($Tier) > -1)
    {
        $_ = $self->currentValue($Tier);
        eval($Code);
        $self->currentValue($Tier, $_);
    };
                
          # Restore initial position in tier
          $self->restoreItem($Tier);
}

#
# Shift a tier by the specified amount. Makes sure the first item starts at 0 and 
# the last item ends at $length (if given). Items shifted outside [0, length] 
# are removed. If length is 0 or not given, the current duration of the Tier is 
# used.
sub shiftTier    # ($Tier, $timeshift, $length)
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return 0;
    my $timeshift = shift || 0;
    my $length = shift || $self->duration($Tier);
    
    # No shift, nothing to do
    return -1 unless $timeshift;
    
    #
    # Store current position in tier
    $self->storeItem($Tier);

    # Iterate over all items
    $self->presetItem($Tier);
    while($self->nextItem($Tier) > -1)
    {
        $self->currentStart($Tier, $self->currentStart($Tier) + $timeshift);
        $self->currentEnd($Tier, $self->currentEnd($Tier) + $timeshift);
    };

    # Put first item on zero
    # Iterate over all items, remove those that END before 0
    $self->firstItem($Tier);
    while($self->currentEnd($Tier) <= 0)
    {
	$self->removeItem($Tier);
    };
    $self->currentStart($Tier, 0);

    # Put last item on length (if length is given)
    if($length > 0)
    {
	# Iterate over all items, remove those that BEGIN after length
	$self->lastItem($Tier);
	while($self->currentStart($Tier) >= $length)
	{
	    $self->removeItem($Tier, 1);
            $self->lastItem($Tier);
	};
	$self->currentEnd($Tier, $length);
    };
    
    # Restore initial position in tier
    $self->restoreItem($Tier);
};

#
# Shift all tiers by the specified amount, Cuts tiers to fit given length
# (if length is not given, the current length of each tier is used)
sub shiftSentenceLabel    # ($timeshift, $length)
{
    my $self = shift;
    my $timeshift = shift || 0;
    my $length = shift || "";

    # No shift, nothing to do
    return -1 unless $timeshift;
    
    # Iterate over tiers
    my $i;
    my $NoTiers = scalar(@{$self->{TIERORDER}});
    for($i=0; $i < $NoTiers; ++$i)
    {
    	# Shift all items
    	my $CurrentTierName = $self->{TIERORDER}[$i];
    	$self->shiftTier($CurrentTierName, $timeshift, $length);
    };
    
};

#
# Compare two Sentence Labels. Is currentItem substituted or inserted in SentenceLabel2?
sub insertedItem    # ($Tier, $SentenceLabel) -> INSERTED, DELETED, SUBSTITUTED, EQUAL
{
    my $self = shift;
          my $Tier = shift || $self->{CURRENTTIER} || return 0;
          my $label2 = shift || return 0;
        
          # Return 'EQUAL' if items are identical
          my $Result = 'EQUAL';
        
          # Get values
          my $Item1 = $self->currentValue($Tier);
          my $Item2 = $label2->currentValue($Tier);
          # Next values
          my $nextItem1 = $self->readNextValue($Tier);
          my $nextItem2 = $label2->readNextValue($Tier);
        
          # A possible gemminate, treat the first one as deleted
          if(($Item1 eq $Item2) && ($Item2 eq $nextItem2))
          {
              if($nextItem2 ne $nextItem1)
              {
                  $Result = 'DELETED';
              };
          };
        
          # Items are different
          unless($Item1 eq $Item2)
          {
              my $previousItem2 = $label2->readPreviousValue($Tier);
              $nextItem1 = $1 if $nextItem1 =~ /^\s*([^\-\_\s]+)[\-\_\s]/;
              #
              # Store current position in tiers
              $self->storeItem($Tier);
              $label2->storeItem($Tier);

              # Current item is an inserted silence (and not a deleted item followed by an inserted silence)
              if($Item1 =~ /^[\*\#\s]+$/ && ($nextItem2 !~ /^[\*\#\s]+$/))
              {
            $Result = 'INSERTED';
            if(($nextItem1 eq $nextItem2) && ($nextItem1 ne $Item2))
            {
                $Result = 'DELETED-INSERTED';
            };
              }
              # Current item is a deleted silence
              elsif($Item2 =~ /^[\*\#\s]+$/ && $nextItem1 !~ /^[\*\#\s]+$/)
              {
            $Result = 'DELETED';
              }
              # Current item is a fused product
              elsif(($nextItem2 ne "" && $Item1 =~ /\Q$Item2\E([\-\_\s])\Q$nextItem2\E/) ||
                 ($previousItem2 ne "" && $Item1 =~ /\Q$previousItem2\E([\-\_\s])\Q$Item2\E/))
              {
            $Result = 'FUSED';
              }
              # currentItem1 equals other->nextItem2
              elsif($Item1 eq $nextItem2)
              {
            $Result = 'DELETED';
        }
        # nextItem1 equals other->currentItem2
        elsif($nextItem1 eq $Item2)
        {
            $Result = 'INSERTED';
        }
              # Current item is a (non-matchin) fused product
              elsif($Item1 =~ /\S[\-\_\s]\S/)
              {
            $Result = 'FUSED-NONMATCHING';
            # Determine number of items
            my @ItemList = split(/[\-\_\s]/, $Item1);
            # Store position of other item
            $label2->storeItem('$Tier');
            my $FusedSegments = new SentenceLabel;
            @{$FusedSegments->{TIER}{$Tier}} = (@ItemList, $nextItem1);
            $FusedSegments->presetItem($Tier);
            my $FusedNumber = 0;
            while($FusedSegments->nextItem($Tier) < $FusedSegments->TierLength($Tier) -1)
            {
                 my $FusedResult = $FusedSegments->insertedItem($Tier, $label2);
                 $FusedSegments->previousItem($Tier) if $FusedResult eq 'DELETED';
                 $label2->nextItem($Tier);
                 ++$FusedNumber if $FusedResult =~ /EQUAL|SUBSTITUTED|DELETED/;
            };
            # Restore position of other item
            $label2->restoreItem('$Tier');

            # Store the number of fused items
            $Result .= " $FusedNumber";
        }
        # A deleted item is followed by an inserted silence
              elsif($Item1 =~ /^[\*\#\s]*$/)
        {
            $Result = 'DELETED-INSERTED';
        }
        # Aligned, but replaced
        else
        {
            $Result = 'SUBSTITUTED';
        };
              # Restore initial position in tier
              $self->restoreItem($Tier);
              $label2->restoreItem($Tier);
          };

          return $Result;
}

#
# Fill in missing ID numbers with UNIQUE codes
sub InterpolateIDtier   # ($Tier) Complete the {ID}{$Tier}
{
    my $self = shift;
        my $Tier = shift || $self->{CURRENTTIER} || return 0;
        #
        # The ID codes to use
        my $PreviousIDcode = "";
        my $CurrentIDcode = "";
        my $NextIDcode = "";

        $self->presetItem($Tier);
        while($self->nextItem($Tier) > -1)
        {
            $PreviousIDcode = $CurrentIDcode;
            $CurrentIDcode = $self->currentIDcode($Tier);
            $NextIDcode = "";

            my $CurrentItemPosition = $self->currentItem($Tier);
            unless($self->grepnextID($Tier, '\S') < 0)
            {
                $NextIDcode = $self->currentIDcode($Tier);
            };
            $self->setItem($Tier, $CurrentItemPosition);   # Reset the current position

                unless($CurrentIDcode)
                {
                        my $NewIDcode = $PreviousIDcode;
                        # Simple just add -A or -1
                        if($PreviousIDcode !~ /\-(\d+|[a-z]+)$/i)
                        {
                                if($NextIDcode !~ /$PreviousIDcode\-(\d+|[a-z]+)$/i)
                                {
                                        $NewIDcode .= $PreviousIDcode =~ /\d+$/ ? '-1' : '-A';
                                }
                                else
                                {
                                        $NewIDcode .= $PreviousIDcode =~ /\d+$/ ? '--1' : '--A';
                                };

                                # Make sure the ID is unique
                                $self->storeItem($Tier);
                                while($self->locateID($Tier, "$NewIDcode") > -1)
                                {
                                        $NewIDcode = IncreaseIDcode($NewIDcode);
                                };
                                $self->restoreItem($Tier);   # Reset the current position

                        }
                        # A little less simple
                        elsif($PreviousIDcode =~ /\-([\d]+|[a-z]+)\-([\d]+|[a-z]+)$/i)
                        {
                                $NewIDcode = $`."-";
                                my $Insert1 = $1;
                                # Make sure the ID is unique
                                $self->storeItem($Tier);
                                while($self->locateID($Tier, "$NewIDcode$Insert1") > -1)
                                {
                                        ++$Insert1;
                                };
                                $self->restoreItem($Tier);   # Reset the current position

                                my $Insert2 = $Insert1 =~ /\d+$/ ? '1' : 'A';
                                $NewIDcode .= "$Insert1-$Insert2";
                        }
                        # Almost simple
                        elsif($PreviousIDcode =~ /[\-]+([\d]+|[a-z]+)$/i)
                        {
                                $NewIDcode = $`."-";
                                my $Insert1 = $1;
                                $Insert1 = $Insert1 =~ /\d+$/ ? '2' : 'B';
                                # Make sure the ID is unique
                                $self->storeItem($Tier);
                                while($self->locateID($Tier, "$NewIDcode$Insert1") > -1)
                                {
                                        ++$Insert1;
                                };
                                $self->restoreItem($Tier);   # Reset the current position

                                my $Insert2 = $Insert1 =~ /\d+$/ ? '1' : 'A';
                                $NewIDcode .= "$Insert1-$Insert2";
                        };

                        $self->currentIDcode($Tier, $NewIDcode);
                };
        };
        return $Tier;
};

# Reconstruct ID codes for daughters in "lower" tiers
# recursively. Start at the current item in the StartTier
sub reconstructIDcodes   # ($StartTier)
{
    my $self = shift;
    my $StartTier = shift || return -1;
    
    my @RemainingTierList = reverse(@{$self->{'TIERORDER'}});
    # Remove parent tiers
    while(@RemainingTierList && $StartTier ne shift(@RemainingTierList)){};
    return -1 unless @RemainingTierList;
    
    my $ChildTier = $RemainingTierList[0];
    die "Tier $ChildTier does not exist\n" unless $self->existsTier($ChildTier);
    
    # Position Childtier
    $self->presetItem($ChildTier);
    $self->nextStartininterval($ChildTier, $self->currentStart($StartTier), 
                    $self->currentEnd($StartTier));
    
    # Get current ID
    my $ParentID = $self->currentIDcode($StartTier);
    return -1 unless $ParentID =~ /[^\_\s]/;
    my $ChildID = $ParentID;
    
    # Construct the first ID
    if(($StartTier eq 'WORDS' && $ChildTier eq 'CGN')
        || ($StartTier eq 'CGN' && $ChildTier eq 'LEXCGN')
        || ($StartTier eq 'SYLLABLES' && $ChildTier eq 'LEXSYLL')
        )
    {
        # Nothing
    }
    else
    {
        if($ChildTier eq 'SYLLABLES' || $ChildTier eq 'LEXSYLL')
        {
            $ChildID .= 'S';
        }
        elsif($ChildTier eq 'SYLLPARTS')
        {
            if($self->currentValue($ChildTier) !~ /[\#\*\@AEIOQIYiyaeou29\|\}\+]/)
            {
                $ChildID .= 'O';
            }
            else
            {
                $ChildID .= 'K';
            };
        }
        else
        {
            $ChildID .= $ParentID =~ /\d$/ ? 'A' : 1;
        };
    };
    
    # Write it into the ChildTier, and recurse down
    $self->presetItem($ChildTier);
    while($self->nextStartininterval($ChildTier, $self->currentStart($StartTier), 
                    $self->currentEnd($StartTier)) > -1)
    {
        $self->currentIDcode($ChildTier, $ChildID);
        if($ChildTier eq 'SYLLPARTS')
        {
            if($ChildID =~ /O$/)
            {
                $ChildID =~ s/O$/K/g;
            } 
            elsif($ChildID =~ /K$/)
            {
                $ChildID =~ s/K$/C/g;
            };
        }
        else
        {
            $ChildID = SentenceLabel::IncreaseIDcode($ChildID);
        };
        $self->reconstructIDcodes($ChildTier);
    };
    
    # Return Index in the Child tier
    return $self->currentItem($ChildTier);
};
                
# Reconstruct Values in a parent tier from a child tier by combining all 
# items of the source
# in the corresponding target item (ONLY when label boundaries are correct).
# Items are concatenated with interspersed $Connector strings (e.g., '-').
# If special inital or final markers should be preserved, these should match
# (RegExp) $KeepMarker.
sub reconstructValues   # ($StartTier, $TargetTier, $SourceTier, $Connector, $KeepMarker)
{
    my $self = shift;
    my $StartTier = shift || 'WORDS';
    my $TargetTier = shift || $self->{CURRENTTIER} ||'SYLLABLES';
    my $SourceTier = shift || $self->previousTierName($TargetTier) || 'PHONEMES';
    my $Connector = shift || "";
    my $KeepMarker = shift || "";
    
    # Iterate over the Source and Target Tiers
    $self->presetItem($TargetTier);
    # While inside the item
    while($self->nextStartininterval($TargetTier, $StartTier) > -1)
    {
         my @SourceList = ();
         # Keep markers that should be restored
         my $RestoreInitial = ($self->currentValue($TargetTier) =~ /^([\=]?$KeepMarker|[\=])/) ? $1 : "";
         my $RestoreFinal = ($self->currentValue($TargetTier) =~ /($KeepMarker[\=]?|[\=])$/) ? $1 : "";
         
         # Collect Items from the source tier
         $self->presetItem($SourceTier);
         while($self->nextStartininterval($SourceTier, $TargetTier) > -1)
         {
             my $currentValue = $self->currentValue($SourceTier);
             $currentValue =~ s/\=//g;
             push(@SourceList, $currentValue);
         };
         $self->currentValue($TargetTier, $RestoreInitial.(join($Connector, @SourceList)).$RestoreFinal);
    };
    
}

# Actually read a label file and contruct the label "ITEM"
sub ReadLabelFile   # ($FileName) Fills $self with tiers
{
    my $self = shift;
    my $FileName = shift;

    # Open file
    if($FileName =~ /\.gz$/)
    {
    	open(SOURCE, "gunzip -c $FileName|") || die "gunzip -c $FileName|: $!\n";
    }
    elsif($FileName ne '-')
    {
    	open(SOURCE, "<$FileName") || die "$FileName: $!\n";
    }
    else
    {
    	open(SOURCE, "<&STDIN") || die "STDIN: $!\n";
    };

    # Initialise Sentence ID code
    if($Filename =~ /[\.][^\.]*$/)
    {
        $self->{'SentenceIDcode'} = $`;
    };

    # Get the numerical tolerance
    my $Tolerance = $self->{'TOLERANCE'};
    
    #
    # Fill all the TIERS
    #
    # From a TextGrid (label)
    my $Line;
    my $SentenceIDcode = $self->{'SentenceIDcode'};
    
    my $GlobalStart;
    my $GlobalEnd;
    my $NmbrTiers;
    my %TierLength = ();
    
    #
    # Read in the complete source file
    my @AllLines = <SOURCE>;
    if(@AllLines)
    {
        my $Tier = "";
        while($Line = shift(@AllLines) || @AllLines)
        {
	        chomp($Line);
            # Get the header info
            
            if($Line =~ /\"TextGrid\"/i)
            {
                $Line = shift(@AllLines);
                $Line = shift(@AllLines);
                $GlobalStart = $Line;
                $Line = shift(@AllLines);
                $GlobalEnd = $Line;
                $Line = shift(@AllLines);
                $Line = shift(@AllLines);
                $NmbrTiers = $Line;
            };
            
            # A Tier has been found
            if($Line =~ /\"IntervalTier\"/i)
            {
                # Get the Tier name
                $Line = shift(@AllLines);
	            chomp($Line);
                # Empty tiernames, the first one is the PHONEMES tier, the others become 'SENTENCE'
                if($Line !~ /\w/)
                {
                    $Line = $self->existsTier('PHONEMES') ? '"NONAME"' : '"PHONEMES"';
                };
                # Actually read the tier (read all characters, even non-\w,except \")
                if($Line =~ /\"(\w+)\"/i)
                {
                    $Tier = $1;
                    # Check whether the tier name is correct
                    my $TierName = $Tier;

                    #
                    my $StartTime = shift(@AllLines);
                    my $EndTime = shift(@AllLines);
                    $DURATION = $EndTime - $StartTime;
                    my $NumberOfItems = shift(@AllLines);
                    $TierLength{$Tier} = $NumberOfItems;
                    
		            # Check file integrety, but ignore rounding errors
                    if(abs($StartTime - $GlobalStart) > 0.001 # $Tolerance 
                      || abs($EndTime -  $GlobalEnd) > 0.001)  # $Tolerance)
                    {
                        print STDERR "Corrupt Label File: $FileName tier $Tier $StartTime - $EndTime vs $GlobalStart - $GlobalEnd\n";
#                        return 0;
                    };
                    
                    #
                    # Skip if tier already exists
                    next if $self->existsTier($Tier);
                    #
                    # Create a new (empty) Tier entry
                    $self->createTier($Tier);

                    # Read all the items
                    my $OldIDcode = "";
                    while(@AllLines && ($AllLines[0] !~ /\"(Interval|Text)Tier\"/))
                    {
                        # Start
                        $Line = shift(@AllLines);
                        next unless $Line =~ /\S/;
                        $Line =~ /[\d\.]+/;
                        my $NewStart = $&;

                        # End
                        $Line = shift(@AllLines);
                        $Line =~ /[\d\.]+/;
                        my $NewEnd = $&;

                        # Label (remove any new-lines)
                        $Line = shift(@AllLines);
			            chomp($Line);

			            # Check whether the label is complete (i.e., contains 2 ""-quotes)
			            unless($Line =~ /^\s*\".*\"\s*$/)
			            {
				            # This is awefull, but not a label (i.e., missing quotes)
				            die "Not a label: '$Line' in $FileName $.\n" if $Line =~ /\S/ && $Line !~ /\"/;
				            # AAARRRRCCCHHHHHH the label contains new-lines
				            # Read the other lines
				            while($Line !~ /\"\s*$/ && $AllLines[0] =~ /[^\s\d\.]/)
				            {
					            $Line .= shift(@AllLines);
					            chomp($Line);
				            };
			            };

			            # Correct label 
                        $Line =~  s/^\s*\"\s+\"\s*$/\"#__\"/g;  # Insert Silence
                        $Line =~ s/^\s*\"//g;   # Remove leading spaces
                        $Line =~ s/\"\s*$//g;   # Remove trailing spaces
                        $Line =~ s/[\`]+/\`/g;   # Prevent `-quote doubling
                        $Line =~ s/[\']+/\'/g;   # Prevent '-quote doubling
                        $Line =~ s/[\"]+/\"/g;   # Prevent "-quote doubling

                        # Extract Folded ID codes
                        # Marked by a double _
                        my $NewIDcode = "";

                        if($Line =~ /[\_]{2}([^\_]*)/)
                        {
                            $NewIDcode = "$1$'";
                            $Line = $`;
                        };
                        # Store the actual value
                        my $NewValue = $Line;

                        # Actually add the new item to the Tier
                        $self->pushItem($Tier,
                        $NewValue, $NewIDcode, $NewStart, $NewEnd);
                    };
                };
            };
        };
    };
    
    #
    # Check integrity of labelfile
    if($NmbrTiers != scalar(keys(%TierLength)))
    {
            print STDERR "Corrupt Label File: $FileName number of Tiers: $NmbrTiers != ",scalar(keys(%TierLength)), "\n";
            return 0;
    };
    
    my $Tier;
    foreach $Tier (keys(%TierLength))
    {
        if(abs($self->duration($Tier) - $GlobalEnd) > $self->{TOLERANCE})
        {
            print STDERR "Corrupt Label File: $FileName tier '$Tier', Endtime: ", $self->duration($Tier), " != $GlobalEnd\n";
#            return 0;
        };
        if($self->TierLength($Tier) != $TierLength{$Tier})
        {
            print STDERR "Corrupt Label File: $FileName tier '$Tier', Length: ", $self->TierLength($Tier), " != $TierLength{$Tier}\n";
#            return 0;
        };
        
    };
    #
    # Ready
    return $self;
}

#
# Normalize Syllables tier
# Make sure every Item in the targettier contains only a valid
# collection of reference items. The &Splitter function
# determines whether the target item should be split.
sub normalizeTier    # ($TargetTier, $ReferenceTier, \&Splitter)
{
        my $self = shift;
        my $TargetTier = shift || 'SYLLABLES';
        my $ReferenceTier = shift || 'PHONEMES'; 
        my $Splitter = shift || sub {0;};
        
        my $InsertedItems = 0;
        
        # Iterate over Targettier
        $self->presetItem($TargetTier);
        while($self->nextItem($TargetTier) > -1)
        {
            # Get all items from the ReferenceTier
            my @ItemList = ();
            $self->presetItem($ReferenceTier);
            while($self->nextStartininterval($ReferenceTier, $TargetTier) > -1)
            {
                push(@ItemList, $self->currentValue($ReferenceTier));
            };
            # Split of the nonfitting tail of the list
            @SplitList = &$Splitter(@ItemList);
            if(scalar(@SplitList) > 0)
            {
                $self->nextItem($TargetTier);
                $self->presetItem($ReferenceTier);
                # Jump to the last item
                $self->nextStartininterval($ReferenceTier, $TargetTier);
                # Jump to FIRST item of part to split-off
                $self->currentItem($ReferenceTier, $self->currentItem($ReferenceTier) - scalar(@SplitList));
                # Insert a new item in the Targettier
                $self->insertItemBefore($TargetTier, "", "", $self->currentStart($ReferenceTier));
                # Step back to the old item
                $self->previousItem($TargetTier);
                
                ++$InsertedItems;
            };
        };
        
        return $InsertedItems;
}

#
# Fill Tiers TOP-DOWN
my @TierOrder = ('SENTENCE', 'TRANSLIT', 'WORDS', 'SYLLABLES', 'SYLLPARTS', 'PHONEMES');
sub FillIDcodes
{
    my $self = shift;
    #
    my $TierNumber;
    for($TierNumber=1; $TierNumber < scalar(@TierOrder); ++$TierNumber)
    {
        $CurrentTier = $TierOrder[$TierNumber];
        $ParentTier = $TierOrder[$TierNumber-1];

        # Useless unless there are some ID's in the parent and none in the Current

        $self->presetItem($ParentTier);
        next if $self->grepnextID($ParentTier, '\S') < 0;
        $self->presetItem($CurrentTier);
        next unless $self->grepnextID($CurrentTier, '\S') < 0;

        #
        $self->presetItem($CurrentTier);  # Jump to -1
        while($self->nextItem($CurrentTier) > -1)
        {
            # The ID of an item is determined by its START
            die "NO parent item of $CurrentTier '", $self->currentItem($CurrentTier), "' ",
                $self->{'SentenceIDcode'}, " in $ParentTier: ", $self->currentItem($ParentTier), "\n"
                if $self->parentItemStart($CurrentItem, $ParentTier) < 0;

            # Remember the current position
            $self->storeItem($CurrentTier);

            # Get the Previous ID and value
            $self->previousItem($CurrentTier);
            my $PreviousID = $self->currentIDcode($CurrentTier);
            my $PreviousValue = $self->currentValue($CurrentTier);

            # Get the Parent ID
            my $ParentID = $self->currentIDcode($ParentTier);

            # The previous item is INSIDE the current parent item, Increase ID
            if($self->Startisininterval($CurrentTier, $ParentTier) >= 0)
            {
                $self->restoreItem($CurrentTier);
                if($CurrentTier ne 'SYLLPARTS')
                {
                    $self->currentIDcode($CurrentTier, IncreaseIDcode($PreviousID));
                }
                else
                {
                    if($self->currentValue($CurrentTier) =~ /[\@AEIOQIYiyaeou29\|\}]/)
                    {
                        $self->currentIDcode($CurrentTier, $ParentID . 'K');
                        # An inserted syllable? Then the previous coda must be an onset?
                        if($PreviousID =~ /C$/)
                        {
                             $self->previousItem($CurrentTier);
                             $self->currentIDcode($CurrentTier, $ParentID . 'O');
                             $self->nextItem($CurrentTier);
                        };
                        
                    }
                    elsif($PreviousID =~ /O$/)
                    {
                        $self->currentIDcode($CurrentTier, $ParentID . 'K');
                    }
                    elsif($PreviousID =~ /K$/)
                    {
                        $self->currentIDcode($CurrentTier, $ParentID . 'C');
                    }
                    elsif($PreviousID =~ /C$/)  # Something wrong, New syllable?
                    {
                        $self->currentIDcode($CurrentTier, $ParentID . 'O');
                    };

                };
            }
            else        # The current item is the FIRST item
            {
                $self->restoreItem($CurrentTier);
                $NewIDcode = $ParentID;

                if($CurrentTier eq 'SYLLABLES')
                {
                    $NewIDcode .= 'S';
                }
                elsif($CurrentTier eq 'SYLLPARTS')
                {
                    if($self->currentValue($CurrentTier) !~ /[\@AEIOQIYiyaeou29\|\}\*]/)
                    {
                        $NewIDcode .= 'O';
                    }
                    else
                    {
                        $NewIDcode .= 'K';
                    };
                }
                else
                {
                    $NewIDcode .= $ParentID =~ /\d$/ ? 'A' : 1;
                };
                $self->currentIDcode($CurrentTier, $NewIDcode);
            };
        };
    };
}

#
# Fill a parent tier from a child tier by combining all items of the source
# in the corresponding target item (ONLY when label boundaries are correct).
# Items are concatenated with interspersed $Connector strings (e.g., '-').
# If special inital or final markers should be preserved, these should match
# (RegExp) $KeepMarker.
sub assembleTierValues  # ($TargetTier, $SourceTier, $Connector, $KeepMarker)
{
    my $self = shift;
    my $TargetTier = shift || $self->{CURRENTTIER} ||'SYLLABLES';
    my $SourceTier = shift || $self->previousTierName($TargetTier) || 'PHONEMES';
    my $Connector = shift || "";
    my $KeepMarker = shift || "";
    
    # Iterate over the Source and Target Tiers
    $self->presetItem($TargetTier);
    while($self->nextItem($TargetTier) > -1)
    {
         my @SourceList = ();
         # Keep markers that should be restored
         my $RestoreInitial = ($self->currentValue($TargetTier) =~ /^($KeepMarker).+/) ? $1 : "";
         my $RestoreFinal = ($self->currentValue($TargetTier) =~ /.+($KeepMarker)$/) ? $1 : "";
         
         # Collect Items from the source tier
         $self->presetItem($SourceTier);
         while($self->nextStartininterval($SourceTier, $TargetTier) > -1)
         {
             push(@SourceList, $self->currentValue($SourceTier));
         };
         $self->currentValue($TargetTier, $RestoreInitial.(join($Connector, @SourceList)).$RestoreFinal);
    };
    
}

#
# Construct an intermediate tier using a "glueing function"
# Glue($CurrentItem, $NextItem) = 1 -> Glue
# Glue($CurrentItem, $NextItem) = 0 -> Split
sub interpolateBetweenTiers   # ($NewTier, $ChildTier, $ParentTier, \&Glue)
{
    my $self = shift;
    my $NewTier = shift || 'SYLLPARTS';
    my $ChildTier = shift || $self->{CURRENTTIER} || 'PHONEMES';
    my $ParentTier = shift || $self->nextTierName($ChildTier) || 'SYLLABLES';
    my $Glue = shift || sub {0;};

    # Don't mess with existing tiers
    return -1 if $self->createTier($NewTier) == -1;
    
    my $Tolerance = $self->{TOLERANCE};
    # Iterate over the Parent and Child Tiers
    $self->presetItem($ParentTier);
    while($self->nextItem($ParentTier) > -1)
    {
    	 # Get the boundaries of the parent item
         my $ParentStart = $self->currentStart($ParentTier);
         my $ParentEnd = $self->currentEnd($ParentTier);
         my @ItemList = ();
         my $StartTime = $ParentStart;
         my $EndTime = $StartTime;
         
         # Collect Items from the child tier
         $self->presetItem($ChildTier);
         while($self->nextStartininterval($ChildTier, $ParentTier) > -1)
         {
	     # Potential New End of item
             $EndTime = $self->currentEnd($ChildTier);
             push(@ItemList, $self->currentValue($ChildTier));
             # Don't Glue
             if($EndTime >= $ParentEnd - $Tolerance 
                || ! (&$Glue($self->currentValue($ChildTier), $self->readNextValue($ChildTier))))
             {
                 my $NewItemValue = join("", @ItemList);
                 my $NewIDcode = '';
                 my $NewStart = $StartTime;
                 my $NewEnd = $EndTime;
                 # Push the new item on the tier
                 $self->pushItem($NewTier,
                                 $NewItemValue,
                                 $NewIDcode,
                                 $NewStart,
                                 $NewEnd);
                # Initialize the startime and SourceList
                $StartTime = $EndTime;
                @ItemList = ();
             };
          };
    };
    
    return $NewTier;
}

# Manage output of ID tiers
sub FoldedIDcodes       # (Tiernames...)   The Tiers whith ID codes folded in
{
    my $self = shift;
    # Tiers with folded ID coded
    @{$self->{FoldedIDcodes}} = @_ if @_;
    @{$self->{FoldedIDcodes}} = @{$self->{'TIERORDER'}} unless @_;
}

sub IDcodeTiers # (Tiernames...)   The Tiers whith separate ID code tiers
{
    my $self = shift;
    # Tiers with folded ID coded
    @{$self->{IDcodeTiers}} = @_ if @_;
    @{$self->{IDcodeTiers}} = @{$self->{'TIERORDER'}} unless @_;
}

# Write a labelfile to the output. Output can be an open filedescriptor
# or a filename
sub print       # (<OUTPUT>, Tiers...)   Print to filedescriptor <OUTPUT>
{
    my $self = shift;
    # Output must be an open file descriptor (e.g., STDOUT) or a filename
    my $OUTPUT = shift;
    # Get the names of the requested tiers
    my @PrintedTiers = @_;
    @PrintedTiers = ('WORDS', 'SYLLABLES', 'PHONEMES') unless @PrintedTiers;

    #
    # Make formatted (Praat) output
    #
    my $i;
    if($OUTPUT !~ /[\.\/\\\:]/)
    {
        open(OUTPUT, ">&$OUTPUT") || die ">&$OUTPUT: $!\n";
    }
    else
    {
        open(OUTPUT, ">$OUTPUT") || die ">$OUTPUT: $!\n";
    };

    my $PrintEnd = sprintf("%7.7F", $self->{END}{$PrintedTiers[0]}[-1]);
    $PrintEnd =~ s/0+$//g;
    print OUTPUT << "LABELEND";
File type = "ooTextFile short"
"TextGrid"

0
$PrintEnd
<exists>
LABELEND

    my $NumberOfTiers = 0;
    my $Tier;

    print OUTPUT scalar(@PrintedTiers), "\n";

    foreach $Tier (reverse(@PrintedTiers))
    {
        # The tier with the values
        print OUTPUT "\"IntervalTier\"\n";
        print OUTPUT "\"$Tier\"\n";
        print OUTPUT "0\n";
        my $PrintEnd = sprintf("%7.7F", $self->{END}{$Tier}[-1]);
        $PrintEnd =~ s/0+$//g;
        print OUTPUT "$PrintEnd\n";
        print OUTPUT scalar(@{$self->{TIER}{$Tier}}), "\n";

        my $Interval;
        for($Interval=0; $Interval < scalar(@{$self->{TIER}{$Tier}}); ++$Interval)
        {
	        my $PrintStart = ${$self->{START}{$Tier}}[$Interval] ? ${$self->{START}{$Tier}}[$Interval] : '0';
	        $PrintStart = sprintf("%7.7F", $PrintStart);
            $PrintStart = $`.$& if /[^\.]*\.[\d]{6}[^0]?/;
	        my $PrintEnd = ${$self->{END}{$Tier}}[$Interval];
	        $PrintEnd = sprintf("%7.7F", $PrintEnd);
            $PrintEnd = $`.$& if /[^\.]*\.[\d]{6}[^0]?/;
            print OUTPUT "$PrintStart\n";
            print OUTPUT "$PrintEnd\n";
            my $PrintText = "";
            # Fold the ID codes into the tier labels
            $PrintText .= ${$self->{TIER}{$Tier}}[$Interval];
            $PrintText .= '__' . ${$self->{ID}{$Tier}}[$Interval] if grep(/^$Tier$/, @{$self->{FoldedIDcodes}});
	        # Double quotes for praat (only when really needed)
            $PrintText =~ s/([\"\`])/$1$1/g;
            $PrintText =~ s/([\'])/$1$1/g if grep(/^$Tier$/, @{$self->{FoldedIDcodes}});
            print OUTPUT "\"$PrintText\"\n";
        };

        # Skip the ID code tier unless they are required
        next unless grep(/^$Tier$/, @{$self->{IDcodeTiers}});;

        # The tier with the IDcodes
        print OUTPUT "\"IntervalTier\"\n";
        print OUTPUT "\"${Tier}ID\"\n";
        print OUTPUT "0\n";
        print OUTPUT "$self->{END}{$Tier}[-1]\n";
        print OUTPUT scalar(@{$self->{ID}{$Tier}}), "\n";

        for($Interval=0; $Interval < scalar(@{$self->{ID}{$Tier}}); ++$Interval)
        {
            print OUTPUT ${$self->{START}{$Tier}}[$Interval]
            ? ${$self->{START}{$Tier}}[$Interval] : '0', "\n";
            print OUTPUT "${$self->{END}{$Tier}}[$Interval]\n";
            print OUTPUT "\"${$self->{ID}{$Tier}}[$Interval]\"\n";
        };
    };

    return 1;
}

# Convert to XML string
sub currentItem2xml	# ($Tier, SubTiers ....) -> \@XMLtext
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || 'SENTENCES';;
    my @TierList = @_;
    
    # Get current values
    my $Begin = $self->currentStart($Tier);
    my $End = $self->currentEnd($Tier);
    my $Duration = $End - $Begin;
    my $ID = $self->currentIDcode($Tier);
    my $Value = $self->currentValue($Tier);
    $Value =~ s/\'/\&quot\;/ig;
    $Value =~ s/\</\&lt\;/ig;
    $Value =~ s/\>/\&gt\;/ig;
    $Value =~ s/\=//ig;
    $Value =~ s/\~/\&\#241\;/ig;
    my $DaughterTier = shift(@TierList);
   
    # Print current item
    my $Header = "<$Tier tb='$Begin' te='$End' id='$ID' td='$Duration'";
    $Header .= " v='$Value'" if $Value =~ /\S/;
    $Header .= "/" unless $DaughterTier;
    $Header .= ">";
    
    # Push the opening tag on the output list
    my @OutputList = ();
    push(@OutputList, $Header);
    
    # Iterate over sublist
    if($DaughterTier)
    {
    	$self->storeItem($DaughterTier);
        $self->presetItem($DaughterTier);
        while($self->nextStartininterval($DaughterTier, $Tier) > -1)
        {
    	    push(@OutputList, @{$self->currentItem2xml($DaughterTier, @TierList)});
        };
    	$self->restoreItem($DaughterTier);
    };
    
    # The closing tag
    push(@OutputList, "</$Tier>") if $DaughterTier;
    # Ready, return the resulting XML list
    return \@OutputList;
};

# Write a labelfile to xml output. Output can be an open filedescriptor
# or a filename
sub printxml       # (<OUTPUT>, $Tier, @SubTiers)   Print to filedescriptor <OUTPUT>
{
    my $self = shift;
    # Output must be an open file descriptor (e.g., STDOUT) or a filename
    my $OUTPUT = shift;
    # Get the names of the requested tiers
    my $Tier = shift || 'SENTENCES';
    my @SubTiers = @_;
    @SubTiers = ('WORDS', 'SYLLABLES', 'PHONEMES') unless @SubTiers;

    #
    # Make formatted xml output
    #

    my @XMLlist = ();
    $self->storeItem($Tier);
    $self->presetItem($Tier);
    while($self->nextItem($Tier) > -1)
    {
    	# Skip silence in the parent tier
	my $currentValue = $self->currentValue($Tier);
    	next unless length($currentValue) > 0 && $currentValue =~ /[^\s\#\*\_]/;
	
	# Get the list with the XML tags
	push(@XMLlist, @{$self->currentItem2xml($Tier, @SubTiers)});
    };
    $self->restoreItem($Tier);
    
    # Open an output filehandle
    if($OUTPUT !~ /[\.\/\\\:]/)
    {
        open(OUTPUT, ">&$OUTPUT") || die ">&$OUTPUT: $!\n";
    }
    else
    {
        open(OUTPUT, ">$OUTPUT") || die ">$OUTPUT: $!\n";
    };

    # print the result
    my $result = print OUTPUT join("\n", @XMLlist), "\n";
    
    close(OUTPUT);
    
    # Return correct (!= 0)
    return $result;
}

# GMT levels
my %GMTlevel = (
'SENTENCE' => 'sentence', 
'TRANSLIT' => 'sentence', 
'WORDS' => 'word', 
'CGN' => 'word', 
'LEXCGN' => 'word', 
'SYLLABLES' => 'syllable', 
'LEXSYLL' => 'syllable', 
'SYLLPARTS' => 'demisyllable', 
'PHONEMES' => 'segment'
);
# Convert to GMT string
sub currentItem2gmt	# ($Tier, SubTiers ....) -> \@XMLtext
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || 'SENTENCES';
    my @TierList = @_;
    
    # Get current values
    my $Begin = $self->currentStart($Tier);
    my $End = $self->currentEnd($Tier);
    my $Duration = $End - $Begin;
    my $ID = $self->currentIDcode($Tier);
    my $Value = $self->currentValue($Tier);
    $Value =~ s/\'/\&quot\;/ig;
    $Value =~ s/\</\&lt\;/ig;
    $Value =~ s/\>/\&gt\;/ig;
    $Value =~ s/\=//ig;
    $Value =~ s/\~/\&\#241\;/ig;
    my $DaughterTier = shift(@TierList);
   
    # Print current item
    my $Header = "<FEAT type=\"$Tier\">$Value</FEAT>";
    
    # Push the opening tag on the output list
    my @OutputList = ();
    push(@OutputList, $Header);
    
    # Iterate over sublist
    if($DaughterTier)
    {
    	$self->storeItem($DaughterTier);
        $self->presetItem($DaughterTier);
	
        while($self->nextStartininterval($DaughterTier, $Tier) > -1)
        {
	    my $CurrentID = $self->currentIDcode($DaughterTier);	
	    # New STRUCT: A new ID must mean a different level (item)
	    if($self->currentIDcode($Tier) ne $CurrentID)
	    {
	    	    my $StructType = $GMTlevel{$DaughterTier} ? $GMTlevel{$DaughterTier} : $DaughterTier;
		    push(@OutputList, "<STRUCT TYPE=\"$StructType\" ID=\"$CurrentID\">");
		    my $CurrentStart = $self->currentStart($DaughterTier);
		    my $CurrentEnd = $self->currentEnd($DaughterTier);
		    push(@OutputList, "<SEG startsAt=\"$CurrentStart\" endsAt=\"$CurrentEnd\"/>");
	    };

    	    push(@OutputList, @{$self->currentItem2gmt($DaughterTier, @TierList)});

	    # Close STRUCT
	    if($GMTlevel{$Tier} ne $GMTlevel{$DaughterTier})
	    {
		    push(@OutputList, "</STRUCT>");
	    };
        };
	
    	$self->restoreItem($DaughterTier);
    };
    
    # Ready, return the resulting XML list
    return \@OutputList;
};

# Write a labelfile to GMT xml output. Output can be an open filedescriptor
# or a filename
sub printgmt       # (<OUTPUT>, $Tier, @SubTiers)   Print to filedescriptor <OUTPUT>
{
    my $self = shift;
    # Output must be an open file descriptor (e.g., STDOUT) or a filename
    my $OUTPUT = shift;
    # Get the names of the requested tiers
    my $Tier = shift || 'SENTENCES';
    my @SubTiers = @_;
    @SubTiers = ('WORDS', 'SYLLABLES', 'PHONEMES') unless @SubTiers;

    #
    # Make formatted xml output
    #

    my @XMLlist = ();
    $self->storeItem($Tier);
    $self->presetItem($Tier);
    while($self->nextItem($Tier) > -1)
    {
    	# Skip silence in the parent tier
	my $currentValue = $self->currentValue($Tier);
    	next unless $self->currentIDcode($Tier);
	
	# New STRUCT
	if($GMTlevel{$Tier})
	{
		my $CurrentID = $self->currentIDcode($Tier);	
		push(@XMLlist, "<STRUCT TYPE=\"$GMTlevel{$Tier}\" ID=\"$CurrentID\">");
		my $CurrentStart = $self->currentStart($Tier);
		my $CurrentEnd = $self->currentEnd($Tier);
		push(@XMLlist, "<SEG startsAt=\"$CurrentStart\" endsAt=\"$CurrentEnd\"/>");
	};

	# Get the list with the XML tags
	push(@XMLlist, @{$self->currentItem2gmt($Tier, @SubTiers)});

	# Close STRUCT
	if($GMTlevel{$Tier})
	{
		push(@XMLlist, "</STRUCT>");
	};
    };
    $self->restoreItem($Tier);
    
    # Open an output filehandle
    if($OUTPUT !~ /[\.\/\\\:]/)
    {
        open(OUTPUT, ">&$OUTPUT") || die ">&$OUTPUT: $!\n";
    }
    else
    {
        open(OUTPUT, ">$OUTPUT") || die ">$OUTPUT: $!\n";
    };

    # print the result
    my $Indent=0;
    @XMLlist= map {if(/\<\s*STRUCT/i){$_ = ("    "x$Indent).$_;++$Indent;} 
                   else {--$Indent if m@\<\s*/\s*STRUCT@i; $_ = ("    "x$Indent).$_}; $_} @XMLlist;
    my $result = print OUTPUT join("\n", @XMLlist), "\n";
    
    close(OUTPUT);
    
    # Return correct (!= 0)
    return $result;
}

#
# Extract a RDBSM record from the current item
#
# The Column headers with [TYPE] information
my @BasicColumnHeader = (
'Speaker [TEXT] Speaker ID', 
'RecNr [INT2] Number of recording session', 
'TextType [CHAR(1)] Type of text (Fixed/Variable)', 
'Style [CHAR(4)] Speaking style',
'ID [TEXT] ID code of item', 
'Value [TEXT] Value of item', 
'Start [FLOAT4] Start time of item in sentence', 
'StartValid [CHAR(1)] Start time is Valid (hand aligned) or Invalid (unresolved)', 
'End [FLOAT4] End time of item in sentence', 
'EndValid [CHAR(1)] End time is Valid (hand aligned) or Invalid (unresolved)', 
'Duration [FLOAT4] End - Start, duration of item', 
'DurationValid [CHAR(1)] Duration is Valid (boundaries hand aligned) or Invalid (unresolved)',
'prevID [TEXT] ID code of previous item', 
'prevValue [TEXT] Value of previous item', 
'nextID [TEXT] ID code of next item', 
'nextValue [TEXT] Value of next item'
);

# Dynamic column headers
sub TierToTableColumnheaders # ($Tier [, Other headers]) -> @ColumnHeaders
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return 0;
    
    # Start with basics
    my @ColumnHeaders = @BasicColumnHeader;
    
    # The Parent alignments
    # Alignments: Initial, Medial, or Final in the other tiers
    $CurrentParentTier = $Tier;
    my $CurrentIDcode = $self->currentIDcode($Tier);
    my @ProcessedIDcodes = ($CurrentIDcode);
    while($CurrentParentTier = $self->nextTierName($CurrentParentTier))
    {
        # Position the Parent tier on the current Item
        my $ParentItem = $self->parentItemStart($Tier, $CurrentParentTier);
        my $TempIDcode = $self->currentIDcode($CurrentParentTier);
        
        # Ignore redundant tiers
        next if grep {$_ eq $TempIDcode} @ProcessedIDcodes;
        push(@ProcessedIDcodes, $TempIDcode);

        push(@ColumnHeaders,
	"${CurrentParentTier}ID \[TEXT\] ID code in ${CurrentParentTier} tier",
	"${CurrentParentTier}align \[CHAR(2)\] Alignment in ${CurrentParentTier} tier (Initial, Medial, or Final)",
	"${CurrentParentTier}pos \[INT2\] Position in ${CurrentParentTier} tier");
    };
    push(@ColumnHeaders, "ChunkID \[TEXT\] ID code of parent chunk (text)");
   
    # Add the remaining arguments to the headers
    push(@ColumnHeaders, @_);
    
    return @ColumnHeaders;
    
}

# The function
# A store for the current position in a higher tier of the current item
my %ItemPos = ();

sub ItemToRecord  # ($Tier) -> @RecordList
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return 0;
    
    # The resulting record
    my @Record = ();
    
    # Initialize the Item Position at the start of the Tier
    %ItemPos = () if $self->currentItem($Tier) <= 0;
    
    # Get the current Item
    my $CurrentIDcode = $self->currentIDcode($Tier);
    my $CurrentSentenceID = $self->currentIDcode('TRANSLIT');         # Needed below
    my $CurrentChunkID = $CurrentSentenceID;         # Needed below
    $CurrentChunkID =~ s/[A-Z\-]+$//g;	# Remove sentence count
    $CurrentChunkID =~ s/[\d\-]+$//g if $CurrentChunkID =~ /[SWY][\d\-]+$/;	# Remove chunk count
    
    my $CurrentValue = $self->currentValue($Tier);
    my $IndeterminedStart = ($CurrentValue =~ s/^\=//g) ? 'I' : 'V';
    my $IndeterminedEnd = ($CurrentValue =~ s/\=$//g) ? 'I' : 'V';
    my $IndeterminedDuration = $IndeterminedStart eq 'I' || $IndeterminedEnd eq 'I' ? 'I' : 'V';
    
    push(@Record, $CurrentIDcode, $CurrentValue);
    push(@Record, sprintf("%6.4F", $self->currentStart($Tier)), $IndeterminedStart);
    push(@Record, sprintf("%6.4F", $self->currentEnd($Tier)), $IndeterminedEnd);
    push(@Record, sprintf("%6.4F", $self->currentEnd($Tier)- $self->currentStart($Tier)), $IndeterminedDuration);
    
    # The previous and following items (if not in a different sentence)
    # Is it the same sentence? (i.e., current start is NOT sentence start)
    # Preserve position in sentence
    $self->storeItem('TRANSLIT');
    if($self->Startisaligned($Tier, 'TRANSLIT') < 0)
    {
    	my $PreviousValue = $self->readPreviousValue($Tier);
    	my $PreviousID = $self->readPreviousIDcode($Tier);
	$PreviousValue =~ s/^\=//g;
	$PreviousValue =~ s/\=$//g;
        push(@Record, $PreviousID, $PreviousValue);
    }
    else   # Other sentence, ignore
    {
        push(@Record, 'NULL', 'NULL');
    };
    # Is it the same sentence?
    if($self->Endisaligned($Tier, 'TRANSLIT') < 0)
    {
    	my $NextValue = $self->readNextValue($Tier);
    	my $NextID = $self->readNextIDcode($Tier);
	$NextValue =~ s/^\=//g;
	$NextValue =~ s/\=$//g;
        push(@Record, $NextID, $NextValue);
    }
    else   # Other sentence, ignore
    {
        push(@Record, 'NULL', 'NULL');
    };
                  
    # Retore previous position in sentence
    $self->restoreItem('TRANSLIT');
		
    # Parent ID codes, Alignments: Initial, Medial, or Final in the other tiers
    $CurrentParentTier = $Tier;
    my @ProcessedIDcodes = ($CurrentIDcode);
    while($CurrentParentTier = $self->nextTierName($CurrentParentTier))
    {
        # Position the Parent tier on the current Item
        my $ParentItem = $self->parentItemStart($Tier, $CurrentParentTier);
        my $TempIDcode = $self->currentIDcode($CurrentParentTier);
        
        # Ignore redundant tiers
        next if grep {$_ eq $TempIDcode} @ProcessedIDcodes;
        push(@ProcessedIDcodes, $TempIDcode);
	
	# Store the current parent ID code
        push(@Record, $TempIDcode);

        # Indicate position with I(nitial), M(edial), and F(inal)
        my $Position = "";
        # Initial
        $Position  = "I" if $self->Startisaligned($Tier, $CurrentParentTier) > -1;
        # Final
        $Position .= "F" if $self->Endisaligned($Tier, $CurrentParentTier) > -1;
        # Medial
        $Position  = "M" unless $Position;
        
        # Handle the current position of the item in the parent tier
        $ItemPos{$CurrentParentTier} = 1 if $Position =~ /^I/;  # Reset position
        ++$ItemPos{$CurrentParentTier} if $Position !~ /^I/;  # Increment position
        
        # Store it
        push(@Record, $Position, $ItemPos{$CurrentParentTier});
   };
    # Add the Chunk ID
    push(@Record, $CurrentChunkID) unless $Tier eq 'CHUNK';
    
    # Return the record
    return @Record;
}

# Construct a list of records from a tier within the current item of the parent tier
sub TierToTable   # ($Tier, $ParentTier, \&PostEditor [, Other (constant) values])
{
    my $self = shift;
    my $Tier = shift || $self->{CURRENTTIER} || return 0;
    my $ParentTier = shift || $self->nextTierName($Tier) || 'TRANSLIT';
    my $PostEditor = shift || 0;

    my @Table = ();
    
    # Get the Recording information
    my $CurrentSpeaker;
    my $CurrentRecordingNr;
    my $CurrentTextType;
    my $CurrentStyle;
    my $CurrentParentID = $self->currentIDcode($ParentTier);
    if($CurrentParentID =~ /^([A-Z]+[\d]+[A-Z]+)(\d+)([A-Z])([A-Z]+)/)
    {
        $CurrentSpeaker = $1;
        $CurrentRecordingNr = $2;
        $CurrentTextType = $3;
        $CurrentStyle = $4;
        
        # 'PS' is actually 'F' + 'PS'
        if($CurrentTextType eq 'P' || $CurrentStyle =~ /P[AB]/)
        {
            $CurrentStyle = $CurrentTextType.$CurrentStyle;
            $CurrentTextType = 'F';
	    $CurrentStyle = 'PR' if $CurrentStyle =~ /P[AB]/;
        };
        
    };
    
    my @RecordingInfo = 
    ($CurrentSpeaker, $CurrentRecordingNr, $CurrentTextType, $CurrentStyle);
    
    $self->storeItem($Tier);   # Make sure you end where you start
    my $ItemPos = -1;
    unless($Tier eq $ParentTier)
    {
	$self->presetItem($Tier);
    	$ItemPos = $self->nextStartininterval($Tier, $ParentTier);
    }
    else
    {
    	$ItemPos = $self->currentItem($Tier);
    };
    
    
    while($ItemPos > -1)
    {
        my @Record = $self->ItemToRecord($Tier);

        # Add the recording info IN FRONT
        unshift(@Record, @RecordingInfo);
        
        # Allow changes in the basic record structure
        &$PostEditor($self, \@Record) if ref($PostEditor);

        # Add remaining arguments as values 
        push(@Record, @_);
        
        # Add the record to the table
        push(@Table, \@Record);
	
	# Next one
    	unless($Tier eq $ParentTier)
    	{
		$ItemPos = $self->nextStartininterval($Tier, $ParentTier);
    	}
    	else
    	{
    		$ItemPos = -1;
    	};
    };

    $self->restoreItem($Tier);   # Make sure you end where you start
    
    return @Table;
}    

#
# If not called within a require, check the integrity of the argument files
unless(caller())
{
    my @GlobFileList = @ARGV;

    my $FilePattern;
    
    # Get all the subs
    if(grep(/\-\-?h(elp)?/, @ARGV))
    {
        my $Leading = "";
        open(PROGFILE, "<$0") || die "$0: $!\n";
        while(<PROGFILE>)
        {
            if(/^\s*sub /)
            {
                print $Leading, "\# ", $_, "\#\n\#\n"; 
                $Leading = "";
            }
            elsif(/^\s*\# /)
            {
                $Leading .= $_;
            }
            else
            {
                $Leading = "";
            };
        };
    };

    # Handle all arguments
    foreach $FilePattern (@GlobFileList)
    {
        # Get the real filenames (expand * and ?)
        my @FileList = glob("$FilePattern");
        my $FileName;
    
        # Handle All files
        foreach $FileName (@FileList)
        {
                my $Label = new SentenceLabel;
                # This gives off a warning if the file is corrupt!
                $Label->ReadLabelFile($FileName);
        };
    };
}

1; # Make require happy
