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

Last change on this file was 5937, checked in by westram, 11 years ago
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 2.6 KB
Line 
1#!/usr/bin/perl
2# ================================================================ #
3#                                                                  #
4#   File      : genbank_gen_long_features.pl                       #
5#   Purpose   : modifies genbank feature table for easy scanning   #
6#               with ARBs ift                                      #
7#                                                                  #
8#   Coded by Ralf Westram (coder@reallysoft.de) in November 2007   #
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  my $mode = 0;
23  foreach (<STDIN>) {
24    $line_number++;
25    if ($mode==0) { # copy all till feature table
26      if (/^FEATURES/o) { $mode = 1; }
27      print $_;
28    }
29    elsif ($mode==1) { # reformat feature table (qualifiers)
30      if (/^                     /o) { # qualifier-line
31        my ($white,$rest) = ($&,$');
32
33        chomp($rest);
34        if ($rest =~ /^\//o) { # start of qualifier
35          if (defined $line_to_print) { print $line_to_print."\n"; $line_to_print=undef; }
36          # $line_to_print = $white.$rest;
37          $line_to_print = 'FTx  '.$last_feature.substr("                ",length($last_feature)).$rest;
38        }
39        else {
40          if (not defined $line_to_print) {
41            die "Found continued qualifier line (expected start of qualifier or new feature)"
42          }
43          $line_to_print .= $rest;
44        }
45      }
46      elsif (/^ORIGIN/) {
47        if (defined $line_to_print) { print $line_to_print."\n"; $line_to_print=undef; }
48        print $_;
49
50        $mode=2; # switch mode
51      }
52      else { # new feature
53        if (defined $line_to_print) { print $line_to_print."\n"; $line_to_print=undef; }
54        if (/^(     )([a-z_]+)( .*)$/io) { # checked - really new feature
55          my ($white1,$feature,$rest) = ($1,$2,$3);
56          $last_feature = $feature;
57          chomp($rest);
58          $line_to_print = "FT   ".$feature.$rest;
59        }
60        else {
61          die "Unexpected case (expected new feature)";
62        }
63      }
64    }
65    else { # mode==2 -> copy sequence
66      print $_;
67      if ($_ eq "//\n") {
68        $mode = 0; # reset mode
69      }
70    }
71  }
72  if (defined $line_to_print) { die "Unexpected content in internal feature-buffer"; }
73};
74if ($@) {
75  chomp $@;
76  die "$@ in line $line_number of inputfile\n";
77}
Note: See TracBrowser for help on using the repository browser.