DbFramework::Persistent - Persistent Perl object base class

  package Foo;
  use base qw(DbFramework::Persistent);

  package main;
  $foo = new Foo($table,$dbh,$catalog);
  $foo->attributes_h(\%foo};
  $foo->insert;
  $foo->attributes_h(\%new_foo);
  $foo->update(\%attributes);
  $foo->delete;
  $foo->init_pk;
  @foo     = $foo->select($condition,$order);
  $hashref = $foo->table_qualified_attribute_hashref;
  $code    = DbFramework::Persistent::make_class($name);

package DbFramework::Persistent;
use strict;
use vars qw( $TABLE $_DEBUG $VERSION %ATTRIBUTES_H $CATALOG );
$VERSION = '1.10';
use base qw(DbFramework::Util);
use Alias;
use DbFramework::Table;

## CLASS DATA

my $Debugging = 0;

my %fields = (
	      TABLE        => undef,
	      ATTRIBUTES_H => undef,
	      CATALOG      => undef,
);

##-----------------------------------------------------------------------------
## CLASS METHODS
##-----------------------------------------------------------------------------

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my($table,$dbh,$catalog) = @_;
  my $self = bless { _PERMITTED => \%fields, %fields, }, $class;
  $table = new DbFramework::Table($table,undef,undef,$dbh)
    unless (ref($table) eq 'DbFramework::Table');
  $self->table($table->init_db_metadata($catalog));
  $self->catalog($catalog);
  return $self;
}

##-----------------------------------------------------------------------------

sub make_class {
  my($proto,$name) = @_;
  my $class = ref($proto) || $proto;

  my $code = qq{package $name;
use strict;
use base qw(DbFramework::Persistent);
};
}

##-----------------------------------------------------------------------------
## OBJECT METHODS
##-----------------------------------------------------------------------------

sub delete {
  my $self = attr shift;
  return $TABLE->delete($self->_pk_conditions);
}

#------------------------------------------------------------------------------

sub insert {
  my $self = attr shift;
  return $TABLE->insert($self->attributes_h);
}

#------------------------------------------------------------------------------

sub update {
  my $self = attr shift;
  my %attributes = defined($_[0]) ? %{$_[0]} : %{$self->attributes_h};
  # get pk attributes
  my %pk_attributes;
  for ( $TABLE->is_identified_by->attribute_names ) {
    $pk_attributes{$_} = $attributes{$_};
  }
  return $TABLE->update($self->attributes_h,$self->where_and(\%pk_attributes));
}

#------------------------------------------------------------------------------

sub select {
  my $self = attr shift;

  my @things;
  my @columns = $TABLE->attribute_names;
  for ( $TABLE->select(\@columns,shift,shift) ) {
    print STDERR "\@{\$_} = @{$_}\n" if $_DEBUG;
    # pass Table *object* to new to retain any fk relationships
    my $thing = $self->new($TABLE,$TABLE->dbh,$CATALOG);
    my %attributes;
    for ( my $i = 0; $i <= $#columns; $i++ ) {
      print STDERR "assigning $columns[$i] = $_->[$i]\n" if $_DEBUG;
      $attributes{$columns[$i]} = $_->[$i];
    }
    $thing->attributes_h([%attributes]);
    push(@things,$thing);
  }
  return @things;
}

##-----------------------------------------------------------------------------

#=head2 validate_required()

#Returns a list of attribute names which must B<not> be NULL but are
#undefined.  If I<@attributes> is undefined, validates all attributes.

#=cut

#sub validate_required {
#  my $self  = attr shift; my $table = $self->table;
#  my($attribute,@invalid);

#  my @attributes = @_ ? @_ : sort keys(%STATE);
#  foreach $attribute ( @attributes ) {
#    my $column = $table->get_column($attribute);
#    if ( ! $column->null && ! defined($self->get_attribute($attribute)) ) {
#      my $heading = $column->heading;
#      if ( $heading ) {
#	push(@invalid,$heading)
#      } else {
#	push(@invalid,$attribute);
#      }
#    }
#  }   
#  return @invalid;
#}

##-----------------------------------------------------------------------------

# return a SQL 'WHERE' clause condition consisting of primary key
# attributes and their corresponding values joined by 'AND'

sub _pk_conditions {
  my $self       = attr shift;
  my @attributes = @{$TABLE->is_identified_by->incorporates_l};
  my %values     = %{$self->attributes_h};
  my %pk_attributes;
  for ( @attributes ) {
    my $column = $_->name;
    $pk_attributes{$column} = $values{$column};
  }
  return $self->where_and(\%pk_attributes);
}

##-----------------------------------------------------------------------------

# return a SQL 'WHERE' clause condition consisting of attributes named
# after keys in %attributes and their corresponding values joined by
# 'AND'
 
sub where_and {
  my $self       = attr shift;
  my %attributes = %{$_[0]};
  my $conditions;
  for ( keys %attributes ) {
    my($attribute) = $TABLE->get_attributes($_);
    $conditions .= ' AND ' if $conditions;
    my($name,$type) = ($attribute->name,$attribute->references->type);
    $conditions .= "$name = " . $TABLE->dbh->quote($attributes{$name},$type);
  }
  print STDERR "$conditions\n" if $_DEBUG;
  $conditions;
}

##-----------------------------------------------------------------------------

#=head2 fill_template($name)

#Returns the template named I<$name> in the table associated with this
#object filled with the object's attribute values.  See
#L<DbFramework::Table/"fill_template()">.

#=cut

sub fill_template {
  my($self,$name) = (attr shift,shift);
  $TABLE->fill_template($name,$self->attributes_h);
}

##-----------------------------------------------------------------------------

sub as_html_form {
  my $self = attr shift;
  my %attributes = %{$self->attributes_h};
  my $html;
  for ( @{$self->table->contains_l} ) {
    next if $self->table->in_foreign_key($_);
    my $name = $_->name;
    $html .= "<TR><TD><STRONG>$name</STRONG></TD><TD>"
          . $_->as_html_form_field($attributes{$name})
          .  "</TD></TR>\n";
  }
  return $html;
}

#------------------------------------------------------------------------------

sub init_pk {
  my $self = attr shift;
  my @loh  = $TABLE->select_loh(undef,$self->_pk_conditions);
  $self->attributes_h([ %{$loh[0]} ]);
}

#------------------------------------------------------------------------------

sub table_qualified_attribute_hashref {
  my $self   = attr shift;
  my $t_name = $TABLE->name;
  my %tq;
  for ( keys %ATTRIBUTES_H ) { $tq{"$t_name.$_"} = $ATTRIBUTES_H{$_} }
  return \%tq;
}

1;