#! /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($_) }