view variant_effect_predictor/Bio/EnsEMBL/Analysis/Programs.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
line wrap: on
line source

=head1 LICENSE

  Copyright (c) 1999-2012 The European Bioinformatics Institute and
  Genome Research Limited.  All rights reserved.

  This software is distributed under a modified Apache license.
  For license details, please see

    http://www.ensembl.org/info/about/code_licence.html

=head1 CONTACT

  Please email comments or questions to the public Ensembl
  developers list at <dev@ensembl.org>.

  Questions may also be sent to the Ensembl help desk at
  <helpdesk@ensembl.org>.

=cut

package Bio::EnsEMBL::Analysis::Programs;
use strict;
use vars qw( %Program_Paths );
use Carp;
use Cwd;
use Sys::Hostname;
use Bio::EnsEMBL::Utils::Exception qw ( throw ) ; 

sub import {
    my $pkg = shift;
    foreach (@_) {
        #print STDERR "importing: $_\n";
        $Program_Paths{ $_ } = 0;
    }
    my( $home, @PATH, @missing );
    
    $home = cwd() or die "Can't save cwd";
    my $H = [ $home, 1 ];
    
    @PATH = split /:/, $ENV{'PATH'};
    foreach (@PATH) {
        s|/?$|/|; # Append / to each path
    }
    
    # For each program, check there is an executable
    foreach my $program (keys %Program_Paths) {
        
        # Deal with paths
        if ($program =~ m|/|) {
            _go_home( $H );
            my $path = $program;
            # Deal with tildes
            $path =~ s{^~([^/]*)}{ $1 ? (getpwnam($1))[7]
                                      : (getpwuid($>))[7] }e;
            if (my $real = _is_prog( $H, $path )) {
                $Program_Paths{ $program } = $real;
            }            
        }
        # Or search through all paths
        else {
            foreach my $path (@PATH) {
                _go_home( $H );
                if (my $real = _is_prog( $H, $path, $program )) {
                    $Program_Paths{ $program } = $real;
                    last;
                }
            }
        }
    }
    _go_home( $H ); # Return to home directory
    
    # Make a list of all missing programs
    foreach my $program (keys %Program_Paths) {
        push( @missing, $program ) unless $Program_Paths{ $program };
    }
    
    # Give informative death message if programs weren't found
    if (@missing) { 
        throw("Unable to locate the following programs as '". (getpwuid($<))[0]. "' on host '". hostname(). "' :\t".
        join ( " --> " , @missing )) ; 
    }
}

# Recursive function which follows links, or tests final destination
sub _is_prog {
    my( $h, $path, $prog ) = @_;

    # Need to split path if $prog not provided
    unless ($prog) {
        ($path, $prog) = $path =~ m|(.*?)([^/]+)$|;
    }
    
    if (-l "$path$prog") {
        # Follow link
        _follow( $h, $path ) or return;
        unless (-x readlink($prog)) {
          confess "Can't read link '$path$prog' : $!";
	}
	my $link = $prog;
	$path = cwd() or confess "Can't determine cwd";
        return "$path/$prog";
    } elsif (-f _ and -x _) {
        # Return full path
        _follow( $h, $path ) or return;
        $path = cwd() or confess "Can't determine cwd";
        return "$path/$prog";
    } else {
        # Not a link or an executable plain file
        return;
    }
}

# To avoid unnecessary chdir'ing
sub _follow {
    my( $H, $path ) = @_;
    
    # Chdir without arguments goes to home dir.
    # Can't use defined in test since $path may contain
    # a real null string.
    if ( ! $path and $path ne '0' ) {
        return 1;
    } elsif (chdir($path)) {
        $H->[1] = 0;
        return 1;
    } else {
        return;
    }
}
sub _go_home {
    my( $H ) = @_;
    
    # Go home unless we're already there
    if ($H->[1] == 0) {
        if (chdir( $H->[0] )) {
            $H->[1] = 1;
        } else {
            confess "Can't go home to [ ", $H->[0], ' ]';
        }
    }
}

1;

__END__

=head1 NAME Programs

=head1 SYSNOPSIS

    use Bio::EnsEMBL::Analysis::Programs qw( efetch getz est2genome 
                     /usr/local/bin/this_one
                     ~me/some/path/my_prog
                     ~/../jane/bin/her_prog );

    # Can also do at run time
    Bio::EnsEMBL::Analysis::Programs->import( $someProg );

    $path_to_prog = $Bio::EnsEMBL::Analysis::Programs::Program_Paths{ $prog };

=head1 DESCRIPTION

B<Programs> is used to check at compile time for the
presence of executables which will be called from your
script.  Arguments passed via the use statement
can be just the program name, or an absolute or
relative path to the program.  Tildes are expanded
correctly (I<not> using "glob").  Failure to find any
one program is fatal, and a list of all failures is
printed, along with the host''s name.

If you want to check for a program during run time,
the import funtion can be called directly, as shown above.

The paths to each program found are stored in the
B<%Program_Paths> hash, which is keyed on the original
arguments passed.

=head1 BUGS

If the executable is in the root directory, then it''s found
path will appear as "//prog" in %Program_Paths, not "/prog".

=head1 AUTHOR

B<James Gilbert> Email jgrg@sanger.ac.uk