diff --git a/modules/Bio/EnsEMBL/Utils/ConversionSupport.pm b/modules/Bio/EnsEMBL/Utils/ConversionSupport.pm
index 98d729c9b2543c7731ed44026fc92124119ce6c3..820d1d0e4b2ad073042df516e17215a3fa6f648a 100644
--- a/modules/Bio/EnsEMBL/Utils/ConversionSupport.pm
+++ b/modules/Bio/EnsEMBL/Utils/ConversionSupport.pm
@@ -53,6 +53,7 @@ use FindBin qw($Bin $Script);
use POSIX qw(strftime);
use Cwd qw(abs_path);
use DBI;
+use Data::Dumper;
=head2 new
@@ -115,6 +116,7 @@ sub parse_common_options {
'help|h|?',
);
+
# reads config file
my $conffile = $h{'conffile'} || $self->serverroot . "/sanger-plugins/vega/conf/ini-files/Conversion.ini";
$conffile = abs_path($conffile);
@@ -129,8 +131,8 @@ sub parse_common_options {
s/^[#;].*//;
s/\s+[;].*$//;
- # read options into internal parameter datastructure
- next unless (/(\w\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/) {
@@ -143,6 +145,7 @@ sub parse_common_options {
} elsif ($conffile) {
warning("Unable to open configuration file $conffile for reading: $!");
}
+
# override configured parameter with commandline options
map { $self->param($_, $h{$_}) } keys %h;
@@ -232,6 +235,27 @@ sub get_common_params {
);
}
+=head2 get_lutre_params
+
+ Example : my @allowed_params = $self->get_lutre_params, 'extra_param';
+ Description : Returns a list of commonly used parameters in for working with a loutre db
+ Return type : Array - list of common parameters
+ Exceptions : none
+ Caller : general
+
+=cut
+
+sub get_loutre_params {
+ return qw(
+ loutrehost
+ loutreport
+ loutreuser
+ loutrepass
+ loutredbname
+ );
+}
+
+
=head2 confirm_params
Example : $support->confirm_params;
@@ -634,6 +658,7 @@ sub get_database {
otter => 'Bio::Otter::DBSQL::DBAdaptor',
vega => 'Bio::Otter::DBSQL::DBAdaptor',
compara => 'Bio::EnsEMBL::DBSQL::DBAdaptor',
+ loutre => 'Bio::Vega::DBSQL::DBAdaptor',
);
throw("Unknown database: $database") unless $adaptors{$database};
@@ -675,7 +700,7 @@ sub get_database {
sub get_dbconnection {
my $self = shift;
my $prefix = shift;
-
+
$self->check_required_params(
"${prefix}host",
"${prefix}port",
@@ -691,7 +716,6 @@ sub get_dbconnection {
}
my $dbh;
-
eval{
$dbh = DBI->connect($dsn, $self->param("${prefix}user"),
$self->param("${prefix}pass"), {'RaiseError' => 1, 'PrintError' => 0});
@@ -704,7 +728,6 @@ sub get_dbconnection {
}
$self->{'_dbh'} = $dbh;
-
return $self->{'_dbh'};
}
@@ -813,6 +836,8 @@ sub dynamic_use {
Arg[1] : (optional) Bio::EnsEMBL::DBSQL::DBAdaptor $dba
Arg[2] : (optional) String $version - coord_system version
+ Arg[3] : (optional) String $type - type of region eg chromsome (defaults to 'toplevel')
+ Arg[4] : (optional) Boolean - return non reference slies as well (required for haplotypes eq 6-COX)
Example : my $chr_length = $support->get_chrlength($dba);
Description : Get all chromosomes and their length from the database. Return
chr_name/length for the chromosomes the user requested (or all
@@ -824,15 +849,17 @@ sub dynamic_use {
=cut
sub get_chrlength {
- my ($self, $dba, $version) = @_;
+ my ($self, $dba, $version,$type,$include_non_reference) = @_;
$dba ||= $self->dba;
+ $type ||= 'toplevel';
throw("get_chrlength should be passed a Bio::EnsEMBL::DBSQL::DBAdaptor\n")
unless ($dba->isa('Bio::EnsEMBL::DBSQL::DBAdaptor'));
my $sa = $dba->get_SliceAdaptor;
+
my @chromosomes = map { $_->seq_region_name }
- @{ $sa->fetch_all('chromosome', $version) };
- my %chr = map { $_ => $sa->fetch_by_region('chromosome', $_, undef, undef, undef, $version)->length } @chromosomes;
+ @{ $sa->fetch_all($type, $version,$include_non_reference) };
+ my %chr = map { $_ => $sa->fetch_by_region($type, $_, undef, undef, undef, $version)->length } @chromosomes;
my @wanted = $self->param('chromosomes');
if (@wanted) {
@@ -1149,7 +1176,7 @@ sub log {
sub log_warning {
my ($self, $txt, $indent) = @_;
- $txt = "WARNING: " . $txt;
+ $txt = "\nWARNING: " . $txt;
$self->log($txt, $indent);
$self->{'_warnings'}++;
return(1);
@@ -1428,4 +1455,257 @@ sub commify {
return scalar reverse $num;
}
+=head2 fetch_non_hidden_slices
+
+ Arg[1] : B::E::SliceAdaptor
+ Arg[2] : B::E::AttributeAdaptor
+ Arg[3] : string $coord_system_name (optional) - 'chromosome' by default
+ Arg[4] : string $coord_system_version (optional) - 'otter' by default
+ Example : $chroms = $support->fetch_non_hidden_slice($sa);
+ Description : retrieve all slices from a lutra database that don't have a hidden attribute
+ Return type : arrayref
+ Caller : general
+ Status : stable
+
+=cut
+
+sub fetch_non_hidden_slices {
+ my $self = shift;
+ my $aa = shift or throw("You must supply an attribute adaptor");
+ my $sa = shift or throw("You must supply a slice adaptor");
+ my $cs = shift || 'chromosome';
+ my $cv = shift || 'Otter';
+ my $visible_chroms;
+ foreach my $chrom ( @{$sa->fetch_all($cs,$cv)} ) {
+ my $attribs = $aa->fetch_all_by_Slice($chrom);
+ push @$visible_chroms, $chrom if @{$self->get_attrib_values($attribs,'hidden',0)};
+ }
+ return $visible_chroms;
+}
+
+
+=head2 get_attrib_values
+
+ Arg[1] : Arrayref of B::E::Attributes
+ Arg[2] : 'code' to search for
+ Arg[3] : 'value' to search for (optional)
+ Example : my $c = $self->get_attrib_values($attribs,'name'));
+ Description : (i) In the abscence of an attribute value argument examines an arrayref
+ of B::E::Attributes for a particular attribute type, returning the values
+ for each attribute of that type (can therefore be used to test for the
+ number of attributes of that type).
+ (ii) In the presence of the optional value argument, it can be used to test
+ for the presence of an attribute with a particular value
+ Return type : arrayref of values for that attribute
+ Caller : general
+ Status : stable
+
+=cut
+
+sub get_attrib_values {
+ my $self = shift;
+ my $attribs = shift;
+ my $code = shift;
+ my $value = shift;
+ if (my @atts = grep {$_->code eq $code } @$attribs) {
+ my $r;
+ if ($value) {
+ if (my @values = grep {$_->value eq $value} @atts) {
+ foreach (@values) {
+ push @$r, $_->value;
+ }
+ return $r;
+ }
+ else {
+ return [];
+ }
+ }
+ else {
+ foreach (@atts) {
+ push @$r, $_->value;
+ }
+ return $r;
+ }
+ }
+ else {
+ return [];
+ }
+}
+
+=head2 fix_attrib_value
+
+ Arg[1] : Arrayref of exisiting B::E::Attributes
+ Arg[2] : dbID of object
+ Arg[3] : name of object (just for reporting)
+ Arg[4] : attrib_type.code
+ Arg[5] : attrib_type.value
+ Arg[5] : interactive ? (0 by default)
+ Arg[6] : table
+ Example : $support->fix_attrib_value($attribs,$chr_id,$chr_name,'vega_export_mod','N',1);
+ Description : adds a new attribute to an object, or updates an existing attribute with a new value
+ Can be run in interactive or non-interactive mode (default)
+ Return type : none
+ Caller : general
+ Status : only ever tested with seq_region_attributes to date
+
+=cut
+
+sub fix_attrib_value {
+ my $self = shift;
+ my $attribs = shift;
+ my $id = shift;
+ my $name = shift;
+ my $code = shift;
+ my $value = shift;
+ my $interact = shift || 0;
+ my $table = shift || 'seq_region_attrib';
+
+ #set interactive parameter
+ my $int_before;
+ if (! $interact) {
+ $int_before = $self->param('interactive');
+ $self->param('interactive',0);
+ }
+
+# warn "interactive_before = $int_before";
+ #get any existing value(s) for this attribute
+ my $existings = $self->get_attrib_values($attribs,$code);
+
+ #add a new attribute if there is none...
+ if (! @$existings ) {
+ if ($self->user_proceed("Do you want to set $name attrib (code = $code) to value $value ?")) {
+ my $r = $self->store_new_attribute($id,$code,$value);
+
+ #reset interactive parameter
+ $self->param('interactive',$int_before) if (! $interact);
+ return $r;
+ }
+ }
+ #...warn and exit if you're trying to update more than one value for the same attribute...
+ elsif (scalar @$existings > 1) {
+ $self->log_warning("You shouldn't be trying to update multiple attributes with the same code at once ($name:$code,$value), looks like you have duplicate entries in the (seq_region_)attrib table\n");
+ exit;
+ }
+
+ else {
+ my $existing = $existings->[0];
+ #...or update an attribute with new values...
+ if ($existing ne $value) {
+ if ($self->user_proceed("Do you want to reset $name attrib (code = $code) from $existing to $value ?")) {
+ my $r = $self->update_attribute($id,$code,$value);
+ $self->param('interactive',$int_before) if (! $interact);
+ push @$r, $existing;
+ return $r;
+ }
+ }
+ #...or make no change
+ else {
+ $self->param('interactive',$int_before) if (! $interact);
+ return [];
+ }
+ }
+}
+
+=head2 _get_attrib_id
+
+ Arg[1] : attrib_type.code
+ Arg[2] : database handle
+ Example : $self->_get_attrib_id('name',$dbh)
+ Description : get attrib_type.attrib_type_id from a attrib_type.code
+ Return type : attrib_type.attrib_type_id
+ Caller : internal
+ Status : stable
+
+=cut
+
+sub _get_attrib_id {
+ my $self = shift;
+ my $attrib_code = shift;
+ my $dbh = shift;
+ my ($attrib_id) = $dbh->selectrow_array(
+ qq(select attrib_type_id
+ from attrib_type
+ where code = ?),
+ {},
+ ($attrib_code)
+ );
+ if (! $attrib_id) {
+ $self->log_warning("There is no attrib_type_id for code $attrib_code, please patch the attrib_table\n");
+ exit;
+ }
+ else {
+ return $attrib_id;
+ }
+}
+
+=head2 store_new_attribute
+
+ Arg[1] : seq_region.seq_region_id
+ Arg[2] : attrib_type.code
+ Arg[3] : attrib_type.value
+ ARG[4] : table to update (seq_region_attribute by default)
+ Example : $support->store_new_attribute(23,name,5);
+ Description : uses MySQL to store an entry (code and value) in an attribute table
+ (seq_region_attrib by default)
+ Return type : array_ref
+ Caller : general
+ Status : stable
+
+=cut
+
+sub store_new_attribute {
+ my $self = shift;
+ my $sr_id = shift;
+ my $attrib_code = shift;
+ my $attrib_value = shift;
+ my $table = shift || 'seq_region_attrib';
+
+ #get database handle
+ my $dbh = $self->get_dbconnection('loutre');
+ #get attrib_type_id for this particular attribute
+ my $attrib_id = $self->_get_attrib_id($attrib_code,$dbh);
+ #store
+ my $r = $dbh->do(
+ qq(insert into $table
+ values (?,?,?)),
+ {},
+ ($sr_id,$attrib_id,$attrib_value)
+ );
+ return ['Stored',$r];
+}
+
+=head2 update_attribute
+
+ Arg[1] : seq_region.seq_region_id
+ Arg[2] : attrib_type.code
+ Arg[3] : attrib_type.value
+ ARG[4] : table to update (seq_region_attribute by default)
+ Example : $support->update_attribute(23,name,5);
+ Description : uses MySQL to update an attribute table (seq_region_attrib by default)
+ Return type : array_ref
+ Caller : general
+ Status : stable
+
+=cut
+
+sub update_attribute {
+ my $self = shift;
+ my $sr_id = shift;
+ my $attrib_code = shift;
+ my $attrib_value = shift;
+ my $table = shift || 'seq_region_attrib';
+ my $dbh = $self->get_dbconnection('loutre');
+ my $attrib_id = $self->_get_attrib_id($attrib_code,$dbh);
+ #update
+ my $r = $dbh->do(
+ qq(update $table
+ set value = ?
+ where seq_region_id = $sr_id
+ and attrib_type_id = $attrib_id),
+ {},
+ ($attrib_value)
+ );
+ return ['Updated',$r];
+}
+
1;