code_perl/Maasha/GFF.pm

   1 package Maasha::GFF;
   2
   3
   4 # Copyright (C) 2007-2008 Martin A. Hansen.
   5
   6 # This program is free software; you can redistribute it and/or
   7 # modify it under the terms of the GNU General Public License
   8 # as published by the Free Software Foundation; either version 2
   9 # of the License, or (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  19
  20 # http://www.gnu.org/copyleft/gpl.html
  21
  22
  23 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  24
  25
  26 # Routines for manipulation 'Generic Feature Format' - GFF version 3.
  27 # Read more here:
  28 # http://www.sequenceontology.org/resources/gff3.html
  29
  30
  31 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  32
  33
  34 use warnings;
  35 use strict;
  36 use Data::Dumper;
  37 use Maasha::Common;
  38
  39 use vars qw( @ISA @EXPORT_OK );
  40
  41 require Exporter;
  42
  43 @ISA = qw( Exporter );
  44
  45 use constant {
  46     seqid       => 0,
  47     source      => 1,
  48     type        => 2,
  49     start       => 3,
  50     end         => 4,
  51     score       => 5,
  52     strand      => 6,
  53     phase       => 7,
  54     attributes  => 8,
  55 };
  56
  57
  58 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  59
  60
  61 my %ATTRIBUTES = (
  62     id            => 'ID',
  63     name          => 'Name',
  64     alias         => 'Alias',
  65     parent        => 'Parent',
  66     target        => 'Target',
  67     gap           => 'Gap',
  68     derives_from  => 'Derives_from',
  69     note          => 'Note',
  70     dbxref        => 'Dbxref',
  71     ontology_term => 'Ontology_term',
  72 );
  73
  74
  75 sub gff_entry_get
  76 {
  77     # Martin A. Hansen, October 2009
  78
  79     my ( $fh,    # file handle
  80        ) = @_;
  81
  82     # Returns a
  83
  84     my ( $line, @fields );
  85
  86     while ( $line = <$fh>)
  87     {
  88         chomp $line;
  89
  90         next if $line =~ /^$|^#/;   # skip empty lines and lines starting with #
  91
  92         @fields = split /\t/, $line;
  93
  94         return wantarray ? @fields : \@fields;
  95     }
  96 }
  97
  98
  99 sub gff_entry_put
 100 {
 101     # Martin A. Hansen, October 2009
 102
 103     my ( $entry,   # GFF entry
 104          $fh,      # file handle
 105        ) = @_;
 106
 107     $fh ||= \*STDOUT;
 108
 109     print $fh join( "\t", @{ $entry } ), "\n";
 110 }
 111
 112
 113 sub gff_pragma_put
 114 {
 115     # Martin A. Hansen, October 2009
 116
 117     my ( $pragmas,   # list of GFF pragma lines
 118          $fh,        # file handle
 119        ) = @_;
 120
 121     my ( $pragma );
 122
 123     $fh ||= \*STDOUT;
 124
 125     foreach $pragma ( @{ $pragmas } ) {
 126         print $fh "$pragma\n";
 127     }
 128 }
 129
 130
 131 sub gff2biopiece
 132 {
 133     # Martin A. Hansen, October 2009
 134
 135     my ( $entry,   # GFF entry
 136        ) = @_;
 137
 138     # Returns a hashref.
 139
 140     my ( %record, @atts, $att, $key, $val );
 141
 142     %record = (
 143         'S_ID'   => $entry->[ seqid ],
 144         'SOURCE' => $entry->[ source ],
 145         'TYPE'   => $entry->[ type ],
 146         'S_BEG'  => $entry->[ start ],
 147         'S_END'  => $entry->[ end ],
 148         'S_LEN'  => $entry->[ end ] - $entry->[ start ] + 1,
 149         'SCORE'  => $entry->[ score ],
 150         'STRAND' => $entry->[ strand ],
 151         'PHASE'  => $entry->[ phase ],
 152     );
 153
 154     @atts = split /;/, $entry->[ attributes ];
 155
 156     foreach $att ( @atts )
 157     {
 158         ( $key, $val ) = split /=/, $att;
 159
 160         $record{ 'ATT_' . uc $key } = $val;
 161     }
 162
 163     return wantarray ? %record : \%record;
 164 }
 165
 166
 167 sub biopiece2gff
 168 {
 169     # Martin A. Hansen, October 2009.
 170
 171     # Converts a Biopiece record to a GFF entry (a list).
 172
 173     my ( $record,   # Biopiece record
 174        ) = @_;
 175
 176     # Returns a list.
 177
 178     my ( @entry, $key, $tag, @atts );
 179
 180     $entry[ seqid ]  = $record->{ 'S_ID' };
 181     $entry[ source ] = $record->{ 'SOURCE' } || $record->{ 'REC_TYPE' } || '.';
 182     $entry[ type ]   = $record->{ 'TYPE' }   || '.';
 183     $entry[ start ]  = $record->{ 'S_BEG' };
 184     $entry[ end ]    = $record->{ 'S_END' };
 185     $entry[ score ]  = $record->{ 'SCORE' };
 186     $entry[ strand ] = $record->{ 'STRAND' };
 187     $entry[ phase ]  = $record->{ 'PHASE' } || '.';
 188
 189     if ( not exists $record->{ 'ATT_ID' } )
 190     {
 191         push @atts, "ID=$record->{ 'Q_ID' }" if exists $record->{ 'Q_ID' };
 192     }
 193
 194     foreach $key ( %{ $record } )
 195     {
 196         if ( $key =~ /ATT_(.+)/ )
 197         {
 198             $tag = lc $1;
 199
 200             if ( exists $ATTRIBUTES{ $tag } ) {
 201                 $tag = $ATTRIBUTES{ $tag };
 202             }
 203
 204             push @atts, "$tag=" . $record->{ $key };
 205         }
 206     }
 207
 208     $entry[ attributes ] = join ";", @atts;
 209
 210     return wantarray ? @entry : \@entry;
 211 }
 212
 213
 214 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 215
 216 1;