diff variant_effect_predictor/Bio/EnsEMBL/Utils/ScriptUtils.pm @ 0:1f6dce3d34e0

Uploaded

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/EnsEMBL/Utils/ScriptUtils.pm	Thu Apr 11 02:01:53 2013 -0400
@@ -0,0 +1,265 @@
+=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 <[e-mail]>.
+
+  Questions may also be sent to the Ensembl help desk at
+  <[e-mail]>.
+
+=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;
+