Skip to content
Snippets Groups Projects
ConversionSupport.pm 52.8 KiB
Newer Older
  Copyright (c) 1999-2011 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
  Please email comments or questions to the public Ensembl
  Questions may also be sent to the Ensembl help desk at
  <helpdesk@ensembl.org>.
Bio::EnsEMBL::Utils::ConversionSupport - Utility module for Vega release and
schema conversion scripts
  my $serverroot = '/path/to/ensembl';
  my $support = 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 METHODS
package Bio::EnsEMBL::Utils::ConversionSupport;

use strict;
use warnings;
no warnings 'uninitialized';

use Getopt::Long;
use Text::Wrap;
use Bio::EnsEMBL::Utils::Exception qw(throw warning);
use FindBin qw($Bin $Script);
use POSIX qw(strftime);
use Cwd qw(abs_path);
Patrick Meidl's avatar
Patrick Meidl committed
use DBI;
Web Admin's avatar
Web Admin committed
use Data::Dumper;

=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 {
Steve Trevanion's avatar
Steve Trevanion committed
  my $class = shift;
  (my $serverroot = shift) or throw("You must supply a serverroot.");
  my $self = {
    '_serverroot'   => $serverroot,
    '_param'        => { interactive => 1 },
    '_warnings'     => 0,
  };
  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 {
Steve Trevanion's avatar
Steve Trevanion committed
  my $self = shift;

  # read commandline options
  my %h;
  Getopt::Long::Configure("pass_through");
  &GetOptions( \%h,
	       'dbname|db_name=s',
	       'host|dbhost|db_host=s',
	       'port|dbport|db_port=n',
	       'user|dbuser|db_user=s',
	       'pass|dbpass|db_pass=s',
	       'conffile|conf=s',
	       'logfile|log=s',
Maurice Hendrix's avatar
Maurice Hendrix committed
         'nolog|nolog=s',
Steve Trevanion's avatar
Steve Trevanion committed
	       'logpath=s',
	       'logappend|log_append=s',
	       'verbose|v=s',
	       'interactive|i=s',
	       'dry_run|dry|n=s',
	       'help|h|?',
	     );

  # reads config file
  my $conffile = $h{'conffile'} || $self->serverroot . "/sanger-plugins/vega/conf/ini-files/Conversion.ini";
  $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, removing whitespace
      next unless (/(\w\S*)\s*=\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);
Steve Trevanion's avatar
Steve Trevanion committed
    $self->param('conffile', $conffile);
  } elsif ($conffile) {
    warning("Unable to open configuration file $conffile for reading: $!");
  }

# override configured parameter with commandline options
Steve Trevanion's avatar
Steve Trevanion committed
  map { $self->param($_, $h{$_}) } keys %h;

  # if logpath & logfile are not se, set them here to /ensemblweb/vega_dev/shared/logs/conversion/DBNAME/SCRIPNAME_NN.log
  if (not (defined($self->param('logpath')))){
    $self->param('logpath', "/ensemblweb/vega_dev/shared/logs/conversion/".$self->param('dbname')."/" );
  }
Maurice Hendrix's avatar
Maurice Hendrix committed
  if (  (not defined $self->param('logfile') ) && (not defined $self->param('nolog') )  ){
    my $log = $Script;
    $log =~ s/.pl//g;
    my $counter;
    for ($counter=1 ; (-e $self->param('logpath')."/".$log."_".sprintf("%03d", $counter).".log"); $counter++){ warn  $self->param('logpath')."/".$log."_".$counter.".log";}

    $self->param('logfile', $log."_".sprintf("%03d", $counter).".log");
  }
  
Steve Trevanion's avatar
Steve Trevanion committed
  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 {
Steve Trevanion's avatar
Steve Trevanion committed
  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);
  };
  $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 {
Steve Trevanion's avatar
Steve Trevanion committed
  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 {
Steve Trevanion's avatar
Steve Trevanion committed
  return qw(
	    conffile
	    dbname
	    host
	    port
	    user
	    pass
Maurice Hendrix's avatar
Maurice Hendrix committed
      nolog
Steve Trevanion's avatar
Steve Trevanion committed
	    logpath
	    logfile
	    logappend
	    verbose
	    interactive
	    dry_run
	  );
Steve Trevanion's avatar
Steve Trevanion committed
=head2 get_loutre_params
Web Admin's avatar
Web Admin committed

Steve Trevanion's avatar
Steve Trevanion committed
  Arg         : (optional) return a list to parse or not
  Example     : $support->parse_extra_options($support->get_loutre_params('parse'))
  Description : Returns a list of commonly used loutre db parameters - parse option is
                simply used to distinguish between reporting and parsing parameters
Web Admin's avatar
Web Admin committed
  Return type : Array - list of common parameters
  Exceptions  : none
  Caller      : general

=cut

sub get_loutre_params {
Steve Trevanion's avatar
Steve Trevanion committed
  my ($self,$p) = @_;
  if ($p) {
    return qw(
	      loutrehost=s
	      loutreport=s
	      loutreuser=s
	      loutrepass=s
	      loutredbname=s
	    );
  }
  else {
    return qw(
	      loutrehost
	      loutreport
	      loutreuser
	      loutrepass
	      loutredbname
	    );
  }
Steve Trevanion's avatar
Steve Trevanion committed
=head2 remove_vega_params

  Example     : $support->remove_vega_params;
  Description : Removes Vega db conection parameters. Usefull to avoid clutter in log files when
                working exclusively with loutre
  Return type : none
  Exceptions  : none
  Caller      : general

=cut

sub remove_vega_params {
Steve Trevanion's avatar
Steve Trevanion committed
  my $self = shift;
  foreach my $param (qw(dbname host port user pass)) {
    $self->{'_param'}{$param} = undef;
  }
Web Admin's avatar
Web Admin committed

=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 {
Steve Trevanion's avatar
Steve Trevanion committed
  my $self = shift;

  # print parameter table
  print "Running script with these parameters:\n\n";
  print $self->list_all_params;

Steve Trevanion's avatar
Steve Trevanion committed
  if ($self->param('host') eq 'ensdb-1-10') {
Steve Trevanion's avatar
Steve Trevanion committed
    # ask user if he wants to proceed
Steve Trevanion's avatar
Steve Trevanion committed
    exit unless $self->user_proceed("**************\n\n You're working on ensdb-1-10! Is that correct and you want to continue ?\n\n**************");
Steve Trevanion's avatar
Steve Trevanion committed
  }
  else {
    # ask user if he wants to proceed
    exit unless $self->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 {
Steve Trevanion's avatar
Steve Trevanion committed
  my $self = shift;
  my $txt = sprintf "    %-21s%-40s\n", qw(PARAMETER VALUE);
  $txt .= "    " . "-"x71 . "\n";
  $Text::Wrap::colums = 72;
  my @params = $self->allowed_params;
  foreach my $key (@params) {
    my @vals = $self->param($key);
    if (@vals) {
      $txt .= Text::Wrap::wrap( sprintf('   %-21s', $key),
				' 'x24,
				join(", ", @vals)
			      ) . "\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, $settings) = @_;
  my %param_hash;

  # get all allowed parameters
  if ($settings->{'allowed_params'}) {
    # exclude params explicitly stated
    my %exclude = map { $_ => 1 } @{ $settings->{'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 %{ $settings->{'replace'} || {} }) {
    $param_hash{$key} = $settings->{'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 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.
sub user_proceed {
  my ($self, $text) = @_;

  if ($self->param('interactive')) {
    print "$text\n" if $text;
    print "[y/N] ";
    my $input = lc(<>);
    chomp $input;
    unless ($input eq 'y') {
      print "Skipping.\n";
      return(0);
=head2 user_confirm

  Description : DEPRECATED - please use user_proceed() instead

=cut

sub user_confirm {
  my $self = shift;
  exit unless $self->user_proceed("Continue?");
Loading full blame...