#! perl -w
use strict;

=pod

=head1 XON

                   ##      ##       ##
                    ##      ##       ##
                   ##      ##       ##
                  ##      ##       ## 
                 ##      ##       ##
                  ##      ##       ##   
    ##################################################
     ## ------------------------------------------ ######
     ## create_mesh_lemma_db.pl .................. ##   ###
     ## ------------------------------------------ ##     ###
     ## erstellt lemmatisierte Datenbank aus ..... ##      ###
     ## d2005.bin (MeSH) www.nlm.nih.gov/mesh .... ##       ### 
     ## ------------------------------------------ ##       ### 
     ## author..: Jannik Stroetgen ............... ##     ###
     ## email...: stroetge@cl.uni-heidelberg.de .. ##   ###
     ## started.: 18.05.2005 ..................... ##  ### 
     ## finished: 23.01.2006 ..................... #####
    ##################################################  
  ##### embedded documentation tool: pod ......... #####
##########################################################

=cut

=head1 NAME

    create_mesh_lemma_db.pl <d2005.bin>

=cut

=head1 BESCHREIBUNG

    Dieses Skript erstellt eine Datenbank mit den lemmatisierten
    Eintraegen aus dem File d2005.bin (von MeSH). Die Datenbank
    wird gespeicht als MeshDBlemma.txt (fuer mwtf_inguistic.pl).

=cut

=head2 Inputfile

    Inputfile: d2005.bin
    #######
    *NEWRECORD
    ...
    MH = Calcimycin
    ...
    ENTRY = A-23187|T109|T195|LAB|NRW|NLM (1991)|900308|A A 23187|abbcdefs
    ENTRY = A23187|T109|T195|LAB|NRW|UNK (19XX)|741111|abbcdef
    ENTRY = Antibiotic A23187|T109|T195|NON|NRW|NLM (1991)|900308|abbcdef
    ENTRY = A 23187
    ENTRY = A23187, Antibiotic
    MN = D03.438.221.173
    ...
    #######

=cut

=head2 Outputfile

    Outputfile: MeshDBlemma.txt
    #######
    <Mesh Lemma Dictionary XON>
      <D03.438.221.173>
        antibiotic A23187
        a 23187
        A23187 antibiotic
      </D03.438.221.173>
      ...
    #######

=cut

########## <MAIN> ###############################
my $input1 = $ARGV[0]; #d2005.bin
die "\nArguments missing:\n\'perl $0 <d2005.bin>\'\n" unless ($input1);
my $tmpDir = "mwtfTmp"; # temp Directory
system "mkdir $tmpDir"; 
my $tagDir = "$tmpDir/forTagDBtmp"; # tmp file
system "mkdir $tagDir"; # dir erstellen

my $input2 = &read_mesh_data($input1); 
my $dirinput3 = &tag_mesh_data($input2);
my $result = &print_out_lem_info($dirinput3);

if ($result == 1){
    print STDERR "\n\nMeshDBlemma.txt was created successfully\n";
}else{
    print STDERR "\n\nError while producing MeshDBlemma.txt\n";
}

system "rm -r $tagDir";
system "rm -r $tmpDir";
########## </MAIN> ##############################

########## <SUBS> ###############################
########## <read_mesh_data> ##########

=head2 sub read_mesh_data

    @param   $in      Meshfile d2005.bin
    returned $output  "$tmpDir/db4xelda.txt"

    Dieses Sub nimmt das Inputfile und gibt die MeSH-Headings,
    MeSH-Entries, die MeSH-Print-Entries und MeSH-Knoten in ein
    temporaeres File aus. Die Headings, Entries und Print-Entries
    muessen aus mehr als einem Wort bestehen. Kommas werden
    ignoriert und vom Tagger unbekannte Abkuerzungen ersetzt.
    Die Daten werden dann mit Hilfe des Xelda Taggers (von Temis)
    getaggt.

=cut
    
sub read_mesh_data{
    my $in = shift;
    open I, $in or die "cannot open $in $!\n"; #d2005.bin
    my $output = "$tmpDir/db4xelda.txt"; # temp file
    open O, ">$output" or die "cannot open $output $!\n";
    while (my $line = <I>){ # fuer jede zeile
	if ($line =~ m/^\*NEWRECORD/ ){ # neuer Record beginnt
	    $line =~ s/$/ ./o; # an das Ende der Zeile "." zum taggen
	    print O $line;
	}
	if ($line =~ m/^MH = /go ){ # Meshheading matchen
	    $line =~ s/MH = //go; # reines Heading bleibt uebrig
	    if ($line =~ m/ /o){ # damit nicht einzelnes Wort
		$line =~ s/$/ ./o; # an das Ende der Zeile "." zum taggen
		$line =~ s/, / /go; # kommas ersetzen
                # abkeurzungen ersetzen die Tagger nicht kennt,
		# damit das nicht als Satzende getaggt wird
		$line =~ s/Cent./Cent/go; 
		$line =~ s/subsp./subsp/go;
		print O $line;
	    }
	}
	if ($line =~ m/^MN = /go ){ # Mesh-Knotenpunkt
	    $line =~ s/MN = /--------/go; # zum Taggen 
	    $line =~ s/$/ ./o; # an das Ende der Zeile "." zum taggen 
	    print O $line;
	}
	if ($line =~ m/^ENTRY = /go ){ # Entryterm matchen
	    if ($line =~ m/\|/go){ # nur vorderstes ist mwt
		my $l = (split('\|',$line))[0]; # nur vorderstes ist mwt
		$l =~ s/ENTRY = //go; # nur mwt bleibt uebrig
                # damit das nicht als Satzende aufgefasst wird und Kommas raus
		$l =~ s/, / /go; # kommas ersetzen
		# abkuerzungen ersetzen die Tagger nicht kennt 
		# damit das nicht als Satzende getaggt wird
		$l =~ s/Cent./Cent/go;
		$l =~ s/subsp./subsp/go;
		if ($l =~ m/ /o){ # damit nur mwt
		    $l =~ s/$/ ./o; # "." an Zeilenende zum Taggen
		    print O "$l\n";
		}
	    }
	    else{
		$line =~ s/ENTRY = //go; # nur mwt bleibt uebrig
		if ($line =~ m/ /o){ # nur MWT
		    $line =~ s/$/ ./o; # "." am Zeilenende zum Taggen
		    $line =~ s/, / /go; # Kommas raus
		    # abkuerzungen ersetzen die Tagger nicht kennt 
		    # damit das nicht als Satzende getaggt wird
		    $line =~ s/Cent./Cent/go;
		    $line =~ s/subsp./subsp/go;
		    print O $line;
		}
	    }
	}
	if ($line =~ m/^PRINT ENTRY =/go ){ # MWT (s.o)
	    if ($line =~ m/\|/ ){
		my $l = (split('\|',$line))[0];
		$l =~ s/PRINT ENTRY = //go; 
		if ($l =~ m/ /o){
		    $l =~ s/$/ ./o;
		    $l =~ s/, / /go; # Kommas raus
		    # abkuerzungen ersetzen die Tagger nicht kennt 
		    # damit das nicht als Satzende getaggt wird
		    $l =~ s/Cent./Cent/go;
		    $l =~ s/subsp./subsp/go;
		    print O "$l\n";
		}
	    }
	    else{
		$line =~ s/PRINT ENTRY = //go; # (s.o)
		if ($line =~ m/ /o){
		    $line =~ s/$/ ./o;
		    $line =~ s/, / /go; # Kommas raus
		    # abkuerzungen ersetzen die Tagger nicht kennt 
		    # damit das nicht als Satzende getaggt wird
		    $line =~ s/Cent./Cent/go;
		    $line =~ s/subsp./subsp/go;
		    print O $line;
		}
	    }
	}
    }
    close I; 
    close O;
    return $output;
}
########## </read_mesh_data> #########
########## <tag_mesh_data> ###########
sub tag_mesh_data{

=head2 sub tag_mesh_data

    @param    $in        Output des Sub read_mesh_data
    returned: "$tagDir/" Directory Name

    Dieses Sub taggt die MeSH-Daten. Es nimmt ~ 5000
    Records von den MeSH-Daten (bei mehr, waere der Tagger
    langsamer).

=cut
    
    my $in = shift;
    my $tmp = "$tagDir/xelda.tmp"; 
    my $output = "xeldaTags4db4xelda.txt";
    open I, $in or die "cannot open $in $!\n";
    $/ = "*NEWRECORD"; # Recordweise einlesen
    my $i = 0;
    my $j= 0;
    open T, ">$tmp" or die "cannot open $tmp $!\n";
    while (my $record = <I>){
	$i++;
	print T $record;
	if ($i == 5000){ # 5000 Records dann taggen
	    close T;
	    my $name = "$tagDir/$j$output";
	    system "tag -l english $tmp > $name"; # Tag-Befehl fuer Xelda
	    open T, ">$tmp" or die "cannot open $tmp $!\n"; 
	    $i = 0;
	    $j++;
	}
    }
    close I;
    close T;
    system "tag -l english $tmp > $tagDir/last.txt"; # Tag-Befehl fuer Xelda
    system "rm $tmp"; # tmp dir loeschen
    return "$tagDir/";
}
########## </tag_mesh_data> ##########
########## <print_out_lem_info> ###### 
sub print_out_lem_info{

=head2 sub print_out_lem_info

    @param    $dirin    Name des Dir welches von Sub
	                "tag_mesh_data" zurueckgegeben wird

    Dieses Sub nimmt die getaggten Files, die mit dem Sub
    tag_mesh_data erzeugt wurden und gibt die lemmatisierten
    Informationen der MeSH-Datenbank aus. Das File
    "MeshDBlemma.txt" wird erzeugt.

=cut
	
    my $dirin = shift;
    opendir A, $dirin or die "can't open $dirin: $!\n"; # dir oeffnen
    my @input = readdir A; # jede Datei
    my $output = "MeshDBlemma.txt"; # Output datei
    open O, ">$output" or die "cannot open $output $!\n";
    print O "<Mesh Lemma Dictionary XON>\n";
    $/ = "*NEWRECORD\t*NEWRECORD\t\#PROP\#OPEN\n"; # Recordweise einlesen
    foreach my $file (@input){ # fuer jedes File
	if ($file =~ m/txt/ ){ # nur .txt-Dateien
	    my $location = "$dirin$file"; 
	    open I, $location or die "cannot open $location $!\n";
	    while (my $line = <I>){ # Datei Record-weise einlesen
		my $id="";
		my $helpid="";
		my %id;
		if ($line =~ /\-\-\-\-\-\-\-\-\t\-\-\-\-\-\-\-\-\t\#PUNCT\n(.*?)\t/ ){
		    my $i=0;
		    while ($line =~ /\-\-\-\-\-\-\-\-\t\-\-\-\-\-\-\-\-\t\#PUNCT\n(.*?)\t/g ){
			$id = $1; # jeweilige id rausschreiben
			$id{$i}= $id; # id hinzufuegen
			$i++; # index rauf
			$helpid .= " $id"; 
		    }
		    foreach my $key (keys %id){ # jede id printen
			print O "  <$id{$key}>\n";
		    }
		}
		my @words =split("\n",$line); 
		my $multilemma = "   ";
		# lemmatisiertes MWT drucken
		foreach my $w (@words){
		    if ($w =~ m/\t/){
			my $lemma = (split('\t',$w))[1];
			my $tag = (split('\t',$w))[2];
			my $toprint = 1;
			foreach my $t (keys %id){
			    if ($id{$t} eq $lemma){
				$toprint = 0;
			    }
			}
			if ($toprint == 0){
			    ;
			}
			elsif (($lemma =~ m/\*NEWRECORD/) or ($lemma =~ m/^\-\-\-\-\-\-\-\-$/ )){
			    ;
			}
			elsif (($tag  eq "\#SENT") and (!($multilemma eq "   "))){
			    print O "$multilemma\n";
			    $multilemma = "   ";
			}
			elsif($tag eq "\#SENT"){
			    ;
			}
			else{
			    $multilemma .= " $lemma";
			}
		    }
		}
		foreach my $k (keys %id){
		    print O "  <\/$id{$k}>\n";
		}
	    }
	    close I;
	}
    } 
    closedir A;
    close O;
    return 1;
}
########## </print_out_lem_info> #####
########## </SUBS> ##############################
