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