#!/usr/bin/perl

package DBA::DBObject;

=head1 DBA::DBOject

DBA::DBObject - Generic Database Object

=head1 Synopsis

Just create an object definiteion file like the following, one
per table:

   #!/usr/bin/perl

   package <PACKAGE>
   
   use strict;
   use lib qw( /PATH/TO/DBA/LIB );
   use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
   
   @ISA         = qw(Exporter DBA::DBObject);
   @EXPORT      = qw();
   @EXPORT_OK   = qw();
   %EXPORT_TAGS = ();
   
   use DBA::DBObject;
   
   my $definition = {
      # modify this part
      # note that the object must currently have a primary key accessor of
      # the name 'id', the 'primary' alias isn't completely implemented.
      # Examples of each of the four supported types are included:
      'db'        => 'DB_NAME',
      'driver'    => 'DBI:mysql',
      'user'      => 'db_user',
      'pass'      => 'db_pass',
      'table'     => 'Table_Name',
      'primary'   => 'id',
      'attr_map'  => {
         'id'             => {
            'type'        => 'AUTOKEY',
            'name'        => 'primary_key_column',
         },
         'accessor_name'  => {
            'type'        => 'SCALAR',
            'name'        => 'db_column_name',
         },
         'timestamp'      => {
            'type'        => 'TIMESTAMP',
            'name'        => 'ts',
         },
         'passwd'         => {
            'type'        => 'PASSWORD',
            'name'        => 'pw',
         },
      },
   };
   
   # Just copy the below verbatim
   sub new {
      my $ref = shift;
      my $class = ref( $ref ) || $ref;
      my $dbh = shift;
   
      my $self = $class->SUPER::new( $dbh );
      bless( $self, $class );
   
      return $self;
   }

   sub definition {
     return $definition;
   }
   
   1;

Although this is somewhat generic, it curretly mysql-centric

SCALARs are simply values

AUTOKEYs are intended to be mysql auto_increment fields

TIMESTAMP are any date/time field that can be updated via the
NOW() function, and are updated whenever the object is commited
to the database

PASSWORD are automatically set and selected upon using mysql's
builtin PASSWORD() function.  Note that after an object has
been flushed to the database, the password is then retrieved
from the database and stored in memory as the hashed version
of the string.

Objects can in instantated with either of the following:

   $obj = new <PACKAGE>();
   $obj = new <PACKAGE>( $dbh );

Field values may be access as following:

   $obj->field( $value );
   my $value = $obj->field();

Of course, immediately after after instantiation, the objects
are basically empty and te db_get or db_collect objects should
be called to retrieve and existing data, or db_set should be
called to create a new data row.  Functions detailed below.

Basically, this abstracts the table and field names, centralizes
username/password storage, performs some automatic "type conversions"
(e.g., inserting "PASSWORD()" around all PASSWORD-type field
queries), ensures query values are quoted, gives a standard
interface, attempts to re-use database handles, and just
generally tries to keep raw SQL out of the higher levels and
make things easier.  Note that it does provide the capability
to use raw SQL if necessary.

=head1 Functions

=cut

use strict;
use Carp;
use lib qw(../..);
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);

@ISA         = qw(Exporter);
@EXPORT      = qw();
@EXPORT_OK   = qw();
%EXPORT_TAGS = ();

use DBI;

my %dbh_ref;
my $DEBUG;

BEGIN {
   $DEBUG = 0;
}

=head2 new

Creates a new (empty) object.  Does not alter the database.
If passed a database handle, it will re-use that handle and
increment the handle's reference count.

   my $obj = new <PACKAGE>();
   my $obj = new<PACKAGE( $other_obj->handle );

=cut

sub new {
   my $ref = shift;
   my $class = ref( $ref ) || $ref;

   my $dbh    = shift;

   my $self = {};
   bless( $self, $class );

   $self->{'_dbh'} = undef;
   if( defined( $dbh ) ) {
      $self->{'_dbh'} = $dbh;
      $dbh_ref{'_dbh'} = 0 if( !exists( $dbh_ref{$dbh} ) );
      $dbh_ref{$dbh}++;
   }
   $self->{'_modified'} = 0;
   $self->{'data'} = $self->_init();

   return $self;
}

sub _init {
   my $self = shift;
   my $hr   = {};

   my ($ref,$def) = $self->get_ref_def();
   my $map = $def->{'attr_map'};
   
   foreach my $key ( keys %$map ) {
      my $type = $map->{$key}->{'type'};

      if( $type eq 'AUTOKEY' ) {
         $hr->{$key} = {
             'data' => undef,
         };
      } elsif( $type eq 'SCALAR' ) {
         $hr->{$key} = {
             'data' => undef,
         };
      }
      elsif( $type eq 'TIMESTAMP' ) {
         $hr->{$key} = {
             'data' => undef,
         };
      }
   }
   
   return $hr;
}

=head2 db_touch

Will flush the object in memory to the DB, updating and
changed data and setting the timestamp.

   $obj->db_touch();

=cut

sub db_touch {
   my $self = shift;
   return if( !$self->id() );
   $self->{'_modified'} = 1;
   $self->db_set();
   return;
};

=head2 db_get

Will fill out a given object with data from the DB matching
the primary key passed in.  Note that this doesn't work with
primary keys that are multiple columns wide.

   my $obj = new <PACKAGE>();
   $obj->db_get( $primary_key_id );

Returns 1 on success, else undef, use $obj->handle to get DBI
errors.

=cut 

sub db_get {
   my $self = shift;
   my $id   = shift;

   my ($ref,$def) = $self->get_ref_def();
   my $map = $def->{'attr_map'};
   my $sql = 'SELECT * FROM '
           . $def->{'table'}
           . ' WHERE '
           . $map->{$def->{'primary'}}->{'name'}
           . ' = ? ';

   $self->connect() if( !defined( $self->{'_dbh'} ) );
   print STDERR "db_get: $sql ($id)\n" if( $DEBUG ); 
   my $sth = $self->{'_dbh'}->prepare( $sql ) || return undef;
   $sth->execute( $id ) || return undef;

   my @row = $sth->fetchrow();
   for( my $i = 0; $i < scalar(@row); $i++ ) {
      foreach my $key ( keys %$map ) {
         if( $map->{$key}->{'name'} eq $sth->{'NAME'}->[$i] ) {
            $self->$key( $row[$i] );
            # special case handling for password types:
            if( $map->{$key}->{'type'} eq 'PASSWORD' ) {
               $self->{'data'}->{$key}->{'_modified'} = 0;
            }
            last;
         }
      }
   }
   $sth->finish;
   $self->{'_modified'} = 0;

   return undef if( $self->{'_dbh'}->err );
   return 1;
}

=head2 db_purge

Will delete the object from the DB.
If passed a primary key it, will delete that object as opposed
to the current on.

   my $obj = new <PACKAGE>();
   $obj->db_purge( $some_id );
      
   my $obj = new <PACKAGE>();
   $obj->db_get( $some_id );
   if( $obj->status() eq 'FOOBAR' ) {
      $obj->db_purge();
   }
 
Returns 1 on success, else undef, use $obj->handle to get DBI
errors.

=cut 

sub db_purge {
   my $self = shift;
   my $id   = shift || $self->id();
   return if( !$id );

   my ($ref,$def) = $self->get_ref_def();
   my $map = $def->{'attr_map'};
   my $sql = 'DELETE FROM '
           . $def->{'table'}
           . ' WHERE '
           . $map->{$def->{'primary'}}->{'name'}
           . ' = ? ';

   $self->connect() if( !defined( $self->{'_dbh'} ) );
   print STDERR "db_purge: $sql ($id)\n" if( $DEBUG ); 
   my $sth = $self->{'_dbh'}->prepare( $sql ) || return undef;
   $sth->execute( $id ) || return undef;
   $sth->finish;
   $self->{'_modified'} = 1;
   return undef if( $self->{'_dbh'}->err );
   return 1;
}

=head2 db_collect

An somewhat-arbitrary query function.  WIll fetch and array-ref
of objects based on some params.  Not lightweight, as reach 
member of the array-ref returned is a fully-instantiated object.

   # select * kludge:
   my $objs = $obj->db_collect( { 'all' => '1' } );
   
   # more granular, fields are AND'd, array ref values
   # are OR'd:
   my $objs = $obj->db_collect(
     { 'where' => { 'field1' => 'value',
                    'field2' => ['val1','val2','val3'] }
   );
   
   # for manual selects, be careful that input is scrubbed:
   my $objs = $obj->db_collect(
     { 'where literal' => { 'field1' => '<= 3' }
   );
   
   my $objs = $obj->db_collect(
     { 'where literal' => { 'field2' => 'like \'%foo%\'' }
   );


Returns an array ref of objects, else undef, use $obj->handle 
to get DBI errors.

=cut 

sub db_collect {
   my $self   = shift;
   my $params = shift;

   my $all     = $params->{'all'};   # kludge 
   my $where   = $params->{'where'};
   my $literal = $params->{'where literal'};

   my ($value_str, $where_str);

   my ($ref,$def) = $self->get_ref_def();
   my $map = $def->{'attr_map'};

   $self->connect() if( !defined( $self->{'_dbh'} ) );

   if( defined( $all ) ) {
      $where_str = ' 1';
   } elsif( defined( $where ) ) {
      foreach my $field ( keys %$where ) {
         $field =~ s/^[^\w\_\-]$//g;
         $where_str .= ' ' . $map->{$field}->{'name'} . ' ';
         if( ref( $where->{$field} ) =~ m/ARRAY/ ) {
            $where_str .= ' in ( ';
 
            foreach my $val ( @{$where->{$field}} ) {
               if( $map->{$field}->{'type'} eq 'PASSWORD' ) {
                  $where_str .= ' PASSWORD('.$self->{'_dbh'}->quote( $val ).'), ';
               } else {
                  $where_str .= ' '.$self->{'_dbh'}->quote( $val ).', ';
               }
            }
            $where_str =~ s/\, $//;
            $where_str .= ' ) '
         } else {
            $where_str .= ' = ';
            if( $map->{$field}->{'type'} eq 'PASSWORD' ) {
               $where_str .= ' PASSWORD('.$self->{'_dbh'}->quote( $where->{$field} ).')';
            } else {
               $where_str .= ' '.$self->{'_dbh'}->quote( $where->{$field} );
            }
         }
         $where_str .= ' AND ';
      }
      $where_str =~ s/ AND $//;
   } elsif( defined( $literal ) ) {
      foreach my $field ( keys %$literal ) {
         $field =~ s/^[^\w\_\-]$//g;
         $where_str .= ' ' . $map->{$field}->{'name'} . ' '
                    . $literal->{$field} . ' AND ';
      }
      $where_str =~ s/ AND $//;
   } else {
      return 0;
   }

   my $sql = 'SELECT * FROM '
           . $def->{'table'}
           . ' WHERE '
           . $where_str;

   print STDERR "db_collect: $sql\n" if( $DEBUG ); 
   my $sth = $self->{'_dbh'}->prepare( $sql ) || return undef;
   $sth->execute() || return undef;

   my @objs;
   while( my @row = $sth->fetchrow() ) {
      my $obj = $ref->new( $self->{'_dbh'} );
      for( my $i = 0; $i < scalar(@row); $i++ ) {
         foreach my $key ( keys %$map ) {
            if( $map->{$key}->{'name'} eq $sth->{'NAME'}->[$i] ) {
               $obj->$key( $row[$i] );
               last;
            }
         }
      }
      push @objs, $obj;
   }
   $sth->finish;

   return undef if( $self->{'_dbh'}->err );
   return \@objs;
}

=head2 db_exists

Tests to see if the given id exists in the DB.

   my $obj = new <PACKAGE>();
   $obj->db_exists( $primary_key_id );

Returns the number of objects with the primary key id passed to
it, should always return 1 or 0.

=cut 

sub db_exists {
   my $self = shift;
   my $id   = shift;

   my ($ref,$def) = $self->get_ref_def();
   my $map = $def->{'attr_map'};
   my $sql = 'SELECT COUNT(*) FROM '
           . $def->{'table'}
           . ' WHERE '
           . $map->{$def->{'primary'}}->{'name'}
           . ' = ? ';

   $self->connect() if( !defined( $self->{'_dbh'} ) );
   print STDERR "db_exists: $sql ($id)\n" if( $DEBUG ); 
   my $sth = $self->{'_dbh'}->prepare( $sql ) || return undef;
   $sth->execute( $id ) || return undef;

   my @row = $sth->fetchrow();
   $sth->finish;
   return $row[0];
}

=head2 db_set

Stores the given object into the database, automatically inserting 
or updating, automatically setting any AUTOKEY, TIMESTAMP, or 
PASSWORD fields.

Will select the object back out of the db to retrieve the new
AUTOKEY, TIMESTAMP, and hashed PASSWORD fields.

   $obj->db_set();

Returns the primary key id of the object else 0, use $obj->handle
to get DBI errors.

=cut 

sub db_set {
   my $self = shift;
   my ($sql,$update);
   my @keys;
   my @values;
   my $new_id = undef;

   my ($ref,$def) = $self->get_ref_def();
   return undef if( !($self->{'_modified'}) );
   my $map = $def->{'attr_map'};
   $self->connect() if( !defined( $self->{'_dbh'} ) );

   my $defined = defined( $self->id() );
   my $exists = undef;
   if( $defined ) {
      $exists = $self->db_exists( $self->id() );
   }

   if( !$defined || !$exists ) {
      foreach my $key ( keys %$map ) {
         if( $map->{$key}->{'type'} eq 'AUTOKEY' ) {
            push @keys, $map->{$key}->{'name'};
            if( $defined && !$exists ) {
               push @values, $self->id();
            } else {
               push @values, 'NULL';
            }
         } elsif( $map->{$key}->{'type'} eq 'TIMESTAMP' ) {
            push @keys, $map->{$key}->{'name'};
            push @values, 'NOW()';
         } elsif( $map->{$key}->{'type'} eq 'PASSWORD' ) {
            push @keys, $map->{$key}->{'name'};
            push @values, 'PASSWORD('.$self->{'_dbh'}->quote( $self->$key() ).')';
         } elsif( defined( $map->{$key} ) ) {
            if( $map->{$key}->{'type'} eq 'SCALAR' ) {
               if( defined( $self->$key()) ) {
                  push @keys, $map->{$key}->{'name'};
                  push @values, $self->{'_dbh'}->quote( $self->$key() );
               } 
            }
         }
      }
      my $keys_str = join( ', ', @keys );
      $keys_str =~ s/\,\s*$//;
      my $values_str = join( ', ', @values );
      $values_str =~ s/\,\s*$//;

      $sql = 'INSERT INTO '
           . $def->{'table'}
           . ' ( ' . $keys_str . ' )'
           . ' VALUES '
           . '( ' . $values_str . ' ) ';
      print STDERR "db_set (new item): $sql\n" if( $DEBUG ); 
      my $sth = $self->{'_dbh'}->prepare( $sql ) || return undef;
      $sth->execute() || return undef;
      $sth->finish;

      $sql = 'SELECT LAST_INSERT_ID() FROM '
              . $def->{'table'};
      print STDERR "db_set (new item): $sql\n" if( $DEBUG ); 
      $sth = $self->{'_dbh'}->prepare( $sql ) || return undef;
      $sth->execute() || return undef;
      $new_id = ($sth->fetchrow_array())[0];
      $sth->finish;

      # read the object back in to update id's, timestamps, pw
      $self->db_get( $new_id );
   } else {
      foreach my $key ( keys %$map ) {
         if( $map->{$key}->{'type'} eq 'AUTOKEY' ) {
            next;
         } elsif( $map->{$key}->{'type'} eq 'TIMESTAMP' ) {
            $update .= $map->{$key}->{'name'}.' = NOW(), '
         } elsif( defined( $map->{$key} ) ) {
            if( $map->{$key}->{'type'} eq 'SCALAR' ) {
               $update .= $map->{$key}->{'name'}.' = '
                        . $self->{'_dbh'}->quote($self->$key()).', ';
            } elsif( $map->{$key}->{'type'} eq 'PASSWORD' ) {
               # special case, since if the password hasn't been modified
               # but is in hashed form, don't re-hash the hash:
               if( $self->{'data'}->{$key}->{'_modified'} == 1 ) {
                  $update .= $map->{$key}->{'name'}.' = PASSWORD('
                           . $self->{'_dbh'}->quote($self->$key()).'), ';
               }
            }
         }
      }
      $update =~ s/\,\s*$//;
      $sql = 'UPDATE '
           . $def->{'table'}
           . ' SET '
           . $update
           . ' where id = ?';

      print STDERR "db_set (existing item): $sql (".$self->id().")\n" if( $DEBUG ); 
      my $sth = $self->{'_dbh'}->prepare( $sql ) || return undef;
      $sth->execute( $self->id() ) || return undef;
      $sth->finish;
      $new_id = $self->id();

      # read the object back in to update id's, timestamps, pw
      $self->db_get( $new_id );
   }

   return undef if( $self->{'_dbh'}->err );
   $self->{'_modified'} = 0;
   return $new_id || 0;
}

=head2 handle

Returns the database handle suitable for passing to another instantiation
of the same type of object.

   my $dbh = $obj->handle();

=cut

sub handle {
   my $self = shift;
   return $self->{'_dbh'};
}

=head1 Breaking the Abstractions:


The actual database column names associated with an accessor
may be retrieved by prepending the normal field accessor name
with "raw_":

   my $val = $obj->field();
   my $column_name = $obj->raw_field();

=head2 table

Returns the actual database name of the table

=cut

sub table {
   my $self = shift;
   my ($ref,$def) = $self->get_ref_def();
   return $def->{'table'};
}

=head2 raw_sql

Can be used to construct arbitrary sql still using the
accessor names, returns a statement handle after the execute.  
Pass it a sql string, additional arguments are assumed to be
values for '?' placeholders.  Don't forget to quote your values 
that aren't in placeholders and call $sth->finish when you're done.

Use the "raw" and "table" accessors here (example join, broken
down for legibility) :

   my $table1  = $obj1->table;
   my $table2  = $obj2->table;
   my $result1 = "$table1." . $obj1->raw_field1;
   my $result2 = "$table2." . $obj2->raw_field2;
   my $where   = "$table1." . $obj1->raw_field3;
   
   my $sql = "SELECT $result1, $result2 FROM "
           . "$table1, $table2 WHERE "
           . " WHERE $where = ?"
   
   $obj->raw_sql( $sql, $field3_value );

Assume that the standard field accessor would be $obj->field,
to retrieve the actual column name, the acecssor would be 
$obj->raw_field

=cut 

sub raw_sql {
   my $self = shift;
   my $sql  = shift;

   print STDERR "raw_sql: $sql (".@_.")\n" if( $DEBUG ); 
   my $sth = $self->{'_dbh'}->prepare( $sql ) || return undef;
   $sth->execute( @_ ) || return undef;
   
   return $sth;
}

=head2 raw_sql

Return the objects or objects as a hash refs of accessor->value
data, or an array ref of hash refs, suitable for passing to templating
functions.

my $hr = $obj->as_hr();

my $ar = Object::Type->as_hr( [ $obj1, $obj2 ] );
my $ar = $obj->as_hr( [ $obj1, $obj2 ] );

=cut 

sub as_hr {
   my $self = shift;

   if( ref( $self ) eq '' ) {
      # assume array arg:
      my $args = shift;
      my $ar = [];
      foreach my $elt ( @$args ) {
         push @$ar, $elt->_as_hr();
      }
      return $ar;
   } else {
      # called via object, check for args:
      my $args = shift;
      if( defined( $args ) ) {
         my $ar = [];
         foreach my $elt ( @$args ) {
            push @$ar, $elt->_as_hr();
         }
         return $ar;
      } else {
         return $self->_as_hr();
      }
   }
}

sub _as_hr {
   my $self = shift;
   my $hr = {};

   my ($ref,$def) = $self->get_ref_def();
   my $map = $def->{'attr_map'};

   foreach my $key ( keys %$map ) {
      $hr->{$key} = $self->$key();
   }

   return $hr;
}

=head1 Debugging

To set global debugging to print all the SQL executed to 
STDERR, set this (although called through an object, the
effect is global):

   $obj->debug( 1 );  # debugging on
   $obj->debug( 0 );  # debugging off

=cut

# Set this to output all sql performed to STDERR
sub debug {
   my $arg = shift;
   $DEBUG = $arg if( defined( $arg ) );
   return;
}

# Prints out the field accessor names and their types
sub _enumerate {
   my $self = shift;
   my ($ref,$def) = $self->get_ref_def();
   my $map = $def->{'attr_map'};
   foreach my $key ( keys %$map ) {
      print STDERR "$key: ".$map->{$key}->{'type'}."\n";
   }
   return;
}

# Does the DBI connect, increments dbh reference count
sub connect {
   my $self = shift;
   my ($ref,$def) = $self->get_ref_def();

   $self->{'_dbh'} = DBI->connect( $def->{'driver'}.":".
                                   $def->{'db'},
                                   $def->{'user'},
                                   $def->{'pass'} );

   $dbh_ref{$self->{'_dbh'}} = 0 if( !exists( $dbh_ref{$self->{'_dbh'}} ) );
   $dbh_ref{$self->{'_dbh'}}++;

   return;
}

# Internal use only, retrieves the package global object reference 
# type and definition.  Kludgy as it "call into" a sub-type.
sub get_ref_def {
   my $self = shift;
   my $obj  = shift;
   my $ref;

   if( defined( $obj ) ) {
      $ref = $obj;
   } else {
      ($ref = $self) =~ s/\=.*//;
   }

   no strict;
   my $def = $ref."::definition";
   $def = &$def;
   use strict;

   return ($ref,$def);
}

# accessor function value setting/getting
sub AUTOLOAD {
   my $self     = shift;
   my $arg      = shift;
   my ($fcn,$ref,$def);

   ($fcn = $AUTOLOAD) =~ s/.*:://;
   return if( $fcn eq 'DESTROY' );

   ($ref,$def) = $self->get_ref_def();
   my $map = $def->{'attr_map'};

   if( defined( $map->{$fcn} ) ) {
      my $type = $map->{$fcn}->{'type'};

      if( defined( $arg ) ) {
         $self->{'_modified'} = 1;
         $self->{'data'}->{$fcn}->{'data'} = $arg;
         if( $map->{$fcn}->{'type'} eq 'PASSWORD' ) {
            $self->{'data'}->{$fcn}->{'_modified'} = 1;
         }
         return $arg;
      } else {
         return $self->{'data'}->{$fcn}->{'data'};
      }
   } else {
      # for raw sql access:
      if( $fcn =~ m/^raw_(.*)$/ ) {
         if( defined( $map->{$1} ) ) {
            return $map->{$1}->{'name'};
         }
      }
      return;
   }

   ### NOT REACHED ###
   return $self->{'data'}->{$fcn}->{'data'};
}

# fiery doom, will disconnect if the reference
# count gets too low
sub DESTROY {
   my $self = shift;
   $dbh_ref{$self->{'_dbh'}}--;
   if( $dbh_ref{$self->{'_dbh'}} < 1 ) {
      delete $dbh_ref{$self->{'_dbh'}};
      $self->{'_dbh'}->disconnect();
   }
   return;
}

=head1 Credits

All functionality and bugs copyright 2002 Barclay Osborn

=cut 

1;