File Coverage

blib/lib/FASTX/PE.pm
Criterion Covered Total %
statement 77 94 81.9
branch 25 40 62.5
condition 13 29 44.8
subroutine 9 9 100.0
pod 2 2 100.0
total 126 174 72.4


line stmt bran cond sub pod time code
1             package FASTX::PE;
2 7     7   3967 use 5.012;
  7         26  
3 7     7   45 use warnings;
  7         11  
  7         275  
4 7     7   44 use Carp qw(confess cluck);
  7         13  
  7         430  
5 7     7   47 use Data::Dumper;
  7         13  
  7         333  
6 7     7   44 use FASTX::Reader;
  7         14  
  7         229  
7 7     7   46 use File::Basename;
  7         29  
  7         8093  
8             $FASTX::PE::VERSION = $FASTX::Reader::VERSION;
9             #ABSTRACT: A Paired-End FASTQ files reader, based on FASTX::Reader.
10              
11             my $for_suffix_re = '(/1|_R?1)';
12             my $rev_suffix_re = '(/2|_R?2)';
13              
14              
15             sub new {
16              
17             # Instantiate object
18 9     9 1 3898 my ($class, $args) = @_;
19              
20 9         77 my %accepted_parameters = (
21             'filename' => 1,
22             'tag1' => 1,
23             'tag2' => 1,
24             'rev' => 1,
25             'interleaved' => 1,
26             'nocheck' => 1,
27             'revcompl' => 1,
28             'verbose' => 1,
29             );
30              
31 9         59 my $valid_attributes = join(', ', keys %accepted_parameters);
32              
33 9 50       36 if ($args) {
34 9         19 for my $parameter (keys %{ $args} ) {
  9         33  
35             confess("Attribute <$parameter> is not expected. Valid attributes are: $valid_attributes\n")
36 20 50       61 if (! $accepted_parameters{$parameter} );
37             }
38             } else {
39 0         0 $args->{filename} = '{{STDIN}}';
40             }
41              
42             my $self = {
43             filename => $args->{filename},
44             rev => $args->{rev},
45             interleaved => $args->{interleaved} // 0,
46             tag1 => $args->{tag1},
47             tag2 => $args->{tag2},
48             nocheck => $args->{nocheck} // 0,
49             revcompl => $args->{revcompl} // 0,
50 9   100     169 verbose => $args->{verbose} // 0,
      50        
      100        
      100        
51             };
52              
53              
54 9         37 my $object = bless $self, $class;
55              
56             # Required to read STDIN?
57 9 50 33     117 if ($self->{filename} eq '{{STDIN}}' or not $self->{filename}) {
58 0         0 $self->{interleaved} = 1;
59 0         0 $self->{stdin} = 1;
60             }
61              
62 9 100       35 if ($self->{interleaved}) {
63             # Decode interleaved
64 2 50       8 if ($self->{stdin}) {
65 0         0 $self->{R1} = FASTX::Reader->new({ filename => '{{STDIN}}' });
66             } else {
67 2         20 $self->{R1} = FASTX::Reader->new({ filename => "$self->{filename}"});
68             }
69             } else {
70             # Decode PE
71 7 100       22 if ( ! defined $self->{rev} ) {
72              
73             # Auto calculate reverse (R2) filename
74 1         73 my $rev = basename($self->{filename});
75              
76 1 50 33     8 if (defined $self->{tag1} and defined $self->{tag2}) {
77 0         0 $rev =~s/$self->{tag1}/$self->{tag2}/;
78 0         0 $rev = dirname($self->{basename}) . $rev;
79             } else {
80              
81 1         4 $rev =~s/_R1/_R2/;
82 1 50       68 say STDERR "R2 not provided, autoguess (_R1/_R2): $rev" if ($self->{verbose});
83 1 50       99 if ($rev eq basename($self->{filename}) ) {
84 1         7 $rev =~s/_1\./_2./;
85 1 50       19 say STDERR "R2 not provided for $self->{filename}, now autoguess (_1/_2): $rev" if ($self->{verbose});
86             }
87              
88 1         42 $rev = dirname($self->{filename}) . '/' . $rev;
89             }
90              
91 1 50       24 if (not -e $rev) {
    50          
92             # TO DEFINE: confess("ERROR: The rev file for '$self->{filename}' was not found in '$rev'\n");
93 0         0 say STDERR "WARNING: Pair not specified and R2 \"$rev\" not found for R1 \"$self->{filename}\":\n trying parsing as interleaved.\n";
94 0         0 $self->{interleaved} = 1;
95 0         0 $self->{nocheck} = 0;
96             } elsif ($self->{filename} eq $rev) {
97 0         0 say STDERR "WARNING: Pair not specified for \"$self->{filename}\":\n trying parsing as interleaved.\n";
98 0         0 $self->{interleaved} = 1;
99 0         0 $self->{nocheck} = 0;
100             } else {
101 1         4 $self->{rev} = $rev;
102             }
103              
104             }
105              
106 7         61 $self->{R1} = FASTX::Reader->new({ filename => "$self->{filename}"});
107             $self->{R2} = FASTX::Reader->new({ filename => "$self->{rev}"})
108 5 50       366 if (not $self->{interleaved});
109              
110             }
111              
112              
113 6         431 return $object;
114             }
115              
116              
117              
118             sub getReads {
119 6     6 1 1653 my $self = shift;
120             #my ($fh, $aux) = @_;
121             #@::::::: :::
122 6         277 my $pe;
123             my $r1;
124 6         0 my $r2;
125              
126 6 100       109 if ($self->{interleaved}) {
127 2         35 $r1 = $self->{R1}->getRead();
128 2         17 $r2 = $self->{R1}->getRead();
129             } else {
130 4         114 $r1 = $self->{R1}->getRead();
131 4         38 $r2 = $self->{R2}->getRead();
132             }
133              
134 6 50 33     127 if (! defined $r1->{name} and !defined $r2->{name}) {
    50 33        
135 0         0 return undef;
136             } elsif (! defined $r1->{name} or !defined $r2->{name}) {
137 0   0     0 my $r = $r1->{name} // $r2->{name};
138 0         0 $self->{error} = "Premature termination, missing read mate for \"$r\"";
139 0         0 return undef;
140             }
141              
142 6         29 my $name_1;
143             my $name_2;
144              
145 6 50       30 if ($self->{nocheck} != 1) {
146 6         20 $name_1 = $r1->{name};
147 6         41 $name_2 = $r2->{name};
148 6         538 $name_1 =~s/${for_suffix_re}$//;
149 6         160 $name_2 =~s/${rev_suffix_re}$//;
150 6 100       38 if ($name_1 ne $name_2) {
151 1         577 confess("Read name different in PE:\n[$r1->{name}] !=\n[$r2->{name}]\n");
152             }
153              
154 5 50 33     95 if (not $r1->{qual} or not $r2->{qual}) {
155 0         0 confess("Missing quality for one of the two reads ($name_1, $name_2)");
156             }
157             }
158              
159              
160 5   33     67 $pe->{name} = $name_1 // $r1->{name};
161 5         59 $pe->{seq1} = $r1->{seq};
162 5         18 $pe->{qual1} = $r1->{qual};
163              
164 5 100       32 if ($self->{revcompl}) {
165 1         12 $pe->{seq2} = _rc( $r2->{seq} );
166 1         10 $pe->{qual2} = reverse( $r2->{qual} );
167             } else {
168 4         12 $pe->{seq2} = $r2->{seq};
169 4         18 $pe->{qual2} = $r2->{qual};
170             }
171              
172 5         25 $pe->{comment1} = $r1->{comment};
173 5         13 $pe->{comment2} = $r2->{comment};
174              
175 5         49 return $pe;
176              
177             }
178              
179              
180              
181              
182              
183             sub _rc {
184 1     1   9 my $sequence = shift @_;
185 1         4 $sequence = reverse($sequence);
186 1         4 $sequence =~tr/ACGTacgt/TGCAtgca/;
187 1         16 return $sequence;
188             }
189             1;
190              
191             __END__