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 -- PostgreSQL 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 Pg 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 Pg 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        Creates a SCHEMA for the tables. 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 use constant MAX_INT =>  2_147_483_647;
 167 use constant MIN_INT => -2_147_483_648;
 168 use constant MAX_BIN =>  1_000_000_000;  # size of largest feature = 1 Gb
 169 use constant MIN_BIN =>  1000;           # smallest bin we'll make - on a 100 Mb chromosome, there'll be 100,000 of these
 170
 171 ###
 172 # object initialization
 173 #
 174 # NOTE: most of this code can be refactored and inherited from DBI or DBI::mysql adapter
 175 #
 176 sub init {
 177   my $self          = shift;
 178   my ($dsn,
 179       $is_temporary,
 180       $autoindex,
 181       $namespace,
 182       $dump_dir,
 183       $user,
 184       $pass,
 185       $dbi_options,
 186       $writeable,
 187       $create,
 188       $schema,
 189      ) = rearrange(['DSN',
 190                     ['TEMP','TEMPORARY'],
 191                     'AUTOINDEX',
 192                     'NAMESPACE',
 193                     ['DUMP_DIR','DUMPDIR','TMP','TMPDIR'],
 194                     'USER',
 195                     ['PASS','PASSWD','PASSWORD'],
 196                     ['OPTIONS','DBI_OPTIONS','DBI_ATTR'],
 197                     ['WRITE','WRITEABLE'],
 198                     'CREATE',
 199                     'SCHEMA'
 200                    ],@_);
 201
 202
 203   $dbi_options  ||= {pg_server_prepare => 0};
 204   $writeable    = 1 if $is_temporary or $dump_dir;
 205
 206   $dsn or $self->throw("Usage: ".__PACKAGE__."->init(-dsn => \$dbh || \$dsn)");
 207
 208   my $dbh;
 209   if (ref $dsn) {
 210     $dbh = $dsn;
 211   } else {
 212     $dsn = "dbi:Pg:$dsn" unless $dsn =~ /^dbi:/;
 213     $dbh = DBI->connect($dsn,$user,$pass,$dbi_options) or $self->throw($DBI::errstr);
 214   }
 215   $dbh->do('set client_min_messages=warning') if $dbh;
 216   $self->{'original_arguments'} = {
 217       'dsn' => $dsn,
 218       'user' => $user,
 219       'pass' => $pass,
 220       'dbh_options' => $dbi_options,
 221   };
 222   $self->{dbh}       = $dbh;
 223   $self->{dbh}->{InactiveDestroy} = 1;
 224   $self->{is_temp}   = $is_temporary;
 225   $self->{writeable} = $writeable;
 226   $self->{namespace} = $namespace || $schema || 'public';
 227   $self->schema($self->{namespace});
 228
 229   $self->default_settings;
 230   $self->autoindex($autoindex)                   if defined $autoindex;
 231   $self->dumpdir($dump_dir)                      if $dump_dir;
 232   if ($self->is_temp) {
 233     # warn "creating a temp database isn't supported";
 234     #$self->init_tmp_database();
 235     $self->init_database('erase');
 236   } elsif ($create) {
 237     $self->init_database('erase');
 238   }
 239 }
 240
 241 sub table_definitions {
 242   my $self = shift;
 243   return {
 244           feature => <<END,
 245 (
 246   id       serial primary key,
 247   typeid   int      not null,
 248   seqid    int,
 249   start    int,
 250   "end"      int,
 251   strand   int      default 0,
 252   tier     int,
 253   bin      int,
 254   indexed  int default 1,
 255   object     bytea not null
 256 );
 257   CREATE INDEX feature_stuff ON feature(seqid,tier,bin,typeid);
 258   CREATE INDEX feature_typeid ON feature(typeid);
 259 END
 260
 261           locationlist => <<END,
 262 (
 263   id         serial primary key,
 264   seqname    text   not null
 265 ); CREATE INDEX locationlist_seqname ON locationlist(seqname);
 266 END
 267
 268           typelist => <<END,
 269 (
 270   id       serial primary key,
 271   tag      text  not null
 272 ); CREATE INDEX typelist_tab ON typelist(tag);
 273 END
 274           name => <<END,
 275 (
 276   id           int       not null,
 277   name         text  not null,
 278   display_name int       default 0
 279 );
 280   CREATE INDEX name_id ON name( id );
 281   CREATE INDEX name_name ON name( name );
 282   CREATE INDEX name_lcname ON name( lower(name) );
 283   CREATE INDEX name_lcname_varchar_patt_ops ON name USING BTREE (lower(name) varchar_pattern_ops);
 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      text  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 UNIQUE INDEX parent2child_id_child ON parent2child(id,child);
 309 END
 310
 311           meta => <<END,
 312 (
 313   name      text primary key,
 314   value     text 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     interval_stats => <<END,
 327 (
 328    typeid            int not null,
 329    seqid             int not null,
 330    bin               int not null,
 331    cum_count         int not null
 332  );
 333  CREATE UNIQUE INDEX interval_stats_id ON interval_stats(typeid,seqid,bin);
 334 END
 335          };
 336 }
 337
 338 sub schema {
 339   my ($self, $schema) = @_;
 340   $self->{'schema'} = $schema if defined($schema);
 341   if ($schema) {
 342     $self->_check_for_namespace();
 343     $self->dbh->do("SET search_path TO " . $self->{'schema'} );
 344   } else {
 345     $self->dbh->do("SET search_path TO public");
 346   }
 347   return $self->{'schema'};
 348 }
 349 ###
 350 # wipe database clean and reinstall schema
 351 #
 352 sub _init_database {
 353   my $self = shift;
 354   my $erase = shift;
 355
 356   my $dbh    = $self->dbh;
 357   my $namespace = $self->namespace;
 358   my $tables = $self->table_definitions;
 359     my $temporary = $self->is_temp ? 'TEMPORARY' : '';
 360   foreach (keys %$tables) {
 361     next if $_ eq 'meta';      # don't get rid of meta data!
 362     my $table = $self->_qualify($_);
 363     $dbh->do("DROP TABLE IF EXISTS $table") if $erase;
 364     my @table_exists = $dbh->selectrow_array("SELECT * FROM pg_tables WHERE tablename = '$table' AND schemaname = '$self->namespace'");
 365                 if (!scalar(@table_exists)) {
 366                         my $query = "CREATE $temporary TABLE $table $tables->{$_}";
 367                         $dbh->do($query) or $self->throw($dbh->errstr);
 368                 }
 369   }
 370   $self->subfeatures_are_indexed(1) if $erase;
 371   1;
 372 }
 373
 374 sub maybe_create_meta {
 375   my $self = shift;
 376   return unless $self->writeable;
 377   my $namespace    = $self->namespace;
 378   my $table        = $self->_qualify('meta');
 379   my $tables       = $self->table_definitions;
 380   my $temporary    = $self->is_temp ? 'TEMPORARY' : '';
 381   my @table_exists = $self->dbh->selectrow_array("SELECT * FROM pg_tables WHERE tablename = 'meta' AND schemaname = '$namespace'");
 382   $self->dbh->do("CREATE $temporary TABLE $table $tables->{meta}")
 383       unless @table_exists;
 384 }
 385
 386 ###
 387 # check if the namespace/schema exists, if not create it
 388 #
 389
 390 sub _check_for_namespace {
 391   my $self = shift;
 392   my $namespace = $self->namespace;
 393   return if $namespace eq 'public';
 394   my $dbh  = $self->dbh;
 395   my @schema_exists = $dbh->selectrow_array("SELECT * FROM pg_namespace WHERE nspname = '$namespace'");
 396   if (!scalar(@schema_exists)) {
 397       my $query = "CREATE SCHEMA $namespace";
 398           $dbh->do($query) or $self->throw($dbh->errstr);
 399
 400           # if temp parameter is set and schema created for this process then enable removal in remove_namespace()
 401           if ($self->is_temp) {
 402               $self->{delete_schema} = 1;
 403           }
 404   }
 405 }
 406
 407 ###
 408 # Overiding inherited mysql _qualify (We do not need to qualify for PostgreSQL as we have set the search_path above)
 409 #
 410 sub _qualify {
 411   my $self = shift;
 412   my $table_name = shift;
 413   return $table_name;
 414 }
 415
 416 ###
 417 # when is_temp is set and the schema did not exist beforehand then we are able to remove it
 418 #
 419 sub remove_namespace {
 420   my $self = shift;
 421   if ($self->{delete_schema}) {
 422       my $namespace = $self->namespace;
 423       $self->dbh->do("DROP SCHEMA $namespace") or $self->throw($self->dbh->errstr);
 424   }
 425 }
 426
 427 ####Overiding the inherited mysql function _prepare
 428
 429 sub _prepare {
 430    my $self = shift;
 431    my $query = shift;
 432    my $dbh   = $self->dbh;
 433    my $schema = $self->{namespace};
 434
 435    if ($schema) {
 436      $self->_check_for_namespace();
 437      $dbh->do("SET search_path TO " . $self->{'schema'} );
 438    } else {
 439      $dbh->do("SET search_path TO public");
 440    }
 441    my $sth   = $dbh->prepare_cached($query, {}, 3) or
 442    $self->throw($dbh->errstr);
 443    $sth;
 444 }
 445
 446 sub _finish_bulk_update {
 447   my $self = shift;
 448   my $dbh  = $self->dbh;
 449   my $dir  = $self->{dumpdir} || '.';
 450   for my $table ('feature',$self->index_tables) {
 451     my $fh   = $self->dump_filehandle($table);
 452     my $path = $self->dump_path($table);
 453     $fh->close;
 454     my $qualified_table = $self->_qualify($table);
 455     system "cp $path $path.bak";
 456     # Get stuff from file into STDIN so we don't have to be superuser
 457     open my $FH, '<', $path or $self->throw("Could not read file '$path': $!");
 458     print STDERR "Loading file $path\n";
 459     $dbh->do("COPY $qualified_table FROM STDIN CSV QUOTE '''' DELIMITER '\t'") or $self->throw($dbh->errstr);
 460     while (my $line = <$FH>) {
 461       $dbh->pg_putline($line);
 462     }
 463     $dbh->pg_endcopy() or $self->throw($dbh->errstr);
 464     close $FH;
 465     #unlink $path;
 466   }
 467   delete $self->{bulk_update_in_progress};
 468   delete $self->{filehandles};
 469 }
 470
 471
 472 ###
 473 # Add a subparts to a feature. Both feature and all subparts must already be in database.
 474 #
 475 sub _add_SeqFeature {
 476   my $self     = shift;
 477
 478   # special purpose method for case when we are doing a bulk update
 479   return $self->_dump_add_SeqFeature(@_) if $self->{bulk_update_in_progress};
 480
 481   my $parent   = shift;
 482   my @children = @_;
 483
 484   my $dbh = $self->dbh;
 485   local $dbh->{RaiseError} = 1;
 486
 487   my $child_table = $self->_parent2child_table();
 488   my $count = 0;
 489
 490   my $querydel = "DELETE FROM $child_table WHERE id = ? AND child = ?";
 491   my $query = "INSERT INTO $child_table (id,child) VALUES (?,?)";
 492   my $sthdel = $self->_prepare($querydel);
 493   my $sth = $self->_prepare($query);
 494
 495   my $parent_id = (ref $parent ? $parent->primary_id : $parent)
 496     or $self->throw("$parent should have a primary_id");
 497
 498   $self->begin_work or $self->throw($dbh->errstr);
 499   eval {
 500     for my $child (@children) {
 501       my $child_id = ref $child ? $child->primary_id : $child;
 502       defined $child_id or die "no primary ID known for $child";
 503       $sthdel->execute($parent_id, $child_id);
 504       $sth->execute($parent_id,$child_id);
 505       $count++;
 506     }
 507   };
 508
 509   if ($@) {
 510     warn "Transaction aborted because $@";
 511     $self->rollback;
 512   }
 513   else {
 514     $self->commit;
 515   }
 516   $sth->finish;
 517   $count;
 518 }
 519
 520 # because this is a reserved word in postgresql
 521 ###
 522 # get primary sequence between start and end
 523 #
 524 sub _fetch_sequence {
 525   my $self = shift;
 526   my ($seqid,$start,$end) = @_;
 527
 528   # backward compatibility to the old days when I liked reverse complementing
 529   # dna by specifying $start > $end
 530   my $reversed;
 531   if (defined $start && defined $end && $start > $end) {
 532     $reversed++;
 533     ($start,$end) = ($end,$start);
 534   }
 535   $start-- if defined $start;
 536   $end--   if defined $end;
 537
 538   my $offset1 = $self->_offset_boundary($seqid,$start || 'left');
 539   my $offset2 = $self->_offset_boundary($seqid,$end   || 'right');
 540   my $sequence_table = $self->_sequence_table;
 541   my $locationlist_table = $self->_locationlist_table;
 542
 543   my $sth     = $self->_prepare(<<END);
 544 SELECT sequence,"offset"
 545    FROM $sequence_table as s,$locationlist_table as ll
 546    WHERE s.id=ll.id
 547      AND ll.seqname= ?
 548      AND "offset" >= ?
 549      AND "offset" <= ?
 550    ORDER BY "offset"
 551 END
 552
 553   my $seq = '';
 554   $sth->execute($seqid,$offset1,$offset2) or $self->throw($sth->errstr);
 555
 556   while (my($frag,$offset) = $sth->fetchrow_array) {
 557     substr($frag,0,$start-$offset) = '' if defined $start && $start > $offset;
 558     $seq .= $frag;
 559   }
 560   substr($seq,$end-$start+1) = '' if defined $end && $end-$start+1 < length($seq);
 561   if ($reversed) {
 562     $seq = reverse $seq;
 563     $seq =~ tr/gatcGATC/ctagCTAG/;
 564   }
 565   $sth->finish;
 566   $seq;
 567 }
 568
 569 sub _offset_boundary {
 570   my $self = shift;
 571   my ($seqid,$position) = @_;
 572
 573   my $sequence_table     = $self->_sequence_table;
 574   my $locationlist_table = $self->_locationlist_table;
 575
 576   my $sql;
 577   $sql =  $position eq 'left'  ? "SELECT min(\"offset\") FROM $sequence_table as s,$locationlist_table as ll WHERE s.id=ll.id AND ll.seqname=?"
 578          :$position eq 'right' ? "SELECT max(\"offset\") FROM $sequence_table as s,$locationlist_table as ll WHERE s.id=ll.id AND ll.seqname=?"
 579          :"SELECT max(\"offset\") FROM $sequence_table as s,$locationlist_table as ll WHERE s.id=ll.id AND ll.seqname=? AND \"offset\"<=?";
 580
 581   my $sth = $self->_prepare($sql);
 582   my @args = $position =~ /^-?\d+$/ ? ($seqid,$position) : ($seqid);
 583   $sth->execute(@args) or $self->throw($sth->errstr);
 584   my $boundary = $sth->fetchall_arrayref->[0][0];
 585   $sth->finish;
 586   return $boundary;
 587 }
 588
 589 sub _name_sql {
 590   my $self = shift;
 591   my ($name,$allow_aliases,$join) = @_;
 592   my $name_table   = $self->_name_table;
 593
 594   my $from  = "$name_table as n";
 595   my ($match,$string) = $self->_match_sql($name);
 596
 597   my $where = "n.id=$join AND lower(n.name) $match";
 598   $where   .= " AND n.display_name>0" unless $allow_aliases;
 599   return ($from,$where,'',$string);
 600 }
 601
 602 sub _search_attributes {
 603   my $self = shift;
 604   my ($search_string,$attribute_names,$limit) = @_;
 605   my @words               = map {quotemeta($_)} split /\s+/,$search_string;
 606   my $name_table          = $self->_name_table;
 607   my $attribute_table     = $self->_attribute_table;
 608   my $attributelist_table = $self->_attributelist_table;
 609   my $type_table          = $self->_type_table;
 610   my $typelist_table      = $self->_typelist_table;
 611
 612   my @tags    = @$attribute_names;
 613   my $tag_sql = join ' OR ',("al.tag=?") x @tags;
 614
 615   my $perl_regexp = join '|',@words;
 616
 617   my @wild_card_words = map { "%$_%" } @words;
 618   my $sql_regexp = join ' OR ',("a.attribute_value SIMILAR TO ?")  x @words;
 619   my $sql = <<END;
 620 SELECT name,attribute_value,tl.tag,n.id
 621   FROM $name_table as n,$attribute_table as a,$attributelist_table as al,$type_table as t,$typelist_table as tl
 622   WHERE n.id=a.id
 623     AND al.id=a.attribute_id
 624     AND n.id=t.id
 625     AND t.typeid=tl.id
 626     AND n.display_name=1
 627     AND ($tag_sql)
 628     AND ($sql_regexp)
 629 END
 630   $sql .= "LIMIT $limit" if defined $limit;
 631   $self->_print_query($sql,@tags,@wild_card_words) if DEBUG || $self->debug;
 632   my $sth = $self->_prepare($sql);
 633   $sth->execute(@tags,@wild_card_words) or $self->throw($sth->errstr);
 634
 635   my @results;
 636   while (my($name,$value,$type,$id) = $sth->fetchrow_array) {
 637     my (@hits) = $value =~ /$perl_regexp/ig;
 638     my @words_in_row = split /\b/,$value;
 639     my $score  = int(@hits*100/@words/@words_in_row);
 640     push @results,[$name,$value,$score,$type,$id];
 641   }
 642   $sth->finish;
 643   @results = sort {$b->[2]<=>$a->[2]} @results;
 644   return @results;
 645 }
 646
 647 # overridden here because the mysql adapter uses
 648 # a non-standard query hint
 649 sub _attributes_sql {
 650   my $self = shift;
 651   my ($attributes,$join) = @_;
 652
 653   my ($wf,@bind_args)       = $self->_make_attribute_where('a','al',$attributes);
 654   my ($group_by,@group_args)= $self->_make_attribute_group('a',$attributes);
 655
 656   my $attribute_table       = $self->_attribute_table;
 657   my $attributelist_table   = $self->_attributelist_table;
 658
 659   my $from = "$attribute_table as a, $attributelist_table as al";
 660
 661   my $where = <<END;
 662   a.id=$join
 663   AND   a.attribute_id=al.id
 664   AND ($wf)
 665 END
 666
 667   my $group = $group_by;
 668
 669   my @args  = (@bind_args,@group_args);
 670   return ($from,$where,$group,@args);
 671 }
 672
 673 sub _match_sql {
 674   my $self = shift;
 675   my $name = shift;
 676
 677   my ($match,$string);
 678   if ($name =~ /(?:^|[^\\])[*?]/) {
 679     $name =~ s/(^|[^\\])([%_])/$1\\$2/g;
 680     $name =~ s/(^|[^\\])\*/$1%/g;
 681     $name =~ s/(^|[^\\])\?/$1_/g;
 682     $match = "LIKE ?";
 683     $string  = lc($name);
 684   } else {
 685     $match = "= lower(?)";
 686     $string  = lc($name);
 687   }
 688   return ($match,$string);
 689 }
 690
 691 # overridden because of differences between LIKE behavior in mysql and postgres
 692 # as well as case-sensitivity of matches
 693 sub _types_sql {
 694   my $self  = shift;
 695   my ($types,$type_table) = @_;
 696   my ($primary_tag,$source_tag);
 697
 698   my @types = ref $types eq 'ARRAY' ?  @$types : $types;
 699
 700   my $typelist      = $self->_typelist_table;
 701   my $from = "$typelist AS tl";
 702
 703   my (@matches,@args);
 704
 705   for my $type (@types) {
 706
 707     if (ref $type && $type->isa('Bio::DB::GFF::Typename')) {
 708       $primary_tag = $type->method;
 709       $source_tag  = $type->source;
 710     } else {
 711       ($primary_tag,$source_tag) = split ':',$type,2;
 712     }
 713
 714     if ($source_tag) {
 715       push @matches,"lower(tl.tag)=lower(?)";
 716       push @args,"$primary_tag:$source_tag";
 717     } else {
 718       push @matches,"tl.tag ILIKE ?";
 719       push @args,"$primary_tag:%";
 720     }
 721   }
 722   my $matches = join ' OR ',@matches;
 723
 724   my $where = <<END;
 725    tl.id=$type_table.typeid
 726    AND   ($matches)
 727 END
 728
 729   return ($from,$where,'',@args);
 730 }
 731
 732 # overridden because mysql adapter uses the non-standard REPLACE syntax
 733 sub setting {
 734   my $self = shift;
 735   my ($variable_name,$value) = @_;
 736   my $meta  = $self->_meta_table;
 737
 738   if (defined $value && $self->writeable) {
 739     my $querydel = "DELETE FROM $meta WHERE name = ?";
 740     my $query    = "INSERT INTO $meta (name,value) VALUES (?,?)";
 741     my $sthdel   = $self->_prepare($querydel);
 742     my $sth      = $self->_prepare($query);
 743     $sthdel->execute($variable_name);
 744     $sth->execute($variable_name,$value) or $self->throw($sth->errstr);
 745     $sth->finish;
 746     $self->{settings_cache}{$variable_name} = $value;
 747   }
 748   else {
 749     return $self->{settings_cache}{$variable_name} if exists $self->{settings_cache}{$variable_name};
 750     my $query = "SELECT value FROM $meta as m WHERE m.name=?";
 751     my $sth = $self->_prepare($query);
 752 #    $sth->execute($variable_name) or $self->throw($sth->errstr);
 753     unless ($sth->execute($variable_name)) {
 754       my $errstr = $sth->errstr;
 755       $sth = $self->_prepare("SHOW search_path");
 756       $sth->execute();
 757       $errstr .= "With search_path " . $sth->fetchrow_arrayref->[0] . "\n";
 758       $self->throw($errstr);
 759     }
 760
 761     my ($value) = $sth->fetchrow_array;
 762     $sth->finish;
 763     return $self->{settings_cache}{$variable_name} = $value;
 764   }
 765 }
 766
 767 # overridden because of use of REPLACE in mysql adapter
 768 ###
 769 # Replace Bio::SeqFeatureI into database.
 770 #
 771 sub replace {
 772   my $self       = shift;
 773   my $object     = shift;
 774   my $index_flag = shift || undef;
 775
 776   # ?? shouldn't need to do this
 777   # $self->_load_class($object);
 778   my $id = $object->primary_id;
 779   my $features = $self->_feature_table;
 780
 781   my $query = "INSERT INTO $features (id,object,indexed,seqid,start,\"end\",strand,tier,bin,typeid) VALUES (?,?,?,?,?,?,?,?,?,?)";
 782   my $query_noid = "INSERT INTO $features (object,indexed,seqid,start,\"end\",strand,tier,bin,typeid) VALUES (?,?,?,?,?,?,?,?,?)";
 783   my $querydel = "DELETE FROM $features WHERE id = ?";
 784
 785   my $sthdel = $self->_prepare($querydel);
 786   my $sth = $self->_prepare($query);
 787   my $sth_noid = $self->_prepare($query_noid);
 788
 789   my @location = $index_flag ? $self->_get_location_and_bin($object) : (undef)x6;
 790
 791   my $primary_tag = $object->primary_tag;
 792   my $source_tag  = $object->source_tag || '';
 793   $primary_tag    .= ":$source_tag";
 794   my $typeid   = $self->_typeid($primary_tag,1);
 795
 796   if ($id) {
 797     $sthdel->execute($id);
 798     $sth->execute($id,encode_base64($self->freeze($object), ''),$index_flag||0,@location,$typeid) or $self->throw($sth->errstr);
 799   } else {
 800     $sth_noid->execute(encode_base64($self->freeze($object), ''),$index_flag||0,@location,$typeid) or $self->throw($sth->errstr);
 801   }
 802
 803   my $dbh = $self->dbh;
 804
 805   $object->primary_id($dbh->last_insert_id(undef, undef, undef, undef, {sequence=>$features."_id_seq"})) unless defined $id;
 806
 807   $self->flag_for_indexing($dbh->last_insert_id(undef, undef, undef, undef, {sequence=>$features."_id_seq"})) if $self->{bulk_update_in_progress};
 808 }
 809
 810 =head2 types
 811
 812  Title   : types
 813  Usage   : @type_list = $db->types
 814  Function: Get all the types in the database
 815  Returns : array of Bio::DB::GFF::Typename objects
 816  Args    : none
 817  Status  : public
 818
 819 =cut
 820
 821 # overridden because "offset" is reserved in postgres
 822 ###
 823 # Insert a bit of DNA or protein into the database
 824 #
 825 sub _insert_sequence {
 826   my $self = shift;
 827   my ($seqid,$seq,$offset) = @_;
 828   my $id = $self->_locationid($seqid);
 829   my $seqtable = $self->_sequence_table;
 830   my $sthdel = $self->_prepare("DELETE FROM $seqtable WHERE id = ? AND \"offset\" = ?");
 831   my $sth = $self->_prepare(<<END);
 832 INSERT INTO $seqtable (id,"offset",sequence) VALUES (?,?,?)
 833 END
 834   $sthdel->execute($id,$offset);
 835   $sth->execute($id,$offset,$seq) or $self->throw($sth->errstr);
 836 }
 837
 838 # overridden because of mysql adapter's use of REPLACE
 839 ###
 840 # This subroutine flags the given primary ID for later reindexing
 841 #
 842 sub flag_for_indexing {
 843   my $self = shift;
 844   my $id   = shift;
 845   my $needs_updating = $self->_update_table;
 846
 847   my $querydel = "DELETE FROM $needs_updating WHERE id = ?";
 848   my $query = "INSERT INTO $needs_updating VALUES (?)";
 849   my $sthdel = $self->_prepare($querydel);
 850   my $sth = $self->_prepare($query);
 851
 852   $sthdel->execute($id);
 853   $sth->execute($id) or $self->throw($self->dbh->errstr);
 854 }
 855
 856 # overridden because of the different ways that mysql and postgres
 857 # handle id sequences
 858 sub _genericid {
 859   my $self = shift;
 860   my ($table,$namefield,$name,$add_if_missing) = @_;
 861   my $qualified_table = $self->_qualify($table);
 862   my $sth = $self->_prepare(<<END);
 863 SELECT id FROM $qualified_table WHERE $namefield=?
 864 END
 865   $sth->execute($name) or die $sth->errstr;
 866   my ($id) = $sth->fetchrow_array;
 867   $sth->finish;
 868   return $id if defined $id;
 869   return     unless $add_if_missing;
 870
 871   $sth = $self->_prepare(<<END);
 872 INSERT INTO $qualified_table ($namefield) VALUES (?)
 873 END
 874   $sth->execute($name) or die $sth->errstr;
 875   my $dbh = $self->dbh;
 876   return $dbh->last_insert_id(undef, undef, undef, undef, {sequence=>$qualified_table."_id_seq"});
 877 }
 878
 879 # overridden because of differences in binding between mysql and postgres adapters
 880 # given a statement handler that is expected to return rows of (id,object)
 881 # unthaw each object and return a list of 'em
 882 sub _sth2objs {
 883   my $self = shift;
 884   my $sth  = shift;
 885   my @result;
 886   my ($id, $o);
 887         $sth->bind_col(1, \$id);
 888         $sth->bind_col(2, \$o, { pg_type => PG_BYTEA});
 889   #while (my ($id,$o) = $sth->fetchrow_array) {
 890   while ($sth->fetch) {
 891     my $obj = $self->thaw(decode_base64($o) ,$id);
 892     push @result,$obj;
 893   }
 894   $sth->finish;
 895   return @result;
 896 }
 897
 898 # given a statement handler that is expected to return rows of (id,object)
 899 # unthaw each object and return a list of 'em
 900 sub _sth2obj {
 901   my $self = shift;
 902   my $sth  = shift;
 903   my ($id,$o) = $sth->fetchrow_array;
 904   return unless $o;
 905   my $obj = $self->thaw(decode_base64($o) ,$id);
 906   $obj;
 907 }
 908
 909 ####################################################################################################
 910 # SQL Fragment generators
 911 ####################################################################################################
 912
 913 # overridden because of base64 encoding needed here
 914 ###
 915 # special-purpose store for bulk loading - write to a file rather than to the db
 916 #
 917 sub _dump_store {
 918   my $self    = shift;
 919   my $indexed = shift;
 920
 921   my $count = 0;
 922   my $store_fh = $self->dump_filehandle('feature');
 923   my $dbh      = $self->dbh;
 924
 925   my $autoindex = $self->autoindex;
 926
 927   for my $obj (@_) {
 928     my $id       = $self->next_id;
 929     my ($seqid,$start,$end,$strand,$tier,$bin) = $indexed ? $self->_get_location_and_bin($obj) : (undef)x6;
 930     my $primary_tag = $obj->primary_tag;
 931     my $source_tag  = $obj->source_tag || '';
 932     $primary_tag    .= ":$source_tag";
 933     my $typeid   = $self->_typeid($primary_tag,1);
 934
 935                 my $frozen_object = encode_base64($self->freeze($obj), '');
 936                 # TODO: Fix this, why does frozen object start with quote but not end with one
 937     print $store_fh join("\t",$id,$typeid,$seqid,$start,$end,$strand,$tier,$bin,$indexed,$frozen_object),"\n";
 938     $obj->primary_id($id);
 939     $self->_update_indexes($obj) if $indexed && $autoindex;
 940     $count++;
 941   }
 942
 943   # remember whether we are have ever stored a non-indexed feature
 944   unless ($indexed or $self->{indexed_flag}++) {
 945     $self->subfeatures_are_indexed(0);
 946   }
 947   $count;
 948 }
 949
 950 sub _enable_keys  { }  # nullop
 951 sub _disable_keys { }  # nullop
 952
 953 sub _add_interval_stats_table {
 954     my $self = shift;
 955     my $tables          = $self->table_definitions;
 956     my $interval_stats  = $self->_interval_stats_table;
 957     ##check to see if it exists yet; if it does, just return because
 958     ##there is a drop from in the next step
 959     my $dbh = $self->dbh;
 960     my @table_exists = $dbh->selectrow_array("SELECT * FROM pg_tables WHERE tablename
 961  = '$interval_stats' AND schemaname = '".$self->namespace."'");
 962     if (!scalar(@table_exists)) {
 963         my $query = "CREATE TABLE $interval_stats $tables->{interval_stats}";
 964         $dbh->do($query) or $self->throw($dbh->errstr);
 965     }
 966 }
 967
 968 sub _fetch_indexed_features_sql {
 969     my $self     = shift;
 970     my $features = $self->_feature_table;
 971     return <<END;
 972 SELECT typeid,seqid,start-1,"end"
 973   FROM $features as f
 974  WHERE f.indexed=1
 975   ORDER BY typeid,seqid,start
 976 END
 977 }
 978
 979
 980
 981 1;