BaseAdaptor.pm 12.7 KB
Newer Older
1 2 3 4
package Bio::EnsEMBL::Hive::DBSQL::BaseAdaptor;

use strict;
no strict 'refs';   # needed to allow AUTOLOAD create new methods
5
use DBI 1.6;        # the 1.6 functionality is important for detecting autoincrement fields and other magic.
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

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 @_;
25
        $self->_table_info_loader();
26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
    }
    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 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();
93
    my $dbh         = $dbc->db_handle();
94
    my $driver      = $dbc->driver();
95
    my $dbname      = $dbc->dbname();
96 97 98
    my $table_name  = $self->table_name();

    my %column_set  = ();
99
    my %name2type   = ();
100
    my $autoinc_id  = '';
101 102 103 104 105 106
    my @primary_key = $dbh->primary_key(undef, undef, $table_name);

    my $sth = $dbh->column_info(undef, undef, $table_name, '%');
    $sth->execute();
    while (my $row = $sth->fetchrow_hashref()) {
        my ($position, $name, $type, $is_ai) = @$row{'ORDINAL_POSITION','COLUMN_NAME', 'TYPE_NAME', 'mysql_is_auto_increment'};
107

108 109 110 111
        $column_set{$name}  = 1;
        $name2type{$name}   = $type;
        if($is_ai) {
            $autoinc_id = $name;
112 113 114 115
        }
    }
    $sth->finish;

116
    if(($driver eq 'sqlite') and scalar(@primary_key)==1 and (uc($name2type{$primary_key[0]}) eq 'INTEGER') ) {
117 118 119
        $autoinc_id = $primary_key[0];
    }

120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
    $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 ";
    }

137
    # print STDOUT $sql,"\n";
138 139 140 141 142 143 144 145 146 147 148

    my $sth = $self->prepare($sql);
    $sth->execute;  
    my ($count) = $sth->fetchrow();
    $sth->finish;  

    return $count;
}


sub fetch_all {
149 150
    my ($self, $constraint, $one_per_key, $key_list, $value_column) = @_;
    
151 152 153 154 155 156 157 158 159 160 161 162 163 164
    my $table_name      = $self->table_name();
    my $columns_csv     = join(', ', keys %{$self->column_set()});

    my $sql = "SELECT $columns_csv FROM $table_name";

    if($constraint) { 
        $sql .= " WHERE $constraint ";
    }

    # print STDOUT $sql,"\n";

    my $sth = $self->prepare($sql);
    $sth->execute;  

165
    my $result_struct;  # will be autovivified to the correct data structure
166 167

    while(my $hashref = $sth->fetchrow_hashref) {
168 169 170 171 172 173 174 175 176
        my $pptr = \$result_struct;
        foreach my $syll (@$key_list) {
            $pptr = \$$pptr->{$hashref->{$syll}};   # using pointer-to-pointer to enforce same-level vivification
        }
        my $object = $value_column
            ? $hashref->{$value_column}
            : $self->objectify($hashref);
        if($one_per_key) {
            $$pptr = $object;
177
        } else {
178
            push @$$pptr, $object;
179 180 181 182
        }
    }
    $sth->finish;  

183 184 185 186 187 188 189 190 191
    unless(defined($result_struct)) {
        if(scalar(@$key_list)) {
            $result_struct = {};
        } elsif(!$one_per_key) {
            $result_struct = [];
        }
    }

    return $result_struct;  # either listref or hashref is returned, depending on the call parameters
192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281
}


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 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));

282 283 284 285 286 287
    my $table_name              = $self->table_name();
    my $all_storable_columns    = [ keys %{ $self->column_set() } ];
    my $autoinc_id              = $self->autoinc_id();
    my $driver                  = $self->dbc->driver();
    my $insertion_method        = $self->insertion_method;  # INSERT, INSERT_IGNORE or REPLACE
    $insertion_method           =~ s/_/ /g;
288 289 290
    if($driver eq 'sqlite') {
        $insertion_method =~ s/INSERT IGNORE/INSERT OR IGNORE/ig;
    }
291

292
    my %hashed_sth = ();  # do not prepare statements until there is a real need
293 294 295

    foreach my $object (@$objects) {
        if($check_presence_in_db_first and my $present = $self->check_object_present_in_db($object)) {
296
            $self->mark_stored($object, $present);
297
        } else {
298 299 300
            my ($columns_being_stored, $column_key) = (ref($object) eq 'HASH') ? ( [ sort keys %$object ], join(', ', sort keys %$object) ) : ($all_storable_columns, '*all*');

            my $this_sth;
301

302 303 304 305 306 307 308 309 310 311 312
                # only prepare (once!) if we get here:
            unless($this_sth = $hashed_sth{$column_key}) {
                    # By using question marks we can insert true NULLs by setting corresponding values to undefs:
                my $sql = "$insertion_method INTO $table_name (".join(', ', @$columns_being_stored).') VALUES ('.join(',', (('?') x scalar(@$columns_being_stored))).')';
                # print "STORE: $sql\n";
                $this_sth = $hashed_sth{$column_key} = $self->prepare( $sql ) or die "Could not prepare statement: $sql";
            }

            # print "STORED_COLUMNS: ".join(', ', map { "`$_`" } @$columns_being_stored)."\n";
            my $values_being_stored = $self->slicer( $object, $columns_being_stored );
            # print "STORED_VALUES: ".join(', ', map { "'$_'" } @$values_being_stored)."\n";
313

314
            my $return_code = $this_sth->execute( @$values_being_stored )
315
                    # using $return_code in boolean context allows to skip the value '0E0' ('no rows affected') that Perl treats as zero but regards as true:
316
                or die "Could not store fields\n\t{$column_key}\nwith data:\n\t(".join(',', @$values_being_stored).')';
Leo Gordon's avatar
Leo Gordon committed
317
            if($return_code > 0) {     # <--- for the same reason we have to be explicitly numeric here
Leo Gordon's avatar
Leo Gordon committed
318
                $self->mark_stored($object, $self->dbc->db_handle->last_insert_id(undef, undef, $table_name, $autoinc_id) );
319 320 321 322
            }
        }
    }

323 324 325
    foreach my $sth (values %hashed_sth) {
        $sth->finish();
    }
326 327 328 329 330 331 332 333 334 335

    return $object_or_list;
}


sub DESTROY { }   # to simplify AUTOLOAD

sub AUTOLOAD {
    our $AUTOLOAD;

336 337 338 339 340
    if($AUTOLOAD =~ /::fetch(_all)?(?:_by_(\w+?))?(?:_HASHED_FROM_(\w+?))?(?:_TO_(\w+?))?$/) {
        my $all             = $1;
        my $filter_string   = $2;
        my $key_string      = $3;
        my $value_column    = $4;
341 342 343 344

        my ($self) = @_;
        my $column_set = $self->column_set();

345 346 347 348 349 350 351 352
        my $filter_components = $filter_string && [ split('_and_', $filter_string) ];
        foreach my $column_name ( @$filter_components ) {
            unless($column_set->{$column_name}) {
                die "unknown column '$column_name'";
            }
        }
        my $key_components = $key_string && [ split('_and_', $key_string) ];
        foreach my $column_name ( @$key_components ) {
353 354 355 356
            unless($column_set->{$column_name}) {
                die "unknown column '$column_name'";
            }
        }
357 358 359
        if($value_column && !$column_set->{$value_column}) {
            die "unknown column '$value_column'";
        }
360

361
#        print "Setting up '$AUTOLOAD' method\n";
362 363 364 365 366 367 368 369 370
        *$AUTOLOAD = sub {
            my $self = shift @_;
            return $self->fetch_all(
                join(' AND ', map { "$filter_components->[$_]='$_[$_]'" } 0..scalar(@$filter_components)-1),
                !$all,
                $key_components,
                $value_column
            );
        };
371 372 373 374 375 376 377 378
        goto &$AUTOLOAD;    # restart the new method
    } elsif($AUTOLOAD =~ /::count_all_by_(\w+)$/) {
        my $filter_name = $1;

        my ($self) = @_;
        my $column_set = $self->column_set();

        if($column_set->{$filter_name}) {
379
#            print "Setting up '$AUTOLOAD' method\n";
380 381 382 383 384 385 386
            *$AUTOLOAD = sub { my ($self, $filter_value) = @_; return $self->count_all("$filter_name='$filter_value'"); };
            goto &$AUTOLOAD;    # restart the new method
        } else {
            die "unknown column '$filter_name'";
        }
    } elsif($AUTOLOAD =~ /::update_(\w+)$/) {
        my @columns_to_update = split('_and_', $1);
387
#        print "Setting up '$AUTOLOAD' method\n";
388 389 390 391 392 393 394 395 396
        *$AUTOLOAD = sub { my ($self, $object) = @_; return $self->update($object, @columns_to_update); };
        goto &$AUTOLOAD;    # restart the new method
    } else {
        print "sub '$AUTOLOAD' not implemented";
    }
}

1;