From 8f5a9b673980baa6d8c6344cccdb6345c13473ce Mon Sep 17 00:00:00 2001
From: Steve Trevanion <st3@sanger.ac.uk>
Date: Mon, 20 Apr 2009 13:42:16 +0000
Subject: [PATCH] merge from 49-dev
---
.../Bio/EnsEMBL/Utils/ConversionSupport.pm | 317 +++++++++++-------
1 file changed, 199 insertions(+), 118 deletions(-)
diff --git a/modules/Bio/EnsEMBL/Utils/ConversionSupport.pm b/modules/Bio/EnsEMBL/Utils/ConversionSupport.pm
index 8a95b35361..491b848abe 100644
--- a/modules/Bio/EnsEMBL/Utils/ConversionSupport.pm
+++ b/modules/Bio/EnsEMBL/Utils/ConversionSupport.pm
@@ -245,8 +245,10 @@ sub get_common_params {
=head2 get_loutre_params
- Example : my @allowed_params = $self->get_loutre_params, 'extra_param';
- Description : Returns a list of commonly used parameters in for working with a loutre db
+ 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
Return type : Array - list of common parameters
Exceptions : none
Caller : general
@@ -254,13 +256,25 @@ sub get_common_params {
=cut
sub get_loutre_params {
- return qw(
- loutrehost
- loutreport
- loutreuser
- loutrepass
- loutredbname
- );
+ 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
+ );
+ }
}
=head2 remove_vega_params
@@ -300,9 +314,9 @@ sub confirm_params {
print "Running script with these parameters:\n\n";
print $self->list_all_params;
- if ($self->param('host') eq 'web-4-11') {
+ if ($self->param('host') eq 'ensdb-1-10') {
# ask user if he wants to proceed
- exit unless $self->user_proceed("**************\n\n You're working on web-4-11! Is that correct and you want to continue ?\n\n**************");
+ exit unless $self->user_proceed("**************\n\n You're working on ensdb-1-10! Is that correct and you want to continue ?\n\n**************");
}
else {
# ask user if he wants to proceed
@@ -369,7 +383,6 @@ sub create_commandline_options {
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);
@@ -394,7 +407,6 @@ sub create_commandline_options {
foreach my $param (keys %param_hash) {
$options_string .= sprintf("--%s %s ", $param, $param_hash{$param});
}
-
return $options_string;
}
@@ -696,8 +708,17 @@ sub get_database {
-dbname => $self->param("${prefix}dbname"),
-group => $database,
);
-
- # explicitely set the dnadb to itself - by default the Registry assumes
+ #can use this approach to get dna from another db
+# my $dna_db = $adaptors{$database}->new(
+# -host => 'otterlive',
+# -port => '3301',
+# -user => $self->param("${prefix}user"),
+# -pass => $self->param("${prefix}pass"),
+# -dbname => 'loutre_human',
+# );
+# $dba->dnadb($dna_db);
+
+ # otherwise explicitely set the dnadb to itself - by default the Registry assumes
# a group 'core' for this now
$dba->dnadb($dba);
@@ -935,26 +956,25 @@ sub get_chrlength {
=cut
sub get_ensembl_chr_mapping {
- my ($self, $dba, $version) = @_;
- $dba ||= $self->dba;
- throw("get_ensembl_chr_mapping 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 %chrs;
- foreach my $chr (@chromosomes) {
- my $sr = $sa->fetch_by_region('chromosome', $chr, undef, undef, undef, $version);
- my ($ensembl_name_attr) = @{ $sr->get_all_Attributes('ensembl_name') };
- if ($ensembl_name_attr) {
- $chrs{$chr} = $ensembl_name_attr->value;
- } else {
- $chrs{$chr} = $chr;
- }
+ my ($self, $dba, $version) = @_;
+ $dba ||= $self->dba;
+ throw("get_ensembl_chr_mapping 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 %chrs;
+ foreach my $chr (@chromosomes) {
+ my $sr = $sa->fetch_by_region('chromosome', $chr, undef, undef, undef, $version);
+ my ($ensembl_name_attr) = @{ $sr->get_all_Attributes('ensembl_name') };
+ if ($ensembl_name_attr) {
+ $chrs{$chr} = $ensembl_name_attr->value;
+ } else {
+ $chrs{$chr} = $chr;
}
-
- return \%chrs;
+ }
+ return \%chrs;
}
=head2 get_taxonomy_id
@@ -1193,7 +1213,7 @@ sub log {
Arg[1] : String $txt - the warning text to log
Arg[2] : Int $indent - indentation level for log message
- Arg[2] : Bool - add a line break before warning if true
+ Arg[3] : Bool - add a line break before warning if true
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.
@@ -1445,6 +1465,26 @@ sub date {
return strftime "%Y-%m-%d %T", localtime;
}
+=head2 format_time
+
+ Example : print $support->format_time($gene->modifed_date) . "\n";
+ Description : Prints timestamps from the database
+ Return type : String - nicely formatted time stamp
+ Exceptions : none
+ Caller : general
+
+=cut
+
+
+sub date_format {
+ my( $self, $time, $format ) = @_;
+ my( $d,$m,$y) = (localtime($time))[3,4,5];
+ my %S = ('d'=>sprintf('%02d',$d),'m'=>sprintf('%02d',$m+1),'y'=>$y+1900);
+ (my $res = $format ) =~s/%(\w)/$S{$1}/ge;
+ return $res;
+}
+
+
=head2 mem
Example : print "Memory usage: " . $support->mem . "\n";
@@ -1491,8 +1531,8 @@ sub commify {
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 loutra database that don't have a hidden attribute
+ Example : $chroms = $support->fetch_non_hidden_slice($sa,$aa);
+ Description : retrieve all slices from a loutre database that don't have a hidden attribute
Return type : arrayref
Caller : general
Status : stable
@@ -1500,31 +1540,72 @@ sub commify {
=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 $chrom_name = $chrom->name;
- my $attribs = $aa->fetch_all_by_Slice($chrom,'hidden');
- if ( scalar(@$attribs) > 1 ) {
- $self->log_warning("More than one hidden attribute for chromosome $chrom_name\n");
- }
- elsif ($attribs->[0]->value == 0) {
- push @$visible_chroms, $chrom;
- }
- elsif ($attribs->[0]->value == 1) {
- $self->log_verbose("chromosome $chrom_name is hidden\n");
- }
- else {
- $self->log_warning("No hidden attribute for chromosome $chrom_name\n");
- }
- }
- return $visible_chroms;
+ 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 $chrom_name = $chrom->name;
+ my $attribs = $aa->fetch_all_by_Slice($chrom,'hidden');
+ if ( scalar(@$attribs) > 1 ) {
+ $self->log_warning("More than one hidden attribute for chromosome $chrom_name\n");
+ }
+ elsif ($attribs->[0]->value == 0) {
+ push @$visible_chroms, $chrom;
+ }
+ elsif ($attribs->[0]->value == 1) {
+ $self->log_verbose("chromosome $chrom_name is hidden\n");
+ }
+ else {
+ $self->log_warning("No hidden attribute for chromosome $chrom_name\n");
+ }
+ }
+ return $visible_chroms;
+}
+
+=head2 get_non_hidden_slice_names
+
+ 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 : $chrom_names = $support->get_non_hidden_slice_names($sa,$aa);
+ Description : retrieve names of all slices from a loutre database that don't have a hidden attribute
+ Return type : arrayref of names of all non-hidden slices
+ Caller : general
+ Status : stable
+
+=cut
+
+sub get_non_hidden_slice_names {
+ 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_chrom_names;
+ foreach my $chrom ( @{$sa->fetch_all($cs,$cv)} ) {
+ my $chrom_name = $chrom->seq_region_name;
+ my $attribs = $aa->fetch_all_by_Slice($chrom,'hidden');
+ if ( scalar(@$attribs) > 1 ) {
+ $self->log_warning("More than one hidden attribute for chromosome $chrom_name\n");
+ }
+ elsif ($attribs->[0]->value == 0) {
+ push @$visible_chrom_names, $chrom_name;
+ }
+ elsif ($attribs->[0]->value == 1) {
+ $self->log_verbose("chromosome $chrom_name is hidden\n");
+ }
+ else {
+ $self->log_warning("No hidden attribute for chromosome $chrom_name\n");
+ }
+ }
+ return $visible_chrom_names;
}
+
=head2 get_wanted_chromosomes
Arg[1] : B::E::U::ConversionSupport
@@ -1532,47 +1613,47 @@ sub fetch_non_hidden_slices {
Arg[3] : B::E::AttributeAdaptor
Arg[4] : string $coord_system_name (optional) - 'chromosome' by default
Arg[5] : string $coord_system_version (optional) - 'otter' by default
- Example : @chr_names = &Slice::get_wanted_chromosomes($support,$laa,$lsa);
+ Example : $chr_names = $support->get_wanted_chromosomes($laa,$lsa);
Description : retrieve names of slices from a lutra database that are ready for dumping to Vega.
Deals with list of names to ignore (ignore_chr = LIST)
- Return type : arrayref
+ Return type : arrayref of slices
Caller : general
Status : stable
=cut
sub get_wanted_chromosomes {
- 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 $export_mode = $self->param('release_type');
- my $release = $self->param('vega_release');
- my $names;
- my $chroms = $self->fetch_non_hidden_slices($aa,$sa,$cs,$cv);
+ 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 $export_mode = $self->param('release_type');
+ my $release = $self->param('vega_release');
+ my $names;
+ my $chroms = $self->fetch_non_hidden_slices($aa,$sa,$cs,$cv);
CHROM:
- foreach my $chrom (@$chroms) {
- my $attribs = $aa->fetch_all_by_Slice($chrom);
- my $vals = $self->get_attrib_values($attribs,'vega_export_mod');
- if (scalar(@$vals > 1)) {
- $self->log_warning ("Multiple attribs for \'vega_export_mod\', please fix before continuing");
- exit;
- }
- next CHROM if (! grep { $_ eq $export_mode} @$vals);
- $vals = $self->get_attrib_values($attribs,'vega_release',$release);
- if (scalar(@$vals > 1)) {
- $self->log_warning ("Multiple attribs for \'vega_release\' value = $release , please fix before continuing");
- exit;
- }
- next CHROM if (! grep { $_ eq $release} @$vals);
- my $name = $chrom->seq_region_name;
- if (my @ignored = $self->param('ignore_chr')) {
- next CHROM if (grep {$_ eq $name} @ignored);
- }
- push @{$names}, $name;
- }
- return $names;
+ foreach my $chrom (@$chroms) {
+ my $attribs = $aa->fetch_all_by_Slice($chrom);
+ my $vals = $self->get_attrib_values($attribs,'vega_export_mod');
+ if (scalar(@$vals > 1)) {
+ $self->log_warning ("Multiple attribs for \'vega_export_mod\', please fix before continuing");
+ exit;
+ }
+ next CHROM if (! grep { $_ eq $export_mode} @$vals);
+ $vals = $self->get_attrib_values($attribs,'vega_release',$release);
+ if (scalar(@$vals > 1)) {
+ $self->log_warning ("Multiple attribs for \'vega_release\' value = $release , please fix before continuing");
+ exit;
+ }
+ next CHROM if (! grep { $_ eq $release} @$vals);
+ my $name = $chrom->seq_region_name;
+ if (my @ignored = $self->param('ignore_chr')) {
+ next CHROM if (grep {$_ eq $name} @ignored);
+ }
+ push @{$names}, $name;
+ }
+ return $names;
}
@@ -1596,33 +1677,33 @@ sub get_wanted_chromosomes {
=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 [];
+ 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
--
GitLab