File Coverage

blib/lib/FASTX/ScriptHelper.pm
Criterion Covered Total %
statement 87 141 61.7
branch 13 56 23.2
condition 8 30 26.6
subroutine 18 22 81.8
pod 9 9 100.0
total 135 258 52.3


line stmt bran cond sub pod time code
1             package FASTX::ScriptHelper;
2             #ABSTRACT: Shared routines for binaries using FASTX::Reader and FASTX::PE.
3              
4 1     1   70938 use 5.012;
  1         13  
5 1     1   5 use warnings;
  1         2  
  1         33  
6              
7 1     1   6 use Carp qw(confess cluck);
  1         2  
  1         147  
8 1     1   638 use Data::Dumper;
  1         6990  
  1         82  
9 1     1   509 use FASTX::Reader;
  1         3  
  1         50  
10 1     1   9 use File::Basename;
  1         3  
  1         62  
11 1     1   6 use File::Spec;
  1         10  
  1         34  
12 1     1   724 use Term::ANSIColor qw(color);
  1         8405  
  1         802  
13 1     1   820 use JSON::PP;
  1         16300  
  1         91  
14 1     1   684 use Capture::Tiny qw(capture);
  1         27876  
  1         1672  
15              
16              
17             $FASTX::ScriptHelper::VERSION = '0.1.0';
18              
19             our @ISA = qw(Exporter);
20             our @EXPORT = qw(rc fu_printfasta fu_printfastq verbose);
21             our @EXPORT_OK = qw($fu_linesize $fu_verbose); # symbols to export on request
22              
23              
24             sub new {
25              
26             # Instantiate object
27 1     1 1 697 my ($class, $args) = @_;
28              
29 1         7 my %accepted_parameters = (
30             'verbose' => 1,
31             'debug' => 1,
32             'logfile' => 1,
33             'linesize'=> 1,
34             );
35              
36 1         6 my $valid_attributes = join(', ', keys %accepted_parameters);
37              
38 1         3 for my $parameter (keys %{ $args} ) {
  1         4  
39             confess("Attribute <$parameter> is not expected. Valid attributes are: $valid_attributes\n")
40 3 50       9 if (! $accepted_parameters{$parameter} );
41             }
42              
43              
44             my $self = {
45             logfile => $args->{logfile} // undef,
46             debug => $args->{debug} // 0,
47             verbose => $args->{verbose} // 0,
48 1   50     17 linesize => $args->{linesize} // 0,
      50        
      50        
      50        
49             };
50 1         3 my $object = bless $self, $class;
51              
52 1 50       10 if (defined $self->{logfile}) {
53 1         7 verbose($self, "Ready to log in $object->{logfile}");
54 1   33     90 open my $logfh, '>', "$object->{logfile}" || confess("ERROR: Unable to write log file to $object->{logfile}\n");
55 1         5 $object->{logfh} = $logfh;
56 1         4 $object->{do_log} = 1;
57             }
58              
59 1         6 return $object;
60             }
61              
62              
63              
64             sub fu_printfasta {
65              
66 0     0 1 0 my $self = undef;
67 0 0       0 if ( ref($_[0]) eq 'FASTX::ScriptHelper' ) {
68 0         0 $self = shift @_;
69             }
70              
71 0         0 my ($name, $comment, $seq) = @_;
72 0 0       0 confess("No sequence provided for $name") unless defined $seq;
73 0         0 my $print_comment = '';
74 0 0       0 if (defined $comment) {
75 0         0 $print_comment = ' ' . $comment;
76             }
77              
78 0         0 say '>', $name, $print_comment;
79 0 0       0 if ($self) {
80 0         0 print split_string($self,$seq);
81             } else {
82 0         0 print split_string($seq);
83             }
84              
85             }
86              
87              
88             sub fu_printfastq {
89 0     0 1 0 my $self = undef;
90 0 0       0 if ( ref($_[0]) eq 'FASTX::ScriptHelper' ) {
91 0         0 $self = shift @_;
92             }
93 0         0 my ($name, $comment, $seq, $qual) = @_;
94 0         0 my $print_comment = '';
95 0 0       0 if (defined $comment) {
96 0         0 $print_comment = ' ' . $comment;
97             }
98 0 0       0 $qual = 'I' x length($seq) unless (defined $qual);
99 0         0 say '@', $name, $print_comment;
100 0 0       0 if ($self) {
101 0         0 print split_string($self,$seq) , "+\n", split_string($self,$qual);
102             } else {
103 0         0 print split_string($seq) , "+\n", split_string($qual);
104             }
105              
106             }
107              
108              
109             sub rc ($) {
110 1     1 1 1960 my $self = undef;
111 1 50       6 if ( ref($_[0]) eq 'FASTX::ScriptHelper' ) {
112 1         3 $self = shift @_;
113             }
114 1         4 my $sequence = reverse($_[0]);
115 1 50       4 if (is_seq($sequence)) {
116 1         3 $sequence =~tr/ACGTacgt/TGCAtgca/;
117 1         5 return $sequence;
118             }
119             }
120              
121              
122             sub is_seq {
123 1     1 1 2 my $self = undef;
124 1 50       4 if ( ref($_[0]) eq 'FASTX::ScriptHelper' ) {
125 0         0 $self = shift @_;
126             }
127 1         2 my $string = shift @_;
128 1 50       5 if ($string =~/[^ACGTRYSWKMBDHVN]/i) {
129 0         0 return 0;
130             } else {
131 1         6 return 1;
132             }
133             }
134              
135              
136             sub split_string {
137 0     0 1 0 my $self = undef;
138 0 0       0 if ( ref($_[0]) eq 'FASTX::ScriptHelper' ) {
139 0         0 $self = shift @_;
140             }
141 0         0 my $input_string = shift @_;
142 0 0       0 confess("No string provided") unless $input_string;
143 0         0 my $formatted = '';
144 0   0     0 my $line_width = $self->{linesize} // $main::opt_line_size // 0; # change here
      0        
145              
146 0 0       0 return $input_string. "\n" unless ($line_width);
147 0         0 for (my $i = 0; $i < length($input_string); $i += $line_width) {
148 0         0 my $frag = substr($input_string, $i, $line_width);
149 0         0 $formatted .= $frag."\n";
150             }
151 0         0 return $formatted;
152             }
153              
154              
155             sub verbose {
156 1     1 1 3 my $self = undef;
157 1 50       5 if ( ref($_[0]) eq 'FASTX::ScriptHelper' ) {
158 1         4 $self = shift @_;
159             }
160 1         4 my ($message, $reference, $reference_name) = @_;
161 1   50     6 my $variable_name = $reference_name // 'data';
162 1         4 my $timestamp = _getTimeStamp();
163 1 50 33     11 if ( (defined $self and $self->{verbose} ) or (defined $main::opt_verbose and $main::opt_verbose) ) {
      0        
      33        
164 1 50       5 if (defined $self->{do_log}) {
165 0         0 say {$self->{logfh}} "[$timestamp] $message";
  0         0  
166 0 0       0 say {$self->{logfh}} Data::Dumper->Dump([$reference], [$variable_name])
  0         0  
167             if (defined $reference);
168             }
169 1         7 say STDERR color('cyan'),"[$timestamp]", color('reset'), " $message";
170 1 50       351 say STDERR color('magenta'), Data::Dumper->Dump([$reference], [$variable_name])
171             if (defined $reference);
172             } else {
173 0         0 return -1;
174             }
175              
176             }
177              
178             sub run {
179 1     1 1 3 my $self = undef;
180 1 50       4 if ( ref($_[0]) eq 'FASTX::ScriptHelper' ) {
181 1         3 $self = shift @_;
182             }
183 1         4 my ($command, $options) = @_;
184              
185            
186              
187 1         3 my $cmd = _runCmd($command);
188 1 50       14 if ($cmd->{exit}) {
189 0         0 $cmd->{failed} = 1;
190 0 0       0 if (! $options->{candie}) {
191 0         0 confess("Execution of an external command failed:\n$command");
192             }
193             }
194 1         13 return ($cmd);
195              
196              
197             }
198              
199             sub writelog {
200 0     0 1 0 my $self = undef;
201 0 0       0 if ( ref($_[0]) eq 'FASTX::ScriptHelper' ) {
202 0         0 $self = shift @_;
203             }
204 0         0 my ($message, $reference) = @_;
205              
206 0 0 0     0 if (defined $self and $self->{do_log}) {
207 0         0 say {$self->{logfh}} "[", _getTimeStamp() ,"] $message";
  0         0  
208             }
209              
210              
211             }
212              
213             sub _getTimeStamp {
214              
215 1     1   62 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
216 1         12 my $timestamp = sprintf ( "%04d-%02d-%02d %02d:%02d:%02d",
217             $year+1900,$mon+1,$mday,$hour,$min,$sec);
218 1         4 return $timestamp;
219             }
220              
221             sub _runCmd(@) {
222 1 50   1   5 if ( ref($_[0]) eq 'FASTX::ScriptHelper' ) {
223 0         0 shift @_;
224             }
225 1         3 my @cmd = @_;
226 1         2 my $output;
227 1         4 $output->{cmd} = join(' ', @cmd);
228              
229             my ($stdout, $stderr, $exit) = capture {
230 1     1   4579 system( @cmd );
231 1         36 };
232 1         1389 chomp($stderr);
233 1         11 chomp($stdout);
234 1         9 $output->{stdout} = $stdout;
235 1         8 $output->{stderr} = $stderr;
236 1         11 $output->{exit} = $exit;
237            
238 1         22 return $output;
239             }
240              
241              
242              
243             1;
244              
245             __END__