some script utilities (configuration parsing, logging and various other stuff)

modules/Bio/EnsEMBL/Utils/ConfParser.pm

+package Bio::EnsEMBL::Utils::ConfParser;
+
+=head1 NAME
+
+Bio::EnsEMBL::Utils::ConversionSupport - Utility module for Vega release and
+schema conversion scripts
+
+=head1 SYNOPSIS
+
+    my $serverroot = '/path/to/ensembl';
+    my $suport = new Bio::EnsEMBL::Utils::ConversionSupport($serverroot);
+
+    # parse common options
+    $support->parse_common_options;
+
+    # parse extra options for your script
+    $support->parse_extra_options('string_opt=s', 'numeric_opt=n');
+
+    # ask user if he wants to run script with these parameters
+    $support->confirm_params;
+
+    # see individual method documentation for more stuff
+
+=head1 DESCRIPTION
+
+This module is a collection of common methods and provides helper functions 
+for the Vega release and schema conversion scripts. Amongst others, it reads
+options from a config file, parses commandline options and does logging.
+
+=head1 LICENCE
+
+This code is distributed under an Apache style licence:
+Please see http://www.ensembl.org/code_licence.html for details
+
+=head1 AUTHOR
+
+Patrick Meidl <pm2@sanger.ac.uk>
+
+=head1 CONTACT
+
+Post questions to the EnsEMBL development list ensembl-dev@ebi.ac.uk
+
+=cut
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use Getopt::Long;
+use Text::Wrap;
+use Cwd qw(abs_path);
+use Bio::EnsEMBL::Utils::Argument qw(rearrange);
+use Bio::EnsEMBL::Utils::Exception qw(throw warning);
+use Bio::EnsEMBL::Utils::ScriptUtils qw(user_proceed);
+use Bio::EnsEMBL::Utils::Logger;
+
+
+=head2 new
+
+  Arg[SERVERROOT] : String $serverroot
+                root directory of your ensembl code
+  Example     : my $support = new Bio::EnsEMBL::Utils::ConversionSupport(
+                                        '/path/to/ensembl');
+  Description : constructor
+  Return type : Bio::EnsEMBL::Utils::ConversionSupport object
+  Exceptions  : thrown if no serverroot is provided
+  Caller      : general
+
+=cut
+
+sub new {
+  my $class = shift;
+
+  my ($serverroot) = rearrange(['SERVERROOT'], @_);
+
+  throw("You must supply a serverroot.") unless ($serverroot);
+
+  my $self = {
+      '_serverroot'   => $serverroot,
+      '_param'        => { interactive => 1 },
+  };
+
+  bless ($self, $class);
+
+  return $self;
+}
+
+
+=head2 parse_common_options
+
+  Example     : $support->parse_common_options;
+  Description : This method reads options from a configuration file and parses
+                some commandline options that are common to all scripts (like
+                db connection settings, help, dry-run). Commandline options
+                will override config file settings. 
+
+                All options will be accessible via $self->param('name').
+  Return type : true on success 
+  Exceptions  : thrown if configuration file can't be opened
+  Caller      : general
+
+=cut
+
+sub parse_common_options {
+  my $self = shift;
+
+  # read commandline options
+  my %h;
+  Getopt::Long::Configure("pass_through");
+  &GetOptions( \%h,
+      'conffile|conf=s',
+      'logfile|log=s',
+      'logpath=s',
+      'logappend|log_append=s',
+      'is_component=s',
+      'verbose|v=s',
+      'interactive|i=s',
+      'dry_run|dry|n=s',
+      'help|h|?',
+      );
+
+  # reads config file
+  my $conffile = $h{'conffile'} || $self->param('default_conf') ||
+    "$ENV{HOME}/.ensembl_script.conf";
+  $conffile = abs_path($conffile);
+
+  if (-e $conffile) {
+    open(CONF, $conffile) or throw( 
+        "Unable to open configuration file $conffile for reading: $!");
+
+    my $serverroot = $self->serverroot;
+
+    while (<CONF>) {
+      chomp;
+
+      # remove comments
+      s/^[#;].*//;
+      s/\s+[;].*$//;
+
+      # read options into internal parameter datastructure
+      next unless (/(\w\S*)\s*=\s*(.*)/);
+      my $name = $1;
+      my $val = $2;
+      if ($val =~ /\$SERVERROOT/) {
+        $val =~ s/\$SERVERROOT/$serverroot/g;
+        $val = abs_path($val);
+      }
+      $self->param($name, $val);
+    }
+
+    $self->param('conffile', $conffile);
+  }
+
+  # override configured parameter with commandline options
+  map { $self->param($_, $h{$_}) } keys %h;
+  return(1);
+}
+
+
+=head2 parse_extra_options
+
+  Arg[1-N]    : option descriptors that will be passed on to Getopt::Long
+  Example     : $support->parse_extra_options('string_opt=s', 'numeric_opt=n');
+  Description : Parse extra commandline options by passing them on to
+                Getopt::Long and storing parameters in $self->param('name).
+  Return type : true on success
+  Exceptions  : none (caugth by $self->error)
+  Caller      : general
+
+=cut
+
+sub parse_extra_options {
+  my ($self, @params) = @_;
+  
+  Getopt::Long::Configure("no_pass_through");
+  
+  eval {
+    # catch warnings to pass to $self->error
+    local $SIG{__WARN__} = sub { die @_; };
+    &GetOptions(\%{ $self->{'_param'} }, @params);
+  };
+
+  # comma to list
+  foreach my $param (@params) {
+    if ($param =~ /\@$/) {
+      $param =~ s/(^\w+).*/$1/;
+      $self->comma_to_list($param);
+    }
+  }
+  
+  $self->error($@) if $@;
+  
+  return(1);
+}
+
+
+=head2 allowed_params
+
+  Arg[1-N]    : (optional) List of allowed parameters to set
+  Example     : my @allowed = $self->allowed_params(qw(param1 param2));
+  Description : Getter/setter for allowed parameters. This is used by
+                $self->confirm_params() to avoid cluttering of output with
+                conffile entries not relevant for a given script. You can use
+                $self->get_common_params() as a shortcut to set them.
+  Return type : Array - list of allowed parameters
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub allowed_params {
+  my $self = shift;
+
+  # setter
+  if (@_) {
+    @{ $self->{'_allowed_params'} } = @_;
+  }
+
+  # getter
+  if (ref($self->{'_allowed_params'}) eq 'ARRAY') {
+    return @{ $self->{'_allowed_params'} };
+  } else {
+    return ();
+  }
+}
+
+
+=head2 get_common_params
+
+  Example     : my @allowed_params = $self->get_common_params, 'extra_param';
+  Description : Returns a list of commonly used parameters in the conversion
+                scripts. Shortcut for setting allowed parameters with
+                $self->allowed_params().
+  Return type : Array - list of common parameters
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub get_common_params {
+  return qw(
+      conffile
+      logpath
+      logfile
+      logappend
+      is_component
+      verbose
+      interactive
+      dry_run
+  );
+}
+
+
+=head2 confirm_params
+
+  Example     : $support->confirm_params;
+  Description : Prints a table of parameters that were collected from config
+                file and commandline and asks user to confirm if he wants
+                to proceed.
+  Return type : true on success
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub confirm_params {
+  my $self = shift;
+
+  if ($self->param('interactive')) {
+    # print parameter table
+    print "Running script with these parameters:\n\n";
+    print $self->list_all_params;
+
+    # ask user if he wants to proceed
+    exit unless user_proceed("Continue?");
+  }
+  
+  return(1);
+}
+
+
+=head2 list_all_params
+
+  Example     : print LOG $support->list_all_params;
+  Description : prints a table of the parameters used in the script
+  Return type : String - the table to print
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub list_all_params {
+  my $self = shift;
+
+  $Text::Wrap::colums = 72;
+
+  my $txt = sprintf "    %-20s%-40s\n", qw(PARAMETER VALUE);
+  $txt .= "    " . "-"x70 . "\n";
+
+  foreach my $key ($self->allowed_params) {
+    my $val;
+    if (defined($self->param($key))) {
+      $txt .= Text::Wrap::wrap(sprintf('    %-20s', $key), ' 'x24,
+        join(", ", $self->param($key)))."\n";
+    }
+  }
+
+  $txt .= "\n";
+
+  return $txt;
+}
+
+
+=head2 create_commandline_options
+
+  Arg[1]      : Hashref $settings - hashref describing what to do
+                Allowed keys:
+                    allowed_params => 0|1   # use all allowed parameters
+                    exclude => []           # listref of parameters to exclude
+                    replace => {param => newval} # replace value of param with
+                                                 # newval
+  Example     : $support->create_commandline_options({
+                    allowed_params => 1,
+                    exclude => ['verbose'],
+                    replace => { 'dbname' => 'homo_sapiens_vega_33_35e' }
+                });
+  Description : Creates a commandline options string that can be passed to any
+                other script using ConversionSupport.
+  Return type : String - commandline options string
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub create_commandline_options {
+  my $self = shift;
+
+  my ($allowed_params, $exclude, $replace) = rearrange(
+    ['ALLOWED_PARAMS', 'EXCLUDE', 'REPLACE'], @_);
+
+  my %param_hash;
+
+  # get all allowed parameters
+  if ($allowed_params) {
+    # exclude params explicitly stated
+    my %exclude = map { $_ => 1 } @{ $exclude || [] };
+
+    foreach my $param ($self->allowed_params) {
+      unless ($exclude{$param}) {
+        my ($first, @rest) = $self->param($param);
+        next unless (defined($first));
+
+        if (@rest) {
+          $first = join(",", $first, @rest);
+        }
+        $param_hash{$param} = $first;
+      }
+    }
+
+  }
+
+  # replace values
+  foreach my $key (keys %{ $replace || {} }) {
+    $param_hash{$key} = $replace->{$key};
+  }
+
+  # create the commandline options string
+  my $options_string;
+  foreach my $param (keys %param_hash) {
+    $options_string .= sprintf("--%s %s ", $param, $param_hash{$param});
+  }
+
+  return $options_string;
+}
+
+
+=head2 check_required_params
+
+  Arg[1-N]    : List @params - parameters to check
+  Example     : $self->check_required_params(qw(dbname host port));
+  Description : Checks $self->param to make sure the requested parameters
+                have been set. Dies if parameters are missing.
+  Return type : true on success
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub check_required_params {
+  my ($self, @params) = @_;
+  
+  my @missing = ();
+  
+  foreach my $param (@params) {
+    push @missing, $param unless $self->param($param);
+  }
+  
+  if (@missing) {
+    throw("Missing parameters: @missing.\nYou must specify them on the commandline or in your conffile.\n");
+  }
+  
+  return(1);
+}
+
+
+=head2 comma_to_list
+
+  Arg[1-N]    : list of parameter names to parse
+  Example     : $support->comma_to_list('chromosomes');
+  Description : Transparently converts comma-separated lists into arrays (to
+                allow different styles of commandline options, see perldoc
+                Getopt::Long for details). Parameters are converted in place
+                (accessible through $self->param('name')).
+  Return type : true on success
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub comma_to_list {
+  my $self = shift;
+  
+  foreach my $param (@_) {
+    $self->param($param, split (/,/, join (',', $self->param($param))));
+  }
+  
+  return(1);
+}
+
+
+=head2 list_or_file
+
+  Arg[1]      : Name of parameter to parse
+  Example     : $support->list_or_file('gene_stable_id');
+  Description : Determines whether a parameter holds a list or it is a filename
+                to read the list entries from.
+  Return type : true on success
+  Exceptions  : thrown if list file can't be opened
+  Caller      : general
+
+=cut
+
+sub list_or_file {
+  my ($self, $param) = @_;
+  
+  my @vals = $self->param($param);
+  return unless (@vals);
+
+  my $firstval = $vals[0];
+  
+  if (scalar(@vals) == 1 && -e $firstval) {
+    # we didn't get a list of values, but a file to read values from
+    @vals = ();
+    
+    open(IN, $firstval) or throw("Cannot open $firstval for reading: $!");
+    
+    while(<IN>){
+      chomp;
+      push(@vals, $_);
+    }
+    
+    close(IN);
+    
+    $self->param($param, @vals);
+  }
+  
+  $self->comma_to_list($param);
+  
+  return(1);
+}
+
+
+=head2 param
+
+  Arg[1]      : Parameter name
+  Arg[2-N]    : (optional) List of values to set
+  Example     : my $dbname = $support->param('dbname');
+                $support->param('port', 3306);
+                $support->param('chromosomes', 1, 6, 'X');
+  Description : Getter/setter for parameters. Accepts single-value params and
+                list params.
+  Return type : Scalar value for single-value parameters, array of values for
+                list parameters
+  Exceptions  : thrown if no parameter name is supplied
+  Caller      : general
+
+=cut
+
+sub param {
+  my $self = shift;
+  my $name = shift or throw("You must supply a parameter name");
+
+  # setter
+  if (@_) {
+    if (scalar(@_) == 1) {
+      # single value
+      $self->{'_param'}->{$name} = shift;
+    } else {
+      # list of values
+      undef $self->{'_param'}->{$name};
+      @{ $self->{'_param'}->{$name} } = @_;
+    }
+  }
+
+  # getter
+  if (ref($self->{'_param'}->{$name}) eq 'ARRAY') {
+    # list parameter
+    return @{ $self->{'_param'}->{$name} };
+  } elsif (defined($self->{'_param'}->{$name})) {
+    # single-value parameter
+    return $self->{'_param'}->{$name};
+  } else {
+    return undef;
+  }
+}
+
+
+=head2 serverroot
+
+  Arg[1]      : (optional) String - root directory of your ensembl sandbox
+  Example     : my $serverroot = $support->serverroot;
+  Description : Getter/setter for the root directory of your ensembl sandbox.
+                This is set when ConversionSupport object is created, so
+                usually only used as a getter.
+  Return type : String - the server root directory
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub serverroot {
+  my $self = shift;
+  $self->{'_serverroot'} = shift if (@_);
+  return $self->{'_serverroot'};
+}
+
+
+=head2 error
+
+  Arg[1]      : (optional) String - error message
+  Example     : $support->error("An error occurred: $@");
+                exit(0) if $support->error;
+  Description : Getter/setter for error messages
+  Return type : String - error message
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub error {
+    my $self = shift;
+    $self->{'_error'} = shift if (@_);
+    return $self->{'_error'};
+}
+
+
+=head2 
+
+  Arg[1]      : 
+  Example     : 
+  Description : 
+  Return type : 
+  Exceptions  : 
+  Caller      : 
+  Status      :
+
+=cut
+
+sub logger {
+  my $self = shift;
+
+  if (@_) {
+    $self->{'_logger'} = shift;
+
+  } elsif (! $self->{'_logger'}) {
+    # log to STDERR if no logger supplied
+    $self->{'_logger'} = new Bio::EnsEMBL::Utils::Logger(
+      -VERBOSE => $self->param('verbose'),
+    );
+  }
+
+  return $self->{'_logger'};
+}
+
+1;
+

modules/Bio/EnsEMBL/Utils/Logger.pm

+package Bio::EnsEMBL::Utils::Logger;
+
+=head1 NAME
+
+Bio::EnsEMBL::Utils::ConversionSupport - Utility module for Vega release and
+schema conversion scripts
+
+=head1 SYNOPSIS
+
+    my $serverroot = '/path/to/ensembl';
+    my $suport = new Bio::EnsEMBL::Utils::ConversionSupport($serverroot);
+
+    # parse common options
+    $support->parse_common_options;
+
+    # parse extra options for your script
+    $support->parse_extra_options('string_opt=s', 'numeric_opt=n');
+
+    # ask user if he wants to run script with these parameters
+    $support->confirm_params;
+
+    # see individual method documentation for more stuff
+
+=head1 DESCRIPTION
+
+This module is a collection of common methods and provides helper functions 
+for the Vega release and schema conversion scripts. Amongst others, it reads
+options from a config file, parses commandline options and does logging.
+
+=head1 LICENCE
+
+This code is distributed under an Apache style licence:
+Please see http://www.ensembl.org/code_licence.html for details
+
+=head1 AUTHOR
+
+Patrick Meidl <pm2@sanger.ac.uk>
+
+=head1 CONTACT
+
+Post questions to the EnsEMBL development list ensembl-dev@ebi.ac.uk
+
+=cut
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use FindBin qw($Bin $Script);
+use POSIX qw(strftime);
+use Bio::EnsEMBL::Utils::Argument qw(rearrange);
+use Bio::EnsEMBL::Utils::Exception qw(throw warning);
+
+
+=head2 new
+
+  Arg[1]      : String $serverroot - root directory of your ensembl sandbox
+  Example     : my $support = new Bio::EnsEMBL::Utils::ConversionSupport(
+                                        '/path/to/ensembl');
+  Description : constructor
+  Return type : Bio::EnsEMBL::Utils::ConversionSupport object
+  Exceptions  : thrown if no serverroot is provided
+  Caller      : general
+
+=cut
+
+sub new {
+  my $class = shift;
+
+  my ($logfile, $logpath, $logappend, $verbose, $is_component) = rearrange(
+    ['LOGFILE', 'LOGPATH', 'LOGAPPEND', 'VERBOSE', 'IS_COMPONENT'], @_);
+  
+  my $self = { '_warnings'     => 0, };
+  bless ($self, $class);
+
+  # initialise
+  $self->logfile($logfile);
+  $self->logpath($logpath);
+  $self->logappend($logappend);
+  $self->verbose($verbose);
+  $self->is_component($is_component);
+  
+  return $self;
+}
+
+
+=head2 log
+
+  Arg[1]      : String $txt - the text to log
+  Arg[2]      : Int $indent - indentation level for log message
+  Example     : my $log = $support->log_filehandle;
+                $support->log('Log foo.\n', 1);
+  Description : Logs a message to the filehandle initialised by calling
+                $self->log_filehandle(). You can supply an indentation level
+                to get nice hierarchical log messages.
+  Return type : true on success
+  Exceptions  : thrown when no filehandle can be obtained
+  Caller      : general
+
+=cut
+
+sub log {
+  my ($self, $txt, $indent) = @_;
+
+  $indent ||= 0;
+  my $fh = $self->log_filehandle;
+  
+  # strip off leading linebreaks so that indenting doesn't break
+  $txt =~ s/^(\n*)//;
+  
+  # indent
+  $txt = $1."  "x$indent . $txt;
+  
+  print $fh "$txt";
+  
+  return(1);
+}
+
+
+=head2 log_warning
+
+  Arg[1]      : String $txt - the warning text to log
+  Arg[2]      : Int $indent - indentation level for log message
+  Example     : my $log = $support->log_filehandle;
+                $support->log_warning('Log foo.\n', 1);
+  Description : Logs a message via $self->log and increases the warning counter.
+  Return type : true on success
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub log_warning {
+  my ($self, $txt, $indent) = @_;
+  
+  $txt = "WARNING: " . $txt;
+  $self->log($txt, $indent);
+  
+  $self->{'_warnings'}++;
+  
+  return(1);
+}
+
+
+=head2 log_error
+
+  Arg[1]      : String $txt - the error text to log
+  Arg[2]      : Int $indent - indentation level for log message
+  Example     : my $log = $support->log_filehandle;
+                $support->log_error('Log foo.\n', 1);
+  Description : Logs a message via $self->log and exits the script.
+  Return type : none
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub log_error {
+  my ($self, $txt, $indent) = @_;
+  
+  $txt = "ERROR: ".$txt;
+  $self->log($txt, $indent);
+  
+  $self->log("Exiting prematurely.\n\n");
+  $self->log("Runtime: ".$self->runtime." ".$self->date_and_mem."\n\n");
+  
+  exit;
+}
+
+
+=head2 log_verbose
+
+  Arg[1]      : String $txt - the warning text to log
+  Arg[2]      : Int $indent - indentation level for log message
+  Example     : my $log = $support->log_filehandle;
+                $support->log_verbose('Log this verbose message.\n', 1);
+  Description : Logs a message via $self->log if --verbose option was used
+  Return type : TRUE on success, FALSE if not verbose
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub log_verbose {
+  my ($self, $txt, $indent) = @_;
+
+  return(0) unless $self->verbose;
+
+  $self->log($txt, $indent);
+  return(1);
+}
+
+
+=head2 log_stamped
+
+  Arg[1]      : String $txt - the warning text to log
+  Arg[2]      : Int $indent - indentation level for log message
+  Example     : my $log = $support->log_filehandle;
+                $support->log_stamped('Log this stamped message.\n', 1);
+  Description : Appends timestamp and memory usage to a message and logs it via
+                $self->log
+  Return type : TRUE on success
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub log_stamped {
+  my ($self, $txt, $indent) = @_;
+  
+  # append timestamp and memory usage to log text
+  $txt =~ s/(\n*)$//;
+  $txt .= " ".$self->date_and_mem.$1;
+  
+  $self->log($txt, $indent);
+  return(1);
+}
+
+
+sub log_progress {
+  my $self = shift;
+  my $max = shift;
+  my $curr = shift;
+  my $incr = shift || 20;
+  my $indent = shift;
+  my $show_mem = shift;
+
+  throw("You must provide a maximum and current value to log progress.")
+    unless ($max and $curr);
+
+  if (($curr % $incr) == 0 or $curr < 20 or $curr == $max) {
+    my $mem;
+    $mem = ", mem ".$self->mem if ($show_mem);
+    my $log_str = "\r".('  'x$indent)."$curr/$max (".int($curr/$max*100)."\%$mem)";
+    $log_str .= "\n" if ($curr == $max);
+    
+    $self->log($log_str);
+  }
+
+}
+
+
+sub log_progressbar {
+  my $self = shift;
+  my $name = shift;
+  my $curr = shift;
+  my $indent = shift;
+  
+  throw("You must provide a name and the current value for your progress bar")
+    unless ($name and $curr);
+
+  # return if we haven't reached the next increment
+  return if ($curr < int($self->{'_progress'}->{$name}->{'next'}));
+
+  my $index = $self->{'_progress'}->{$name}->{'index'};
+  my $percent = $index*5;
+
+  my $log_str = "\r".('  'x$indent)."[".('='x$index).(' 'x(20-$index))."] ${percent}\%";
+  $log_str .= "\n" if ($curr == $self->{'_progress'}->{$name}->{'max_val'});
+
+  $self->log($log_str);
+
+  # increment counters
+  $self->{'_progress'}->{$name}->{'index'}++;
+  $self->{'_progress'}->{$name}->{'next'} +=
+    $self->{'_progress'}->{$name}->{'binsize'};
+}
+
+
+sub init_progressbar {
+  my $self = shift;
+  my $name = shift;
+  my $max = shift;
+
+  throw("You must provide a name and the maximum value for your progress bar")
+    unless ($name and $max);
+
+  # calculate bin size; we will use 20 bins (5% increments)
+  my $binsize = $max/20;
+
+  $self->{'_progress'}->{$name}->{'max_val'} = $max;
+  $self->{'_progress'}->{$name}->{'binsize'} = $binsize;
+  $self->{'_progress'}->{$name}->{'next'} = 0;
+  $self->{'_progress'}->{$name}->{'index'} = 0;
+}
+
+
+=head2 log_filehandle
+
+  Arg[1]      : (optional) String $mode - file access mode
+  Example     : my $log = $support->log_filehandle;
+                # print to the filehandle
+                print $log 'Lets start logging...\n';
+                # log via the wrapper $self->log()
+                $support->log('Another log message.\n');
+  Description : Returns a filehandle for logging (STDERR by default, logfile if
+                set from config or commandline). You can use the filehandle
+                directly to print to, or use the smart wrapper $self->log().
+                Logging mode (truncate or append) can be set by passing the
+                mode as an argument to log_filehandle(), or with the
+                --logappend commandline option (default: truncate)
+  Return type : Filehandle - the filehandle to log to
+  Exceptions  : thrown if logfile can't be opened
+  Caller      : general
+
+=cut
+
+sub log_filehandle {
+  my ($self, $mode) = @_;
+  
+  unless ($self->{'_log_filehandle'}) {
+    $mode ||= '>';
+    $mode = '>>' if ($self->logappend);
+    
+    my $fh = \*STDERR;
+    
+    if (my $logfile = $self->logfile) {
+      if (my $logpath = $self->logpath) {
+        unless (-e $logpath) {
+          system("mkdir $logpath") == 0 or
+            throw("Can't create log dir $logpath: $!\n");
+        }
+        
+        $logfile = "$logpath/".$self->logfile;
+      }
+      
+      open($fh, "$mode", $logfile) or
+        throw("Unable to open $logfile for writing: $!");
+    }
+
+    $self->{'_log_filehandle'} = $fh;
+  }
+
+  return $self->{'_log_filehandle'};
+}
+
+
+=head2 
+
+  Arg[1]      : 
+  Example     : 
+  Description : 
+  Return type : 
+  Exceptions  : 
+  Caller      : 
+  Status      :
+
+=cut
+
+sub extract_log_identifier {
+  my $self = shift;
+
+  if (my $logfile = $self->logfile) {
+    $logfile =~ /.+\.([^\.]+)\.log/;
+    return $1;
+  } else {
+    return undef;
+  }
+}
+
+
+=head2 init_log
+
+  Example     : $support->init_log;
+  Description : Opens a filehandle to the logfile and prints some header
+                information to this file. This includes script name, date, user
+                running the script and parameters the script will be running
+                with.
+  Return type : Filehandle - the log filehandle
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub init_log {
+  my $self = shift;
+  my $params = shift;
+
+  # get a log filehandle
+  my $log = $self->log_filehandle;
+
+  # remember start time
+  $self->{'_start_time'} = time;
+
+  # don't log parameters if this script is run by another one
+  unless ($self->is_component) {
+    # print script name, date, user who is running it
+    my $hostname = `hostname`;
+    chomp $hostname;
+    my $script = "$hostname:$Bin/$Script";
+    my $user = `whoami`;
+    chomp $user;
+    $self->log("Script: $script\nDate: ".$self->date."\nUser: $user\n");
+
+    # print parameters the script is running with
+    if ($params) {
+      $self->log("Parameters:\n\n");
+      $self->log($params);
+    }
+  }
+
+  return $log;
+}
+
+
+=head2 finish_log
+
+  Example     : $support->finish_log;
+  Description : Writes footer information to a logfile. This includes the
+                number of logged warnings, timestamp and memory footprint.
+  Return type : TRUE on success
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub finish_log {
+  my $self = shift;
+  
+  $self->log("\nAll done for $Script.\n");
+  $self->log($self->warnings." warnings. ");
+  $self->log("Runtime: ".$self->runtime." ".$self->date_and_mem."\n\n");
+  
+  return(1);
+}
+
+
+sub runtime {
+  my $self = shift;
+
+  my $runtime = "n/a";
+
+  if ($self->{'_start_time'}) {
+    my $diff = time - $self->{'_start_time'};
+    my $sec = $diff % 60;
+    $diff = ($diff - $sec) / 60;
+    my $min = $diff % 60;
+    my $hours = ($diff - $min) / 60;
+    
+    $runtime = "${hours}h ${min}min ${sec}sec";
+  }
+
+  return $runtime;
+}
+
+
+=head2 date_and_mem
+
+  Example     : print LOG "Time, memory usage: ".$support->date_and_mem."\n";
+  Description : Prints a timestamp and the memory usage of your script.
+  Return type : String - timestamp and memory usage
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub date_and_mem {
+  my $date = strftime "%Y-%m-%d %T", localtime;
+  my $mem = `ps -p $$ -o vsz |tail -1`;
+  chomp $mem;
+  return "[$date, mem $mem]";
+}
+
+
+=head2 date
+
+  Example     : print "Date: " . $support->date . "\n";
+  Description : Prints a nicely formatted timestamp (YYYY-DD-MM hh:mm:ss)
+  Return type : String - the timestamp
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub date {
+  return strftime "%Y-%m-%d %T", localtime;
+}
+
+
+=head2 mem
+
+  Example     : print "Memory usage: " . $support->mem . "\n";
+  Description : Prints the memory used by your script. Not sure about platform
+                dependence of this call ...
+  Return type : String - memory usage
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub mem {
+  my $mem = `ps -p $$ -o vsz |tail -1`;
+  chomp $mem;
+  return $mem;
+}
+
+
+=head2 warnings
+
+  Example     : print LOG "There were ".$support->warnings." warnings.\n";
+  Description : Returns the number of warnings encountered while running the
+                script (the warning counter is increased by $self->log_warning).
+  Return type : Int - number of warnings
+  Exceptions  : none
+  Caller      : general
+
+=cut
+
+sub warnings {
+  my $self = shift;
+  return $self->{'_warnings'};
+}
+
+
+=head2 
+
+  Arg[1]      : 
+  Example     : 
+  Description : 
+  Return type : 
+  Exceptions  : 
+  Caller      : 
+  Status      :
+
+=cut
+
+sub logfile {
+  my $self = shift;
+  $self->{'_logfile'} = shift if (@_);
+  return $self->{'_logfile'};
+}
+
+
+=head2 
+
+  Arg[1]      : 
+  Example     : 
+  Description : 
+  Return type : 
+  Exceptions  : 
+  Caller      : 
+  Status      :
+
+=cut
+
+sub logpath {
+  my $self = shift;
+  $self->{'_logpath'} = shift if (@_);
+  return $self->{'_logpath'};
+}
+
+
+=head2 
+
+  Arg[1]      : 
+  Example     : 
+  Description : 
+  Return type : 
+  Exceptions  : 
+  Caller      : 
+  Status      :
+
+=cut
+
+sub logappend {
+  my $self = shift;
+  $self->{'_logappend'} = shift if (@_);
+  return $self->{'_logappend'};
+}
+
+
+=head2 
+
+  Arg[1]      : 
+  Example     : 
+  Description : 
+  Return type : 
+  Exceptions  : 
+  Caller      : 
+  Status      :
+
+=cut
+
+sub verbose {
+  my $self = shift;
+  $self->{'_verbose'} = shift if (@_);
+  return $self->{'_verbose'};
+}
+
+
+=head2 
+
+  Arg[1]      : 
+  Example     : 
+  Description : 
+  Return type : 
+  Exceptions  : 
+  Caller      : 
+  Status      :
+
+=cut
+
+sub is_component {
+  my $self = shift;
+  $self->{'_is_component'} = shift if (@_);
+  return $self->{'_is_component'};
+}
+
+
+1;
+

modules/Bio/EnsEMBL/Utils/ScriptUtils.pm

+package Bio::EnsEMBL::Utils::ScriptUtils;
+
+=head1 NAME
+
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+
+=head1 METHODS
+
+
+=head1 LICENCE
+
+This code is distributed under an Apache style licence. Please see
+http://www.ensembl.org/info/about/code_licence.html for details.
+
+=head1 AUTHOR
+
+Patrick Meidl <meidl@ebi.ac.uk>, Ensembl core API team
+
+=head1 CONTACT
+
+Please post comments/questions to the Ensembl development list
+<ensembl-dev@ebi.ac.uk>
+
+=cut
+
+use strict;
+use warnings;
+no warnings 'uninitialized';
+
+use Exporter;
+our @ISA = qw(Exporter);
+
+our @EXPORT_OK = qw(
+  user_proceed
+  commify
+  sort_chromosomes
+  parse_bytes
+);
+
+
+=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 = shift;
+
+  print "$text\n" if $text;
+  print "[y/N] ";
+  
+  my $input = lc(<>);
+  chomp $input;
+  
+  if ($input eq 'y') {
+    return(1);
+  } else {
+    print "Skipping.\n";
+    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('%.0f', $bytes/10**(3*$order));
+
+  return "$parsed ".$suffixes[$order];
+}
+
+1;