#!/usr/bin/perl -w
#Markus Westphal 13.01.2006
######################################################
# Markus Westphal swomim.pl #
######################################################
use strict;
my($pf,$j,$i,$stand,$datei,@ind,$search,$record,$ind,$id,$cc,$dr,@mims,$aus,$aus2,@tics,$ti,$cs,$tr,$m,$row,$omi,$borat,$rock);
#globale Variabeln füllen
$datei = "sp-out.txt";
$i = 0;
$rock = 0;
$row = 0;
#EINLESEN Dateinamen
for($j = -1; $j < $#ARGV; $j++)
{
if($ARGV[$j] =~ /^datei/)
{
($pf, $datei) = split("=", $ARGV[$j]);
}
}
print "AUSGABEDATEI...\n";
#AUSGABEDATEI
open(HF, ">omimaus.htm") || die ("Die Ausgabedatei kann nicht erstellt werden!\n");
print HF 'Auswertung:
';
print HF '';
print HF "SwOMIM - Markus Westphal - FH Gießen-Friedberg";
print HF "";
print HF "";
print HF '| ID | CC | DR | OMIM |
';
print "EINLESEN...\n";
#EINLESEN
open(SW,"<$datei") || die ("$datei kann nicht geoeffnet werden!");
$/ = "/-0-/";
while()
{
print "RECORD\n";
$record = $_;
#print "$record\n";
if($record =~ /DR/m)
{
#print"DRIN\n";
$record =~ /ID\s+(.*AA)\.\nCC\s+(-!-\s+.*)CC\s+\-+\nDR\s+(.*)\n.*/s;
$id = $1;
$cc = $2;
$dr = $3;
$cc =~ s/CC//g;$cc =~ s/ //g; $cc =~ s/\n//g;
$dr =~ s/DR//g;$dr =~ s/ //g; $dr =~ s/\n//g;
if($dr =~ /MIM; /m)
{
#print "DRIN\n";
@mims = split("MIM;",$dr);
$m = 0;
$row = 0;
$tr = "";
foreach(@mims)
{
if($_ =~ /^ (\d+);/)
{
print "LINK\n";
if($m > 0){$tr = "\n";}
$aus = &ParseOmim($1);
($aus,$aus2) = split("##",$aus);
$tics[$m] = $tr.'| '.$aus.' |
| '.$cs.' |
';
$m++;
$row = $row+2;
$tr = "";
}
}
print HF '| '.$id.' | '.$cc.' | '.$dr.' | ';
foreach(@tics)
{
print HF "$_";
}
undef(@tics);
undef(@mims);
print HF "
\n";
print "EINTAG ERSTELLT\n";
}
}
$rock++;
$/ = "/-$rock-/";
}
close(SW);
print HF "
\n\n\n";
close(HF);
print "FERTIG!\n";
#OMIM-Funktionen
sub ParseOmim()
{
my($z) = @_; #gesuchte MIM ID
print "$z\n";
$omi = "E:\\gendatenbanken\\swissprot\\omim\\omim.txt";
open(OM, "<$omi") || die ("$omi kann nicht gelesen werden!\n");
$/ = "*RECORD*";
while()
{
if($_ =~ m/\*FIELD\* NO\n$z/m)
{
$borat = $_;
last;
}
}
close(OM);
#RegExp für TI CS
if($borat =~ /\*FIELD\* CS/m)
{
$borat =~ /.*\*FIELD\* TI\n(.*)\*FIELD\* TX.*\*FIELD\* CS\n(.*)\*FIELD\* .*\*RECORD\*/s;
$ti = $1;
$cs = $2;
}
else
{
$borat =~ /.*\*FIELD\* TI\n(.*)\*FIELD\* TX.*/s;
$ti = $1;
$cs = "NICHT VORHANDEN!";
}
$ti =~ s/\n//g || print "$borat\n";
$ti = "TI: ".$ti;
$cs = "CS: ".$cs;
$ti = $ti."###".$cs;
return $ti;
}