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 return wantarray ? @fields : \@fields;
101 # Martin A. Hansen, October 2009
103 my ( $entry, # GFF entry
109 print $fh join( "\t", @{ $entry } ), "\n";
115 # Martin A. Hansen, October 2009
117 my ( $pragmas, # list of GFF pragma lines
125 foreach $pragma ( @{ $pragmas } ) {
126 print $fh "$pragma\n";
133 # Martin A. Hansen, October 2009
135 my ( $entry, # GFF entry
140 my ( %record, @atts, $att, $key, $val );
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 ],
154 @atts = split /;/, $entry->[ attributes ];
156 foreach $att ( @atts )
158 ( $key, $val ) = split /=/, $att;
160 $record{ 'ATT_' . uc $key } = $val;
163 return wantarray ? %record : \%record;
169 # Martin A. Hansen, October 2009.
171 # Converts a Biopiece record to a GFF entry (a list).
173 my ( $record, # Biopiece record
178 my ( @entry, $key, $tag, @atts );
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' } || '.';
189 if ( not exists $record->{ 'ATT_ID' } )
191 push @atts, "ID=$record->{ 'Q_ID' }" if exists $record->{ 'Q_ID' };
194 foreach $key ( %{ $record } )
196 if ( $key =~ /ATT_(.+)/ )
200 if ( exists $ATTRIBUTES{ $tag } ) {
201 $tag = $ATTRIBUTES{ $tag };
204 push @atts, "$tag=" . $record->{ $key };
208 $entry[ attributes ] = join ";", @atts;
210 return wantarray ? @entry : \@entry;
214 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<