branch-1-6/Bio/DB/SeqFeature/Store/DBI/Pg.pm

   1
   2 package Bio::DB::SeqFeature::Store::DBI::Pg;
   3 use DBD::Pg qw(:pg_types);
   4 use MIME::Base64;
   5 # $Id: Pg.pm 14656 2008-04-14 15:05:37Z lstein $
   6
   7 =head1 NAME
   8
   9 Bio::DB::SeqFeature::Store::DBI::Pg -- Mysql implementation of Bio::DB::SeqFeature::Store
  10
  11 =head1 SYNOPSIS
  12
  13   use Bio::DB::SeqFeature::Store;
  14
  15   # Open the sequence database
  16   my $db = Bio::DB::SeqFeature::Store->new(-adaptor => 'DBI::Pg',
  17                                           -dsn     => 'dbi:Pg:test');
  18
  19   # get a feature from somewhere
  20   my $feature = Bio::SeqFeature::Generic->new(...);
  21
  22   # store it
  23   $db->store($feature) or die "Couldn't store!";
  24
  25   # primary ID of the feature is changed to indicate its primary ID
  26   # in the database...
  27   my $id = $feature->primary_id;
  28
  29   # get the feature back out
  30   my $f  = $db->fetch($id);
  31
  32   # change the feature and update it
  33   $f->start(100);
  34   $db->update($f) or die "Couldn't update!";
  35
  36   # searching...
  37   # ...by id
  38   my @features = $db->fetch_many(@list_of_ids);
  39
  40   # ...by name
  41   @features = $db->get_features_by_name('ZK909');
  42
  43   # ...by alias
  44   @features = $db->get_features_by_alias('sma-3');
  45
  46   # ...by type
  47   @features = $db->get_features_by_name('gene');
  48
  49   # ...by location
  50   @features = $db->get_features_by_location(-seq_id=>'Chr1',-start=>4000,-end=>600000);
  51
  52   # ...by attribute
  53   @features = $db->get_features_by_attribute({description => 'protein kinase'})
  54
  55   # ...by the GFF "Note" field
  56   @result_list = $db->search_notes('kinase');
  57
  58   # ...by arbitrary combinations of selectors
  59   @features = $db->features(-name => $name,
  60                             -type => $types,
  61                             -seq_id => $seqid,
  62                             -start  => $start,
  63                             -end    => $end,
  64                             -attributes => $attributes);
  65
  66   # ...using an iterator
  67   my $iterator = $db->get_seq_stream(-name => $name,
  68                                      -type => $types,
  69                                      -seq_id => $seqid,
  70                                      -start  => $start,
  71                                      -end    => $end,
  72                                      -attributes => $attributes);
  73
  74   while (my $feature = $iterator->next_seq) {
  75     # do something with the feature
  76   }
  77
  78   # ...limiting the search to a particular region
  79   my $segment  = $db->segment('Chr1',5000=>6000);
  80   my @features = $segment->features(-type=>['mRNA','match']);
  81
  82   # getting & storing sequence information
  83   # Warning: this returns a string, and not a PrimarySeq object
  84   $db->insert_sequence('Chr1','GATCCCCCGGGATTCCAAAA...');
  85   my $sequence = $db->fetch_sequence('Chr1',5000=>6000);
  86
  87   # what feature types are defined in the database?
  88   my @types    = $db->types;
  89
  90   # create a new feature in the database
  91   my $feature = $db->new_feature(-primary_tag => 'mRNA',
  92                                  -seq_id      => 'chr3',
  93                                  -start      => 10000,
  94                                  -end        => 11000);
  95
  96 =head1 DESCRIPTION
  97
  98 Bio::DB::SeqFeature::Store::Pg is the Mysql adaptor for
  99 Bio::DB::SeqFeature::Store. You will not create it directly, but
 100 instead use Bio::DB::SeqFeature::Store-E<gt>new() to do so.
 101
 102 See L<Bio::DB::SeqFeature::Store> for complete usage instructions.
 103
 104 =head2 Using the Mysql adaptor
 105
 106 Before you can use the adaptor, you must use the Pgadmin tool to
 107 create a database and establish a user account with write
 108 permission. In order to use "fast" loading, the user account must have
 109 "file" privileges.
 110
 111 To establish a connection to the database, call
 112 Bio::DB::SeqFeature::Store-E<gt>new(-adaptor=E<gt>'DBI::Pg',@more_args). The
 113 additional arguments are as follows:
 114
 115   Argument name       Description
 116   -------------       -----------
 117
 118  -dsn              The database name. You can abbreviate
 119                    "dbi:Pg:foo" as "foo" if you wish.
 120
 121  -user             Username for authentication.
 122
 123  -pass             Password for authentication.
 124
 125  -namespace        A prefix to attach to each table. This allows you
 126                    to have several virtual databases in the same
 127                    physical database.
 128
 129  -temp             Boolean flag. If true, a temporary database
 130                    will be created and destroyed as soon as
 131                    the Store object goes out of scope. (synonym -temporary)
 132
 133  -autoindex        Boolean flag. If true, features in the database will be
 134                    reindexed every time they change. This is the default.
 135
 136
 137  -tmpdir           Directory in which to place temporary files during "fast" loading.
 138                    Defaults to File::Spec->tmpdir(). (synonyms -dump_dir, -dumpdir, -tmp)
 139
 140  -dbi_options      A hashref to pass to DBI->connect's 4th argument, the "attributes."
 141                    (synonyms -options, -dbi_attr)
 142
 143  -write            Pass true to open database for writing or updating.
 144
 145 If successful, a new instance of
 146 Bio::DB::SeqFeature::Store::DBI::Pg will be returned.
 147
 148 In addition to the standard methods supported by all well-behaved
 149 Bio::DB::SeqFeature::Store databases, several following
 150 adaptor-specific methods are provided. These are described in the next
 151 sections.
 152
 153 =cut
 154
 155 use strict;
 156
 157 use base 'Bio::DB::SeqFeature::Store::DBI::mysql';
 158 use Bio::DB::SeqFeature::Store::DBI::Iterator;
 159 use DBI;
 160 use Memoize;
 161 use Cwd 'abs_path';
 162 use Bio::DB::GFF::Util::Rearrange 'rearrange';
 163 use File::Spec;
 164 use constant DEBUG=>0;
 165
 166 # from the MySQL documentation...
 167 # WARNING: if your sequence uses coordinates greater than 2 GB, you are out of luck!
 168 use constant MAX_INT =>  2_147_483_647;
 169 use constant MIN_INT => -2_147_483_648;
 170 use constant MAX_BIN =>  1_000_000_000;  # size of largest feature = 1 Gb
 171 use constant MIN_BIN =>  1000;           # smallest bin we'll make - on a 100 Mb chromosome, there'll be 100,000 of these
 172
 173 ###
 174 # object initialization
 175 #
 176 # NOTE: most of this code can be refactored and inherited from DBI or DBI::mysql adapter
 177 #
 178 sub init {
 179   my $self          = shift;
 180   my ($dsn,
 181       $is_temporary,
 182       $autoindex,
 183       $namespace,
 184       $dump_dir,
 185       $user,
 186       $pass,
 187       $dbi_options,
 188       $writeable,
 189       $create,
 190       $schema,
 191      ) = rearrange(['DSN',
 192                     ['TEMP','TEMPORARY'],
 193                     'AUTOINDEX',
 194                     'NAMESPACE',
 195                     ['DUMP_DIR','DUMPDIR','TMP','TMPDIR'],
 196                     'USER',
 197                     ['PASS','PASSWD','PASSWORD'],
 198                     ['OPTIONS','DBI_OPTIONS','DBI_ATTR'],
 199                     ['WRITE','WRITEABLE'],
 200                     'CREATE',
 201                     'SCHEMA'
 202                    ],@_);
 203
 204
 205   $dbi_options  ||= {};
 206   $writeable    = 1 if $is_temporary or $dump_dir;
 207
 208   $dsn or $self->throw("Usage: ".__PACKAGE__."->init(-dsn => \$dbh || \$dsn)");
 209
 210   my $dbh;
 211   if (ref $dsn) {
 212     $dbh = $dsn;
 213   } else {
 214     $dsn = "dbi:Pg:$dsn" unless $dsn =~ /^dbi:/;
 215     $dbh = DBI->connect($dsn,$user,$pass,$dbi_options) or $self->throw($DBI::errstr);
 216   }
 217   $dbh->do('set client_min_messages=warning') if $dbh;
 218   $self->{'original_arguments'} = {
 219       'dsn' => $dsn,
 220       'user' => $user,
 221       'pass' => $pass,
 222       'dbh_options' => $dbi_options,
 223   };
 224   $self->{dbh}       = $dbh;
 225   $self->{dbh}->{InactiveDestroy} = 1;
 226   $self->{is_temp}   = $is_temporary;
 227   $self->{namespace} = $namespace;
 228   $self->{writeable} = $writeable;
 229   $self->schema($schema) if ($schema);
 230
 231   $self->default_settings;
 232   $self->autoindex($autoindex)                   if defined $autoindex;
 233   $self->dumpdir($dump_dir)                      if $dump_dir;
 234   if ($self->is_temp) {
 235     # warn "creating a temp database isn't supported";
 236     #$self->init_tmp_database();
 237     $self->init_database('erase');
 238   } elsif ($create) {
 239     $self->init_database('erase');
 240   }
 241 }
 242
 243 sub table_definitions {
 244   my $self = shift;
 245   return {
 246           feature => <<END,
 247 (
 248   id       serial primary key,
 249   typeid   int      not null,
 250   seqid    int,
 251   start    int,
 252   "end"      int,
 253   strand   int      default 0,
 254   tier     int,
 255   bin      int,
 256   indexed  int default 1,
 257   object     bytea not null
 258 );
 259   CREATE INDEX feature_stuff ON feature(seqid,tier,bin,typeid);
 260   CREATE INDEX feature_typeid ON feature(typeid);
 261 END
 262
 263           locationlist => <<END,
 264 (
 265   id         serial primary key,
 266   seqname    varchar(256)   not null
 267 ); CREATE INDEX locationlist_seqname ON locationlist(seqname);
 268 END
 269
 270           typelist => <<END,
 271 (
 272   id       serial primary key,
 273   tag      varchar(256)  not null
 274 ); CREATE INDEX typelist_tab ON typelist(tag);
 275 END
 276           name => <<END,
 277 (
 278   id           int       not null,
 279   name         varchar(256)  not null,
 280   display_name int       default 0
 281 );
 282   CREATE INDEX name_id ON name(id);
 283   CREATE INDEX name_name ON name(name);
 284 END
 285
 286           attribute => <<END,
 287 (
 288   id               int       not null,
 289   attribute_id     int   not null,
 290   attribute_value  text
 291 );
 292   CREATE INDEX attribute_id ON attribute(id);
 293   CREATE INDEX attribute_id_val ON attribute(attribute_id,SUBSTR(attribute_value, 1, 10));
 294 END
 295
 296           attributelist => <<END,
 297 (
 298   id       serial primary key,
 299   tag      varchar(256)  not null
 300 );
 301   CREATE INDEX attributelist_tag ON attributelist(tag);
 302 END
 303           parent2child => <<END,
 304 (
 305   id               int       not null,
 306   child            int       not null
 307 );
 308   CREATE INDEX parent2child_id_child ON parent2child(id,child);
 309 END
 310
 311           meta => <<END,
 312 (
 313   name      varchar(128) primary key,
 314   value     varchar(128) not null
 315 )
 316 END
 317           sequence => <<END,
 318 (
 319   id       int not null,
 320   "offset"   int not null,
 321   sequence text,
 322   primary key(id,"offset")
 323 )
 324 END
 325          };
 326 }
 327
 328 sub schema {
 329   my ($self, $schema) = @_;
 330   $self->{'schema'} = $schema if defined($schema);
 331   if ($schema) {
 332     $self->dbh->do("SET search_path TO " . $self->{'schema'} . ", public");
 333   } else {
 334     $self->dbh->do("SET search_path TO public");
 335   }
 336   return $self->{'schema'};
 337 }
 338 ###
 339 # wipe database clean and reinstall schema
 340 #
 341 sub _init_database {
 342   my $self = shift;
 343   my $erase = shift;
 344
 345   my $dbh    = $self->dbh;
 346   my $tables = $self->table_definitions;
 347   foreach (keys %$tables) {
 348     next if $_ eq 'meta';      # don't get rid of meta data!
 349     my $table = $self->_qualify($_);
 350     $dbh->do("DROP TABLE IF EXISTS $table") if $erase;
 351     my @table_exists = $dbh->selectrow_array("SELECT * FROM pg_tables WHERE tablename = '$table'");
 352                 if (!scalar(@table_exists)) {
 353                         my $query = "CREATE TABLE $table $tables->{$_}";
 354                         $dbh->do($query) or $self->throw($dbh->errstr);
 355                 }
 356   }
 357   $self->subfeatures_are_indexed(1) if $erase;
 358   1;
 359 }
 360
 361 sub maybe_create_meta {
 362   my $self = shift;
 363   return unless $self->writeable;
 364   my $table        = $self->_qualify('meta');
 365   my $tables       = $self->table_definitions;
 366   my $temporary    = $self->is_temp ? 'TEMPORARY' : '';
 367   my @table_exists = $self->dbh->selectrow_array("SELECT * FROM pg_tables WHERE tablename = '$table'");
 368   $self->dbh->do("CREATE $temporary TABLE $table $tables->{meta}")
 369       unless @table_exists || $temporary;
 370 }
 371
 372 sub _finish_bulk_update {
 373   my $self = shift;
 374   my $dbh  = $self->dbh;
 375   my $dir  = $self->{dumpdir} || '.';
 376   for my $table ('feature',$self->index_tables) {
 377     my $fh   = $self->dump_filehandle($table);
 378     my $path = $self->dump_path($table);
 379     $fh->close;
 380     my $qualified_table = $self->_qualify($table);
 381     system "cp $path $path.bak";
 382     # Get stuff from file into STDIN so we don't have to be superuser
 383     open FH, $path;
 384     print STDERR "Loading file $path\n";
 385     $dbh->do("COPY $qualified_table FROM STDIN CSV QUOTE '''' DELIMITER '\t'") or $self->throw($dbh->errstr);
 386     while (my $line = <FH>) {
 387       $dbh->pg_putline($line);
 388     }
 389     $dbh->pg_endcopy() or $self->throw($dbh->errstr);
 390     close FH;
 391     #unlink $path;
 392   }
 393   delete $self->{bulk_update_in_progress};
 394   delete $self->{filehandles};
 395 }
 396
 397
 398 ###
 399 # Add a subparts to a feature. Both feature and all subparts must already be in database.
 400 #
 401 sub _add_SeqFeature {
 402   my $self     = shift;
 403
 404   # special purpose method for case when we are doing a bulk update
 405   return $self->_dump_add_SeqFeature(@_) if $self->{bulk_update_in_progress};
 406
 407   my $parent   = shift;
 408   my @children = @_;
 409
 410   my $dbh = $self->dbh;
 411   local $dbh->{RaiseError} = 1;
 412
 413   my $child_table = $self->_parent2child_table();
 414   my $count = 0;
 415
 416   my $querydel = "DELETE FROM $child_table WHERE id = ? AND child = ?";
 417   my $query = "INSERT INTO $child_table (id,child) VALUES (?,?)";
 418   my $sthdel = $self->_prepare($querydel);
 419   my $sth = $self->_prepare($query);
 420
 421   my $parent_id = (ref $parent ? $parent->primary_id : $parent)
 422     or $self->throw("$parent should have a primary_id");
 423
 424   $dbh->begin_work or $self->throw($dbh->errstr);
 425   eval {
 426     for my $child (@children) {
 427       my $child_id = ref $child ? $child->primary_id : $child;
 428       defined $child_id or die "no primary ID known for $child";
 429       $sthdel->execute($parent_id, $child_id);
 430       $sth->execute($parent_id,$child_id);
 431       $count++;
 432     }
 433   };
 434
 435   if ($@) {
 436     warn "Transaction aborted because $@";
 437     $dbh->rollback;
 438   }
 439   else {
 440     $dbh->commit;
 441   }
 442   $sth->finish;
 443   $count;
 444 }
 445
 446 # because this is a reserved word in postgresql
 447 ###
 448 # get primary sequence between start and end
 449 #
 450 sub _fetch_sequence {
 451   my $self = shift;
 452   my ($seqid,$start,$end) = @_;
 453
 454   # backward compatibility to the old days when I liked reverse complementing
 455   # dna by specifying $start > $end
 456   my $reversed;
 457   if (defined $start && defined $end && $start > $end) {
 458     $reversed++;
 459     ($start,$end) = ($end,$start);
 460   }
 461   $start-- if defined $start;
 462   $end--   if defined $end;
 463
 464   my $offset1 = $self->_offset_boundary($seqid,$start || 'left');
 465   my $offset2 = $self->_offset_boundary($seqid,$end   || 'right');
 466   my $sequence_table = $self->_sequence_table;
 467   my $locationlist_table = $self->_locationlist_table;
 468
 469   my $sth     = $self->_prepare(<<END);
 470 SELECT sequence,"offset"
 471    FROM $sequence_table as s,$locationlist_table as ll
 472    WHERE s.id=ll.id
 473      AND ll.seqname= ?
 474      AND "offset" >= ?
 475      AND "offset" <= ?
 476    ORDER BY "offset"
 477 END
 478
 479   my $seq = '';
 480   $sth->execute($seqid,$offset1,$offset2) or $self->throw($sth->errstr);
 481
 482   while (my($frag,$offset) = $sth->fetchrow_array) {
 483     substr($frag,0,$start-$offset) = '' if defined $start && $start > $offset;
 484     $seq .= $frag;
 485   }
 486   substr($seq,$end-$start+1) = '' if defined $end && $end-$start+1 < length($seq);
 487   if ($reversed) {
 488     $seq = reverse $seq;
 489     $seq =~ tr/gatcGATC/ctagCTAG/;
 490   }
 491   $sth->finish;
 492   $seq;
 493 }
 494
 495 sub _offset_boundary {
 496   my $self = shift;
 497   my ($seqid,$position) = @_;
 498
 499   my $sequence_table     = $self->_sequence_table;
 500   my $locationlist_table = $self->_locationlist_table;
 501
 502   my $sql;
 503   $sql =  $position eq 'left'  ? "SELECT min(\"offset\") FROM $sequence_table as s,$locationlist_table as ll WHERE s.id=ll.id AND ll.seqname=?"
 504          :$position eq 'right' ? "SELECT max(\"offset\") FROM $sequence_table as s,$locationlist_table as ll WHERE s.id=ll.id AND ll.seqname=?"
 505          :"SELECT max(\"offset\") FROM $sequence_table as s,$locationlist_table as ll WHERE s.id=ll.id AND ll.seqname=? AND \"offset\"<=?";
 506
 507   my $sth = $self->_prepare($sql);
 508   my @args = $position =~ /^-?\d+$/ ? ($seqid,$position) : ($seqid);
 509   $sth->execute(@args) or $self->throw($sth->errstr);
 510   my $boundary = $sth->fetchall_arrayref->[0][0];
 511   $sth->finish;
 512   return $boundary;
 513 }
 514
 515 sub _name_sql {
 516   my $self = shift;
 517   my ($name,$allow_aliases,$join) = @_;
 518   my $name_table   = $self->_name_table;
 519
 520   my $from  = "$name_table as n";
 521   my ($match,$string) = $self->_match_sql($name);
 522
 523   my $where = "n.id=$join AND lower(n.name) $match";
 524   $where   .= " AND n.display_name>0" unless $allow_aliases;
 525   return ($from,$where,'',$string);
 526 }
 527
 528 sub _search_attributes {
 529   my $self = shift;
 530   my ($search_string,$attribute_names,$limit) = @_;
 531   my @words               = map {quotemeta($_)} split /\s+/,$search_string;
 532   my $name_table          = $self->_name_table;
 533   my $attribute_table     = $self->_attribute_table;
 534   my $attributelist_table = $self->_attributelist_table;
 535   my $type_table          = $self->_type_table;
 536   my $typelist_table      = $self->_typelist_table;
 537
 538   my @tags    = @$attribute_names;
 539   my $tag_sql = join ' OR ',("al.tag=?") x @tags;
 540
 541   my $perl_regexp = join '|',@words;
 542
 543   my @wild_card_words = map { "%$_%" } @words;
 544   my $sql_regexp = join ' OR ',("a.attribute_value SIMILAR TO ?")  x @words;
 545   my $sql = <<END;
 546 SELECT name,attribute_value,tl.tag,n.id
 547   FROM $name_table as n,$attribute_table as a,$attributelist_table as al,$type_table as t,$typelist_table as tl
 548   WHERE n.id=a.id
 549     AND al.id=a.attribute_id
 550     AND n.id=t.id
 551     AND t.typeid=tl.id
 552     AND n.display_name=1
 553     AND ($tag_sql)
 554     AND ($sql_regexp)
 555 END
 556   $sql .= "LIMIT $limit" if defined $limit;
 557   $self->_print_query($sql,@tags,@wild_card_words) if DEBUG || $self->debug;
 558   my $sth = $self->_prepare($sql);
 559   $sth->execute(@tags,@wild_card_words) or $self->throw($sth->errstr);
 560
 561   my @results;
 562   while (my($name,$value,$type,$id) = $sth->fetchrow_array) {
 563     my (@hits) = $value =~ /$perl_regexp/ig;
 564     my @words_in_row = split /\b/,$value;
 565     my $score  = int(@hits*100/@words/@words_in_row);
 566     push @results,[$name,$value,$score,$type,$id];
 567   }
 568   $sth->finish;
 569   @results = sort {$b->[2]<=>$a->[2]} @results;
 570   return @results;
 571 }
 572
 573 # overridden here because the mysql adapter uses
 574 # a non-standard query hint
 575 sub _attributes_sql {
 576   my $self = shift;
 577   my ($attributes,$join) = @_;
 578
 579   my ($wf,@bind_args)       = $self->_make_attribute_where('a','al',$attributes);
 580   my ($group_by,@group_args)= $self->_make_attribute_group('a',$attributes);
 581
 582   my $attribute_table       = $self->_attribute_table;
 583   my $attributelist_table   = $self->_attributelist_table;
 584
 585   my $from = "$attribute_table as a, $attributelist_table as al";
 586
 587   my $where = <<END;
 588   a.id=$join
 589   AND   a.attribute_id=al.id
 590   AND ($wf)
 591 END
 592
 593   my $group = $group_by;
 594
 595   my @args  = (@bind_args,@group_args);
 596   return ($from,$where,$group,@args);
 597 }
 598
 599 sub _match_sql {
 600   my $self = shift;
 601   my $name = shift;
 602
 603   my ($match,$string);
 604   if ($name =~ /(?:^|[^\\])[*?]/) {
 605     $name =~ s/(^|[^\\])([%_])/$1\\$2/g;
 606     $name =~ s/(^|[^\\])\*/$1%/g;
 607     $name =~ s/(^|[^\\])\?/$1_/g;
 608     $match = "ILIKE ?";
 609     $string  = $name;
 610   } else {
 611     $match = "= lower(?)";
 612     $string  = lc($name);
 613   }
 614   return ($match,$string);
 615 }
 616
 617 # overridden because of differences between LIKE behavior in mysql and postgres
 618 # as well as case-sensitivity of matches
 619 sub _types_sql {
 620   my $self  = shift;
 621   my ($types,$type_table) = @_;
 622   my ($primary_tag,$source_tag);
 623
 624   my @types = ref $types eq 'ARRAY' ?  @$types : $types;
 625
 626   my $typelist      = $self->_typelist_table;
 627   my $from = "$typelist AS tl";
 628
 629   my (@matches,@args);
 630
 631   for my $type (@types) {
 632
 633     if (ref $type && $type->isa('Bio::DB::GFF::Typename')) {
 634       $primary_tag = $type->method;
 635       $source_tag  = $type->source;
 636     } else {
 637       ($primary_tag,$source_tag) = split ':',$type,2;
 638     }
 639
 640     if (defined $source_tag) {
 641       push @matches,"lower(tl.tag)=lower(?)";
 642       push @args,"$primary_tag:$source_tag";
 643     } else {
 644       push @matches,"tl.tag ILIKE ?";
 645       push @args,"$primary_tag:%";
 646     }
 647   }
 648   my $matches = join ' OR ',@matches;
 649
 650   my $where = <<END;
 651    tl.id=$type_table.typeid
 652    AND   ($matches)
 653 END
 654
 655   return ($from,$where,'',@args);
 656 }
 657
 658 # overridden because mysql adapter uses the non-standard REPLACE syntax
 659 sub setting {
 660   my $self = shift;
 661   my ($variable_name,$value) = @_;
 662   my $meta  = $self->_meta_table;
 663
 664   if (defined $value && $self->writeable) {
 665     my $querydel = "DELETE FROM $meta WHERE name = ?";
 666     my $query    = "INSERT INTO $meta (name,value) VALUES (?,?)";
 667     my $sthdel   = $self->_prepare($querydel);
 668     my $sth      = $self->_prepare($query);
 669     $sthdel->execute($variable_name);
 670     $sth->execute($variable_name,$value) or $self->throw($sth->errstr);
 671     $sth->finish;
 672     $self->{settings_cache}{$variable_name} = $value;
 673   }
 674   else {
 675     return $self->{settings_cache}{$variable_name} if exists $self->{settings_cache}{$variable_name};
 676     my $query = "SELECT value FROM $meta as m WHERE m.name=?";
 677     my $sth = $self->_prepare($query);
 678 #    $sth->execute($variable_name) or $self->throw($sth->errstr);
 679     unless ($sth->execute($variable_name)) {
 680       my $errstr = $sth->errstr;
 681       $sth = $self->_prepare("SHOW search_path");
 682       $sth->execute();
 683       $errstr .= "With search_path " . $sth->fetchrow_arrayref->[0] . "\n";
 684       $self->throw($errstr);
 685     }
 686
 687     my ($value) = $sth->fetchrow_array;
 688     $sth->finish;
 689     return $self->{settings_cache}{$variable_name} = $value;
 690   }
 691 }
 692
 693 # overridden because of use of REPLACE in mysql adapter
 694 ###
 695 # Replace Bio::SeqFeatureI into database.
 696 #
 697 sub replace {
 698   my $self       = shift;
 699   my $object     = shift;
 700   my $index_flag = shift || undef;
 701
 702   # ?? shouldn't need to do this
 703   # $self->_load_class($object);
 704   my $id = $object->primary_id;
 705   my $features = $self->_feature_table;
 706
 707   my $query = "INSERT INTO $features (id,object,indexed,seqid,start,\"end\",strand,tier,bin,typeid) VALUES (?,?,?,?,?,?,?,?,?,?)";
 708   my $query_noid = "INSERT INTO $features (object,indexed,seqid,start,\"end\",strand,tier,bin,typeid) VALUES (?,?,?,?,?,?,?,?,?)";
 709   my $querydel = "DELETE FROM $features WHERE id = ?";
 710
 711   my $sthdel = $self->_prepare($querydel);
 712   my $sth = $self->_prepare($query);
 713   my $sth_noid = $self->_prepare($query_noid);
 714
 715   my @location = $index_flag ? $self->_get_location_and_bin($object) : (undef)x6;
 716
 717   my $primary_tag = $object->primary_tag;
 718   my $source_tag  = $object->source_tag || '';
 719   $primary_tag    .= ":$source_tag";
 720   my $typeid   = $self->_typeid($primary_tag,1);
 721
 722   if ($id) {
 723     $sthdel->execute($id);
 724     $sth->execute($id,encode_base64($self->freeze($object), ''),$index_flag||0,@location,$typeid) or $self->throw($sth->errstr);
 725   } else {
 726     $sth_noid->execute(encode_base64($self->freeze($object), ''),$index_flag||0,@location,$typeid) or $self->throw($sth->errstr);
 727   }
 728
 729   my $dbh = $self->dbh;
 730
 731   $object->primary_id($dbh->last_insert_id(undef, undef, undef, undef, {sequence=>$features."_id_seq"})) unless defined $id;
 732
 733   $self->flag_for_indexing($dbh->last_insert_id(undef, undef, undef, undef, {sequence=>$features."_id_seq"})) if $self->{bulk_update_in_progress};
 734 }
 735
 736 =head2 types
 737
 738  Title   : types
 739  Usage   : @type_list = $db->types
 740  Function: Get all the types in the database
 741  Returns : array of Bio::DB::GFF::Typename objects
 742  Args    : none
 743  Status  : public
 744
 745 =cut
 746
 747 # overridden because "offset" is reserved in postgres
 748 ###
 749 # Insert a bit of DNA or protein into the database
 750 #
 751 sub _insert_sequence {
 752   my $self = shift;
 753   my ($seqid,$seq,$offset) = @_;
 754   my $id = $self->_locationid($seqid);
 755   my $seqtable = $self->_sequence_table;
 756   my $sthdel = $self->_prepare("DELETE FROM $seqtable WHERE id = ? AND \"offset\" = ?");
 757   my $sth = $self->_prepare(<<END);
 758 INSERT INTO $seqtable (id,"offset",sequence) VALUES (?,?,?)
 759 END
 760   $sthdel->execute($id,$offset);
 761   $sth->execute($id,$offset,$seq) or $self->throw($sth->errstr);
 762 }
 763
 764 # overridden because of mysql adapter's use of REPLACE
 765 ###
 766 # This subroutine flags the given primary ID for later reindexing
 767 #
 768 sub flag_for_indexing {
 769   my $self = shift;
 770   my $id   = shift;
 771   my $needs_updating = $self->_update_table;
 772
 773   my $querydel = "DELETE FROM $needs_updating WHERE id = ?";
 774   my $query = "INSERT INTO $needs_updating VALUES (?)";
 775   my $sthdel = $self->_prepare($querydel);
 776   my $sth = $self->_prepare($query);
 777
 778   $sthdel->execute($id);
 779   $sth->execute($id) or $self->throw($self->dbh->errstr);
 780 }
 781
 782 # overridden because of the different ways that mysql and postgres
 783 # handle id sequences
 784 sub _genericid {
 785   my $self = shift;
 786   my ($table,$namefield,$name,$add_if_missing) = @_;
 787   my $qualified_table = $self->_qualify($table);
 788   my $sth = $self->_prepare(<<END);
 789 SELECT id FROM $qualified_table WHERE $namefield=?
 790 END
 791   $sth->execute($name) or die $sth->errstr;
 792   my ($id) = $sth->fetchrow_array;
 793   $sth->finish;
 794   return $id if defined $id;
 795   return     unless $add_if_missing;
 796
 797   $sth = $self->_prepare(<<END);
 798 INSERT INTO $qualified_table ($namefield) VALUES (?)
 799 END
 800   $sth->execute($name) or die $sth->errstr;
 801   my $dbh = $self->dbh;
 802   return $dbh->last_insert_id(undef, undef, undef, undef, {sequence=>$qualified_table."_id_seq"});
 803 }
 804
 805 # overridden because of differences in binding between mysql and postgres adapters
 806 # given a statement handler that is expected to return rows of (id,object)
 807 # unthaw each object and return a list of 'em
 808 sub _sth2objs {
 809   my $self = shift;
 810   my $sth  = shift;
 811   my @result;
 812   my ($id, $o);
 813         $sth->bind_col(1, \$id);
 814         $sth->bind_col(2, \$o, { pg_type => PG_BYTEA});
 815   #while (my ($id,$o) = $sth->fetchrow_array) {
 816   while ($sth->fetch) {
 817     my $obj = $self->thaw(decode_base64($o) ,$id);
 818     push @result,$obj;
 819   }
 820   $sth->finish;
 821   return @result;
 822 }
 823
 824 # given a statement handler that is expected to return rows of (id,object)
 825 # unthaw each object and return a list of 'em
 826 sub _sth2obj {
 827   my $self = shift;
 828   my $sth  = shift;
 829   my ($id,$o) = $sth->fetchrow_array;
 830   return unless $o;
 831   my $obj = $self->thaw(decode_base64($o) ,$id);
 832   $obj;
 833 }
 834
 835 ####################################################################################################
 836 # SQL Fragment generators
 837 ####################################################################################################
 838
 839 # overridden because of base64 encoding needed here
 840 ###
 841 # special-purpose store for bulk loading - write to a file rather than to the db
 842 #
 843 sub _dump_store {
 844   my $self    = shift;
 845   my $indexed = shift;
 846
 847   my $count = 0;
 848   my $store_fh = $self->dump_filehandle('feature');
 849   my $dbh      = $self->dbh;
 850
 851   my $autoindex = $self->autoindex;
 852
 853   for my $obj (@_) {
 854     my $id       = $self->next_id;
 855     my ($seqid,$start,$end,$strand,$tier,$bin) = $indexed ? $self->_get_location_and_bin($obj) : (undef)x6;
 856     my $primary_tag = $obj->primary_tag;
 857     my $source_tag  = $obj->source_tag || '';
 858     $primary_tag    .= ":$source_tag";
 859     my $typeid   = $self->_typeid($primary_tag,1);
 860
 861                 my $frozen_object = encode_base64($self->freeze($obj), '');
 862                 # TODO: Fix this, why does frozen object start with quote but not end with one
 863     print $store_fh join("\t",$id,$typeid,$seqid,$start,$end,$strand,$tier,$bin,$indexed,$frozen_object),"\n";
 864     $obj->primary_id($id);
 865     $self->_update_indexes($obj) if $indexed && $autoindex;
 866     $count++;
 867   }
 868
 869   # remember whether we are have ever stored a non-indexed feature
 870   unless ($indexed or $self->{indexed_flag}++) {
 871     $self->subfeatures_are_indexed(0);
 872   }
 873   $count;
 874 }
 875
 876 1;