Skip to content

GitLab

Commit c8e6e805 authored by Leo Gordon's avatar Leo Gordon
Browse files

using a new BaseAdaptor as the base class for some simpler adaptors

parent baa146d3
Hide whitespace changes
Inline Side-by-side
Showing with 514 additions and 709 deletions
modules/Bio/EnsEMBL/Hive/AnalysisCtrlRule.pm
View file @ c8e6e805
......@@ -58,10 +58,21 @@ use Bio::EnsEMBL::Utils::Exception;
=cut
sub new {
my ($class,@args) = @_;
my $self = bless {}, $class;
my $class = shift @_;
my $self = bless {}, $class;
return $self;
my ( $dbID, $adaptor, $condition_analysis_url, $ctrled_analysis_id ) =
rearrange( [ qw (DBID ADAPTOR CONDITION_ANALYSIS_URL CTRLED_ANALYSIS_ID) ], @_ );
# database persistence:
$self->dbID( $dbID ) if(defined($dbID));
$self->adaptor( $adaptor ) if(defined($adaptor));
# simple scalars:
$self->condition_analysis_url( $condition_analysis_url ) if(defined($condition_analysis_url));
$self->ctrled_analysis_id( $ctrled_analysis_id ) if(defined($ctrled_analysis_id));
return $self;
}
sub adaptor {
......
modules/Bio/EnsEMBL/Hive/AnalysisJob.pm
View file @ c8e6e805
......@@ -263,7 +263,7 @@ sub dataflow_output_id {
if($target_analysis_or_table->can('dataflow')) {
my $insert_ids = $target_analysis_or_table->dataflow( $output_ids_for_this_rule );
$target_analysis_or_table->dataflow( $output_ids_for_this_rule );
} else {
......
modules/Bio/EnsEMBL/Hive/DBSQL/AnalysisCtrlRuleAdaptor.pm
View file @ c8e6e805
# Perl module for Bio::EnsEMBL::Hive::DBSQL::AnalysisCtrlRuleAdaptor
#
# Date of creation: 22.03.2004
# Original Creator : Jessica Severin <jessica@ebi.ac.uk>
#
# Copyright EMBL-EBI 2004
#
# You may distribute this module under the same terms as perl itself
=pod
=head1 NAME
......@@ -15,8 +6,8 @@
=head1 SYNOPSIS
$AnalysisCtrlRuleAdaptor = $db_adaptor->get_AnalysisCtrlRuleAdaptor;
$analysisCtrlRuleAdaptor = $analysisCtrlRuleObj->adaptor;
$analysis_ctrl_rule_adaptor = $db_adaptor->get_AnalysisCtrlRuleAdaptor;
$analysis_ctrl_rule_adaptor = $analysisCtrlRuleObj->adaptor;
=head1 DESCRIPTION
......@@ -27,98 +18,32 @@
Please contact ehive-users@ebi.ac.uk mailing list with questions/suggestions.
=head1 APPENDIX
The rest of the documentation details each of the object methods.
Internal methods are usually preceded with a _
=cut
package Bio::EnsEMBL::Hive::DBSQL::AnalysisCtrlRuleAdaptor;
use strict;
use Carp;
use Bio::EnsEMBL::Hive::AnalysisCtrlRule;
use Bio::EnsEMBL::Utils::Argument;
use Bio::EnsEMBL::Utils::Exception;
use base ('Bio::EnsEMBL::DBSQL::BaseAdaptor');
=head2 fetch_all_by_ctrled_analysis_id
Arg [1] : int $id
the unique database identifier for the feature to be obtained
Example : $ctrlRuleArray = $adaptor->fetch_all_by_ctrled_analysis_id($ctrled_analysis->dbID);
Description: Returns an array reference of all the AnalysisCtrlRule objects
for the specified controled analysis.
Returntype : listref of Bio::EnsEMBL::Hive::AnalysisCtrlRule objects
Exceptions : thrown if $id is not defined
Caller : general
=cut
sub fetch_all_by_ctrled_analysis_id {
my ($self,$id) = @_;
unless(defined $id) {
throw("fetch_all_by_ctrled_analysis_id must have an id");
}
use base ('Bio::EnsEMBL::Hive::DBSQL::BaseAdaptor');
my $constraint = "r.ctrled_analysis_id = $id";
return $self->_generic_fetch($constraint);
sub default_table_name {
return 'analysis_ctrl_rule';
}
=head2 fetch_all
Arg : None
Example : my $all_rules = $ctrlRuleDBA->fetch_all();
Description: fetches all AnalysisCtrlRule objects from database
Returntype : array reference of Bio::EnsEMBL::Hive::AnalysisCtrlRule objects
Exceptions : none
Caller : general
=cut
sub fetch_all {
my $self = shift;
return $self->_generic_fetch();
sub default_insertion_method {
return 'INSERT_IGNORE';
}
=head2 store
Arg[1] : Bio::EnsEMBL::Hive::AnalysisCtrlRule object
Usage : $self->store( $rule );
Function : Stores a rule in db
Sets adaptor and dbID in AnalysisCtrlRule object
Returntype : none
=cut
sub store {
my ( $self, $rule ) = @_;
my $newly_inserted_rule = 0;
my $condition_analysis_url = $rule->condition_analysis_url;
my $ctrled_analysis_id = $rule->ctrled_analysis_id;
sub object_class {
return 'Bio::EnsEMBL::Hive::AnalysisCtrlRule';
}
my $sth = $self->prepare("INSERT IGNORE INTO analysis_ctrl_rule (condition_analysis_url, ctrled_analysis_id) VALUES(?,?)");
my $rtnCode = $sth->execute($condition_analysis_url, $ctrled_analysis_id);
if($rtnCode and ($rtnCode != 0E0)) { # 0E0 is returned when the command succeeds, but 0 rows are updated (so in case of 'INSERT IGNORE' likely a key clash)
$newly_inserted_rule = 1;
$sth->finish();
} elsif(!$rtnCode) {
die "Could not create analysis_ctrl_rule('$condition_analysis_url', '$ctrled_analysis_id')";
}
$rule->adaptor( $self );
return $newly_inserted_rule;
}
=head2 remove_by_condition_analysis_url
......@@ -156,11 +81,10 @@ sub remove_by_condition_analysis_url {
analysis will only unblock if ALL conditions are satisified.
Returntype : none
Exceptions : none
Caller : general
Caller : HiveGeneric_conf.pm and various pipeline-creating scripts
=cut
sub create_rule {
my ($self, $conditionAnalysis, $ctrledAnalysis) = @_;
......@@ -171,121 +95,8 @@ sub create_rule {
$rule->ctrled_analysis($ctrledAnalysis);
$rule->condition_analysis($conditionAnalysis);
return $self->store($rule);
}
############################
#
# INTERNAL METHODS
# (pseudo subclass methods)
#
############################
#internal method used in multiple calls above to build objects from table data
sub _tables {
my $self = shift;
return (['analysis_ctrl_rule', 'r']);
}
sub _columns {
my $self = shift;
return qw (r.ctrled_analysis_id
r.condition_analysis_url
);
}
sub _objs_from_sth {
my ($self, $sth) = @_;
my @rules = ();
my ($ctrled_analysis_id, $condition_analysis_url);
$sth->bind_columns(\$ctrled_analysis_id, \$condition_analysis_url);
while ($sth->fetch()) {
my $rule = Bio::EnsEMBL::Hive::AnalysisCtrlRule->new;
$rule->adaptor($self);
$rule->ctrled_analysis_id($ctrled_analysis_id);
$rule->condition_analysis_url($condition_analysis_url);
push @rules, $rule;
}
return \@rules;
return $self->store($rule, 1); # avoid redundancy
}
sub _default_where_clause {
my $self = shift;
return '';
}
sub _final_clause {
my $self = shift;
return '';
}
###############################################################################
#
# General access methods that could be moved
# into a superclass
#
###############################################################################
sub _generic_fetch {
my ($self, $constraint, $join) = @_;
my @tables = $self->_tables;
my $columns = join(', ', $self->_columns());
if ($join) {
foreach my $single_join (@{$join}) {
my ($tablename, $condition, $extra_columns) = @{$single_join};
if ($tablename && $condition) {
push @tables, $tablename;
if($constraint) {
$constraint .= " AND $condition";
} else {
$constraint = " $condition";
}
}
if ($extra_columns) {
$columns .= ", " . join(', ', @{$extra_columns});
}
}
}
#construct a nice table string like 'table1 t1, table2 t2'
my $tablenames = join(', ', map({ join(' ', @$_) } @tables));
my $sql = "SELECT $columns FROM $tablenames";
my $default_where = $self->_default_where_clause;
my $final_clause = $self->_final_clause;
#append a where clause if it was defined
if($constraint) {
$sql .= " WHERE $constraint ";
if($default_where) {
$sql .= " AND $default_where ";
}
} elsif($default_where) {
$sql .= " WHERE $default_where ";
}
#append additional clauses which may have been defined
$sql .= " $final_clause";
my $sth = $self->prepare($sql);
$sth->execute;
# print STDERR $sql,"\n";
return $self->_objs_from_sth($sth);
}
1;
modules/Bio/EnsEMBL/Hive/DBSQL/BaseAdaptor.pm 0 → 100644
View file @ c8e6e805
package Bio::EnsEMBL::Hive::DBSQL::BaseAdaptor;
use strict;
use Data::Dumper;
no strict 'refs'; # needed to allow AUTOLOAD create new methods
use base ('Bio::EnsEMBL::DBSQL::BaseAdaptor');
sub default_table_name {
die "Please define table_name either by setting it via table_name() method or by redefining default_table_name() in your adaptor class";
}
sub default_insertion_method {
return 'INSERT_IGNORE';
}
sub table_name {
my $self = shift @_;
if(@_) { # setter
$self->{_table_name} = shift @_;
}
return $self->{_table_name} || $self->default_table_name();
}
sub insertion_method {
my $self = shift @_;
if(@_) { # setter
$self->{_insertion_method} = shift @_;
}
return $self->{_insertion_method} || $self->default_insertion_method();
}
sub object_class { # this one can stay undefined
my $self = shift @_;
if(@_) { # setter
$self->{_object_class} = shift @_;
}
return $self->{_object_class};
}
sub column_set {
my $self = shift @_;
if(@_) { # setter
$self->{_column_set} = shift @_;
} elsif( !defined( $self->{_column_set} ) ) {
$self->_table_info_loader();
}
return $self->{_column_set};
}
sub primary_key { # not necessarily auto-incrementing
my $self = shift @_;
if(@_) { # setter
$self->{_primary_key} = shift @_;
} elsif( !defined( $self->{_primary_key} ) ) {
$self->_table_info_loader();
}
return $self->{_primary_key};
}
sub updatable_column_list { # it's just a cashed view, you cannot set it directly
my $self = shift @_;
unless($self->{_updatable_column_list}) {
my %primary_key_set = map { $_ => 1 } @{$self->primary_key()};
my $column_set = $self->column_set();
$self->{_updatable_column_list} = [ grep { not $primary_key_set{$_} } keys %$column_set ];
}
return $self->{_updatable_column_list};
}
sub autoinc_id {
my $self = shift @_;
if(@_) { # setter
$self->{_autoinc_id} = shift @_;
} elsif( !defined( $self->{_autoinc_id} ) ) {
$self->_table_info_loader();
}
return $self->{_autoinc_id};
}
sub _table_info_loader {
my $self = shift @_;
my $dbc = $self->dbc();
my $dbname = $dbc->dbname();
my $table_name = $self->table_name();
my %column_set = ();
my @primary_key = ();
my $autoinc_id = '';
my $sql = "SELECT column_name,column_key,extra FROM information_schema.columns WHERE table_schema='$dbname' and table_name='$table_name'";
my $sth = $self->prepare($sql);
$sth->execute;
while(my ($column_name, $column_key, $extra) = $sth->fetchrow ) {
$column_set{$column_name} = 1;
if($column_key eq 'PRI') {
push @primary_key, $column_name;
if($extra eq 'auto_increment') {
$autoinc_id = $column_name;
}
}
}
$sth->finish;
$self->column_set( \%column_set );
$self->primary_key( \@primary_key );
$self->autoinc_id( $autoinc_id );
}
sub count_all {
my ($self, $constraint) = @_;
my $table_name = $self->table_name();
my $sql = "SELECT COUNT(*) FROM $table_name";
if($constraint) {
$sql .= " WHERE $constraint ";
}
print STDOUT $sql,"\n";
my $sth = $self->prepare($sql);
$sth->execute;
my ($count) = $sth->fetchrow();
$sth->finish;
return $count;
}
sub fetch_all {
my ($self, $constraint) = @_;
my $table_name = $self->table_name();
my $columns_csv = join(', ', keys %{$self->column_set()});
my $object_class = $self->object_class();
my $sql = "SELECT $columns_csv FROM $table_name";
if($constraint) {
$sql .= " WHERE $constraint ";
}
# print STDOUT $sql,"\n";
my $sth = $self->prepare($sql);
$sth->execute;
my @objects;
while(my $hashref = $sth->fetchrow_hashref) {
if($object_class) {
push @objects, $object_class->new( -adaptor => $self, map { ('-'.uc($_) => $hashref->{$_}) } keys %$hashref );
} else {
push @objects, $hashref; # faster, but only works for naked data types and lacks a link back to the adaptor
}
}
$sth->finish;
return \@objects;
}
sub primary_key_constraint {
my $self = shift @_;
my $primary_key = $self->primary_key(); # Attention: the order of primary_key columns of your call should match the order in the table definition!
if(@$primary_key) {
return join (' AND ', map { $primary_key->[$_]."='".$_[$_]."'" } (0..scalar(@$primary_key)-1));
} else {
my $table_name = $self->table_name();
die "Table '$table_name' doesn't have a primary_key";
}
}
sub fetch_by_dbID {
my $self = shift @_; # the rest in @_ should be primary_key column values
return $self->fetch_all( $self->primary_key_constraint( @_ ) );
}
sub slicer { # take a slice of the object (if only we could inline in Perl!)
my ($self, $object, $fields) = @_;
if( my $object_class = $self->object_class() ) {
return [ map { $object->$_() } @$fields ];
} else {
return [ @$object{@$fields} ]; # <--- slicing a hashref here
}
}
sub remove { # remove the object by primary_key
my $self = shift @_;
my $object = shift @_;
my $table_name = $self->table_name();
my $primary_key_constraint = $self->primary_key_constraint( $self->slicer($object, $self->primary_key()) );
my $sql = "DELETE FROM $table_name WHERE $primary_key_constraint";
my $sth = $self->prepare($sql);
$sth->execute();
$sth->finish();
}
sub update { # update (some or all) non_primary columns from the primary
my $self = shift @_;
my $object = shift @_; # the rest in @_ should be the column names to be updated
my $table_name = $self->table_name();
my $primary_key_constraint = $self->primary_key_constraint( $self->slicer($object, $self->primary_key()) );
my $columns_to_update = scalar(@_) ? \@_ : $self->updatable_column_list();
my $values_to_update = $self->slicer( $object, $columns_to_update );
unless(@$columns_to_update) {
die "There are no dependent columns to update, as everything seems to belong to the primary key";
}
my $sql = "UPDATE $table_name SET ".join(', ', map { "$columns_to_update->[$_]=$values_to_update->[$_]" } (0..@$columns_to_update-1) )." WHERE $primary_key_constraint";
my $sth = $self->prepare($sql);
$sth->execute();
$sth->finish();
}
sub check_object_present_in_db { # return autoinc_id/undef if the table has autoinc_id or just 1/undef if not
my ( $self, $object ) = @_;
my $table_name = $self->table_name();
my $column_set = $self->column_set();
my $autoinc_id = $self->autoinc_id();
my $non_autoinc_columns = [ grep { $_ ne $autoinc_id } keys %$column_set ];
my $non_autoinc_values = $self->slicer( $object, $non_autoinc_columns );
my $sql = 'SELECT '.($autoinc_id or 1)." FROM $table_name WHERE ".
# we look for identical contents, so must skip the autoinc_id columns when fetching:
join(' AND ', map { my $v=$non_autoinc_values->[$_]; "$non_autoinc_columns->[$_] ".(defined($v) ? "='$v'" : 'IS NULL') } (0..@$non_autoinc_columns-1) );
my $sth = $self->prepare($sql);
$sth->execute();
my ($return_value) = $sth->fetchrow();
$sth->finish;
return $return_value;
}
sub store {
my ($self, $object_or_list, $check_presence_in_db_first) = @_;
my $objects = (ref($object_or_list) eq 'ARRAY') # ensure we get an array of objects to store
? $object_or_list
: [ $object_or_list ];
return unless(scalar(@$objects));
my $table_name = $self->table_name();
my $column_set = $self->column_set();
my $autoinc_id = $self->autoinc_id();
my $insertion_method = $self->insertion_method; # INSERT, INSERT_IGNORE or REPLACE
$insertion_method =~ s/_/ /g;
my $object_class = $self->object_class();
# NB: here we assume all hashes will have the same keys:
my $non_autoinc_columns = [ grep { $_ ne $autoinc_id } keys %$column_set ];
# By using question marks we can insert true NULLs by setting corresponding values to undefs:
my $sql = "$insertion_method INTO $table_name (".join(', ', @$non_autoinc_columns).') VALUES ('.join(',', (('?') x scalar(@$non_autoinc_columns))).')';
my $sth; # do not prepare the statement until there is a real need