|
0
|
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
|
