File Coverage

blib/lib/CracTools/SAMReader.pm
Criterion Covered Total %
statement 93 106 87.7
branch 23 46 50.0
condition 2 3 66.6
subroutine 16 17 94.1
pod 11 11 100.0
total 145 183 79.2


line stmt bran cond sub pod time code
1             package CracTools::SAMReader;
2              
3             {
4             $CracTools::SAMReader::DIST = 'CracTools';
5             }
6             # ABSTRACT: An easy to use tool to read files in SAM format.
7             $CracTools::SAMReader::VERSION = '1.251';
8              
9 2     2   14652 use strict;
  2         5  
  2         49  
10 2     2   9 use warnings;
  2         4  
  2         43  
11 2     2   9 use Carp;
  2         3  
  2         108  
12 2     2   850 use CracTools::SAMReader::SAMline;
  2         4  
  2         1760  
13              
14              
15             sub new {
16 2     2 1 2890 my $class = shift;
17 2         6 my ($sam_file,$sam_type) = @_;
18              
19 2         10 my $self = bless{
20             sam_file => $sam_file,
21             sam_type => $sam_type,
22             }, $class;
23              
24 2         9 $self->init();
25              
26 2         10 return $self;
27             }
28              
29              
30             sub iterator {
31 1     1 1 5 my $self = shift;
32 1         4 my $f_it = $self->iteratorFile("IGNORE_HEADERS");
33              
34             return sub {
35 7     7   38 my ($line) = $f_it->();
36 7         12 my $sam_line;
37 7 100       15 if(defined $line) {
38 6         23 $sam_line = CracTools::SAMReader::SAMline->new($line);
39             }
40 7         15 return $sam_line;
41 1         6 };
42             }
43              
44              
45             sub iteratorFile {
46 3     3 1 5 my $self = shift;
47 3         6 my $option = shift;
48 3         10 my $sam_file = $self->{sam_file};
49              
50 3 50       21 if($sam_file =~ /\.sam$/) {
    0          
    0          
51 3 50       53 open(SAM,"< $sam_file") or die ("Cannot open $sam_file");
52             } elsif($self->{sam_file} =~ /\.sam.gz$/) {
53 0 0       0 open(SAM,"gunzip -c $sam_file |") or die ("Cannot open $sam_file");
54             } elsif($self->{sam_file} =~ /\.bam$/) {
55 0 0       0 open(SAM, "-|", "samtools view -h $sam_file" )or die "Cannot open $sam_file, check if samtools are installed.";
56             } else {
57 0 0       0 open(SAM,"< $sam_file") or die ("Cannot open $sam_file");
58 0         0 warn "Unknown file format. We assume this is SAM (uncompressed).";
59             }
60              
61 3         87 my $next_line;
62 3         7 my $line_number = 0;
63              
64 3 100 66     18 if(defined $option && $option eq "IGNORE_HEADERS") {
65 1         9 while(my $line = ) {
66 4 100       22 if(!($line =~ /^@/)) {
67 1         3 $next_line = $line;
68 1         2 $line_number++;
69 1         2 last;
70             }
71             }
72             } else {
73 2         21 $next_line = ;
74             }
75              
76             return sub {
77 39     39   62 my $sam_line = $next_line;
78 39         71 $next_line = ;
79 39         50 $line_number++;
80 39 100       72 if($sam_line) {
81 37         89 return $sam_line, $line_number;
82             } else {
83 2 0       15 close(SAM) or warn $! ? "Error closing samtools pipe: $!" : "Exit status $? from samtools";
    50          
84 2         7 return ();
85             }
86 3         16 };
87             }
88              
89              
90              
91             sub header {
92 8     8 1 11 my $self = shift;
93 8         42 return $self->{header};
94             }
95              
96              
97             sub refSeqLength {
98 1     1 1 3 my $self = shift;
99 1         3 my $ref_seq = shift;
100 1 50       4 croak("Missing reference sequence name in arguement") unless defined $ref_seq;
101 1         4 my $refseq_lengths = $self->allRefSeqLengths();
102 1         6 return $refseq_lengths->{$ref_seq};
103             }
104              
105              
106             sub allRefSeqLengths {
107 2     2 1 4 my $self = shift;
108 2         7 my @header_lines = split('\n',$self->header);
109 2         4 my %refseq_lengths;
110 2         6 foreach (@header_lines) {
111 30 100       96 if ($_ =~/\@SQ.*SN:/) {
112 25         86 my ($name,$length) = $_ =~/\@SQ.*SN:(\S+)\s+LN:(\d+)+/;
113 25         58 $refseq_lengths{$name} = $length;
114             }
115             }
116 2         7 return \%refseq_lengths;
117             }
118              
119              
120             sub commandLine {
121 2     2 1 4 my $self = shift;
122 2 50       6 if(defined $self->header) {
123 2         6 my @header_lines = split('\n',$self->header);
124 2         6 my $command_line;
125 2         5 foreach (@header_lines) {
126 6 100       27 if ($_ =~/\@PG.*PN:crac/) {
127 2         17 ($command_line) = $_ =~ /CL:([^\t]+)/;
128             }
129             }
130 2         6 return $command_line;
131             } else {
132 0         0 return undef;
133             }
134             }
135              
136              
137             sub getCracArgumentValue {
138 2     2 1 381 my $self = shift;
139 2         6 my $argument = shift;
140 2         7 my $command_line = $self->commandLine;
141 2 50       5 if(defined $command_line) {
142 2         33 my ($value) = $command_line =~ /--$argument\s+(\S+)/;
143 2         11 return $value;
144             } else {
145 0         0 return undef;
146             }
147             }
148              
149              
150             sub hasCracOption {
151 0     0 1 0 my $self = shift;
152 0         0 my $option = shift;
153 0 0       0 croak("Missing argument") unless defined $option;
154 0 0       0 if(defined $self->commandLine) {
155 0         0 return $self->commandLine =~ /--$option/;
156             } else {
157 0         0 return 0;
158             }
159             }
160              
161              
162             sub getCracVersionNumber {
163 1     1 1 3 my $self = shift;
164 1 50       3 if(defined $self->header) {
165 1         3 my @header_lines = split('\n',$self->header);
166 1         2 my $version_number;
167 1         4 foreach (@header_lines) {
168 3 100       16 if ($_ =~/\@PG.*PN:crac/) {
169 1         6 ($version_number) = $_ =~ /VN:([^\t]+)/;
170 1         2 last;
171             }
172             }
173 1         6 return $version_number;
174             } else {
175 0         0 return undef;
176             }
177             }
178              
179              
180             sub init {
181 2     2 1 4 my $self = shift;
182 2         7 my $f_it = $self->iteratorFile;
183 2         4 my $header;
184 2         6 while(my ($line) = $f_it->()) {
185 31 100       69 if($line =~ /^@/) {
186 30         65 $header .= $line;
187             } else {
188 1         2 last;
189             }
190             }
191 2         14 $self->{header} = $header;
192             }
193              
194             1;
195              
196             __END__