#Copyright Massachusetts Institute of technology, 1998.
#Written by Eric Prud'hommeaux for the World Wide Web Consortium

use strict;
require Exporter;
# require AutoLoader;

use W3C::Database::DBIInterface;

$W3C::Database::ObjectBase::REVISION = '$Id: ObjectBase.pm,v 1.18 2003/05/10 18:21:26 eric Exp $ ';

package W3C::Database::ObjectBase;
use W3C::Database::Exception;
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK @TODO
	    $FieldType_INT $FieldType_TINYINT $FieldType_ENUM $FieldType_CHAR $FieldType_VARCHAR $FieldType_TEXT);

@ISA = qw(Exporter); # AutoLoader);
@EXPORT = qw($FieldType_INT $FieldType_TINYINT $FieldType_ENUM $FieldType_CHAR $FieldType_VARCHAR $FieldType_TEXT);
@EXPORT_OK = qw();
$VERSION = 0.11;
$DSLI = 'adpO';
@TODO = ('');

#####
# constants

use vars qw($FieldType_INT $FieldType_TINYINT $FieldType_ENUM $FieldType_CHAR $FieldType_VARCHAR $FieldType_TEXT $FieldType_BLOB
	    $FieldType_DATE $FieldType_TIME $FieldType_DATETIME $FieldType_TIMESTAMP);
($FieldType_INT, $FieldType_TINYINT, $FieldType_ENUM, $FieldType_CHAR, $FieldType_VARCHAR, $FieldType_TEXT, $FieldType_BLOB, 
 $FieldType_DATE, $FieldType_TIME, $FieldType_DATETIME, $FieldType_TIMESTAMP) = (0..11);

#use vars qw($FieldType_INT $FieldType_TINYINT $FieldType_ENUM $FieldType_CHAR $FieldType_VARCHAR $FieldType_TEXT);
#($FieldType_INT, $FieldType_TINYINT, $FieldType_ENUM, $FieldType_CHAR, $FieldType_VARCHAR, $FieldType_TEXT) = (0..5);

package W3C::Database::ObjectDatabaseException;
@W3C::Database::ObjectDatabaseException::ISA = qw(W3C::Database::Exception);
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-object') if (!$self->{-object});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {return 'error in the "'.$_[0]->getDatabase.'" database, "'.$_[0]->getObject.'" object';}
sub getObject {return $_[0]->{-target};}

package W3C::Database::ObjectDatabaseUpdateException;
@W3C::Database::ObjectDatabaseUpdateException::ISA = qw(W3C::Database::ObjectDatabaseException);
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-update') if (!$self->{-update});
    $self->missingParm('-failure') if (!$self->{-failure});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {
    my ($self) = @_;
    my $ret = 'error in the "'.
	$self->getDatabase.'" database, "'.
	    $self->getObject.'" object, "'.
		$self->getUpdate.'" update, "'.
		    $self->getFailure.'" failure';
    return $ret;
}
sub getUpdate {return $_[0]->{-update};}
sub getFailure {return $_[0]->{-failure};}

package W3C::Database::ObjectBase;
use W3C::Util::Exception;

sub showId () {
    my ($self) = @_;
    return $self->{THIS_TABLE}{-table}.'['.$self->{DB_ID}.']';
}

# check - go to the database to see what the current values are

sub check ($) {
    my ($self, $fields) = @_;
    my $table = $self->{THIS_TABLE}{-table};
    my $key = $self->{THIS_TABLE}{-primaryKey}.'='.$self->getPrimaryKey;
    my $query = 'SELECT '.join(',', @$fields).' FROM '.$table.' WHERE '.$key;
    my (@values, @diffs);
    $self->{DB}->executeWideQuery(\@values, $query);
    for (my $i = 0; $i < @$fields; $i++) {
	my $field = $fields->[$i];
	my $value = $values[$i];
	if ($self->{FIELD_ORIG}{$field} ne $value) {
	    $self->{FIELD_VALUES}{$field} = $value;
	    $self->{FIELD_ORIG}{$field} = $value;
	    $diffs[$i] = 1;
	}
	$diffs[$i] = 1;
    }
    return (\@values, \@diffs);
}

# set - set cached values

sub set ($$) {
    my ($self, $fieldValues) = @_;
    foreach my $field (keys %$fieldValues) {
	$self->{FIELD_VALUES}{$field} = $fieldValues->{$field};
    }
}

# update - set database values
# fieldValues: HASH ref of values to update
#              undef to flush all changed values.
# discretionaryUpdate: 0 - write regardless of cache changes
#                      1 - write only the cache changes
#                      2 - count cache changes

sub update ($;$) {
    my ($self, $fieldValues, $flags) = @_;
    my $thisTable = $self->{THIS_TABLE};
    my @wheres = ($self->{THIS_TABLE}{-primaryKey}.'='.$self->getPrimaryKey);
    $fieldValues = $self->{FIELD_VALUES} if (!defined $fieldValues);
    my $fieldOrig = $self->{FIELD_ORIG};
    my @updates;
    my $updateCount = 0;
    foreach my $field (keys %$fieldValues) {
	my ($oldValue, $oldDbValue) = $self->{DB}->getValue($fieldOrig->{$field}, $field, $thisTable, $flags); # $self->{FIELD_ORIG}{$field};
	my ($value, $dbValue) = $self->{DB}->getValue($fieldValues->{$field}, $field, $thisTable, $flags);
	$fieldValues->{$field} = $value;
	if (!$flags->{-discretionaryUpdate} || 
	    ($flags->{-discretionaryUpdate} && $value ne $oldValue && 
	     ($value || $oldValue))) {
	    $fieldOrig->{$field} = $value;
#	    my $value = $self->{DB}->getValue($field, $fieldValues, $thisTable);
#	    $value = $value->getPrimaryKey if (ref $value);
	    push (@updates, $field.'='.$self->{DB}->escapeWithNULL($dbValue));
	    if (defined $oldValue) {
		push (@wheres, $field.'='.$self->{DB}->escapeWithNULL($oldDbValue));
	    } elsif (defined $flags->{-default}{$field}) {
		push (@wheres, $field.'='.$self->{DB}->escapeWithNULL($flags->{-default}{$field}));
	    } else {
		push (@wheres, $field.' IS NULL');
	    }
	    $updateCount++;
	}
    }
    if ($flags->{-discretionaryUpdate} != 2 && $updateCount > 0) {
	my $query = 'UPDATE '.$thisTable->{-table}.' SET '.join(',', @updates).' WHERE '.join(' AND ', @wheres);
	$self->{DB}->executeUpdate($query);
	if ($self->{DB}->{DB}->{ROWS} != 1 && !(!$flags->{-discretionaryUpdate} && $self->{DB}->{DB}->{ROWS} == 0)) {
	    &throw(new W3C::Database::ObjectDatabaseUpdateException(-database => $self->{DB}, -object => $self, 
								     -object => $self, -update => $query, -failure => 
									 'update affected '.$self->{DB}->{DB}->{ROWS}.' rows'));
	}
    }
    return $updateCount;
}

sub loadExternalKey ($$$) {
    my ($self, $targetTable, $referrerTable, $referrerField) = @_;
    return $self->{DB}->loadExternalKey($self->{DB_ID}, $referrerTable, $referrerField);
}

# copy state of another object
# warning: deletes toCopy - USE JUDICIOUSLY, no checks for external key refs to $toCopy

sub emulate ($;\%) {
    my ($self, $toCopy, $flags) = @_;

    # copy field values
    foreach my $field (keys %{$toCopy->{FIELD_VALUES}}) {
	$self->{FIELD_VALUES}{$field} = $toCopy->{FIELD_VALUES}{$field} if ($field ne $self->{THIS_TABLE}{-primaryKey});
    }

    # delete the old object
    $toCopy->deleteTop({%$flags, -replaceWith => $self});
    if (!$flags->{-discretionaryUpdate}) {
	$self->flush($flags);
    }
}

# dump any cached changes to the database

sub flush (;\%) {
    my ($self, $flags) = @_;
    $flags->{-discretionaryUpdate} = 1 if (!exists $flags->{-discretionaryUpdate});
    return $self->update(undef, $flags);
}

# count changes in the cached edition (diff FIELD_VALEUS and FIELD_ORIG)

sub changes (;\%) {
    my ($self, $flags) = @_;
    $flags->{-discretionaryUpdate} = 2 if (!exists $flags->{-discretionaryUpdate}); # may choose some meaning for 2, t for now
    return $self->update(undef, $flags);
}

# delete self, not any of its leaves - USE JUDICIOUSLY, no checks for external keys

sub deleteTop {
    my ($self, $flags) = @_;
    $self->{DB}->deleteTop($self, $self->{FIELD_VALUES}, $self->{THIS_TABLE}, $flags);
}

sub isBadEgg () {
    my ($self) = @_;
    return $self->{BAD_EGG};
}

#use Date::Manip;
sub show (;$$) {
    my ($self, $flags, $context) = @_;
    return '...' if ($context->{-done}{$self});
    $context->{-done}{$self} = 1;
    my $ret;
    foreach my $field (@{$self->{THIS_TABLE}->{-fieldOrder}}) {
	$ret .= $field;
	$ret .= $self->{FIELD_VALUES}->{$field} eq $self->{FIELD_VALUES}->{$field} ? ':' : '=';
	my $fieldDesc = $self->{THIS_TABLE}{-fields}{$field};
	my $value = $self->{FIELD_VALUES}{$field};
	my ($target, $type) = ($fieldDesc->{-target}, $fieldDesc->{-type});
	if (!defined $value) {
	    $ret .= 'undef';
	} elsif ($target) {
	    $ret .= '('.$value->show($flags, $context).')';
	} elsif ($type == $FieldType_INT || 
		 $type == $FieldType_TINYINT) {
	    $ret .= $value;
	} elsif ($type == $FieldType_ENUM || 
		 $type == $FieldType_CHAR || 
		 $type == $FieldType_VARCHAR || 
		 $type == $FieldType_TEXT) {
	    $ret .= '"'.$value.'"';
	} elsif ($type == $FieldType_BLOB) {
	    $ret .= '"..."';
	} elsif ($type == $FieldType_TIME) {
	    $ret .= '['.&UnixDate(&ParseDateString($value),'%H:%M:%S').']';
	} elsif ($type == $FieldType_DATE || 
		 $type == $FieldType_DATETIME || 
		 $type == $FieldType_TIMESTAMP) {
	    $ret .= '['.&UnixDate(&ParseDateString($value),'%Y %b %d %H:%M:%S').']';
	} else {
	    warn "ObjectBase::show('$self') - no target field and unknown type: $type";
	}
	$ret .= ' ';
    }
    return $ret;
}

1;

__END__

=head1 NAME

W3C::Database::ObjectBase - handy base class for all object_maker classes

=head1 SYNOPSIS

@@@

=head1 DESCRIPTION

This module is part of the W3C::Database CPAN module.

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

perl(1).

=cut
