Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/EnsEMBL/Utils/ScriptUtils.pm @ 0:1f6dce3d34e0
Uploaded
author | mahtabm |
---|---|
date | Thu, 11 Apr 2013 02:01:53 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:1f6dce3d34e0 |
---|---|
1 =head1 LICENSE | |
2 | |
3 Copyright (c) 1999-2012 The European Bioinformatics Institute and | |
4 Genome Research Limited. All rights reserved. | |
5 | |
6 This software is distributed under a modified Apache license. | |
7 For license details, please see | |
8 | |
9 http://www.ensembl.org/info/about/code_licence.html | |
10 | |
11 =head1 CONTACT | |
12 | |
13 Please email comments or questions to the public Ensembl | |
14 developers list at <dev@ensembl.org>. | |
15 | |
16 Questions may also be sent to the Ensembl help desk at | |
17 <helpdesk@ensembl.org>. | |
18 | |
19 =cut | |
20 | |
21 =head1 NAME | |
22 | |
23 Bio::EnsEMBL::Utils::ScriptUtils; | |
24 | |
25 =head1 SYNOPSIS | |
26 | |
27 =head1 DESCRIPTION | |
28 | |
29 =head1 METHODS | |
30 | |
31 =cut | |
32 | |
33 package Bio::EnsEMBL::Utils::ScriptUtils; | |
34 | |
35 use strict; | |
36 use warnings; | |
37 no warnings 'uninitialized'; | |
38 | |
39 use Exporter; | |
40 our @ISA = qw(Exporter); | |
41 | |
42 our @EXPORT_OK = qw( | |
43 user_proceed | |
44 commify | |
45 sort_chromosomes | |
46 parse_bytes | |
47 directory_hash | |
48 path_append | |
49 dynamic_use | |
50 inject | |
51 ); | |
52 | |
53 | |
54 =head2 user_proceed | |
55 | |
56 Arg[1] : (optional) String $text - notification text to present to user | |
57 Example : # run a code snipped conditionally | |
58 if ($support->user_proceed("Run the next code snipped?")) { | |
59 # run some code | |
60 } | |
61 | |
62 # exit if requested by user | |
63 exit unless ($support->user_proceed("Want to continue?")); | |
64 Description : If running interactively, the user is asked if he wants to | |
65 perform a script action. If he doesn't, this section is skipped | |
66 and the script proceeds with the code. When running | |
67 non-interactively, the section is run by default. | |
68 Return type : TRUE to proceed, FALSE to skip. | |
69 Exceptions : none | |
70 Caller : general | |
71 | |
72 =cut | |
73 | |
74 sub user_proceed { | |
75 my ($text, $interactive, $default) = @_; | |
76 | |
77 unless (defined($default)) { | |
78 die("Need a default answer for non-interactive runs."); | |
79 } | |
80 | |
81 my $input; | |
82 | |
83 if ($interactive) { | |
84 print "$text\n" if $text; | |
85 print "[y/N] "; | |
86 | |
87 $input = lc(<>); | |
88 chomp $input; | |
89 } else { | |
90 $input = $default; | |
91 } | |
92 | |
93 if ($input eq 'y') { | |
94 return(1); | |
95 } else { | |
96 print "Skipping.\n" if ($interactive); | |
97 return(0); | |
98 } | |
99 } | |
100 | |
101 | |
102 =head2 sort_chromosomes | |
103 | |
104 Arg[1] : (optional) Hashref $chr_hashref - Hashref with chr_name as keys | |
105 Example : my $chr = { '6-COX' => 1, '1' => 1, 'X' => 1 }; | |
106 my @sorted = $support->sort_chromosomes($chr); | |
107 Description : Sorts chromosomes in an intuitive way (numerically, then | |
108 alphabetically). If no chromosome hashref is passed, it's | |
109 retrieve by calling $self->get_chrlength() | |
110 Return type : List - sorted chromosome names | |
111 Exceptions : thrown if no hashref is provided | |
112 Caller : general | |
113 | |
114 =cut | |
115 | |
116 sub sort_chromosomes { | |
117 my @chromosomes = @_; | |
118 | |
119 return (sort _by_chr_num @chromosomes); | |
120 } | |
121 | |
122 | |
123 =head2 _by_chr_num | |
124 | |
125 Example : my @sorted = sort _by_chr_num qw(X, 6-COX, 14, 7); | |
126 Description : Subroutine to use in sort for sorting chromosomes. Sorts | |
127 numerically, then alphabetically | |
128 Return type : values to be used by sort | |
129 Exceptions : none | |
130 Caller : internal ($self->sort_chromosomes) | |
131 | |
132 =cut | |
133 | |
134 sub _by_chr_num { | |
135 my @awords = split /-/, $a; | |
136 my @bwords = split /-/, $b; | |
137 | |
138 my $anum = $awords[0]; | |
139 my $bnum = $bwords[0]; | |
140 | |
141 if ($anum !~ /^[0-9]*$/) { | |
142 if ($bnum !~ /^[0-9]*$/) { | |
143 return $anum cmp $bnum; | |
144 } else { | |
145 return 1; | |
146 } | |
147 } | |
148 if ($bnum !~ /^[0-9]*$/) { | |
149 return -1; | |
150 } | |
151 | |
152 if ($anum <=> $bnum) { | |
153 return $anum <=> $bnum; | |
154 } else { | |
155 if ($#awords == 0) { | |
156 return -1; | |
157 } elsif ($#bwords == 0) { | |
158 return 1; | |
159 } else { | |
160 return $awords[1] cmp $bwords[1]; | |
161 } | |
162 } | |
163 } | |
164 | |
165 | |
166 =head2 commify | |
167 | |
168 Arg[1] : Int $num - a number to commify | |
169 Example : print "An easy to read number: ".$self->commify(100000000); | |
170 # will print 100,000,000 | |
171 Description : put commas into a number to make it easier to read | |
172 Return type : a string representing the commified number | |
173 Exceptions : none | |
174 Caller : general | |
175 Status : stable | |
176 | |
177 =cut | |
178 | |
179 sub commify { | |
180 my $num = shift; | |
181 | |
182 $num = reverse($num); | |
183 $num =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; | |
184 | |
185 return scalar reverse $num; | |
186 } | |
187 | |
188 | |
189 sub parse_bytes { | |
190 my $bytes = shift; | |
191 | |
192 my @suffixes = qw(bytes kb Mb Gb Tb); | |
193 | |
194 my $length = length($bytes); | |
195 my $order = int(($length-1)/3); | |
196 | |
197 my $parsed = sprintf('%.1f', $bytes/10**(3*$order)); | |
198 | |
199 return "$parsed ".$suffixes[$order]; | |
200 } | |
201 | |
202 | |
203 sub directory_hash { | |
204 my $filename = shift; | |
205 | |
206 my (@md5) = md5_hex($filename) =~ /\G(..)/g; | |
207 return join('/', @md5[0..2]); | |
208 } | |
209 | |
210 | |
211 sub path_append { | |
212 my $path1 = shift; | |
213 my $path2 = shift; | |
214 | |
215 # default to current directory | |
216 $path1 = '.' unless (defined($path1)); | |
217 | |
218 my $return_path = "$path1/$path2"; | |
219 | |
220 unless (-d $return_path) { | |
221 system("mkdir -p $return_path") == 0 or | |
222 die("Unable to create directory $return_path: $!\n"); | |
223 } | |
224 | |
225 return $return_path; | |
226 } | |
227 | |
228 | |
229 =head2 inject | |
230 | |
231 Arg [1] : String $classname - The name of the class to require/import | |
232 Example : $self->inject('Bio::EnsEMBL::DBSQL::DBAdaptor'); | |
233 Description: Requires and imports the methods for the classname provided, | |
234 checks the symbol table so that it doesnot re-require modules | |
235 that have already been required. | |
236 Returntype : true on success | |
237 Exceptions : Warns to standard error if module fails to compile | |
238 Caller : internal | |
239 | |
240 =cut | |
241 | |
242 sub inject { | |
243 my $classname = shift; | |
244 my ($parent_namespace, $module) = $classname =~/^(.*::)(.*)$/ ? | |
245 ($1,$2) : ('::', $classname); | |
246 no strict 'refs'; | |
247 | |
248 # return if module has already been imported | |
249 return 1 if $parent_namespace->{$module.'::'}; | |
250 | |
251 eval "require $classname"; | |
252 die("Failed to require $classname: $@") if ($@); | |
253 | |
254 $classname->import(); | |
255 | |
256 return 1; | |
257 } | |
258 | |
259 | |
260 sub dynamic_use { | |
261 return inject(@_); | |
262 } | |
263 | |
264 1; | |
265 |