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         next if scalar @fields < 9;
  95
  96         return wantarray ? @fields : \@fields;
  97     }
  98 }
  99
 100
 101 sub gff_entry_put
 102 {
 103     # Martin A. Hansen, October 2009
 104
 105     my ( $entry,   # GFF entry
 106          $fh,      # file handle
 107        ) = @_;
 108
 109     $fh ||= \*STDOUT;
 110
 111     print $fh join( "\t", @{ $entry } ), "\n";
 112 }
 113
 114
 115 sub gff_pragma_put
 116 {
 117     # Martin A. Hansen, October 2009
 118
 119     my ( $pragmas,   # list of GFF pragma lines
 120          $fh,        # file handle
 121        ) = @_;
 122
 123     my ( $pragma );
 124
 125     $fh ||= \*STDOUT;
 126
 127     foreach $pragma ( @{ $pragmas } ) {
 128         print $fh "$pragma\n";
 129     }
 130 }
 131
 132
 133 sub gff2biopiece
 134 {
 135     # Martin A. Hansen, October 2009
 136
 137     my ( $entry,   # GFF entry
 138        ) = @_;
 139
 140     # Returns a hashref.
 141
 142     my ( %record, @atts, $att, $key, $val );
 143
 144     %record = (
 145         'S_ID'   => $entry->[ seqid ],
 146         'SOURCE' => $entry->[ source ],
 147         'TYPE'   => $entry->[ type ],
 148         'S_BEG'  => $entry->[ start ] - 1,
 149         'S_END'  => $entry->[ end ]   - 1,
 150         'S_LEN'  => $entry->[ end ]   - $entry->[ start ] + 1,
 151         'SCORE'  => $entry->[ score ],
 152         'STRAND' => $entry->[ strand ],
 153         'PHASE'  => $entry->[ phase ],
 154     );
 155
 156     @atts = split /;/, $entry->[ attributes ];
 157
 158     foreach $att ( @atts )
 159     {
 160         ( $key, $val ) = split /=/, $att;
 161
 162         $record{ 'ATT_' . uc $key } = $val;
 163     }
 164
 165     return wantarray ? %record : \%record;
 166 }
 167
 168
 169 sub biopiece2gff
 170 {
 171     # Martin A. Hansen, October 2009.
 172
 173     # Converts a Biopiece record to a GFF entry (a list).
 174
 175     my ( $record,   # Biopiece record
 176        ) = @_;
 177
 178     # Returns a list.
 179
 180     my ( @entry, $key, $tag, @atts );
 181
 182     $entry[ seqid ]  = $record->{ 'S_ID' };
 183     $entry[ source ] = $record->{ 'SOURCE' } || $record->{ 'REC_TYPE' } || '.';
 184     $entry[ type ]   = $record->{ 'TYPE' }   || '.';
 185     $entry[ start ]  = $record->{ 'S_BEG' };
 186     $entry[ end ]    = $record->{ 'S_END' };
 187     $entry[ score ]  = $record->{ 'SCORE' };
 188     $entry[ strand ] = $record->{ 'STRAND' };
 189     $entry[ phase ]  = $record->{ 'PHASE' } || '.';
 190
 191     if ( not exists $record->{ 'ATT_ID' } )
 192     {
 193         push @atts, "ID=$record->{ 'Q_ID' }" if exists $record->{ 'Q_ID' };
 194     }
 195
 196     foreach $key ( %{ $record } )
 197     {
 198         if ( $key =~ /ATT_(.+)/ )
 199         {
 200             $tag = lc $1;
 201
 202             if ( exists $ATTRIBUTES{ $tag } ) {
 203                 $tag = $ATTRIBUTES{ $tag };
 204             }
 205
 206             push @atts, "$tag=" . $record->{ $key };
 207         }
 208     }
 209
 210     $entry[ attributes ] = join ";", @atts;
 211
 212     return wantarray ? @entry : \@entry;
 213 }
 214
 215
 216 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 217
 218 1;