#! /usr/bin/perl -w
sub cat ($$$)
{
my($a,$sep,$b) = @_;
# concatenates $a and $b, with $sep if needed.
return ($a eq "" ? $b : ($a . $sep . $b))
}
sub parseitem($)
{
my ($txt) = @_;
# returns the first token or "{}"-bracketed string from $txt,
# and also $txt minus that thing and extra space.
if ($txt =~ m/^{([^}]*)} */)
{ return ($1, $'); }
elsif ($txt =~ m/^([^ ]+)( *|$)/)
{ return ($1, $'); }
else
{ printf STDERR "no value = %s\n", $txt; return ("",$txt); }
}
sub parse($)
{
my($txt) = @_;
# Parses and formats a label line
my($lab,$sec,$sig,$cmt,$alt,$loc);
my($tmp,$guy);
if ($txt =~ m/^([^ ]+) *= */)
{ $lab = $1; $txt = $'; }
else
{ printf STDERR "no label = %s\n", $txt; return ""; }
$sig = "";
$cmt = "";
$sec = "";
$alt = "";
$loc = "";
while ($txt ne "\n")
{
if ($txt =~ s/^s://)
{ ($tmp,$txt) = parseitem($txt); $sec = cat($sec, ";", $tmp); }
elsif ($txt =~ s/^m://)
{ ($tmp,$txt) = parseitem($txt); $sig = cat($sig, ";", $tmp); }
elsif ($txt =~ s/^n://)
{ ($tmp,$txt) = parseitem($txt); $cmt = cat($cmt, ";", $tmp); }
elsif ($txt =~ s/^([A-Z])://)
{ $guy = $1;
($tmp,$txt) = parseitem($txt);
$alt = cat($alt, ";", ($guy . "=" . $tmp));
}
elsif ($txt =~ m/^<([^>]+)> */)
{
$tmp = $1; $txt = $';
if ($loc ne "") { printf STDERR "dupl loc = %s %s\n", $tmp, $txt; return ""; }
$loc = $tmp;
}
else
{ printf STDERR "bad field = %s\n", $txt; return ""; }
}
if ($alt ne "") { $alt = ( "(" . $alt . ")" ); }
return sprintf("%s|%s%s|%s|%s|%s\n", $loc,$lab,$alt,$sig,$sec,$cmt);
}
while (<>)
{
print parse($_)
}