annotate variant_effect_predictor/Bio/EnsEMBL/Utils/ScriptUtils.pm @ 3:d30fa12e4cc5 default tip

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