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