Mercurial > repos > mahtabm > ensembl
comparison variant_effect_predictor/Bio/EnsEMBL/Analysis/Programs.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 package Bio::EnsEMBL::Analysis::Programs; | |
22 use strict; | |
23 use vars qw( %Program_Paths ); | |
24 use Carp; | |
25 use Cwd; | |
26 use Sys::Hostname; | |
27 use Bio::EnsEMBL::Utils::Exception qw ( throw ) ; | |
28 | |
29 sub import { | |
30 my $pkg = shift; | |
31 foreach (@_) { | |
32 #print STDERR "importing: $_\n"; | |
33 $Program_Paths{ $_ } = 0; | |
34 } | |
35 my( $home, @PATH, @missing ); | |
36 | |
37 $home = cwd() or die "Can't save cwd"; | |
38 my $H = [ $home, 1 ]; | |
39 | |
40 @PATH = split /:/, $ENV{'PATH'}; | |
41 foreach (@PATH) { | |
42 s|/?$|/|; # Append / to each path | |
43 } | |
44 | |
45 # For each program, check there is an executable | |
46 foreach my $program (keys %Program_Paths) { | |
47 | |
48 # Deal with paths | |
49 if ($program =~ m|/|) { | |
50 _go_home( $H ); | |
51 my $path = $program; | |
52 # Deal with tildes | |
53 $path =~ s{^~([^/]*)}{ $1 ? (getpwnam($1))[7] | |
54 : (getpwuid($>))[7] }e; | |
55 if (my $real = _is_prog( $H, $path )) { | |
56 $Program_Paths{ $program } = $real; | |
57 } | |
58 } | |
59 # Or search through all paths | |
60 else { | |
61 foreach my $path (@PATH) { | |
62 _go_home( $H ); | |
63 if (my $real = _is_prog( $H, $path, $program )) { | |
64 $Program_Paths{ $program } = $real; | |
65 last; | |
66 } | |
67 } | |
68 } | |
69 } | |
70 _go_home( $H ); # Return to home directory | |
71 | |
72 # Make a list of all missing programs | |
73 foreach my $program (keys %Program_Paths) { | |
74 push( @missing, $program ) unless $Program_Paths{ $program }; | |
75 } | |
76 | |
77 # Give informative death message if programs weren't found | |
78 if (@missing) { | |
79 throw("Unable to locate the following programs as '". (getpwuid($<))[0]. "' on host '". hostname(). "' :\t". | |
80 join ( " --> " , @missing )) ; | |
81 } | |
82 } | |
83 | |
84 # Recursive function which follows links, or tests final destination | |
85 sub _is_prog { | |
86 my( $h, $path, $prog ) = @_; | |
87 | |
88 # Need to split path if $prog not provided | |
89 unless ($prog) { | |
90 ($path, $prog) = $path =~ m|(.*?)([^/]+)$|; | |
91 } | |
92 | |
93 if (-l "$path$prog") { | |
94 # Follow link | |
95 _follow( $h, $path ) or return; | |
96 unless (-x readlink($prog)) { | |
97 confess "Can't read link '$path$prog' : $!"; | |
98 } | |
99 my $link = $prog; | |
100 $path = cwd() or confess "Can't determine cwd"; | |
101 return "$path/$prog"; | |
102 } elsif (-f _ and -x _) { | |
103 # Return full path | |
104 _follow( $h, $path ) or return; | |
105 $path = cwd() or confess "Can't determine cwd"; | |
106 return "$path/$prog"; | |
107 } else { | |
108 # Not a link or an executable plain file | |
109 return; | |
110 } | |
111 } | |
112 | |
113 # To avoid unnecessary chdir'ing | |
114 sub _follow { | |
115 my( $H, $path ) = @_; | |
116 | |
117 # Chdir without arguments goes to home dir. | |
118 # Can't use defined in test since $path may contain | |
119 # a real null string. | |
120 if ( ! $path and $path ne '0' ) { | |
121 return 1; | |
122 } elsif (chdir($path)) { | |
123 $H->[1] = 0; | |
124 return 1; | |
125 } else { | |
126 return; | |
127 } | |
128 } | |
129 sub _go_home { | |
130 my( $H ) = @_; | |
131 | |
132 # Go home unless we're already there | |
133 if ($H->[1] == 0) { | |
134 if (chdir( $H->[0] )) { | |
135 $H->[1] = 1; | |
136 } else { | |
137 confess "Can't go home to [ ", $H->[0], ' ]'; | |
138 } | |
139 } | |
140 } | |
141 | |
142 1; | |
143 | |
144 __END__ | |
145 | |
146 =head1 NAME Programs | |
147 | |
148 =head1 SYSNOPSIS | |
149 | |
150 use Bio::EnsEMBL::Analysis::Programs qw( efetch getz est2genome | |
151 /usr/local/bin/this_one | |
152 ~me/some/path/my_prog | |
153 ~/../jane/bin/her_prog ); | |
154 | |
155 # Can also do at run time | |
156 Bio::EnsEMBL::Analysis::Programs->import( $someProg ); | |
157 | |
158 $path_to_prog = $Bio::EnsEMBL::Analysis::Programs::Program_Paths{ $prog }; | |
159 | |
160 =head1 DESCRIPTION | |
161 | |
162 B<Programs> is used to check at compile time for the | |
163 presence of executables which will be called from your | |
164 script. Arguments passed via the use statement | |
165 can be just the program name, or an absolute or | |
166 relative path to the program. Tildes are expanded | |
167 correctly (I<not> using "glob"). Failure to find any | |
168 one program is fatal, and a list of all failures is | |
169 printed, along with the host''s name. | |
170 | |
171 If you want to check for a program during run time, | |
172 the import funtion can be called directly, as shown above. | |
173 | |
174 The paths to each program found are stored in the | |
175 B<%Program_Paths> hash, which is keyed on the original | |
176 arguments passed. | |
177 | |
178 =head1 BUGS | |
179 | |
180 If the executable is in the root directory, then it''s found | |
181 path will appear as "//prog" in %Program_Paths, not "/prog". | |
182 | |
183 =head1 AUTHOR | |
184 | |
185 B<James Gilbert> Email jgrg@sanger.ac.uk | |
186 | |
187 | |
188 | |
189 | |
190 | |
191 | |
192 | |
193 | |
194 | |
195 | |
196 |