lib/Bio/DB/BioSQL/Oracle/TermAdaptorDriver.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::DB::BioSQL::Oracle::TermAdaptorDriver
   4 #
   5 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   6 #
   7 # Cared for by Hilmar Lapp <hlapp at gmx.net>
   8 #
   9 # Copyright Hilmar Lapp
  10 #
  11
  12 #
  13 # (c) Hilmar Lapp, hlapp at gmx.net, 2003.
  14 # (c) GNF, Genomics Institute of the Novartis Research Foundation, 2003.
  15 #
  16 # You may distribute this module under the same terms as perl itself.
  17 # Refer to the Perl Artistic License (see the license accompanying this
  18 # software package, or see http://www.perl.com/language/misc/Artistic.html)
  19 # for the terms under which you may use, modify, and redistribute this module.
  20 #
  21 # THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  22 # WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  23 # MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  24 #
  25
  26 # POD documentation - main docs before the code
  27
  28 =head1 NAME
  29
  30 Bio::DB::BioSQL::Oracle::TermAdaptorDriver - DESCRIPTION of Object
  31
  32 =head1 SYNOPSIS
  33
  34 Give standard usage here
  35
  36 =head1 DESCRIPTION
  37
  38 Describe the object here
  39
  40 =head1 FEEDBACK
  41
  42 =head2 Mailing Lists
  43
  44 User feedback is an integral part of the evolution of this and other
  45 Bioperl modules. Send your comments and suggestions preferably to
  46 the Bioperl mailing list.  Your participation is much appreciated.
  47
  48   bioperl-l@bioperl.org                  - General discussion
  49   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  50
  51 =head2 Support
  52
  53 Please direct usage questions or support issues to the mailing list:
  54
  55 I<bioperl-l@bioperl.org>
  56
  57 rather than to the module maintainer directly. Many experienced and
  58 reponsive experts will be able look at the problem and quickly
  59 address it. Please include a thorough description of the problem
  60 with code and data examples if at all possible.
  61
  62 =head2 Reporting Bugs
  63
  64 Report bugs to the Bioperl bug tracking system to help us keep track
  65 of the bugs and their resolution. Bug reports can be submitted via
  66 the web:
  67
  68   http://redmine.open-bio.org/projects/bioperl/
  69
  70 =head1 AUTHOR - Hilmar Lapp
  71
  72 Email hlapp at gmx.net
  73
  74 =head1 CONTRIBUTORS
  75
  76 Additional contributors names and emails here
  77
  78 =head1 APPENDIX
  79
  80 The rest of the documentation details each of the object methods.
  81 Internal methods are usually preceded with a _
  82
  83 =cut
  84
  85
  86 # Let the code begin...
  87
  88
  89 package Bio::DB::BioSQL::Oracle::TermAdaptorDriver;
  90 use vars qw(@ISA);
  91 use strict;
  92
  93 use Bio::DB::BioSQL::Oracle::BasePersistenceAdaptorDriver;
  94
  95 @ISA = qw(Bio::DB::BioSQL::Oracle::BasePersistenceAdaptorDriver);
  96
  97
  98 =head2 remove_synonyms
  99
 100  Title   : remove_synonyms
 101  Usage   :
 102  Function: Removes all synonyms for an ontology term.
 103  Example :
 104  Returns : TRUE on success, and FALSE otherwise.
 105  Args    : The calling persistence adaptor.
 106
 107            The persistent term object for which to remove the synonyms
 108            (a Bio::DB::PersistentObjectI compliant object with defined
 109            primary key).
 110
 111
 112 =cut
 113
 114 sub remove_synonyms{
 115     my ($self,$adp,$obj) = @_;
 116
 117     # delete statement cached?
 118     my $cachekey = "DELETE SYNONYMS";
 119     my $sth = $adp->sth($cachekey);
 120     # if not we need to build it
 121     if(! $sth) {
 122         # we need table name and foreign key
 123         my $table = $self->table_name("TermSynonym");
 124         my $fkname = $self->foreign_key_name($obj->obj);
 125         # build, prepare, and cache the SQL statement
 126         $sth = $self->_build_sth($adp, $cachekey,
 127                                  "DELETE FROM $table WHERE $fkname = ?");
 128     }
 129     # bind parameters and execute insert
 130     my $dbgmsg = "executing with values (".
 131         $obj->primary_key().") (FK to ".ref($obj->obj).")";
 132     $adp->debug("$cachekey: $dbgmsg\n");
 133     my $rv = $sth->execute($obj->primary_key());
 134     if(! $rv) {
 135         $self->warn("failed to remove term synonyms (".ref($adp)
 136                     .") with values (".$obj->primary_key()
 137                     .") (FK to ".ref($obj->obj)."):\n".$sth->errstr());
 138     }
 139     return $rv;
 140 }
 141
 142 =head2 store_synonym
 143
 144  Title   : store_synonym
 145  Usage   :
 146  Function: Stores a synonym for an ontology term.
 147  Example :
 148  Returns : TRUE on success, and FALSE otherwise.
 149  Args    : The calling persistence adaptor.
 150
 151            The persistent term object for which to store the synonym
 152            (a Bio::DB::PersistentObjectI compliant object with defined
 153            primary key).
 154
 155            The synonym to store (a scalar).
 156
 157
 158 =cut
 159
 160 sub store_synonym{
 161     my ($self,$adp,$obj,$syn) = @_;
 162
 163     # insert and look-up statements cached?
 164     my $icachekey = "INSERT SYNONYM";
 165     my $isth = $adp->sth($icachekey);
 166     # if not we need to build them
 167     if(! $isth) {
 168         # we need table name, foreign key, and slot map
 169         my $table = $self->table_name("TermSynonym");
 170         my $fkname = $self->foreign_key_name($obj->obj);
 171         my $colmap = $self->slot_attribute_map($table);
 172         # build, prepare, and cache the SQL statements
 173         $isth = $self->_build_sth($adp, $icachekey,
 174                                   "INSERT INTO $table (".
 175                                   join(", ", $colmap->{'synonym'}, $fkname).
 176                                   ") VALUES (?, ?)");
 177     }
 178     # bind parameters and execute insert
 179     my $dbgmsg = "executing with values ($syn, ".
 180         $obj->primary_key().") (synonym, FK to ".ref($obj->obj).")";
 181     $adp->debug("$icachekey: $dbgmsg\n");
 182     my $rv = $isth->execute($syn, $obj->primary_key());
 183     if(! $rv) {
 184         # this might be a UK failure, not a bad statement error
 185         if (index($isth->errstr(), "ORA-00001") >= 0) {
 186             # we actually don't need to execute a look-up here because the
 187             # synonym is not an object and hence has no primary key itself
 188             $rv = "0E0"; # evaluates to TRUE, but numerically equals zero
 189         } else {
 190             $self->warn("failed to store term synonym (".ref($adp)
 191                         .") with values ($syn) (FK ".$obj->primary_key()
 192                         ." to ".ref($obj->obj)."):\n"
 193                         .$isth->errstr());
 194         }
 195     }
 196     return $rv;
 197 }
 198
 199 sub _build_sth{
 200     my ($self,$adp,$cachekey,$sql) = @_;
 201     # prepare and cache
 202     $adp->debug("$cachekey: preparing: $sql\n");
 203     my $sth = $adp->dbh->prepare($sql);
 204     $self->throw("failed to prepare \"$sql\": ".$adp->dbh->errstr)
 205         unless $sth;
 206     $adp->sth($cachekey,$sth);
 207     return $sth;
 208 }
 209
 210 =head2 get_synonyms
 211
 212  Title   : get_synonyms
 213  Usage   :
 214  Function: Retrieves the synonyms for an ontology term and adds them
 215            the term's synonyms.
 216  Example :
 217  Returns : TRUE on success, and FALSE otherwise.
 218  Args    : The calling persistence adaptor.
 219
 220            The persistent term object for which to retrieve the
 221            synonyms (a Bio::DB::PersistentObjectI compliant object
 222            with defined primary key).
 223
 224
 225 =cut
 226
 227 sub get_synonyms{
 228     my ($self,$adp,$obj) = @_;
 229
 230     # look-up statement cached?
 231     my $cachekey = "SELECT SYNONYMS";
 232     my $sth = $adp->sth($cachekey);
 233     # if not we need to build it
 234     if(! $sth) {
 235         # we need table name, foreign key, and slot map
 236         my $table = $self->table_name("TermSynonym");
 237         my $fkname = $self->foreign_key_name($obj->obj);
 238         my $colmap = $self->slot_attribute_map($table);
 239         # build, prepare, and cache the SQL statement
 240         $sth = $self->_build_sth($adp, $cachekey,
 241                                  "SELECT ".$colmap->{'synonym'}.
 242                                  " FROM $table WHERE $fkname = ?");
 243     }
 244     # bind parameters and execute select
 245     my $dbgmsg = "executing with values (".
 246         $obj->primary_key().") (FK to ".ref($obj->obj).")";
 247     $adp->debug("$cachekey: $dbgmsg\n");
 248     my $rv = $sth->execute($obj->primary_key());
 249     $self->warn("failed to execute $cachekey: ".$sth->errstr) unless $rv;
 250     while(my $row = $sth->fetchrow_arrayref()) {
 251         $obj->add_synonym($row->[0]);
 252     }
 253     return $rv;
 254 }
 255
 256 =head2 bind_param
 257
 258  Title   : bind_param
 259  Usage   :
 260  Function: Binds a parameter value to a prepared statement.
 261
 262            We override this in order to possibly truncate term
 263            definitions longer than 4000 characters, the limit of
 264            Oracle's VARCHAR2 data type. Note that this problem does
 265            not exist with Pg's and mysql's text types.
 266
 267  Example :
 268  Returns : the return value of the DBI::bind_param() call
 269  Args    : the DBI statement handle to bind to
 270            the index of the column (1-based)
 271            the value to bind
 272            additional arguments to be passed to the sth->bind_param call
 273
 274
 275 =cut
 276
 277 sub bind_param{
 278     my ($self,$sth,$i,$val,@bindargs) = @_;
 279
 280     # definition is the 3rd value to bind
 281     if (($i == 3) && defined($val) && (length($val) > 4000)) {
 282         $self->warn("term definition is "
 283                     .length($val)." chars long, need to truncate to 4000");
 284         $val = substr($val,0,4000);
 285     }
 286     return $self->SUPER::bind_param($sth,$i,$val,@bindargs);
 287 }
 288
 289 1;