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