File Coverage

blib/lib/GenOO/Data/File/GFF.pm
Criterion Covered Total %
statement 74 77 96.1
branch 20 26 76.9
condition n/a
subroutine 18 18 100.0
pod 0 3 0.0
total 112 124 90.3


line stmt bran cond sub pod time code
1             # POD documentation - main docs before the code
2              
3             =head1 NAME
4              
5             GenOO::Data::File::GFF - Object implementing methods for accessing GFF formatted files (http://www.sanger.ac.uk/resources/software/gff/spec.html)
6              
7             =head1 SYNOPSIS
8              
9             # Object that manages a gff file.
10              
11             # To initialize
12             my $gff_file = GenOO::Data::File::GFF->new(
13             file => undef,
14             );
15              
16              
17             =head1 DESCRIPTION
18              
19             This object offers methods to read a gff file line by line.
20              
21             =head1 EXAMPLES
22              
23             # Create object
24             my $gff_file = GenOO::Data::File::GFF->new(
25             file => 't/sample_data/sample.gff.gz'
26             );
27              
28             # Read one record at a time
29             my $record = $gff_file->next_record();
30              
31             =cut
32              
33             # Let the code begin...
34              
35              
36             package GenOO::Data::File::GFF;
37             $GenOO::Data::File::GFF::VERSION = '1.4.6';
38              
39             #######################################################################
40             ####################### Load External modules #####################
41             #######################################################################
42 1     1   4 use Modern::Perl;
  1         2  
  1         7  
43 1     1   145 use autodie;
  1         2  
  1         8  
44 1     1   3891 use Moose;
  1         2  
  1         7  
45 1     1   6401 use namespace::autoclean;
  1         3  
  1         12  
46              
47              
48             #######################################################################
49             ######################### Load GenOO modules ######################
50             #######################################################################
51 1     1   784 use GenOO::Data::File::GFF::Record;
  1         4  
  1         1256  
52              
53              
54             #######################################################################
55             ####################### Interface attributes ######################
56             #######################################################################
57             has 'file' => (
58             isa => 'Maybe[Str]',
59             is => 'rw',
60             required => 1
61             );
62              
63             has 'records_read_count' => (
64             traits => ['Counter'],
65             is => 'ro',
66             isa => 'Num',
67             default => 0,
68             handles => {
69             _inc_records_read_count => 'inc',
70             _reset_records_read_count => 'reset',
71             },
72             );
73              
74              
75             #######################################################################
76             ######################## Private attributes #######################
77             #######################################################################
78             has '_filehandle' => (
79             is => 'ro',
80             builder => '_open_filehandle',
81             init_arg => undef,
82             lazy => 1,
83             );
84              
85             has '_eof_reached' => (
86             is => 'rw',
87             default => 0,
88             init_arg => undef,
89             lazy => 1,
90             );
91              
92             has '_header' => (
93             is => 'ro',
94             default => sub {{}},
95             init_arg => undef,
96             lazy => 1,
97             );
98              
99             has '_cached_records' => (
100             traits => ['Array'],
101             is => 'ro',
102             isa => 'ArrayRef[GenOO::Data::File::GFF::Record]',
103             default => sub { [] },
104             handles => {
105             _all_cached_records => 'elements',
106             _add_record_in_cache => 'push',
107             _shift_cached_record => 'shift',
108             _has_cached_records => 'count',
109             _has_no_cached_records => 'is_empty',
110             },
111             );
112              
113              
114             #######################################################################
115             ############################### BUILD #############################
116             #######################################################################
117             sub BUILD {
118 31     31 0 55 my $self = shift;
119              
120 31         122 $self->_parse_header_section;
121             }
122              
123             #######################################################################
124             ######################## Interface Methods ########################
125             #######################################################################
126             sub next_record {
127 10950     10950 0 14103 my ($self) = @_;
128              
129 10950         8442 my $record;
130 10950 100       371356 if ($self->_has_cached_records) {
131 20         875 $record = $self->_shift_cached_record;
132             }
133             else {
134 10930         18412 $record = $self->_next_record_from_file;
135             }
136              
137 10950 100       39123 if (defined $record) {
138 10933         378647 $self->_inc_records_read_count;
139             }
140 10950         34209 return $record;
141             }
142              
143             sub version {
144 1     1 0 2004 my ($self) = @_;
145 1         38 return $self->_header->{VERSION};
146             }
147              
148              
149             #######################################################################
150             ######################### Private Methods #########################
151             #######################################################################
152             sub _parse_header_section {
153 31     31   52 my ($self) = @_;
154              
155 31         939 my $filehandle = $self->_filehandle;
156 31         1004 while (my $line = $filehandle->getline) {
157 143 100       16302 if ($self->_line_looks_like_header($line)) {
    100          
158 32         145 $self->_recognize_and_store_header_line($line);
159             }
160             elsif ($self->_line_looks_like_record($line)) {
161             # When the while reads the first line after the header section
162             # we need to process it immediatelly because in zipped files we cannot go back
163 31         188 my $record = $self->_parse_record_line($line);
164 31         1472 $self->_add_record_in_cache($record);
165 31         1036 return;
166             }
167             }
168             }
169              
170             sub _next_record_from_file {
171 10931     10931   13739 my ($self) = @_;
172              
173 10931         261295 while (my $line = $self->_filehandle->getline) {
174 10914 50       233586 if ($self->_line_looks_like_record($line)) {
    0          
175 10914         18894 return $self->_parse_record_line($line);
176             }
177             elsif ($self->_line_looks_like_header) {
178 0         0 die "A record was expected but line looks like a header - the header should have been parsed already. $line\n";
179             }
180             }
181              
182 17         1126 $self->_eof_reached(1); # When you reach this point the file has finished
183 17         26 return undef;
184             }
185              
186             sub _parse_record_line {
187 10946     10946   13946 my ($self, $line) = @_;
188              
189 10946         12740 chomp $line;
190 10946         13432 $line =~ s/(#.+)$//;
191 10946         14009 my $comment_string = $1;
192 10946         39478 my ($seqname, $source, $feature, $start, $end, $score, $strand, $frame, $attributes_string) = split(/\t/,$line);
193 10946         44004 my @attributes = split(/;\s*/,$attributes_string);
194 10946         9902 my %attributes_hash;
195 10946         14376 foreach my $attribute (@attributes) {
196 21892         55389 $attribute =~ /(.+)[=|\s]"(.+)"/;
197 21892         53041 $attributes_hash{$1} = $2;
198             }
199              
200 10946         370319 return GenOO::Data::File::GFF::Record->new({
201             seqname => $seqname,
202             source => $source,
203             feature => $feature,
204             start_1_based => $start, # 1-based
205             stop_1_based => $end, # 1-based
206             score => $score,
207             strand => $strand,
208             frame => $frame,
209             attributes => \%attributes_hash,
210             comment => $comment_string,
211             });
212             }
213              
214             sub _recognize_and_store_header_line {
215 32     32   98 my ($self, $line) = @_;
216              
217 32 100       112 if ($self->_line_looks_like_version($line)) {
218 16         97 $self->_parse_line_and_store_version($line);
219             }
220             else {
221 16         52 $self->_parse_and_store_generic_header_line($line);
222             }
223             }
224              
225             sub _parse_line_and_store_version {
226 16     16   53 my ($self, $line) = @_;
227              
228 16         98 my $version = (split(/\s+/,$line))[1];
229 16         607 $self->_header->{VERSION} = $version;
230             }
231              
232             sub _parse_and_store_generic_header_line {
233 16     16   24 my ($self, $line) = @_;
234              
235 16         98 my ($key, @values) = split(/\s+/,$line);
236 16         485 $self->_header->{$key} = join(' ', @values);
237             }
238              
239             sub _line_looks_like_header {
240 145     145   2209 my ($self, $line) = @_;
241 145 100       851 return ($line =~ /^#{2}/) ? 1 : 0;
242             }
243              
244             sub _line_looks_like_record {
245 11027     11027   14123 my ($self, $line) = @_;
246 11027 100       30866 return ($line !~ /^#/) ? 1 : 0;
247             }
248              
249             sub _line_looks_like_version {
250 34     34   1880 my ($self, $line) = @_;
251 34 100       221 return ($line =~ /^##gff-version/) ? 1 : 0;
252             }
253              
254              
255             #######################################################################
256             ######################### Private Methods #########################
257             #######################################################################
258             sub _open_filehandle {
259 31     31   50 my ($self) = @_;
260              
261 31         34 my $read_mode;
262             my $HANDLE;
263 31 50       921 if (!defined $self->file) {
    50          
264 0         0 open ($HANDLE, '<-', $self->file);
265             }
266             elsif ($self->file =~ /\.gz$/) {
267 31 50       744 die 'Cannot open file ' . $self->file . "\n" if ! -e $self->file;
268 31         921 open($HANDLE, 'gzip -dc ' . $self->file . ' |');
269             }
270             else {
271 0         0 open ($HANDLE, '<', $self->file);
272             }
273              
274 31         130883 return $HANDLE;
275             }
276              
277              
278             #######################################################################
279             ############################ Finalize #############################
280             #######################################################################
281             __PACKAGE__->meta->make_immutable;
282              
283             1;