#!/usr/bin/perl -w
use strict;

=pod

=head1 XON

                   ##      ##       ##
                    ##      ##       ##
                   ##      ##       ##
                  ##      ##       ## 
                 ##      ##       ##
                  ##      ##       ##   
    ##################################################
     ## ------------------------------------------ ######
     ## mwtf_linguistic.pl ....................... ##   ###
     ## ------------------------------------------ ##     ###
     ## findet Multi-Word-Terms (mwt) die nicht .. ##      ###
     ## woertlich im MeSH Thesaurus sind ......... ##       ### 
     ## ------------------------------------------ ##       ### 
     ## author..: Jannik Stroetgen ............... ##     ###
     ## email...: stroetge@cl.uni-heidelberg.de .. ##   ###
     ## started.: 18.05.2005 ..................... ##  ### 
     ## finished: 20.01.2006 ..................... #####
    ##################################################  
  ##### embedded documentation tool: pod ......... #####
##########################################################

=cut

=head1 NAME

    mwtf_linguistic.pl <MeshDBlemma.txt> <mtrees2005.bin> <input-dir>
         <output-file>

=cut

=head1 BESCHREIBUNG

    Dieses Skript versucht dikontinuierliche Mehr-Wort Terme (MWT)
    (die nicht woertlich im MeSH-Thesaurus gelistet sind) in Pubmed
    Artikeln zu finden. Folgende Dateien werden fuer dieses Skript
    benoetigt:
       - MeshDBlemma.txt
         (erzeugt mit "create_mesh_lemma_dbDB.pl" und "d2005.bin") 
       - mtrees2005.bin
       - Input-Verzeichnis mit .xon-files
         (erzeugt mit "get_abstracts_and_titles.pl" und Pubmed
          xml-File, siehe Ordner "/res")
    
    Dieses Skript benutzt Regeln um MWT in drei Schritten zu finden:
       1. Permutationen
       2. Insertionen (mit Permutationen)
       3. Enumerationen
    Eine Beschreibung, wie diese Regeln veraendert werden koennen,
    ist unter dem Punkt "Regeln" aufgefuehrt.

=cut

#################### <VARS fuer Regeln> ########

=head2 Regeln

    Die MWTs, Insertionen und Enumerationen koennen aus verschiedenen
    POS-Tags bestehen. Die Tags fuer MWTs koennen in die Liste "@mwtTags"
    Tags fuer Enumerationen in "@enumTags und Tags fuer Insertionen in
    "@enumTags" eingetragen werden.
    Achtung: Die Regeln fuer Enumerationen und Insertionen koennen aus
    mehr als einem Tag bestehen. Die einzelnen Tags werden mit einem 
    Slash ("/") voneienander getrennt.

=cut

# Tags die in MWT enthalten sein duerfen
my @mwtTags = (
	       '#ADJ',
	       '#ADJ#OPEN',
	       '#ADV',
	       '#ADJ#GUESSED',
	       '#NOUN',
	       '#NOUN#GUESSED',
	       '#NOUN#OPEN',
	       '#PROP',
	       '#PROP#GUESSED',
	       '#PROP#OPEN',
	       '#CARD',
	       '#MEA',
	       '#PUNCT',
	       '#VPROG#GUESSED',
#	       '#VPROG'
#	       '#VPAST'
	       );
# Tags die die Enumeration beschreiben
my @enumTags = (
		'#COORD',
#		'#CM/#COORD',
		'#COORD/#NOT',
		'#COSUB/#NOT',
#		'#CM/#COORD/#NOT',
		);
# Tags die zwischen Teilen von MWT stehen koennen
my @insertTags = (
		  '#PREP',
		  '#PREP/#DET',
		  '#ADV/#PREP/#DET',
		  '#ADV/#PREP',
		  '#CM/#ADV/#PREP/#DET',
		  '#CM/#ADV/#DET',
		  '#SENT/#ADV/#DET'
		  );
#################### </VARS fuer Regeln> #######

=head2 Inputfiles

=cut

=head3 MeshDBlemma.txt

    <Mesh Lemma Dictionary XON>
      <D03.438.221.173>
        antibiotic A23187
        a 23187
        A23187 antibiotic
      </D03.438.221.173>
      ...    

=cut

=head3 mtrees2005.bin

    Body Regions;A01
    Abdomen;A01.047
    Abdominal Cavity;A01.047.025
    Peritoneum;A01.047.025.600
    Douglas Pouch;A01.047.025.600.225
    Mesentery;A01.047.025.600.451
    ...

=cut

=head3 .xon-files

    <Xeldaresults file="pubmed2004.xml">
    <doc id ="15974560">
    <l s="0" pos="#DET">a</l>
    <l s="1" pos="#PUNCT">"</l>
    <l s="2" pos="#ADJ#GUESSED">one-day</l>
    <l s="3" pos="#NOUN">survey</l>
    <l s="4" pos="#PUNCT">"</l>
    <l s="5" pos="#SENT">:</l>
    <l s="6" pos="#COSUB">as</l>
    <l s="7" pos="#DET">a</l>
    <l s="8" pos="#ADJ">reliable</l>
    <l s="9" pos="#NOUN">estimation</l>
    <l s="10" pos="#PREP">of</l>
    <l s="11" pos="#DET">the</l>
    <l s="12" pos="#ADJ">potential</l>
    <l s="13" pos="#NOUN">recruitment</l>
    <l s="14" pos="#PREP">for</l>
    <l s="15" pos="#ADJ#GUESSED">proton-</l>
    <l s="16" pos="#COORD">and</l>
    <l s="17" pos="#ADJ#GUESSED">carbon-</l>
    <l s="18" pos="#NOUN">ion</l>
    <l s="19" pos="#NOUN">therapy</l>
    <l s="20" pos="#PREP">in</l>
    <l s="21" pos="#PROP">France</l>
    <l s="22" pos="#SENT">.</l>
    ...   

=cut


#################### <VARS> ####################
my $meshDict = $ARGV[0]; # MeshDBlemma.txt
my $mtree    = $ARGV[1]; # mtrees2005.bin
my $inputdir = $ARGV[2]; # Input-Dir mit xon-Dateien (abstracts)
my $output   = $ARGV[3]; # Output-File, z.B. pubmed2004mwt.txt
die "\nArguments missing:\n\'perl $0 <MeshDBlemma.txt> <mtrees2005.bin> <Input-Dir> <output>\'\n" unless ($output);

my $lf = $/;       # speichern der Orginaleinstellungen von $/
my $countabs  = 0; # fuer STDERR - welcher Abstract wird bearbeitet
my $countaabs = 0; # fuer STDERR - welcher Abstract gesamt
my $countfile = 0; # fuer STDERR - welche Datei wird bearbeitet
my $id;            # aktuelle Abstract ID
my $idOld = 0;     # noetig fuer Output
my %abstract;      # aktueller Abstract-Hash $abstract{position}=lemma
my %info;          # hash mit $info{position}=<l...>...</l>
my $absLen = 0;    # Laenge des aktuellen Abstracts
#################### </VARS> ###################

#################### <MAIN> ####################
my %entryTree = &read_meshDB($meshDict); # reading Mesh-DB
my %treeHead  = &read_mtrees($mtree); # reading nodes & MeshHeadings
my @input     = &read_in_dir($inputdir); # reading Input-Dir
&open_out_file($output,$inputdir); # opening Outputfile

foreach my $in (@input){
    chomp $in;
    # jedes Input-File wird ueberprueft, ob es sich um 
    # um eine .xon-Datein handelt
    if ($in =~ m/\.xon$/o){
	$countfile++;
	$countabs=0;
	my $name = "$inputdir$in";
	# Enumerationen, Insertionen und Permutationen suchen
	&get_enums_inserts_perms($name);
    }
}
&close_out_file;
#################### </MAIN> ###################


#################### <SUBS> ####################
########## <read_meshDB> ##########

=head2 sub read_meshDB

    @param   $input     MeshDBlemma.txt (siehe: Inputfiles)
    returned %entTree   siehe Beispiel

    Dieses Sub erzeugt den Hash "%entTree", der folgendermassen
    aufgebaut ist:
       "$entTree{entryTerm}{HeadingNummer}{Knotennummer}=Knoten"
    example:
        $entTree{Aminobenzoic Acid}{0}{0} = D11.768.708.054
        $entTree{Aminobenzoic Acid}{0}{1} = D02.241.223.100.054
        $entTree{Aminobenzoic Acid}{1}{0} = D11.786.708.054.075
        $entTree{Aminobenzoic Acid}{1}{1} = D02.241.223.100.054.055
    Die Informationen kommen aus dem File "MeshDBlemma.txt", das mit 
    "create_mesh_lemma_db.pl" und der Datei "d2005.bin" von MeSH.
    Weil jeder Entry-Term unter mehr als einem Knoten aufgefuehrt 
    werden kann, und jedes Heading wieder auf mehr als einen Knoten
    referieren kann, gibt der erte Index die Heading-Nummer, der
    zweite Index, der zweite Index die Knotennummer dieses Headings
    an.

=cut

sub read_meshDB{
    my $input = shift;
    my %entTree;
    open MESH, $input or
	die "cannot open $input $!\n"; # MeshDBlemma.txt
    print STDERR "\rreading MeshDB...";
    my @keys = ();   # Mesh-Knoten
    my @values = (); # Entry-Term und Heading lemmatisiert
    while (my $line = <MESH>){
	# Mesh-Knoten
	if ((!($line =~ m/^  <\//o)) and ($line =~ m/^  <(.*)>/o)){
	    push(@keys,$1);
	}
	# Entry-Term und Heading lemmatisiert
	elsif ($line =~ m/^    (.*?)\r\n/o){ # bei 'normalem zeilenende'
# 	elsif ($line =~ m/^    (.*?)\n/o){ # falls obiges  nicht funktioniert
	    my $e = $1;
	    # wenn der Entry-Term noch nicht gefunden wurde
	    if (!(grep{$_ eq $e} (@values))){
		push(@values,$e);	    
	    } 
	}
	# Mesh-Knoten geschlossen und min ein knoten gefunden
	elsif (($line =~ m/^  <\//o) and ($#keys >= 0)){
	    # fuer jeden Entry-Term
	    foreach my $v (@values){
		my $l = 0;
                # solange es diesen entryTerm bereits
		# unter anderen haedings gibt,
		# dann wird $l solange um eins erhoeht 
		while ($entTree{$v}{$l}){
		    $l++;
		}
		my $i = 0;
		# jedem Entry-Term die einzelnen Knotenpunkte zuweisen
		foreach my $k (@keys){
		    $entTree{$v}{$l}{$i}=$k;
		    $i++;
		}
	    }
	    @keys = ();
	    @values = ();
	}
    }
    close MESH;
    print STDERR "\rreading MeshDB... finished\n";
    return %entTree;
}
########## </read_meshDB> #########
########## <read_mtrees> ##########

=head2 sub read_mtrees

    @param    $input      mtrees2005.bin (MeSh-File)
    returned  %nodeHead   siehe Beispiel

    Der Hash "%nodeHead" wird erstellt aus der Datei 
    "mtrees2005.bin" (MeSH-File).
    Jeder Knoten bekommt einen Heading
    Beispiel:
      $nodeHead{D11.768.708.054} = Aminobenzoic Acids

=cut

sub read_mtrees{
    my $input = shift;
    my %nodeHead;
    open TREE, $input or die "cannot open $input $!\n";
    print STDERR "\rreading mtree...";
    while (my $line = <TREE>){
	chop $line;
	my @line = split(';',$line);
	# $nodeHead{node} = Heading
	$nodeHead{$line[1]}=$line[0];
    }
    close TREE;
    print STDERR "\rreading mtree... finished \n";
    return %nodeHead;
}
########## </read_mtrees> #########
########## <read_in_dir> ##########

=head2 sub read_in_dir

    @param    $inDir   Dir mit .xon-files (siehe: Inputfiles)
    returned  @out     Liste mit Namen der .xon-Files

    Dieses Sub liest den Inhalt des Input-Dirs ein und gibt eine
    Liste mit den Namen dieser Files zurueck.

=cut

sub read_in_dir{
    my $indir = shift;
    opendir D, $indir or die "cannot open $indir $!\n";
    my @out = readdir D;
    closedir D;
    # alle Dateien des Input-Dir werden zurueckgegeben
    return @out;
}
########## </read_in_dir> #########
########## <open_out_file> ########

=head2 sub open_out_file

    @param    $out     Name des Output-File
                       (siehe: "Outputfile" weiter oben)
    @param    $cname   Name des Input-Dir (corpus-name) mit
                       .xon-files

    Das Out-File wird geoeffnet und die xon-Informations-Zeile
    mit Datum und Name des Inputverzeichnisses wird erstellt.

=cut

sub open_out_file{
    my $out   = shift;
    my $cname = shift;
    my $date = localtime; # Erstellungsdatum
    open OUT, ">$out" or die "cannot open $out $!\n";
    print OUT "<xon-mwt date=\"$date\" corpus=\"$cname\" method=\"linguistic\">\n";
}
########## </open_out_file> #######
########## <get_enums_inserts_perms>

=head2 sub get_enums_inserts_perms

    @param   $input    Name des zu prozessierenden .xon-Files

    gebrauchte, uebergeordnete  Vars:
           $lf         Orginalwert von "$/"
           $id         Die ID des Abstracts
           $countabs   Zaehler fuer Abstracs in aktueller Datei
           $countaabs  Zaehler fuer alle Abstracts
           $countfile  Zaehler fuer aktuelle Datei
           %info       Dieser Hash wird gefuellt
           %abstract   Dieser Hash wird gefuellt
           $absLen     Laenge des aktuellen Abstracts
           @mwtTags    Regeln fuer MWTs (siehe "Regeln" weiter oben)
           @enumTags   Regeln fuer Enumerationen (siehe "Regeln" weiter oben)
           @insertTags Regeln fuer Insertionen (siehe "Regeln" weiter oben)

    Dieses Sub bekommt ein .xon-File uebergeben und versucht in jedem
    Abstract Enumerationen, Insertionen und Permutatioen zu finden.
    Die einzelnen Zaehler werden gesetzt und die Laenge des Abstracts 
    gespeichert.
    Die Hashs %info und %abstracts werden gefuellt:
           $info{Position}='<l s="Position" pos="#TAG">Lemma</l>'
           $abstract{Position}='Lemma'
    Dann werden die folgenden subs aufgerufen:
           get_permutation
           check_permutation
           get_combi_pos
           check_enums
           check_inserts

=cut

sub get_enums_inserts_perms{
    my $input = shift;
    open I, $input or die "cannot open $input $!\n";
    $/ = "</doc>"; # abstractweise einlesen
    while (my $abstract = <I>){ #aktueller Abstract-Text
	if ($abstract =~ /doc id =\"(.*?)\"/o){
	    %info = (); # Hash defined in VARS, filled here
	    %abstract = (); #Hash defined in VARS, filled here
	    $countabs++; # defined in VARS 
	    $countaabs++; # defined in VARS
	    $id = $1; # id defined in VARS, ID des Pubmed-Abstracts
	    printf STDERR "\r%8d - %3d - %4d - %6d",
	    $id, $countfile, $countabs, $countaabs;
	    # $word[i]=<l s"123" pos="#TAG">lemma</l>
	    my @words = split('\n',$abstract);
	    my @enumPositions = (); # Positionen der Enumerationen
	    my @insertPositions = ();  # Positionen der Insertionen
	    my @permPositions = (); # Positionen der Permutationen
	    $absLen = 0;
	    foreach my $lem (@words){
		# $1=Positione $2=Tag $3=Lemma
		if ($lem =~ /s=\"(.*?)\" pos=\"(.*?)\">(.*?)</o){
		    # $info{Position}=<l s="Position" pos="#TAG">Lemma</l>
		    $info{$1} = $lem;
		    # $abstract{Position}=Lemma
		    $abstract{$1} = $3;
		    $absLen++;
		}
	    }
	    if ((!($absLen > 0))or (!(defined ($abstract{$absLen-1})))){
		print "\r$id - Datei: $countfile - Abstract $countabs\n";
	    }
	    # Liste mit allen PermPos je Abstract
	    @permPositions = &get_permutations(@mwtTags);
	    # Die Permutationen werden geprueft
	    &check_permutations(@permPositions); 
	    # Liste mit allen EnumPos je Abstract
	    @enumPositions = &get_combi_pos(@enumTags);
	    # Die Enumerationen werden geprueft
	    &check_enums(@enumPositions);
	    # Liste mit allen InsertPos je Abstract
	    @insertPositions  = &get_combi_pos(@insertTags);
	    # Die Insertions werden geprueft
	    &check_inserts(@insertPositions);
	}
    }
    $/ = $lf; # $/ auf anfangswert zuruecksetzen.
    close I;
}
########## </get_enums_inserts_perms>
########## <get_permutations> #####

=head2 sub get_permutation
    
    @param    @permTags      Liste mit MWT-Tags (siehe: "Regeln" weiter oben)
    returned  @permutations  Liste mit Positionen der moeglichen Permutationen
    gebrauchte, uebergeordnete Vars:
              $absLen        Laenge des aktuellen Abstracts,
                             (Wert kommt aus "get_enums_inserts_perms"
                             und wird hier nicht geaendert)
              %abstract      Hash wurde in "get_enums_inserts_perms"
                             gefuellt (wird hier nicht veraendert)
              %info          Hash wurde in "get_enums_inserts_perms"
                             gefuellt (wird hier nicht veraendert) 

    Dieses Sub prueft, ob es Sequenzen von moeglichen MWT gibt.
    (Parameter-Liste @permTags). Wenn Seqeunzen gefunden werden,
    werden diese in @permutations zurueckgegeben.

=cut

sub get_permutations{
    my @permTags = @_;
    my @permutations = (); 
    my $i;
    my $sinnvoll = 1;
    my $permPos = "";
    # wenn Abstract existiert und fehlerfrei ist
    if (($absLen > 0) and (defined ($abstract{$absLen-1}))){
	# fuer jede Position im Abstract
	for ($i=0;$i<$absLen;$i++){
	    my $actTag = "";
	    # aktuellen Tag nehmen
	    $actTag = $1 if ($info{$i} =~ /pos=\"(.*?)\"/o);
	    # ueberpruefen ob actTag MWT-Tag ist
	    if ((grep{$_ eq $actTag} (@permTags))){
		$sinnvoll = 1;
		$permPos .= "$i ";
	    }
	    # sonst Abbruch
	    else{
		$sinnvoll = 0;
	    }
	    # wenn letzter Tag kein MWT-Tag und perm-Pos nicht 0
	    if (($sinnvoll == 0) and (!($permPos eq ""))){
		# wenn min. zwei Positionen
		if ($permPos =~ m/ (.*?) /o){
		    # moegliche Permutation hinzufuegen
		    push(@permutations,$permPos);
		}
		$permPos = "";
	    }
	    # wenn am Abs-Ende angekommen
	    if ($i == $absLen){
		# wenn letzter Tag kein MWT-Tag
		if ($sinnvoll == 1){
		    # wenn min eine Position
		    if ($permPos =~ m/ /o){
			chop $permPos;
			#wenn min zwei Positionen
			if ($permPos =~ m / /o){
			    # moegl. Permutatuin hinzufuegen
			    push(@permutations,$permPos);
			}		    
		    }
		}
	    }
	    $sinnvoll = 1;
	}
    }
    # moegliche Permutationen zurueckgeben
    return @permutations;
}
########## </get_permutations> ####
########## <get_combi_pos> ########

=head2 sub get_combi_pos

    @param    @combiTags      Entweder Insertions oder Enumerations-Tags
                              (siehe "Regeln" weiter oben)
    returned  @combiPositions Positionen der Insertion/Enumeration
                              Tags
    gebrauchte, uebergeordnete Vars:
              %info           Hash wurde in "get_enums_inserts_perms"
                              gefuellt (wird hier nicht veraendert)

    Dieses Sub prueft, ob es Sequenzen von Insertionen/Enumerationen
    gibt. Wenn Sequenzen gefunden werden , werden sie in @combiPositions
    zurueckgegeben.

=cut

sub get_combi_pos{
    my @combiTags = @_; # entw. @enumTags oder @insertTags
    my @combiPositions = (); # die jeweiligen Positionen
    # fuer jede Combi-Regel
    foreach (@combiTags){
	my @combi = split('/',$_); # die einzelnen Tags der jew. Regel
	my $combiLen = $#combi; # Laenge der Regel
	# fuer jedes Wort im Abstract
	foreach my $key (keys %info){
	    my $combiPosition = "";
	    my $i;
	    # von Tag1 - TagN der Regel
	    for ($i=0;$i<=$combiLen;$i++){
		my $lookat = $key+$i;
		# uerberpruefen auf abstract-ende
		if (defined ($info{$lookat})){
		    if ($info{$lookat} =~ /pos=\"$combi[$i]\">/ ){
			# Position der Regel
			$combiPosition .=  "$lookat ";
		    }
		    else{
			$i = $combiLen+1;
		    }
		    # wemm die Regel komplett abgearbeitet ist und
		    # auch gefunden wurde
		    if (($i == $combiLen) and (!($combiPosition eq ""))){
			push(@combiPositions,$combiPosition);
		    }
		}
	    }
	}
    }
    # Rueckgabe der Positionen aller gefundener Regeln
    return @combiPositions;
}
########## </get_combi_pos> #######
########## <check_permutations> ###

=head2 sub check_permutations

    @param    @permPositions  Positionen der  Permutations-Sequenz
    gebrauchte, uebergeordnete Vars:
              %abstract       Hash wurde in "get_enums_inserts_perms"
                              gefuellt (wird hier nicht veraendert)
 
    Dieses Sub prueft zuerst die Laenge der Permutations-Seqeunz und
    wenn sie nicht zu lang ist, werden folgende Subs aufgerufen
         help_insertions
         look_up_mesh
         get_index_print_out
    um das laengste MWT zu finden, dass im MeSH-Thesaurus steht. Das 
    laengste gefundene MWT wird ausgegeben.

=cut

sub check_permutations{
    my @permPositions = @_; # Positionen der Permutationen
    # fuer jede Permutationsfolge
    foreach my $key (@permPositions){
	my @len = split(' ',$key);
	my $len = $#len; # Laenge der Folge
	# Damit keine zu langen Permutationen errechnet werden
	if ($len < 4 ){
	    # alle Kombinationen der Permutations-Folge
	    my %combis = &help_insertions($key);
	    my @possibleMWT = (); # Liste der moeglichen MWT
	    # fuer jede Kombination
	    foreach (keys %combis){
		my $multipos = $_;
		my @pos = split(' ',$multipos);
		my $multi;
		foreach (@pos){
		    $multi .= "$abstract{$_} ";
		}
		chop $multi;
		$multi .= "{{POS}}$multipos";
		push(@possibleMWT,$multi);
	    }
	    # wenn moegliches MWT gefunden
	    if ($#possibleMWT >= 0){
		# in MeshDBlemma suchen
		my @found = &look_up_mesh(@possibleMWT);
		# wenn MWT gefunden
		if ($#found > -1){
		    # Knotenpunkt holen und ausgeben
		    &get_index_print_out(@found);
		}
	    }
	}
    }
}
########## </check_permutations> ##
########## <check_enums> ##########

=head2 sub check_enums

    @param    @enumPositions  Positionen der Enumerations-Sequenz
    gebrauchte, uebergeordnete Vars:          
              %info           Hash wurde in "get_enums_inserts_perms"
                              gefuellt (wird hier nicht veraendert)
              @mwtTags        Regeln fuer MWT (siehe "Regeln" weiter oben) 
 
    Dieses Sub erzeugt alle moeglichen Kombinationen des MWT um die
    Enumerations-Sequenz. Laengere Enumerationen, die mit Komma
    abgetrennt sind, werden als separate Enumerationen behandelt.
    Die Subs
         enum_combinations
         look_up_mesh
         get_index_print_out
    werden aufgerufen um das laengste MWT zu finden, das im MeSH-Thesaurus
    aufgelistet ist. Das laengste MWT wird ausgegeben.

=cut

#Enumerationen werden ueberprueft
sub check_enums{
    my @enumPositions = @_; #Positionen der Enumerationen
    my $posComma = "X"; # fuer erstes Komma vor der egtl. Enumeration
    my $posComma2 = "X"; # fuer zweites Komma vor der egtl. Enumeration
    # fuer jede gefundene Positionenfolge
    foreach my $position (@enumPositions){
	my $hinterEnum = 0;
	my @enumpos = split(' ',$position);
	my $startenum = $enumpos[0]; # erste Position der Enum
	my $endenum = $enumpos[$#enumpos]; # letzte Position der Enum
	my @enumeration = (); # eigentliche Enumeration
	my @enumeration1 = (); # mit erstem Komma
	my @enumeration2 = (); # mit zweitem Komma
	# auf mwt-Tags wird kontrolliert vor der enum
	my $i = -1;
	my $sinnvoll = 1;
	# solange ein MWT-Tag steht
	while ($sinnvoll == 1){
	    # dass nicht vor Position 0 im Abstract gesucht wird
	    if (($startenum+$i)>=0){
		my $actTag = $1 if ($info{$startenum+$i}
				    =~ /pos=\"(.*?)\"/o);
		# wenn akt. Tag ein MWT-Tag ist
		if (grep{$_ eq $actTag} (@mwtTags)){
		    # Position dieses Tags in die Liste schreiben
		    unshift(@enumeration,$info{$startenum+$i});
		    $i--;
		}else{
		    # kein MWT-Tag mehr
		    $sinnvoll = 0;
		}
	    }else{
		# bei Position 0 angekommen
		$sinnvoll = 0;
	    }
	}
	# pruefen ob ein Komma steht,
	# also Moeglichkeit fuer doppelte Enum
	if (($startenum+$i)>=0){
	    if ($info{$startenum+$i} =~ m/pos=\"#CM\"/o){
		$posComma = $startenum+$i;
		# weiter auf mwt-Tags pruefen
		$i--;
		$sinnvoll = 1;
		# solange vor Komma ein MWT-Tag steht
		while ($sinnvoll == 1){
		    # uerberpruefen auf abstract-anfang
		    if (defined ($info{$startenum+$i})){
			my $actTag = $1 if ($info{$startenum+$i}
					    =~ /pos=\"(.*?)\"/o);
			# wenn akt. Tag ein MWT-Tag ist
			if (grep{$_ eq $actTag} (@mwtTags)){
			    # Position dieses Tags in die Liste schreiben
			    unshift(@enumeration1,$info{$startenum+$i});
			    $i--;
			}else{
			    # kein MWT-Tag mehr
			    $sinnvoll = 0;
			}
		    }
		    else{
			# bei Position 0 angekommen
			$sinnvoll = 0;
		    }
		}
	    }
	    else{
		@enumeration1 = ();
	    }
	    # pruefen ob ein Komma steht,
	    # also Moeglichkeit fuer dreifache Enum
	    if (($startenum+$i)>=0){
		if ($info{$startenum+$i} =~ m/pos=\"#CM\"/o){
		    $posComma2 = $startenum+$i;
		    # weiter auf mwt-Tags pruefen
		    $i--;
		    $sinnvoll = 1;
		    while ($sinnvoll == 1){
			# uerberpruefen auf abstract-anfang
			if (defined ($info{$startenum+$i})){
			    my $actTag = $1 if (($info{$startenum+$i}
						 =~ /pos=\"(.*?)\"/o));
			    # wenn akt. Tag ein MWT-Tag ist
			    if (grep{$_ eq $actTag} (@mwtTags)){
				# Position dieses Tags
				# in die Liste schreiben
				unshift(@enumeration2,
					$info{$startenum+$i});
				$i--;
			    }else{
				# kein MWT-Tag mehr
				$sinnvoll = 0;
			    }
			}
			else{
			    # bei Position 0 angekommen
			    $sinnvoll = 0;
			}
		    }
		}
		else{
		    @enumeration2 = ();
		}
	    }
	}
	# auf mwt-Tags wird kontrolliert hinter der enum
	$i = 1;
	$sinnvoll = 1;
	# solange ein MWT-Tag steht
	while ($sinnvoll == 1){
	    # uerberpruefen auf abstract-ende
	    if (defined ($info{$endenum+$i})){
		my $actTag = $1 if ($info{$endenum+$i}
				    =~ /pos=\"(.*?)\"/o);
		# wenn akt. Tag ein MWT-Tag ist
		if (grep{$_ eq $actTag} (@mwtTags)){
		    # auch hinter der Enum muss MWT-Tag sein
		    $hinterEnum = 1;
		    # einfache Enum vor der RegelPos gefunden
		    if ($#enumeration >= 0){
			# Position dieses Tags in die Liste schreiben
			push(@enumeration,$info{$endenum+$i});
		    }
		    # doppelte Enum vor der RegelPos gefunden
		    if ($#enumeration1 >= 0){
			# Position dieses Tags in die Liste schreiben
			push(@enumeration1,$info{$endenum+$i});
		    }
		    # dreifache Enum vor der RegelPos gefeunden
		    if ($#enumeration2 >= 0){
			# Position dieses Tags in die Liste schreiben
			push(@enumeration2,$info{$endenum+$i});
		    }
		    $i++;
		}else{
		    # kein MWT-Tag mehr
		    $sinnvoll = 0;
		}
	    }
	    else{
		# am Abstract-Ende angekommen
		$sinnvoll = 0;
	    }
	}
	# auch hinter Enum MWT-Tag gefunden
	if ($hinterEnum == 1){
	    # wenn dreifache Enum
	    if ($#enumeration2 >= 2){
		# Kombinationen der dritten Enum errechnen
		my @results = &enum_combinations(						 @enumeration2,$posComma2,$endenum);
		# wenn Kombinationen gefunden
		if ($#results >= 0){
		    # in Mesh suchen
		    my @found = &look_up_mesh(@results);
		    # wenn MWT gefunden
		    if ($#found > -1){
			# Knotenpunkt holen und ausgeben
			&get_index_print_out(@found);
		    }
		}
	    }
	    # wenn doppelte Enum
	    if ($#enumeration1 >= 2){
		# Kombinationen der zweiten Enum errechnen
		my @results = &enum_combinations(						@enumeration1,$posComma,$endenum);
		# wenn Kombinationen gefunden
		if ($#results >= 0){
		    my @found = &look_up_mesh(@results);
		    # wenn MWT gefunden
		    if ($#found > -1){
			# Knotenpunkt holen und ausgeben
			&get_index_print_out(@found);
		    }
		}
	    }
	    # wenn eigentliche Enum
	    if ($#enumeration >= 2){
		# Kombinationen der eigentlichen Enum errechnen
		my @results = &enum_combinations(						 @enumeration,$startenum,$endenum);
		# wenn Kombinationen gefunden
		if ($#results >= 0){
		    my @found = &look_up_mesh(@results);
		    # wenn MWT gefunden
		    if ($#found > -1){
			# Knotenpunkt holen und ausgeben
			&get_index_print_out(@found);
		    }
		}
	    }
	}
    }
}
########## </check_enums> #########
########## <check_inserts> ########

=head2 sub check_inserts

    @param   @insertPositions Positionen der Insertions-Sequenz
    gebrauchte, uebergeordnete Vars:
             %info            Hash wurde in "get_enums_inserts_perms"
                              gefuellt (wird hier nicht veraendert)
             @mwtTags         Regeln fuer MWT (siehe "Regeln" weiter oben)

    Dieses Sub erstellt alle moeglichen Kombinationen des MWTs um die 
    Insertions-Sequenz. Die Subs
         insert_combinations
         look_up_mesh
         get_index_print_out
    werden aufgerufen um das laengste MWT, das im MeSH-Thesaurus 
    gelistet ist, zu finden. Der laengste gefundene MWT wird ausgegeben.

=cut

# Insertionen evtl. mit Permutationen werden geprueft
sub check_inserts{
    my @insertPositions = @_; # Positionen der Insertions
    # fuer jede Insertionsfolge
    foreach my $position (@insertPositions){
	my @insertpos = split(' ',$position);
	my $startinsert = $insertpos[0]; # erste Position der Insert
	my $endinsert = $insertpos[$#insertpos]; # letzte Pos d. Insert
	my @insertion; # die Woerter um die Insertion herum
	my $i = -1;
	my $sinnvoll = 1;
	# auf mwt-Tags vor der insert wird kontrolliert
	while ($sinnvoll == 1){
	    # das nicht vor Position 0 geprueft wird
	    if (($startinsert+$i)>=0){
		my $actTag = $1 
		    if ($info{$startinsert+$i} =~ /pos=\"(.*?)\"/o);
		# Wenn MWT-Tag
		if (grep{$_ eq $actTag} (@mwtTags)){
		    # Position dieses Tags in Liste
		    unshift(@insertion,$info{$startinsert+$i});
		    $i--;
		}else{
		    # kein MWT-Tag mehr
		    $sinnvoll = 0;
		}
	    }
	    else{
		# an Position 0 angekommen
		$sinnvoll = 0;
	    }
	}
	# auf mwt-Tags hinter der insert wird kontrolliert,
	# wenn davor welche waren 
	$i = 1;
	# MWT-Tags vor der Insertion
	if ($#insertion >= 0){
	    $sinnvoll = 1;
	    # auch hinter der Insert muss MWT-Tag sein
	    my $hinterinsert = 0;
	    # solange MWT-Tag
	    while ($sinnvoll == 1){
		# uerberpruefen auf abstract-ende
		if (defined ($info{$endinsert+$i})){
		    my $actTag = $1 if ($info{$endinsert+$i} =~ /pos=\"(.*?)\"/o);
		    # Wenn MWT-Tag
		    if (grep{$_ eq $actTag} (@mwtTags)){
			# Position dieses Tags in Liste
			push(@insertion,$info{$endinsert+$i});
			$hinterinsert = 1;
			$i++;
		    }else{
			# kein MWT-Tag mehr
			$sinnvoll = 0;
		    } 
		}
		else{
		    # an Abstract-Ende angekommen
		    $sinnvoll = 0;
		}
	    }
	    # wenn vor und hinter der Insert MWT-Tag
	    if (($#insertion >= 1) && ($hinterinsert == 1)){
		# ombinationen errechnen
		my @results = &insert_combinations
		    (@insertion,$startinsert,$endinsert);
		# wenn moegliches MWT gefunden
		if ($#results >= 0){
		    # in MeshDBlemma suchen
		    my @found = &look_up_mesh(@results);
		    # wenn MWT-gefunden
		    if ($#found > -1){
			# Knotenpunkt holen und ausgeben
			&get_index_print_out(@found);
		    }
		}
	    }
	}
    }
}
########## </check_inserts> #######
########## <enum_combinations> ####

=head2 sub enum_combinations

    @param   $pend         Endposition der Enumerations-Sequenz
    @param   $pstart       Startposition der Enumerations-Sequenz
    @param   @enumeration  Die vollstaendige Enumeration

    Dieses Sub erzeugt die moeglichen Kombinationen der Enumerationen.
    Welche Kombinationen erlaubt, sind ist in folgendem Beispiel
    beschrieben:
        "A B C and D E F" 
    --> "A B       D E F"
    --> "A         D E F"
    --> "A B       D E"
    --> "A         D E"
    --> "A B       D"
    --> "A         D"
    --> "A B C       E F"
    --> "A B C         F"
    -->   "B C       E F"
    -->   "B C         F"
    -->     "C         F"

=cut

sub enum_combinations{
    my $pend = pop(@_); # Pos-Ende der Enum-Regel
    my $pstart = pop(@_); # Pos-Anfang der Enum-Regel
    my @enumeration = @_; # alle Pos der Enumeration
    my %posLem; # hash mit posLem{position}=lemma
    # fuer jed. <l s="Position" pos="#TAG">lemma</l>
    foreach my $part (@enumeration){
	my $pos; # Position
	my $lemma; # Lemma
	if ($part =~ /<l s=\"(.*?)\" pos=\"(.*?)\">(.*?)</o){
	    $pos = $1; # Position
	    $lemma = $3; # Lemma
	}
	# Hash aufbauen $posLem{Position}=Lemma
	$posLem{$pos}=$lemma;
    }
    # erstes Wort
    my $start = $1 if ($enumeration[0] =~ /s=\"(.*?)\"/o);
    # letztes Wort
    my $end = $1 if ($enumeration[$#enumeration] =~ /s=\"(.*?)\"/o);
    my @possibleMWT; # Liste mit moeglichen MWT
    my $multi = ""; # moegliches MWT
    my $j;
    my $multipos = ""; # Positionen des moeglichen MWT
    # unmittelbar hinter enum weglassen
    # von erstem Wort bis letztem vor der Enum
    for ($j=$start;$j<$pstart;$j++){
	my $l;
	# von erstem Wort hinter der Enum bis letztes Wort
	for ($l=($pend+1);$l<$end;$l++){
	    my $k;
	    for ($k=$j;$k<=$end;$k++){
		if (($k < $pstart) or (($k>$l)&&($k<$end))) {
		    $multi .="$posLem{$k} ";
		    $multipos .= "$k ";
		}
		elsif ($k==$end){
		    $multi .= "$posLem{$k}";
		    $multipos .= "$k";
		    $multi .= "{{POS}}$multipos";
		    push(@possibleMWT,$multi);
		    $multi = "";
		    $multipos = "";
		}
	    }
	}
    }
    # unmittelbar vor enum weglassen
    # von letztem Wort bis erstes nach Enum
    for ($j=$end;$j>$pend;$j--){
	my $l;
	# von erstes vor Enum bis erstes Wort
	for ($l=$pstart-1;$l>=$start;$l--){
	    my $k;
	    for ($k=$start;$k<=$end;$k++){
		if (($k<$l) or (($k<$j) && ($k>$pend)
				&& (!($multi eq "")))){
		    $multi .= "$posLem{$k} ";
		    $multipos .= "$k ";
		}
		elsif (($k == $j) && (!($multi eq ""))){
		    $multi .= "$posLem{$k}";
		    $multipos .= "$k";
		    $multi .= "{{POS}}$multipos";
		    push(@possibleMWT,$multi);
		    $multi = "";
		    $multipos = "";
		}
	    }
	}
    }
    # Die moeglichen Kombinationen zurueckgeben
    return @possibleMWT;
}
########## </enum_combinations> ###
########## <insert_combinations> ##

=head2 sub insert_combinations

    @param   $pend       Endposition der Insertions-Sequenz
    @param   $pstart     Startposition der Insertions-Sequenz
    @param   @insertion  Die vollstaendige Insertion

    Dieses Sub erzeugt alle moeglichen Kombinationen des MWTs um die 
    Insertions-Sequenz.
    Mit Hilfe der Sub
        help_insertions
    werden die Kombinationen generiert.

=cut

sub insert_combinations{
    my $pend = pop(@_); # Ende der Insertions-Tags
    my $pstart = pop(@_); # Anfang der Insertion-Tags
    my @insertion = @_; # Tags um die Insertions-Tags herum
    my %posLem;
    my @possibleMWT;
    # fuer jede Position der Insertion
    foreach my $part(@insertion){
	my $pos;
	my $lemma;
	if ($part =~ /<l s=\"(.*?)\" pos=\"(.*?)\">(.*?)</o){
	    $pos = $1; # Position
	    $lemma = $3; # Lemma
	}
	$posLem{$pos}=$lemma; #Hash aufbauen
    }
    # Start-Position der ges. Insertion
    my $start = $1 if ($insertion[0] =~ /s=\"(.*?)\"/o);
    # End-Position der ges. Insertion
    my $end = $1 if ($insertion[$#insertion] =~ /s=\"(.*?)\"/o);
    my $multi = "";
    my $multipos ="";
    my $multiend;
    my @vor;
    my @hinter;
    my $j;
    # @vor aufbauen, alle Positionen vor der Insertion
    for ($j=$start;$j<$pstart;$j++){
	push(@vor,$j);
    }
    # @hinter aufbauen, alle Positionen hinter der Insertion
    for ($j=($pend+1);$j<=$end;$j++){
	push(@hinter,$j);
    }
#############################################
    my %help;
    my @help;
    my @help1;
    my @help2;
    # zweimal @vor kopieren 
    push(@help1,@vor);
    push(@help2,@vor);
    # zweimal @hinter kopieren
    push(@help1,@hinter);
    push(@help2,@hinter);
    my $i;
    # wenn min. eine Position @vor uebrig
    if ($#vor > 0){
	# fuer alle @vor
	for ($i=$#vor;$i>=0;$i--){
	    # wenn min. eine Position @help1 uebrig
	    if ($#help1 > 0){
		my $zahl;
		my $k;
		# $zahl aufbauen
		for($k=0;$k<=$#help1;$k++){
		    $zahl .= "$help1[$k] ";
		}
		# hash aufbauen
		$help{$zahl}=1;
		my @help3 = @help1;
		my $j;
		# alle @hinter
		for ($j=$#hinter;$j>=0;$j--){
		    if ($#help3 > 0){
			my $zahl;
			my $k;
			for($k=0;$k<=$#help3;$k++){
			    $zahl .= "$help3[$k] ";
			}
			$help{$zahl}=1;
			# @help3 letztes weg
			pop(@help3);
		    }
		}
		# @help1 erstes weg
		shift(@help1);
	    }
	}
    }
    # wenn min. eine Position @hinter uebrig
    if ($#hinter > 0){
	# fuer alle @hinter
	for ($i=$#hinter;$i>=0;$i--){
	    # wenn min. eine Position @help2 uebrig
	    if ($#help2 > 0){
		my $zahl;
		my $k;
		# $zahl aufbauen
		for($k=0;$k<=$#help2;$k++){
		    $zahl .= "$help2[$k] ";
		}
		# hash aufbauen
		$help{$zahl}=1;
		my @help4 = @help2;
		my $j;
		# alle @vor
		for ($j=$#vor;$j>=0;$j--){
		    if ($#help4 > 0){		
			my $zahl;
			my $k;
			for($k=0;$k<=$#help4;$k++){
			    $zahl .= "$help4[$k] ";
			}
			$help{$zahl}=1;
			# @help4 erstes weg
			shift(@help4);
		    }
		}
		# @help2 letztes weg
		pop(@help2);
	    }
	}
    }
    # fuer alle Positionskombinationen
    foreach my $key (keys %help){
	my @len = split(' ',$key);
	# laenge der Kombinationen
	my $len = $#len;
	# damit die Permutationen nicht zu gross werden
	if ($len < 5){
	    # Permutationen der Kombinationen ausrechnen
	    my %combis = &help_insertions($key);
	    # fuer jede Kombination die moeglichen MWT errechnen
	    foreach (keys %combis){
		my $multipos = $_;
		my @pos = split(' ',$multipos);
		my $multi;
		foreach (@pos){
		    $multi .= "$posLem{$_} ";
		}
		chop $multi;
		$multi .= "{{POS}}$multipos";
		push(@possibleMWT,$multi);
	    }
	}
    }
    # Liste mit moeglichen MWT zurueckgeben
    return @possibleMWT;
}
########## </insert_combinations>
########## <help_insertions> ####

=head2 sub help_insertions

    @param    $help     String mit den Positionen (getrennt durch ' ')
                        fuer die Permutation
    returned  %combies  alle moeglichen Permutationen

    Dieses Sub erzeugt Permutationen wie in folgendem Beispiel beschrieben:
        "A B C"
    --> "A B C"
    --> "B A C"
    --> "B C A"
    --> "A C B"
    --> "C A B"
    --> "C B A"

=cut

sub help_insertions{
    my $help = shift;
    chop $help;
    my @hh = split(' ',$help);
    my %combis;
    my @first = @hh;
    my $x;
    for ($x=0;$x<$#hh;$x++){
	my $y;
	my @alist = @hh;
	my @blist;
	my @clist;
	my $z = $x;
	for ($y=($z+1);$y<=$#hh;$y++){
	    my @help = @alist;
	    splice @alist, $z, 1;
	    @blist = @help;
	    @clist = splice @blist, $z, 1;
	    splice @alist, $y, 0, @clist;
	    my @helplist = @alist;
	    my $l;
	    my $result = join(' ',@helplist);
	    $combis{$result}=1;
	    for ($l=0;$l<=$#helplist;$l++){
		$result = join(' ',@helplist);
		$combis{$result} = 0;
		my $last = pop(@helplist);
		unshift(@helplist,$last);
		my $result = join(' ',@helplist);
		$combis{$result} = 0;
	    }
	    $z++;
	}
    }
    # alle Kombinationen ausgeben
    return %combis;
}
########## </help_insertions> #####
########## <look_up_mesh> #########

=head2 sub look_up_mesh

    @param    @results        Das moegliche MWT mit seinen Positionen
                              folgendermassen: "term{{POS}}0 2 3"
    returned  @mwtPosToReturn laengstes gefundenes MWT als erstes Element
                              Position dieses MWTs als zweites Element
    gebrauchte, uebergeordnete Vars:
              %entryTree      Hash wurde in "get_enums_inserts_perms"
                              gefuellt (wird hier nicht veraendert)
              %abstract       Hash wurde in "get_enums_inserts_perms"
                              gefuellt (wird hier nicht veraendert)
 
    Dieses Sub prueft ob die moeglichen MWT in MeSH als Entry-Term
    oder als Heading gelistet sind und gibt das laengste gefundene MWT
    zurueck.

=cut

sub look_up_mesh{
    my @results = @_; # die moeglichen MWT "multi word term{{POS}}0 2 3"
    my $maxLenFound = 0; #laengstes gefundenes innerhalb einer Umgebung
    my $maxMWTfound; # laengstes gefundenes MWT
    my $MWTposF; # Positionen des gefundenen MWT
    my @mwtPosToReturn; # zurueck zu gebenes MWT
    # fuer jedes moegliche MWT
    foreach (@results){
	my @multiAndPos = split('{{POS}}',$_);
	my $mwt = $multiAndPos[0]; # "multi word term"
	my @posi = split(' ',$multiAndPos[1]); # Liste mit den Positionen
	# Positionen der MWT in orginal Reihenfolge
	my @sortPos = sort {$a <=> $b}(@posi);
	my $startPos = $sortPos[0]; # orginal Start-Position
	my $endPos = $sortPos[$#sortPos]; # orginal End-Position
	my $i;
	my $orginaltext; # MWT in Orginalreihenfolge
	# Orginalreihenfolge aufbauen
	for ($i=$startPos;$i<=$endPos;$i++){
	    my $word = $abstract{$i};
	    $orginaltext .= "$word ";
	}
	# letztes Leerzeichen loeschen
	chop $orginaltext;
	# wenn das moegl. MWT nicht in Orginalreihenfolge als
	# Entry-Term oder Heading existiert
	if (!(defined ($entryTree{$orginaltext}))){
	    my $found = 0;
	    # wenn MWT gefunden
	    if (defined ($entryTree{$mwt})){
		$found = 1;
	    }else{
		$found = 0;
	    }
	    # wenn MWT gefunden und laenger als laengstes gefundenes
	    if (($found == 1) and ($#posi > $maxLenFound)){
		$maxLenFound = $#posi; # max Laenge setzen
		$maxMWTfound = $mwt; # MWT speichern
		$MWTposF = $multiAndPos[1]; # Positionen im Abstract
		# Liste mit MWT und Positionen im Abstract
		@mwtPosToReturn = ($mwt, $MWTposF);
	    }
	}
    }
    # laengstes gefundenes zurueckgeben
    return @mwtPosToReturn;
}
########## </look_up_mesh> ########
########## <get_index_print_out> ##

=head2 sub get_index_print_out

    @param    @found      gefundenes MWT als erstes Element
                          Position des gefundenen MWTs als zweites Element
    gebrauchte, uebergeordnete Vars:
              %entryTree  Hash wurde in "get_enums_inserts_perms"
                          gefuellt (wird hier nicht veraendert)
              %treeHead   Hash wurde in "get_enums_inserts_perms"
                          gefuellt (wird hier nicht veraendert)
              $id         Wert gesetzt in "get_enums_inserts_perms"
              $idOld      Erstes Vorkommen in <VARS>;
                          Wert wird hier geaendert.

    Dieses Sub prueft den/die Knoten der gefundenen MWT und gibt die 
    Ergebnisse folgendermassen aus:
       <doc id="15971344">
       <mwt name="Heading 1" textPos="pos1 pos2">
          <nr>Knoten 1 for Heading 1</nr>
          <nr>Knoten 2 for Heading 1</nr>
       </mwt>
       <mwt name="Heading 2" textPos="pos1 pos2">
          <nr>Knoten 1 for Heading 2</nr>
          <nr>Knoten 2 for Heading 2</nr>
       </mwt>
       </doc>

=cut
 
sub get_index_print_out{
    my $mwt = $_[0]; # MWT
    my $pos = $_[1]; # Positionen
    my @index; # Liste mit Knotenpunkten des MWT
    # fuer jedes MWT = Entry-Term/Heading in mtree2004.bin
    foreach my $key2 (keys %{$entryTree{$mwt}}){
	# fuer jedes Heading
	foreach my $key3 (keys %{$entryTree{$mwt}{$key2}}){
	    # Knotenpunkt hinzufuegen
	    push (@index,$entryTree{$mwt}{$key2}{$key3});
	}
    }
    my $mh = ""; # Mesh-Heading zu Index
    my $mhOld = ""; # voriges Heading
    my $checkedId = $id; # falls <doc> geschlossen werden muss
    my $lastprinteddoc = 0;
    # wenn nicht vorige Abstract-ID = 0 und nicht gleich vorheriger
    if ((!($idOld == 0)) and (!($checkedId == $idOld))){
	print OUT "</mwt>\n</doc>\n";
    }
    # neue Abstract-ID
    if (!($checkedId eq $idOld)){
	print OUT "<doc id=\"$id\">\n";
	$idOld = $checkedId;
	$lastprinteddoc = 1;
    }
    # fuer jeden Knotenpunkt
    foreach (@index){
	my $index = $_;
	my $mh = $treeHead{$index}; # Heading suchen
	# wenn erster Knotenpunkt des Headings
	if (!($mh eq $mhOld)){
	    if (!($lastprinteddoc == 1)){
		print OUT "</mwt>\n";
		$lastprinteddoc = 0;
	    }
	    print OUT "<mwt name=\"$mh\" textPos=\"$pos\">\n";
	    print OUT "<nr>$index</nr>\n";
	    $lastprinteddoc = 0;
	    $mhOld = $mh;
	}
	else{
	    # wenn nicht erster Knotenpunkt des Headings
	    print OUT "<nr>$index</nr>\n";
	}
    }
}
########## </get_index_print_out> #
########## <close_out_file> #######

=head2 sub close_out_file

    Das Out-File wird geschlossen, nachdem die letzten Tags geschlossen
    wurden.

=cut

sub close_out_file{
    print OUT "</mwt>\n</doc>\n</xon-mwt>\n";
    close OUT;
    print STDERR "\n";
}
########## </close_out_file> ######
#################### </SUBS> ###################
