lib/CXGN/DB/Object.pm

   1 package CXGN::DB::Object;
   2
   3 =head1 NAME
   4
   5 CXGN::DB::Object - a parent class for all objects needing a database handle accessor
   6
   7 =head1 DESCRIPTION
   8
   9 This is an "abstract class", meaning that this class is not intended to be used by itself, but rather it should be sub-classed.
  10
  11 For example, a class using CXGN::DB::Object should declare:
  12
  13  package CXGN::SomeObject;
  14
  15  sub new {
  16    my $class = shift;
  17    my $dbh = shift;
  18    return $self = $class->SUPER::new($dbh);
  19  }
  20
  21 Note that it is assumed that these database objects are always fed with a $dbh from somewhere outside the class, which allows better control on the number of open database connections. These $dbh should preferably be created with L<CXGN::DB::Connection>, which respects server configurations and accesses the correct database according to configuration settings.
  22
  23 When working with DBIx::Class (recommended) this class can be used as a parent class and provides the accessors get_schema() and set_schema() to work with schema objects.
  24
  25
  26 =head2 Debugging
  27
  28 CXGN::DB::Object inherits from L<CXGN::Debug>, which should be used for all debugging messages. Use $self->d('debug message here\n');
  29
  30 =head1 AUTHOR(S)
  31
  32 Lukas Mueller (lam87@cornell.edu)
  33
  34 =head1 FUNCTIONS
  35
  36 This class implements the following functions:
  37
  38 =cut
  39
  40 use strict;
  41
  42 use Carp qw/cluck carp/;
  43 use CXGN::Debug;
  44
  45 use base qw /CXGN::Debug /;
  46
  47 =head2 function new
  48
  49   Synopsis:     my $o = CXGN::DB::Object->new($dbh)
  50   Arguments:    a database handle or a DBIx::Class schema object
  51   Returns:      a CXGN::DB::Object
  52   Side effects: if a dbh was supplied, calls set_dbh; if a schema
  53                 is supplied, calls set_schema and sets the dbh
  54                 to the $schema->storage()->dbh().
  55
  56 =cut
  57
  58 sub new {
  59     my $class = shift;
  60     my $param = shift;
  61
  62     my $self = $class->SUPER::new();
  63
  64     if ( ref($param) ) {
  65         if ( $param->can('prepare') && $param->can('selectall_arrayref') )
  66         {    # it's a DBI handle of some sort
  67             $self->d("Received a dbh and setting the dbh...\n");
  68             $self->set_dbh($param);
  69         }
  70         elsif ( $param->isa("DBIx::Class::Schema") ) {
  71             $self->set_schema($param);
  72             $self->set_dbh( $param->storage->dbh );
  73             $self->d("Received a Schema class and setting the schema...\n");
  74         }
  75         else {
  76             cluck
  77 "WARNING! Need either a dbh or a schema in CXGN::DB::Object constructor (got $param)";
  78         }
  79     }
  80     else {
  81         carp "A parameter is required in CXGN::DB::Object constructor";
  82     }
  83     return $self;
  84 }
  85
  86 =head2 accessors set_dbh, get_dbh
  87
  88   Property:     my $dbh = $dbobj->get_dbh()
  89   Description:  gets/sets the database handle of this
  90                 object. The setter is called in the constructor,
  91                 using the database handle supplied as a parameter.
  92
  93 =cut
  94
  95 sub get_dbh {
  96     my $self = shift;
  97     return $self->{dbh};
  98 }
  99
 100 sub set_dbh {
 101     my $self = shift;
 102     $self->{dbh} = shift;
 103 }
 104
 105 =head2 accessors get_schema, set_schema
 106
 107  Usage:        my $s = $dbobj->get_schema()
 108  Desc:         gets a schema object. Useful when implementing
 109                DBIx::Class based modules: one can still inherit
 110                from CXGN::DB::Object and store the schema in this
 111                property.
 112
 113 =cut
 114
 115 sub get_schema {
 116     my $self = shift;
 117     return $self->{schema};
 118 }
 119
 120 sub set_schema {
 121     my $self = shift;
 122     $self->{schema} = shift;
 123 }
 124
 125 =head2 function get_currval
 126
 127   Synopsis:     $currval = $dbobj->get_currval($my_table_id_seq);
 128   Arguments:    returns the current value of the sequence $my_table_id_seq
 129                 useful when a row was inserted (returns the new value of
 130                 the sequence.
 131   Returns:      and int.
 132
 133 =cut
 134
 135 sub get_currval {
 136     my $self        = shift;
 137     my $serial_name = shift;
 138     my $sth         = $self->get_dbh()->prepare("SELECT CURRVAL(?)");
 139     $sth->execute($serial_name);
 140     my ($currval) = $sth->fetchrow_array();
 141     return $currval;
 142 }
 143
 144 1;