4 # Copyright (C) 2007-2008 Martin A. Hansen.
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.
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.
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.
20 # http://www.gnu.org/copyleft/gpl.html
23 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
26 # Routines for manipulation 'Generic Feature Format' - GFF version 3.
28 # http://www.sequenceontology.org/resources/gff3.html
31 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
39 use vars qw( @ISA @EXPORT_OK );
43 @ISA = qw( Exporter );
58 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
68 derives_from => 'Derives_from',
71 ontology_term => 'Ontology_term',
77 # Martin A. Hansen, October 2009
79 my ( $fh, # file handle
84 my ( $line, @fields );
86 while ( $line = <$fh>)
90 next if $line =~ /^$|^#/; # skip empty lines and lines starting with #
92 @fields = split /\t/, $line;
94 next if scalar @fields < 9;
96 return wantarray ? @fields : \@fields;
103 # Martin A. Hansen, October 2009
105 my ( $entry, # GFF entry
111 print $fh join( "\t", @{ $entry } ), "\n";
117 # Martin A. Hansen, October 2009
119 my ( $pragmas, # list of GFF pragma lines
127 foreach $pragma ( @{ $pragmas } ) {
128 print $fh "$pragma\n";
135 # Martin A. Hansen, October 2009
137 my ( $entry, # GFF entry
142 my ( %record, @atts, $att, $key, $val );
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 ],
156 @atts = split /;/, $entry->[ attributes ];
158 foreach $att ( @atts )
160 ( $key, $val ) = split /=/, $att;
162 $record{ 'ATT_' . uc $key } = $val;
165 return wantarray ? %record : \%record;
171 # Martin A. Hansen, October 2009.
173 # Converts a Biopiece record to a GFF entry (a list).
175 my ( $record, # Biopiece record
180 my ( @entry, $key, $tag, @atts );
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' } || '.';
191 if ( not exists $record->{ 'ATT_ID' } )
193 push @atts, "ID=$record->{ 'Q_ID' }" if exists $record->{ 'Q_ID' };
196 foreach $key ( %{ $record } )
198 if ( $key =~ /ATT_(.+)/ )
202 if ( exists $ATTRIBUTES{ $tag } ) {
203 $tag = $ATTRIBUTES{ $tag };
206 push @atts, "$tag=" . $record->{ $key };
210 $entry[ attributes ] = join ";", @atts;
212 return wantarray ? @entry : \@entry;
216 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<