source: branches/profile/PERL_SCRIPTS/ARBTOOLS/IFTHELP/embl_gen_long_features.pl

Last change on this file was 6046, checked in by westram, 11 years ago
  • use faster method reading input
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 2.2 KB
Line 
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
14use strict;
15use warnings;
16
17my $last_feature = undef;
18my $line_number = 0;
19my $line_to_print = undef;
20
21eval {
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};
61if ($@) {
62  chomp $@;
63  die "$@ in line $line_number of inputfile\n";
64}
Note: See TracBrowser for help on using the repository browser.