1# tRNAscanSE/Utils.pm 2# This module contains utility functions used in tRNAscan-SE. 3# 4# -------------------------------------------------------------- 5# This module is part of the tRNAscan-SE program. 6# Copyright (C) 2017 Patricia Chan and Todd Lowe 7# -------------------------------------------------------------- 8# 9 10package tRNAscanSE::Utils; 11use strict; 12 13require Exporter; 14our @ISA = qw(Exporter); 15our @EXPORT = qw(check_output_file open_for_read open_for_write open_for_append tempname 16 print_filename rev_comp_seq max min seg_overlap error_exit_status trim pad pad_num); 17 18our %comp_map = ( # Complement map 19 'A' => 'T', 'T' => 'A', 'U' => 'A', 20 'G' => 'C', 'C' => 'G', 21 'Y' => 'R', 'R' => 'Y', 22 'S' => 'W', 'W' => 'S', 23 'M' => 'K', 'K' => 'M', 24 'B' => 'V', 'V' => 'B', 25 'H' => 'D', 'D' => 'H', 26 'N' => 'N', 'X' => 'X', 27 '?' => '?', '-' => '-'); 28 29sub check_output_file { 30 my ($fname, $prompt_for_overwrite) = @_; 31 my ($ans, $ansline); 32 33 if ((-e $fname) && ($prompt_for_overwrite)) { 34 print STDERR "\nWARNING: $fname exists already.\n\n", 35 " (O)verwrite file, (A)ppend to file, or (Q)uit program? "; 36 $ansline = <STDIN>; 37 $ans = substr($ansline, 0, 1); 38 while ($ans !~ /[AOQaoq]/) { 39 print STDERR "\nReply (O)verwrite (A)ppend, or (Q)uit [O/A/Q]: "; 40 $ansline = <STDIN>; 41 $ans = substr($ansline, 0, 1); 42 } 43 if (uc($ans) eq 'Q') { 44 die "\ntRNAscan-SE aborted.\n\n"; 45 } 46 elsif (uc($ans) eq 'A') { 47 print STDERR "\n Appending to $fname...\n"; 48 open(FHAND,">>$fname") || 49 die "Unable to open $fname for appending. ", 50 "Aborting program.\n"; 51 close(FHAND); 52 return; # successful exit status 53 } 54 else { # $ans eq 'O'verwrote 55 print STDERR "\n Overwriting $fname...\n"; 56 } 57 } 58 open(FHAND, ">$fname") || 59 die "Unable to open $fname for writing. Aborting program.\n"; 60 close(FHAND); 61} 62 63sub open_for_read { 64 my ($FHAND, $fname) = @_; 65 66 open($$FHAND, "$fname") || 67 die "Unable to open $fname for reading. Aborting program.\n"; 68} 69 70sub open_for_write { 71 my ($FHAND, $fname) = @_; 72 73 open($$FHAND, ">$fname") || 74 die "Unable to open $fname for writing. Aborting program.\n"; 75} 76 77sub open_for_append { 78 my ($FHAND, $fname) = @_; 79 80 open ($$FHAND, ">>$fname") || 81 die "FATAL: Unable to open output file ", 82 &print_filename($fname), "\n\n"; 83} 84 85# Function: tempname 86# by SE, modification by TMJL 87# Returns a unique temporary filename. 88# 89# Normally puts temp files to /tmp. This directory can 90# be overridden by an environment variable TMPDIR. 91# 92 93sub tempname 94{ 95 my ($temp_dir, $exten) = @_; 96 my ($name); 97 98 $name = "$temp_dir/tscan$$"."$exten"; 99 return $name; 100} 101 102sub print_filename 103{ 104 my ($fname) = @_; 105 if ($fname eq "-") { 106 $fname = "Standard output"; 107 } 108 return $fname; 109} 110 111sub rev_comp_seq { 112 my ($seq) = @_; 113 my ($seqlen) = length($seq); 114 my ($i, $j, $rcseq); 115 116 $rcseq = 'X' x $seqlen; # pre-extending string for efficiency 117 for ($i = ($seqlen - 1), $j = 0; $i > -1; $i--, $j++) { 118 substr($rcseq, $j, 1) = $comp_map{(substr($seq, $i, 1))}; 119 } 120 return $rcseq; 121} 122 123sub complement_seq 124{ 125 my ($seq) = @_; 126 my $comp_seq = ""; 127 128 for (my $i = 0; $i < length($seq); $i++) 129 { 130 $comp_seq .= $comp_map{(substr($seq, $i, 1))}; 131 } 132 return $comp_seq; 133} 134 135sub min 136{ 137 my ($a, $b) = @_; 138 if ($a < $b) { 139 return ($a); } 140 else { 141 return ($b); 142 } 143} 144 145sub max 146{ 147 my ($a, $b) = @_; 148 if ($a > $b) { 149 return ($a); 150 } 151 else { 152 return ($b); 153 } 154} 155 156sub seg_overlap 157{ 158 my ($seg1_a, $seg1_b, $seg2_a, $seg2_b, $range) = @_; 159 160 if ($range == 0) 161 { 162 if ((($seg1_a >= $seg2_a) && ($seg1_a <= $seg2_b)) || 163 (($seg1_b >= $seg2_a) && ($seg1_b <= $seg2_b)) || 164 (($seg2_a >= $seg1_a) && ($seg2_a <= $seg1_b)) || 165 (($seg2_b >= $seg1_a) && ($seg2_b <= $seg1_b))) 166 { 167 return 1; 168 } 169 else 170 { 171 return 0; 172 } 173 } 174 else 175 { 176 if ((($seg1_a >= ($seg2_a - $range)) && ($seg1_a <= ($seg2_a + $range))) || 177 (($seg1_b >= ($seg2_b - $range)) && ($seg1_b <= ($seg2_b + $range))) || 178 (($seg2_a >= ($seg1_a - $range)) && ($seg2_a <= ($seg1_a + $range))) || 179 (($seg2_b >= ($seg1_b - $range)) && ($seg2_b <= ($seg1_b + $range)))) 180 { 181 return 1; 182 } 183 else 184 { 185 return 0; 186 } 187 } 188} 189 190sub error_exit_status 191{ 192 my ($prog_name, $seq_name) = @_; 193 194 if ($? != 0) { 195 print STDERR "$prog_name could not complete successfully for $seq_name.\n", 196 "Possible memory allocation problem or missing file. (Exit code=",$?,").\n\n"; 197 return 1; 198 } 199 else { 200 return 0; 201 } 202} 203 204sub trim 205{ 206 my $string = shift; 207 $string =~ s/^\s+//; 208 $string =~ s/\s+$//; 209 return $string; 210} 211 212sub pad 213{ 214 my ($string, $len) = @_; 215 my $remain = $len - length($string); 216 my $value = ""; 217 if ($remain > 0) 218 { 219 $value = ' ' x $remain; 220 } 221 $value .= $string; 222 return $value; 223} 224 225sub pad_num 226{ 227 my ($num, $len) = @_; 228 my $string = sprintf("%d", $num); 229 my $remain = $len - length($string); 230 my $value = ""; 231 if ($remain > 0) 232 { 233 $value = '0' x $remain; 234 } 235 $value .= $string; 236 return $value; 237} 238 2391; 240