Raw content of Bio::EnsEMBL::Utils::ScriptUtils
<![CDATA[=head1 LICENSE
Copyright (c) 1999-2009 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
/info/about/code_licence.html
=head1 CONTACT
Please email comments or questions to the public Ensembl
developers list at <ensembl-dev@ebi.ac.uk>.
Questions may also be sent to the Ensembl help desk at
<helpdesk@ensembl.org>.
=cut
=head1 NAME
Bio::EnsEMBL::Utils::ScriptUtils;
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 METHODS
=cut
package Bio::EnsEMBL::Utils::ScriptUtils;
use strict;
use warnings;
no warnings 'uninitialized';
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
user_proceed
commify
sort_chromosomes
parse_bytes
directory_hash
path_append
dynamic_use
inject
);
=head2 user_proceed
Arg[1] : (optional) String $text - notification text to present to user
Example : # run a code snipped conditionally
if ($support->user_proceed("Run the next code snipped?")) {
# run some code
}
# exit if requested by user
exit unless ($support->user_proceed("Want to continue?"));
Description : If running interactively, the user is asked if he wants to
perform a script action. If he doesn't, this section is skipped
and the script proceeds with the code. When running
non-interactively, the section is run by default.
Return type : TRUE to proceed, FALSE to skip.
Exceptions : none
Caller : general
=cut
sub user_proceed {
my ($text, $interactive, $default) = @_;
unless (defined($default)) {
die("Need a default answer for non-interactive runs.");
}
my $input;
if ($interactive) {
print "$text\n" if $text;
print "[y/N] ";
$input = lc(<>);
chomp $input;
} else {
$input = $default;
}
if ($input eq 'y') {
return(1);
} else {
print "Skipping.\n" if ($interactive);
return(0);
}
}
=head2 sort_chromosomes
Arg[1] : (optional) Hashref $chr_hashref - Hashref with chr_name as keys
Example : my $chr = { '6-COX' => 1, '1' => 1, 'X' => 1 };
my @sorted = $support->sort_chromosomes($chr);
Description : Sorts chromosomes in an intuitive way (numerically, then
alphabetically). If no chromosome hashref is passed, it's
retrieve by calling $self->get_chrlength()
Return type : List - sorted chromosome names
Exceptions : thrown if no hashref is provided
Caller : general
=cut
sub sort_chromosomes {
my @chromosomes = @_;
return (sort _by_chr_num @chromosomes);
}
=head2 _by_chr_num
Example : my @sorted = sort _by_chr_num qw(X, 6-COX, 14, 7);
Description : Subroutine to use in sort for sorting chromosomes. Sorts
numerically, then alphabetically
Return type : values to be used by sort
Exceptions : none
Caller : internal ($self->sort_chromosomes)
=cut
sub _by_chr_num {
my @awords = split /-/, $a;
my @bwords = split /-/, $b;
my $anum = $awords[0];
my $bnum = $bwords[0];
if ($anum !~ /^[0-9]*$/) {
if ($bnum !~ /^[0-9]*$/) {
return $anum cmp $bnum;
} else {
return 1;
}
}
if ($bnum !~ /^[0-9]*$/) {
return -1;
}
if ($anum <=> $bnum) {
return $anum <=> $bnum;
} else {
if ($#awords == 0) {
return -1;
} elsif ($#bwords == 0) {
return 1;
} else {
return $awords[1] cmp $bwords[1];
}
}
}
=head2 commify
Arg[1] : Int $num - a number to commify
Example : print "An easy to read number: ".$self->commify(100000000);
# will print 100,000,000
Description : put commas into a number to make it easier to read
Return type : a string representing the commified number
Exceptions : none
Caller : general
Status : stable
=cut
sub commify {
my $num = shift;
$num = reverse($num);
$num =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
return scalar reverse $num;
}
sub parse_bytes {
my $bytes = shift;
my @suffixes = qw(bytes kb Mb Gb Tb);
my $length = length($bytes);
my $order = int(($length-1)/3);
my $parsed = sprintf('%.1f', $bytes/10**(3*$order));
return "$parsed ".$suffixes[$order];
}
sub directory_hash {
my $filename = shift;
my (@md5) = md5_hex($filename) =~ /\G(..)/g;
return join('/', @md5[0..2]);
}
sub path_append {
my $path1 = shift;
my $path2 = shift;
# default to current directory
$path1 = '.' unless (defined($path1));
my $return_path = "$path1/$path2";
unless (-d $return_path) {
system("mkdir -p $return_path") == 0 or
die("Unable to create directory $return_path: $!\n");
}
return $return_path;
}
=head2 inject
Arg [1] : String $classname - The name of the class to require/import
Example : $self->inject('Bio::EnsEMBL::DBSQL::DBAdaptor');
Description: Requires and imports the methods for the classname provided,
checks the symbol table so that it doesnot re-require modules
that have already been required.
Returntype : true on success
Exceptions : Warns to standard error if module fails to compile
Caller : internal
=cut
sub inject {
my $classname = shift;
my ($parent_namespace, $module) = $classname =~/^(.*::)(.*)$/ ?
($1,$2) : ('::', $classname);
no strict 'refs';
# return if module has already been imported
return 1 if $parent_namespace->{$module.'::'};
eval "require $classname";
die("Failed to require $classname: $@") if ($@);
$classname->import();
return 1;
}
sub dynamic_use {
return inject(@_);
}
1;
]]>