code_perl/Maasha/Stockholm.pm

   1 package Maasha::Stockholm;
   2
   3 # Copyright (C) 2006 Martin A. Hansen.
   4
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # http://www.gnu.org/copyleft/gpl.html
  20
  21
  22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  23
  24
  25 # Routines for manipulation of the Stockholm format.
  26 # http://www.cgb.ki.se/cgb/groups/sonnhammer/Stockholm.html
  27
  28
  29 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  30
  31
  32 use strict;
  33 use Data::Dumper;
  34 use Maasha::Common;
  35 use vars qw ( @ISA @EXPORT );
  36
  37 @ISA = qw( Exporter );
  38
  39
  40 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  41
  42
  43 sub get_stockholm_entry
  44 {
  45     # Martin A. Hansen, February 2007.
  46
  47     # Given a file handle, returns the next stockholm
  48     # entry as a list of lines.
  49
  50     my ( $fh,   # file handle
  51        ) = @_;
  52
  53     # returns a list
  54
  55     my ( $line, @lines );
  56
  57     while ( defined $fh and $line = <$fh> )
  58     {
  59         chomp $line;
  60
  61         push @lines, $line;
  62
  63         last if $line eq "//";
  64     }
  65
  66     if ( not @lines ) {
  67         return undef;
  68     } else {
  69         return wantarray ? @lines : \@lines;
  70     }
  71 }
  72
  73
  74 sub parse_stockholm_entry
  75 {
  76     # Martin A. Hansen, February 2007.
  77
  78     # given a Stockholm entry as a list of lines,
  79     # parses this into an elaborate data structure.
  80     # Compultory fields: AC ID DE AU SE SS BM GA TC NC TP SQ
  81     # Non-compultory fields: PI DC DR RC RN RM RT RA RL CC
  82
  83     my ( $entry,   # stockholm entry
  84        ) = @_;
  85
  86     # returns data structure
  87
  88     my ( $line, %hash, %align_hash, @align_list, @align );
  89
  90     foreach $line ( @{ $entry } )
  91     {
  92         next if $line =~ /^# /;
  93
  94         if ( $line =~ /^#=GF\s+([^\s]+)\s+(.*)$/ )
  95         {
  96             push @{ $hash{ "GF" }{ $1 } }, $2;
  97         }
  98         elsif ( $line =~ /^#=GC\s+([^\s]+)\s+(.*)$/ )
  99         {
 100             push @{ $hash{ "GC" }{ $1 } }, $2;
 101         }
 102         elsif ( $line =~ /^#=GS\s+([^\s]+)\s+([^\s]+)\s+(.*)$/ )
 103         {
 104             push @{ $hash{ "GS" }{ $1 }{ $2 } }, $3;
 105         }
 106         elsif ( $line =~ /^#=GR\s+([^\s]+)\s+([^\s]+)\s+(.*)$/ )
 107         {
 108             push @{ $hash{ "GR" }{ $1 }{ $2 } }, $3;
 109         }
 110         elsif ( $line =~ /^([^\s]+)\s+(.+)$/ )
 111         {
 112             push @align_list, $1 if not exists $align_hash{ $1 };
 113
 114             $align_hash{ $1 } .= $2;
 115         }
 116     }
 117
 118     map { $hash{ "GF" }{ $_ } = join " ", @{ $hash{ "GF" }{ $_ } } } keys %{ $hash{ "GF" } };
 119     map { $hash{ "GC" }{ $_ } = join  "", @{ $hash{ "GC" }{ $_ } } } keys %{ $hash{ "GC" } };
 120     map { push @align, [ $_, $align_hash{ $_ } ] } @align_list;
 121
 122     push @align, [ "SS_cons", $hash{ "GC" }{ "SS_cons" } ];
 123     push @align, [ "RF", $hash{ "GC" }{ "RF" } ] if $hash{ "GC" }{ "RF" };
 124
 125     delete $hash{ "GC" };
 126
 127     $hash{ "ALIGN" } = \@align;
 128
 129     return wantarray ? %hash : \%hash;
 130 }
 131
 132
 133 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<