| 1 | #!/usr/bin/perl |
|---|
| 2 | # =============================================================== # |
|---|
| 3 | # # |
|---|
| 4 | # File : embl_gen_long_features.pl # |
|---|
| 5 | # Purpose : modifies embl feature table for easy scanning # |
|---|
| 6 | # with ARBs ift # |
|---|
| 7 | # # |
|---|
| 8 | # Coded by Ralf Westram (coder@reallysoft.de) in March 2005 # |
|---|
| 9 | # Institute of Microbiology (Technical University Munich) # |
|---|
| 10 | # http://www.arb-home.de/ # |
|---|
| 11 | # # |
|---|
| 12 | # =============================================================== # |
|---|
| 13 | |
|---|
| 14 | use strict; |
|---|
| 15 | use warnings; |
|---|
| 16 | |
|---|
| 17 | my $last_feature = undef; |
|---|
| 18 | my $line_number = 0; |
|---|
| 19 | my $line_to_print = undef; |
|---|
| 20 | |
|---|
| 21 | eval { |
|---|
| 22 | while (defined($_=<STDIN>)) { |
|---|
| 23 | $line_number++; |
|---|
| 24 | if (/^FT /) { |
|---|
| 25 | chomp; |
|---|
| 26 | my $rest = $'; |
|---|
| 27 | if ($rest =~ /^([^ ]+)([ ]+)([^ ].*)$/) { # new feature |
|---|
| 28 | my ($name,$spaces,$content) = ($1,$2,$3); |
|---|
| 29 | $last_feature = $name.$spaces; |
|---|
| 30 | if (defined $line_to_print) { print $line_to_print."\n"; $line_to_print=undef; } |
|---|
| 31 | print "FT $last_feature$content\n"; |
|---|
| 32 | } |
|---|
| 33 | else { # continue last feature |
|---|
| 34 | if (defined $last_feature) { |
|---|
| 35 | if ($rest =~ /^ (.*)$/) { |
|---|
| 36 | my $content = $1; |
|---|
| 37 | if ($content =~ /^\//) { # start of new sub-entry |
|---|
| 38 | if (defined $line_to_print) { print $line_to_print."\n"; $line_to_print=undef; } |
|---|
| 39 | $line_to_print = "FTx $last_feature$content"; |
|---|
| 40 | } |
|---|
| 41 | else { |
|---|
| 42 | $line_to_print .= "$content"; # append to previously started sub entry |
|---|
| 43 | } |
|---|
| 44 | } |
|---|
| 45 | else { |
|---|
| 46 | die "Expected some content behind 'FT'\n"; |
|---|
| 47 | } |
|---|
| 48 | } |
|---|
| 49 | else { |
|---|
| 50 | die "Expected start of feature (e.g. 'FT bla')\n"; |
|---|
| 51 | } |
|---|
| 52 | } |
|---|
| 53 | } |
|---|
| 54 | else { |
|---|
| 55 | if (defined $line_to_print) { print $line_to_print."\n"; $line_to_print=undef; } |
|---|
| 56 | print $_; |
|---|
| 57 | } |
|---|
| 58 | } |
|---|
| 59 | if (defined $line_to_print) { print $line_to_print."\n"; $line_to_print=undef; } |
|---|
| 60 | }; |
|---|
| 61 | if ($@) { |
|---|
| 62 | chomp $@; |
|---|
| 63 | die "$@ in line $line_number of inputfile\n"; |
|---|
| 64 | } |
|---|
