BaseAdaptor.pm 12.3 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
282
}


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

    my $table_name          = $self->table_name();
283
    my $column_set          = $self->column_set();
284
    my $autoinc_id          = $self->autoinc_id();
285
    my $driver              = $self->dbc->driver();
286
287
    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
293
294
        # NB: let's pretend we are storing all columns:
    my $stored_columns = [ keys %$column_set ];
    # my $stored_columns = [ grep { $_ ne $autoinc_id } keys %$column_set ];
295
296

        # By using question marks we can insert true NULLs by setting corresponding values to undefs:
297
    my $sql = "$insertion_method INTO $table_name (".join(', ', @$stored_columns).') VALUES ('.join(',', (('?') x scalar(@$stored_columns))).')';
298
299
300
301
    my $sth;    # do not prepare the statement until there is a real need

    foreach my $object (@$objects) {
        if($check_presence_in_db_first and my $present = $self->check_object_present_in_db($object)) {
302
            $self->mark_stored($object, $present);
303
        } else {
304
            #print "STORE: $sql\n";
305
306
            $sth ||= $self->prepare( $sql );    # only prepare (once) if we get here

307
308
309
            #print "STORED_COLUMNS: ".join(', ', @$stored_columns)."\n";
            my $stored_values = $self->slicer( $object, $stored_columns );
            #print "STORED_VALUES: ".join(', ', @$stored_values)."\n";
310

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

Leo Gordon's avatar
Leo Gordon committed
320
    $sth && $sth->finish();
321
322
323
324
325
326
327
328
329
330

    return $object_or_list;
}


sub DESTROY { }   # to simplify AUTOLOAD

sub AUTOLOAD {
    our $AUTOLOAD;

331
332
333
334
335
    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;
336
337
338
339

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

340
341
342
343
344
345
346
347
        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 ) {
348
349
350
351
            unless($column_set->{$column_name}) {
                die "unknown column '$column_name'";
            }
        }
352
353
354
        if($value_column && !$column_set->{$value_column}) {
            die "unknown column '$value_column'";
        }
355
356

        print "Setting up '$AUTOLOAD' method\n";
357
358
359
360
361
362
363
364
365
        *$AUTOLOAD = sub {
            my $self = shift @_;
            return $self->fetch_all(
                join(' AND ', map { "$filter_components->[$_]='$_[$_]'" } 0..scalar(@$filter_components)-1),
                !$all,
                $key_components,
                $value_column
            );
        };
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
        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}) {
            print "Setting up '$AUTOLOAD' method\n";
            *$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);
        print "Setting up '$AUTOLOAD' method\n";
        *$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;