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 'Q_ID' => $entry->[ seqid ],
144 'SOURCE' => $entry->[ source ],
145 'TYPE' => $entry->[ type ],
146 'Q_BEG' => $entry->[ start ],
147 'Q_END' => $entry->[ end ],
148 'SCORE' => $entry->[ score ],
149 'STRAND' => $entry->[ strand ],
150 'PHASE' => $entry->[ phase ],
153 @atts = split /;/, $entry->[ attributes ];
155 foreach $att ( @atts )
157 ( $key, $val ) = split /=/, $att;
159 $record{ 'ATT_' . uc $key } = $val;
162 return wantarray ? %record : \%record;
168 # Martin A. Hansen, October 2009.
170 # Converts a Biopiece record to a GFF entry (a list).
172 my ( $record, # Biopiece record
177 my ( @entry, $key, $tag, @atts );
179 $entry[ seqid ] = $record->{ 'Q_ID' };
180 $entry[ source ] = $record->{ 'SOURCE' };
181 $entry[ type ] = $record->{ 'TYPE' };
182 $entry[ start ] = $record->{ 'Q_BEG' };
183 $entry[ end ] = $record->{ 'Q_END' };
184 $entry[ score ] = $record->{ 'SCORE' };
185 $entry[ strand ] = $record->{ 'STRAND' };
186 $entry[ phase ] = $record->{ 'PHASE' };
188 foreach $key ( %{ $record } )
190 if ( $key =~ /ATT_(.+)/ )
194 if ( exists $ATTRIBUTES{ $tag } ) {
195 $tag = $ATTRIBUTES{ $tag };
198 push @atts, "$tag=" . $record->{ $key };
202 $entry[ attributes ] = join ";", @atts;
204 return wantarray ? @entry : \@entry;
208 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<