lib/CXGN/DB/SQLWrappers.pm

   1
   2 =head1 NAME
   3
   4 CXGN::DB::SQLWrappers
   5
   6 =head1 AUTHOR
   7
   8 John Binns <zombieite@gmail.com>
   9
  10 =head1 DESCRIPTION
  11
  12 Functions which do basic selects and inserts in a clean way, so your code is easier to read, and SQL is segregated here.
  13
  14 =head2 new
  15
  16     my $sql=CXGN::DB::SQLWrappers->new($dbh);
  17
  18 =head2 verbose
  19
  20 Sets verbosity level. Default is 1 meaning loud, setting this to 0 means quiet.
  21
  22     $sql->verbose(0);
  23
  24 =head2 select
  25
  26 A simple way to get primary keys of data which matches some equality conditions. Send in undef for rows you want to match with nulls.
  27
  28     my @ids=$sql->select('enzymes',{enzyme_name=>'EcoRI'});
  29     #Returns a list of all entries in the enzymes table matching the hash
  30
  31 =head2 insert
  32
  33 A simple way to insert data into a table.
  34
  35     my $id=$sql->insert('enzymes',{enzyme_name=>'NewEnzyme'});
  36     #Returns the ID of a new entry into the enzymes table
  37
  38 =head2 insert_unless_exists
  39
  40 Does a 'select' as described above. If no results are found, does an 'insert' as described above and returns you the ID in a hash. If one result is found, returns you the ID in a hash. If more than one result is found, it dies with a good explanation.
  41
  42     my $info=$sql->insert_unless_exists('enzymes',{enzyme_name=>'NewEnzyme'});
  43     if($info->{inserted})
  44     {
  45         print"Inserted with ID $info->{id}.\n";
  46     }
  47     if($info->{exists})
  48     {
  49         print"Similar row exists with ID $info->{id}.\n";
  50     }
  51
  52 =head2 primary_key_column_name
  53
  54 Used by this module, but can be used by anyone else that is interested as well. It queries the Postgres catalog database for a single-column primary key associated with a table and dies if it can't find one.
  55
  56     my $pk_colname=$sql->primary_key_column_name('enzymes');
  57
  58 =cut
  59
  60 use strict;
  61 use warnings;
  62 use CXGN::DB::Connection;
  63 use CXGN::Tools::Text;
  64 use Data::Dumper;
  65
  66 package CXGN::DB::SQLWrappers;
  67
  68 sub new
  69 {
  70     my $class=shift;
  71     my ($dbh)=@_;
  72     my $self=bless({},$class);
  73     $self->{dbh}=$dbh;
  74     $self->{verbose}=1;
  75     return $self;
  76 }
  77
  78 sub verbose
  79 {
  80     my $self=shift;
  81     ($self->{verbose})=@_;
  82 }
  83
  84 sub select
  85 {
  86     my $self=shift;
  87     $self->_check_input(@_);
  88     my ($table,$select_hash)=@_;
  89     my $primary_key_column_name=$self->primary_key_column_name($table);
  90     my $select_statement=
  91     "
  92         select
  93             $primary_key_column_name
  94         from
  95             $table
  96         where
  97             not
  98             (
  99                 (".join(',',keys(%{$select_hash})).") is distinct from (".join(',',map {'?'} keys(%{$select_hash})).")
 100             )
 101     ";#the "not is distinct from" stuff means "is equal to"--BUT it also works for null values (rather than having to replace "=null" with "is null")
 102     my $q=$self->{dbh}->prepare($select_statement);
 103     $q->execute(values(%{$select_hash}));
 104     my @ids;
 105     while(my($id)=$q->fetchrow_array())
 106     {
 107         push(@ids,$id);
 108     }
 109     return @ids;
 110 }
 111
 112 sub insert
 113 {
 114     my $self=shift;
 115     $self->_check_input(@_);
 116     my ($table,$insert_hash)=@_;
 117     my $insert_statement=
 118     "
 119         insert into sgn.$table
 120         (".
 121             join(',',keys(%{$insert_hash}))
 122         .")
 123         values
 124         (".
 125             join(',',map {'?'} keys(%{$insert_hash}))
 126         .")
 127         RETURNING *
 128     ";
 129     my $q=$self->{dbh}->prepare($insert_statement);
 130     $q->execute(values(%{$insert_hash}));
 131     my @row = $q->fetchrow_array();
 132     my $id = $row[0];
 133     if($self->{verbose})
 134     {
 135        # print STDERR "Executed\n$insert_statement;\nwith values\n(".CXGN::Tools::Text::list_to_string(values(%{$insert_hash})).")\ncreating new row with ID $id.\n\n";
 136     }
 137     return $id;
 138 }
 139
 140 sub insert_unless_exists
 141 {
 142     my $self=shift;
 143     my ($table,$hash)=@_;
 144     my $return_info;
 145     $return_info->{table}=$table;
 146     my @ids=$self->select($table,$hash);
 147     if(@ids)
 148     {
 149         if(@ids>1)
 150         {
 151             die"insert_unless_exists found more than one existing entry like this (".CXGN::Tools::Text::list_to_string(@ids)."). This could mean one of 4 things:\n\n1. This table should have a uniqueness constraint, but doesn't\n2. This table has a uniqueness constraint, but null values are causing duplicate rows to appear anyway\n   (nulls do NOT match each other in a comparison of rows for the purposes of a uniqueness constraint)\n3: The row you are trying to insert does not specify enough columns of data to differentiate it from similar rows\n4: You meant to use 'insert' instead of 'insert_unless_exists'\n\nHere is what you tried to insert:\n".Data::Dumper::Dumper $hash;
 152         }
 153         $return_info->{exists}=1;
 154         ($return_info->{id})=@ids;
 155     }
 156     else
 157     {
 158         $return_info->{inserted}=1;
 159         $return_info->{id}=$self->insert($table,$hash);
 160     }
 161     return $return_info;
 162 }
 163
 164 sub primary_key_column_name
 165 {
 166     my $self=shift;
 167     my ($table)=@_;
 168     unless($table=~/^\w+$/){die"Invalid table name '$table'"};
 169     #this query is a modified version of the one in CXGN::DB::Connection::last_insert_id()
 170     my $q=$self->{dbh}->prepare
 171     ("
 172         SELECT
 173             pg_attribute.attname
 174         FROM
 175             pg_class,
 176             pg_attribute,
 177             pg_attrdef,
 178             pg_constraint
 179         WHERE
 180             pg_class.relkind='r'
 181             AND pg_attribute.attrelid=pg_class.oid
 182             AND pg_attrdef.adnum=pg_attribute.attnum
 183             AND pg_attrdef.adrelid=pg_class.oid
 184             AND pg_constraint.conrelid=pg_class.oid
 185             AND pg_constraint.contype='p'
 186             AND array_upper(pg_constraint.conkey,1)=1
 187             AND pg_constraint.conkey[1]=pg_attribute.attnum
 188             AND pg_class.relname=?
 189     ");
 190     $q->execute($table);
 191     my($primary_key_column_name)=$q->fetchrow_array();
 192     unless($primary_key_column_name)
 193     {
 194         die"Primary key column name not found";
 195     }
 196     unless($primary_key_column_name=~/^\w+$/)
 197     {
 198         die"Invalid primary key name found";
 199     }
 200     return $primary_key_column_name;
 201 }
 202
 203 sub _check_input
 204 {
 205     my $self=shift;
 206     my ($table,$hash)=@_;
 207     unless($table=~/^\w+$/)
 208     {
 209         die"Invalid table name '$table'"
 210     };
 211     unless(ref($hash) eq 'HASH')
 212     {
 213         die"Invalid hash '$hash'";
 214     }
 215     for my $key(keys(%{$hash}))
 216     {
 217         unless($key=~/^\w+$/)
 218         {
 219             die"Invalid database column name '$key'";
 220         }
 221     }
 222 }
 223
 224 1;