making fref and gname searching case insensitive in pg adaptor

GMOD · Jul 10, 2006 · ea4372e · ea4372e
1 parent 1b76d93
commit ea4372e
Show file tree

Hide file tree

Showing 27 changed files with 179 additions and 30 deletions.
diff --git a/extras/BioPerl/Bio/DB/Fasta.pm b/extras/BioPerl/Bio/DB/Fasta.pm
@@ -1,4 +1,4 @@
-# $Id: Fasta.pm,v 1.1.2.1.2.10 2006-07-10 02:28:04 scottcain Exp $
+# $Id: Fasta.pm,v 1.1.2.1.2.11 2006-07-10 03:24:35 scottcain Exp $
 #
 # BioPerl module for Bio::DB::Fasta
 #

diff --git a/extras/BioPerl/Bio/DB/GFF.pm b/extras/BioPerl/Bio/DB/GFF.pm
@@ -1,4 +1,4 @@
-# $Id: GFF.pm,v 1.1.2.1.2.10 2006-07-10 02:28:06 scottcain Exp $
+# $Id: GFF.pm,v 1.1.2.1.2.11 2006-07-10 03:24:35 scottcain Exp $
 
 =head1 NAME
 

diff --git a/extras/BioPerl/Bio/DB/GFF/Adaptor/berkeleydb.pm b/extras/BioPerl/Bio/DB/GFF/Adaptor/berkeleydb.pm
@@ -1,6 +1,6 @@
 package Bio::DB::GFF::Adaptor::berkeleydb;
 
-# $Id: berkeleydb.pm,v 1.1.2.1.2.10 2006-07-10 02:28:06 scottcain Exp $
+# $Id: berkeleydb.pm,v 1.1.2.1.2.11 2006-07-10 03:24:35 scottcain Exp $
 
 =head1 NAME
 

diff --git a/extras/BioPerl/Bio/DB/GFF/Adaptor/berkeleydb/iterator.pm b/extras/BioPerl/Bio/DB/GFF/Adaptor/berkeleydb/iterator.pm
@@ -35,7 +35,7 @@ it under the same terms as Perl itself.
 
 package Bio::DB::GFF::Adaptor::berkeleydb::iterator;
 use strict;
-# $Id: iterator.pm,v 1.1.2.1.2.10 2006-07-10 02:28:07 scottcain Exp $
+# $Id: iterator.pm,v 1.1.2.1.2.11 2006-07-10 03:24:36 scottcain Exp $
 use DB_File qw(R_FIRST R_NEXT);
 
 # this module needs to be cleaned up and documented

diff --git a/extras/BioPerl/Bio/DB/GFF/Adaptor/biofetch.pm b/extras/BioPerl/Bio/DB/GFF/Adaptor/biofetch.pm
@@ -1,5 +1,5 @@
 package Bio::DB::GFF::Adaptor::biofetch;
-#$Id: biofetch.pm,v 1.1.2.1.2.10 2006-07-10 02:28:06 scottcain Exp $
+#$Id: biofetch.pm,v 1.1.2.1.2.11 2006-07-10 03:24:35 scottcain Exp $
 =head1 NAME
 
 Bio::DB::GFF::Adaptor::biofetch -- Cache BioFetch objects in a Bio::DB::GFF database

diff --git a/extras/BioPerl/Bio/DB/GFF/Adaptor/biofetch_oracle.pm b/extras/BioPerl/Bio/DB/GFF/Adaptor/biofetch_oracle.pm
@@ -1,5 +1,5 @@
 package Bio::DB::GFF::Adaptor::biofetch_oracle;
-#$Id: biofetch_oracle.pm,v 1.1.2.1.2.10 2006-07-10 02:28:06 scottcain Exp $
+#$Id: biofetch_oracle.pm,v 1.1.2.1.2.11 2006-07-10 03:24:35 scottcain Exp $
 =head1 NAME
 
 Bio::DB::GFF::Adaptor::biofetch -- Cache BioFetch objects in a Bio::DB::GFF database

diff --git a/extras/BioPerl/Bio/DB/GFF/Adaptor/dbi.pm b/extras/BioPerl/Bio/DB/GFF/Adaptor/dbi.pm
@@ -1,4 +1,4 @@
-# $Id: dbi.pm,v 1.1.2.2.2.10 2006-07-10 02:28:07 scottcain Exp $
+# $Id: dbi.pm,v 1.1.2.2.2.11 2006-07-10 03:24:35 scottcain Exp $
 
 =head1 NAME
 

diff --git a/extras/BioPerl/Bio/DB/GFF/Adaptor/dbi/pg.pm b/extras/BioPerl/Bio/DB/GFF/Adaptor/dbi/pg.pm
@@ -91,7 +91,7 @@ SELECT fref,
        fstrand,
        gname
   FROM fdata,fgroup
-  WHERE lower(fgroup.gname)=lower(?)
+  WHERE lower(fgroup.gname) = lower(?)
     AND fgroup.gclass=?
     AND fgroup.gid=fdata.gid
     GROUP BY fref,fstrand,gclass,gname
@@ -142,9 +142,9 @@ SELECT fref,
        max(fstop),
        fstrand
   FROM fdata,fgroup
-  WHERE fgroup.gname=?
+  WHERE lower(fgroup.gname) = lower(?)
     AND fgroup.gclass=?
-    AND fdata.fref=?
+    AND lower(fdata.fref) = lower(?)
     AND fgroup.gid=fdata.gid
     GROUP BY fref,fstrand,gclass
 END
@@ -552,7 +552,7 @@ sub setup_load {
   my $insert_type = $dbh->prepare_delayed('INSERT INTO ftype (fmethod,fsource) VALUES (?,?)');
   my $insertid_type = $dbh->prepare_delayed("SELECT currval('ftype_ftypeid_seq')");
 
-  my $lookup_group = $dbh->prepare_delayed('SELECT gid FROM fgroup WHERE gname=? AND gclass=?');
+  my $lookup_group = $dbh->prepare_delayed('SELECT gid FROM fgroup WHERE lower(gname)=lower(?) AND gclass=?');
   my $insert_group = $dbh->prepare_delayed('INSERT INTO fgroup (gname,gclass) VALUES (?,?)');
   my $insertid_group = $dbh->prepare_delayed("SELECT currval('fgroup_gid_seq')");
 
@@ -1202,6 +1202,155 @@ sub make_features_by_name_where_part {
   }
 }
 
+#
+# Methods from dbi.pm that need to be overridden to make
+# searching for fref case insensitive
+#
+#
+sub get_dna {
+  my $self = shift;
+  my ($ref,$start,$stop,$class) = @_;
+
+  my ($offset_start,$offset_stop);
+
+  my $has_start = defined $start;
+  my $has_stop  = defined $stop;
+
+  my $reversed;
+  if ($has_start && $has_stop && $start > $stop) {
+    $reversed++;
+    ($start,$stop) = ($stop,$start);
+  }
+
+  # turn start and stop into 0-based offsets
+  my $cs = $self->dna_chunk_size;
+  $start -= 1;  $stop -= 1;
+  $offset_start = int($start/$cs)*$cs;
+  $offset_stop  = int($stop/$cs)*$cs;
+
+  my $sth;
+  # special case, get it all
+  if (!($has_start || $has_stop)) {
+    $sth = $self->dbh->do_query('select fdna,foffset from fdna where lower(fref)=lower(?) order by foffset',$ref);
+  }
+
+  elsif (!$has_stop) {
+    $sth = $self->dbh->do_query('select fdna,foffset from fdna where lower(fref)=lower(?) and foffset>=? order by foffset',
+                                $ref,$offset_start);
+  }
+
+  else {  # both start and stop defined
+    $sth = $self->dbh->do_query('select fdna,foffset from fdna where lower(fref)=lower(?) and foffset>=? and foffset<=? order by foffset',
+                                $ref,$offset_start,$offset_stop);
+  }
+
+  my $dna = '';
+  while (my($frag,$offset) = $sth->fetchrow_array) {
+      substr($frag,0,$start-$offset) = '' if $has_start && $start > $offset;
+      $dna .= $frag;
+  }
+  substr($dna,$stop-$start+1) = '' if $has_stop && $stop-$start+1 < length($dna);
+  if ($reversed) {
+    $dna = reverse $dna;
+    $dna =~ tr/gatcGATC/ctagCTAG/;
+  }
+
+  $sth->finish;
+  $dna;
+}
+
+
+sub refseq_query {
+  my $self = shift;
+  my ($refseq,$refclass) = @_;
+  my $query = "lower(fdata.fref)=lower(?)";
+  return wantarray ? ($query,$refseq) : $self->dbh->dbi_quote($query,$refseq);
+}
+
+sub make_types_where_part {
+  my $self = shift;
+  my ($srcseq,$start,$stop,$want_count,$typelist) = @_;
+  my (@query,@args);
+  if (defined($srcseq)) {
+    push @query,'lower(fdata.fref)=lower(?)';
+    push @args,$srcseq;
+    if (defined $start or defined $stop) {
+      $start = 1           unless defined $start;
+      $stop  = MAX_SEGMENT unless defined $stop;
+      my ($q,@a) = $self->overlap_query($start,$stop);
+      push @query,"($q)";
+      push @args,@a;
+    }
+  }
+  if (defined $typelist && @$typelist) {
+    my ($q,@a) = $self->types_query($typelist);
+    push @query,($q);
+    push @args,@a;
+  }
+  my $query = @query ? join(' AND ',@query) : '1=1';
+  return wantarray ? ($query,@args) : $self->dbh->dbi_quote($query,@args);
+}
+
+sub get_feature_id {
+  my $self = shift;
+  my ($ref,$start,$stop,$typeid,$groupid) = @_;
+  my $s = $self->{load_stuff};
+  unless ($s->{get_feature_id}) {
+    my $dbh = $self->features_db;
+    $s->{get_feature_id} =
+      $dbh->prepare_delayed('SELECT fid FROM fdata WHERE lower(fref)=lower(?) AND fstart=? AND fstop=? AND ftypeid=? AND gid=?');
+  }
+  my $sth = $s->{get_feature_id} or return;
+  $sth->execute($ref,$start,$stop,$typeid,$groupid) or return;
+  my ($fid) = $sth->fetchrow_array;
+  return $fid;
+}
+
+sub _delete {
+  my $self = shift;
+  my $delete_spec = shift;
+  my $ranges      = $delete_spec->{segments} || [];
+  my $types       = $delete_spec->{types}    || [];
+  my $force       = $delete_spec->{force};
+  my $range_type  = $delete_spec->{range_type};
+  my $dbh         = $self->features_db;
+
+  my $query = 'delete from fdata';
+  my @where;
+
+  my @range_part;
+  for my $segment (@$ranges) {
+    my $ref   = $dbh->quote($segment->abs_ref);
+    my $start = $segment->abs_start;
+    my $stop  = $segment->abs_stop;
+    my $range =  $range_type eq 'overlaps'     ? $self->overlap_query($start,$stop)
+               : $range_type eq 'contains'     ? $self->contains_query($start,$stop)
+               : $range_type eq 'contained_in' ? $self->contained_in_query($start,$stop)
+               : $self->throw("Invalid range type '$range_type'");
+    push @range_part,"(lower(fref)=lower($ref) AND $range)";
+  }
+  push @where,'('. join(' OR ',@range_part).')' if @range_part;
+
+  # get all the types
+  if (@$types) {
+    my $types_where = $self->types_query($types);
+    my $types_query = "select ftypeid from ftype where $types_where";
+    my $result      = $dbh->selectall_arrayref($types_query);
+    my @typeids     = map {$_->[0]} @$result;
+    my $typelist    = join ',',map{$dbh->quote($_)} @typeids;
+    $typelist ||= "0"; # don't cause DBI to die with invalid SQL when
+                       # unknown feature types were requested.
+    push @where,"(ftypeid in ($typelist))";
+  }
+  $self->throw("This operation would delete all feature data and -force not specified")
+    unless @where || $force;
+  $query .= " where ".join(' and ',@where) if @where;
+  warn "$query\n" if $self->debug;
+  my $result = $dbh->do($query);
+  defined $result or $self->throw($dbh->errstr);
+  $result;
+}
+
 
 
 1;
diff --git a/extras/BioPerl/Bio/DB/GFF/Adaptor/memory.pm b/extras/BioPerl/Bio/DB/GFF/Adaptor/memory.pm
@@ -59,7 +59,7 @@ it under the same terms as Perl itself.
 =cut
 
 use strict;
-# $Id: memory.pm,v 1.1.2.3.2.10 2006-07-10 02:28:07 scottcain Exp $
+# $Id: memory.pm,v 1.1.2.3.2.11 2006-07-10 03:24:35 scottcain Exp $
 # AUTHOR: Shulamit Avraham
 # This module needs to be cleaned up and documented
 

diff --git a/extras/BioPerl/Bio/DB/GFF/Adaptor/memory/iterator.pm b/extras/BioPerl/Bio/DB/GFF/Adaptor/memory/iterator.pm
@@ -35,7 +35,7 @@ it under the same terms as Perl itself.
 
 package Bio::DB::GFF::Adaptor::memory::iterator;
 use strict;
-# $Id: iterator.pm,v 1.1.2.1.2.10 2006-07-10 02:28:08 scottcain Exp $
+# $Id: iterator.pm,v 1.1.2.1.2.11 2006-07-10 03:24:36 scottcain Exp $
 # this module needs to be cleaned up and documented
 use Bio::Root::Version;
 

diff --git a/extras/BioPerl/Bio/Graphics/ConfiguratorI.pm b/extras/BioPerl/Bio/Graphics/ConfiguratorI.pm
@@ -1,4 +1,4 @@
-# $Id: ConfiguratorI.pm,v 1.1.2.3.2.10 2006-07-10 02:28:08 scottcain Exp $
+# $Id: ConfiguratorI.pm,v 1.1.2.3.2.11 2006-07-10 03:24:36 scottcain Exp $
 #
 # BioPerl module for Bio::Graphics::ConfiguratorI
 #

diff --git a/extras/BioPerl/Bio/Graphics/FeatureFile.pm b/extras/BioPerl/Bio/Graphics/FeatureFile.pm
@@ -1,6 +1,6 @@
 package Bio::Graphics::FeatureFile;
 
-# $Id: FeatureFile.pm,v 1.1.2.9.2.10 2006-07-10 02:28:09 scottcain Exp $
+# $Id: FeatureFile.pm,v 1.1.2.9.2.11 2006-07-10 03:24:36 scottcain Exp $
 # This package parses and renders a simple tab-delimited format for features.
 # It is simpler than GFF, but still has a lot of expressive power.
 # See __END__ for the file format

diff --git a/extras/BioPerl/Bio/Graphics/FeatureFile/Iterator.pm b/extras/BioPerl/Bio/Graphics/FeatureFile/Iterator.pm
@@ -1,6 +1,6 @@
 package Bio::Graphics::FeatureFile::Iterator;
 
-# $Id: Iterator.pm,v 1.1.2.2.2.10 2006-07-10 02:28:09 scottcain Exp $
+# $Id: Iterator.pm,v 1.1.2.2.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 =head1 NAME
 

diff --git a/extras/BioPerl/Bio/Graphics/Glyph.pm b/extras/BioPerl/Bio/Graphics/Glyph.pm
@@ -1,6 +1,6 @@
 package Bio::Graphics::Glyph;
 
-# $Id: Glyph.pm,v 1.1.2.11.2.6 2006-07-10 02:28:09 scottcain Exp $
+# $Id: Glyph.pm,v 1.1.2.11.2.7 2006-07-10 03:24:36 scottcain Exp $
 
 use strict;
 use Carp 'croak','cluck';

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/graded_segments.pm b/extras/BioPerl/Bio/Graphics/Glyph/graded_segments.pm
@@ -1,5 +1,5 @@
 package Bio::Graphics::Glyph::graded_segments;
-#$Id: graded_segments.pm,v 1.1.2.4.2.10 2006-07-10 02:28:10 scottcain Exp $
+#$Id: graded_segments.pm,v 1.1.2.4.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 use strict;
 use Bio::Graphics::Glyph::minmax;

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/heterogeneous_segments.pm b/extras/BioPerl/Bio/Graphics/Glyph/heterogeneous_segments.pm
@@ -7,7 +7,7 @@ package Bio::Graphics::Glyph::heterogeneous_segments;
 # -waba_weak_color   => 'red'
 # -waba_coding_color => 'green' 
 
-# $Id: heterogeneous_segments.pm,v 1.1.2.4.2.10 2006-07-10 02:28:10 scottcain Exp $
+# $Id: heterogeneous_segments.pm,v 1.1.2.4.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 use strict;
 use Bio::Graphics::Glyph::graded_segments;

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/minmax.pm b/extras/BioPerl/Bio/Graphics/Glyph/minmax.pm
@@ -1,5 +1,5 @@
 package Bio::Graphics::Glyph::minmax;
-# $Id: minmax.pm,v 1.1.2.4.2.10 2006-07-10 02:28:11 scottcain Exp $
+# $Id: minmax.pm,v 1.1.2.4.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 use strict;
 use Bio::Graphics::Glyph::segments;

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/processed_transcript.pm b/extras/BioPerl/Bio/Graphics/Glyph/processed_transcript.pm
@@ -1,6 +1,6 @@
 package Bio::Graphics::Glyph::processed_transcript;
 
-# $Id: processed_transcript.pm,v 1.1.2.4.2.10 2006-07-10 02:28:11 scottcain Exp $
+# $Id: processed_transcript.pm,v 1.1.2.4.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 use strict;
 use Bio::Graphics::Glyph::transcript2;

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/redgreen_box.pm b/extras/BioPerl/Bio/Graphics/Glyph/redgreen_box.pm
@@ -1,5 +1,5 @@
 package Bio::Graphics::Glyph::redgreen_box;
-#$Id: redgreen_box.pm,v 1.1.2.4.2.10 2006-07-10 02:28:11 scottcain Exp $
+#$Id: redgreen_box.pm,v 1.1.2.4.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 use strict;
 use Bio::Graphics::Glyph::generic;

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/redgreen_segment.pm b/extras/BioPerl/Bio/Graphics/Glyph/redgreen_segment.pm
@@ -1,5 +1,5 @@
 package Bio::Graphics::Glyph::redgreen_segment;
-#$Id: redgreen_segment.pm,v 1.1.2.4.2.10 2006-07-10 02:28:11 scottcain Exp $
+#$Id: redgreen_segment.pm,v 1.1.2.4.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 use strict;
 use Bio::Graphics::Glyph::graded_segments;

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/segmented_keyglyph.pm b/extras/BioPerl/Bio/Graphics/Glyph/segmented_keyglyph.pm
@@ -1,6 +1,6 @@
 package Bio::Graphics::Glyph::segmented_keyglyph;
 
-# $Id: segmented_keyglyph.pm,v 1.1.2.5.2.10 2006-07-10 02:28:11 scottcain Exp $
+# $Id: segmented_keyglyph.pm,v 1.1.2.5.2.11 2006-07-10 03:24:37 scottcain Exp $
 # Don't use this package.  It's just for inheriting the segmented glyph in the panel key.
 
 use strict;

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/segments.pm b/extras/BioPerl/Bio/Graphics/Glyph/segments.pm
@@ -1,5 +1,5 @@
 package Bio::Graphics::Glyph::segments;
-#$Id: segments.pm,v 1.1.2.5.2.10 2006-07-10 02:28:11 scottcain Exp $
+#$Id: segments.pm,v 1.1.2.5.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 use strict;
 use Bio::Location::Simple;

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/so_transcript.pm b/extras/BioPerl/Bio/Graphics/Glyph/so_transcript.pm
@@ -1,6 +1,6 @@
 package Bio::Graphics::Glyph::so_transcript;
 
-# $Id: so_transcript.pm,v 1.1.2.5.2.10 2006-07-10 02:28:11 scottcain Exp $
+# $Id: so_transcript.pm,v 1.1.2.5.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 use strict;
 use Bio::Graphics::Glyph::processed_transcript;

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/transcript.pm b/extras/BioPerl/Bio/Graphics/Glyph/transcript.pm
@@ -1,5 +1,5 @@
 package Bio::Graphics::Glyph::transcript;
-# $Id: transcript.pm,v 1.1.2.5.2.10 2006-07-10 02:28:11 scottcain Exp $
+# $Id: transcript.pm,v 1.1.2.5.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 use strict;
 use Bio::Graphics::Glyph::segments;

diff --git a/extras/BioPerl/Bio/Graphics/Glyph/transcript2.pm b/extras/BioPerl/Bio/Graphics/Glyph/transcript2.pm
@@ -1,6 +1,6 @@
 package Bio::Graphics::Glyph::transcript2;
 
-# $Id: transcript2.pm,v 1.1.2.4.2.10 2006-07-10 02:28:11 scottcain Exp $
+# $Id: transcript2.pm,v 1.1.2.4.2.11 2006-07-10 03:24:37 scottcain Exp $
 
 use strict;
 use Bio::Graphics::Glyph::transcript;

diff --git a/extras/BioPerl/Bio/Graphics/RendererI.pm b/extras/BioPerl/Bio/Graphics/RendererI.pm
@@ -1,4 +1,4 @@
-# $Id: RendererI.pm,v 1.1.2.3.2.10 2006-07-10 02:28:09 scottcain Exp $
+# $Id: RendererI.pm,v 1.1.2.3.2.11 2006-07-10 03:24:36 scottcain Exp $
 
 =head1 NAME
 

diff --git a/extras/BioPerl/Bio/Graphics/Util.pm b/extras/BioPerl/Bio/Graphics/Util.pm
@@ -1,6 +1,6 @@
 package Bio::Graphics::Util;
 
-# $Id: Util.pm,v 1.1.2.3.2.10 2006-07-10 02:28:09 scottcain Exp $
+# $Id: Util.pm,v 1.1.2.3.2.11 2006-07-10 03:24:36 scottcain Exp $
 # Non object-oriented utilities used here-and-there in Bio::Graphics modules
 
 use strict;