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