File Coverage

blib/lib/GenOO/Data/File/SAM.pm
Criterion Covered Total %
statement 47 51 92.1
branch 11 14 78.5
condition n/a
subroutine 10 11 90.9
pod 0 3 0.0
total 68 79 86.0


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::SAM - Object implementing methods for accessing SAM formatted files
6              
7             =head1 SYNOPSIS
8              
9             # Object that manages a sam file.
10              
11             # To initialize
12             my $sam_file = GenOO::Data::File::SAM->new(
13             file => undef,
14             );
15              
16              
17             =head1 DESCRIPTION
18              
19             This object implements methods to read a sam file line by line.
20              
21             =head1 EXAMPLES
22              
23             # Create object
24             my $sam_file = GenOO::Data::File::SAM->new(
25             file => 't/sample_data/sample.sam.gz'
26             );
27              
28             # Read one record at a time
29             my $sam_record = $sam_file->next_record();
30              
31             =cut
32              
33             # Let the code begin...
34              
35             package GenOO::Data::File::SAM;
36             $GenOO::Data::File::SAM::VERSION = '1.5.2';
37              
38             #######################################################################
39             ####################### Load External modules #####################
40             #######################################################################
41 1     1   5065 use Modern::Perl;
  1         2  
  1         10  
42 1     1   190 use autodie;
  1         2  
  1         10  
43 1     1   5754 use Moose;
  1         3  
  1         10  
44 1     1   7904 use namespace::autoclean;
  1         3  
  1         11  
45              
46              
47             #######################################################################
48             ####################### Interface attributes ######################
49             #######################################################################
50             has 'file' => (
51             isa => 'Maybe[Str]', # undef value makes the parser read from STDIN
52             is => 'ro',
53             required => 1,
54             );
55              
56             has 'records_read_count' => (
57             traits => ['Counter'],
58             is => 'ro',
59             isa => 'Num',
60             default => 0,
61             handles => {
62             _inc_records_read_count => 'inc',
63             _reset_records_read_count => 'reset',
64             },
65             );
66              
67             has 'records_class' => (
68             is => 'ro',
69             default => 'GenOO::Data::File::SAM::Record',
70             );
71              
72             #######################################################################
73             ######################## Private attributes #######################
74             #######################################################################
75             has '_filehandle' => (
76             is => 'ro',
77             builder => '_open_filehandle',
78             init_arg => undef,
79             lazy => 1,
80             );
81              
82             has '_is_eof_reached' => (
83             traits => ['Bool'],
84             is => 'rw',
85             isa => 'Bool',
86             default => 0,
87             handles => {
88             _set_eof_reached => 'set',
89             _unset_eof_reached => 'unset',
90             _eof_not_reached => 'not',
91             },
92             );
93              
94             has '_cached_header_lines' => (
95             traits => ['Array'],
96             is => 'ro',
97             default => sub { [] },
98             handles => {
99             _all_cached_header_lines => 'elements',
100             _add_header_line_in_cache => 'push',
101             _shift_cached_header_line => 'shift',
102             _has_cached_header_lines => 'count',
103             _has_no_cached_header_lines => 'is_empty',
104             _cached_header_lines_count => 'count',
105             _clear_cached_header_lines => 'clear'
106             },
107             );
108              
109             has '_cached_record' => (
110             is => 'rw',
111             clearer => '_clear_cached_record',
112             predicate => '_has_cached_record',
113             );
114              
115              
116             #######################################################################
117             ############################## BUILD ##############################
118             #######################################################################
119             sub BUILD {
120 11     11 0 35 my $self = shift;
121              
122 11         363 eval "require ".$self->records_class;
123 11         155 $self->_parse_header_section;
124             }
125              
126              
127             #######################################################################
128             ######################## Interface Methods ########################
129             #######################################################################
130             sub next_record {
131 2939     2939 0 14640 my ($self) = @_;
132              
133 2939         4146 my $record;
134 2939 100       91773 if ($self->_has_cached_record) {
135 5         159 $record = $self->_cached_record;
136 5         227 $self->_clear_cached_record;
137             }
138             else {
139 2934         6064 $record = $self->_next_record_from_file;
140             }
141              
142 2939 100       119037 $self->_inc_records_read_count if defined $record;
143              
144 2939         7022 return $record;
145             }
146              
147             sub header {
148 0     0 0 0 my ($self) = @_;
149              
150 0         0 return join("\n", $self->_all_cached_header_lines);
151             }
152              
153              
154             #######################################################################
155             ######################### Private Methods #########################
156             #######################################################################
157             sub _parse_header_section {
158 11     11   43 my ($self) = @_;
159              
160 11         351 while (my $line = $self->_filehandle->getline) {
161 253 100       11691 if ($line =~ /^\@/) {
162 242         517 chomp($line);
163 242         9195 $self->_add_header_line_in_cache($line);
164             }
165             else {
166             # When the while reads the first line after the header section
167             # we need to process it immediatelly because in zipped files we cannot go back
168 11         55 my $record = $self->_parse_record_line($line);
169 11         516 $self->_cached_record($record);
170 11         365 return;
171             }
172             }
173             }
174              
175             sub _next_record_from_file {
176 2935     2935   7355 my ($self) = @_;
177              
178 2935         72162 my $line = $self->_filehandle->getline;
179 2935 100       70412 if (defined $line) {
180 2932         6421 return $self->_parse_record_line($line);
181             }
182             else {
183 3         185 $self->_set_eof_reached;
184 3         19 return undef;
185             }
186             }
187              
188             sub _parse_record_line {
189 2944     2944   8216 my ($self,$line) = @_;
190              
191 2944         4900 chomp $line;
192 2944         21342 my @fields = split(/\t/,$line);
193 2944         79177 return $self->records_class->new(fields => \@fields);
194             }
195              
196             sub _open_filehandle {
197 11     11   31 my ($self) = @_;
198              
199 11         23 my $read_mode;
200             my $HANDLE;
201 11 50       415 if (!defined $self->file) {
    50          
202 0         0 open ($HANDLE, '<-', $self->file);
203             }
204             elsif ($self->file =~ /\.gz$/) {
205 11 50       305 die 'Cannot open file ' . $self->file . "\n" if ! -e $self->file;
206 11         337 open($HANDLE, 'gzip -dc ' . $self->file . ' |');
207             }
208             else {
209 0         0 open ($HANDLE, '<', $self->file);
210             }
211              
212 11         51118 return $HANDLE;
213             }
214              
215              
216             #######################################################################
217             ############################ Finalize #############################
218             #######################################################################
219             __PACKAGE__->meta->make_immutable;
220              
221             1;