#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::ObjectDB::REVISION = '$Id: ObjectDB.pm,v 1.48 2004/06/09 09:19:06 eric Exp $ ';

package W3C::Database::ObjectDB;
use vars qw($VERSION $DSLI @ISA @EXPORT @EXPORT_OK @TODO 
	    $FieldType_INT $FieldType_TINYINT $FieldType_FLOAT $FieldType_ENUM 
	    $FieldType_CHAR $FieldType_VARCHAR $FieldType_TEXT $FieldType_BLOB 
	    $FieldType_DATE $FieldType_TIME $FieldType_DATETIME $FieldType_TIMESTAMP);

@ISA = qw(W3C::Database::DBIRef Exporter); # AutoLoader);
@EXPORT = qw($FieldType_INT $FieldType_TINYINT $FieldType_FLOAT $FieldType_ENUM 
	     $FieldType_CHAR $FieldType_VARCHAR $FieldType_TEXT $FieldType_BLOB
	     $FieldType_DATE $FieldType_TIME $FieldType_DATETIME $FieldType_TIMESTAMP);
@EXPORT_OK = qw();
$VERSION = 0.11;
$DSLI = 'adpO';
@TODO = ('');

#####
# constants

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

use W3C::Util::Exception;
@W3C::Database::Exception::ISA = qw(W3C::Util::Exception);
@W3C::Database::DropRowException::ISA = qw(W3C::Database::Exception);

package W3C::Database::TableException;
@W3C::Database::TableException::ISA = qw(W3C::Database::Exception);
use W3C::Util::Exception;
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-table') if (!$self->{-table});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {&throw(new W3C::Util::FunctionException);}
sub getTable {return $_[0]->{-table}}

@W3C::Database::NoSuchTableException::ISA = qw(W3C::Database::TableException);
sub W3C::Database::NoSuchTableException::getSpecificMessage {
    return 'no such table "'.$_[0]->getTable.'"';}

package W3C::Database::FieldException;
@W3C::Database::FieldException::ISA = qw(W3C::Database::TableException);
use W3C::Util::Exception;
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-field') if (!$self->{-field});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {&throw(new W3C::Util::FunctionException);}
sub getField {return $_[0]->{-field}}

@W3C::Database::NoSuchFieldException::ISA = qw(W3C::Database::FieldException);
sub W3C::Database::NoSuchFieldException::getSpecificMessage {
    return 'table "'.$_[0]->getTable.'" has no "'.$_[0]->getField.'" field';}

@W3C::Database::NoSuchIndexException::ISA = qw(W3C::Database::FieldException);
sub W3C::Database::NoSuchIndexException::getSpecificMessage {
    return 'table "'.$_[0]->getTable.'" has no "'.$_[0]->getField.'" index';}

package W3C::Database::ValueException;
@W3C::Database::ValueException::ISA = qw(W3C::Database::FieldException);
use W3C::Util::Exception;
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-value') if (!exists $self->{-value});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {&throw(new W3C::Util::FunctionException);}
sub getValue {return $_[0]->{-value}}

package W3C::Database::ValueTypeException;
@W3C::Database::ValueTypeException::ISA = qw(W3C::Database::ValueException);

sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-neededType') if (!$self->{-neededType});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {return $_[0]->getTable.'.'.$_[0]->getField.': "'.$_[0]->getValue.'" must be a '.$_[0]->getNeededType;}
sub getNeededType {return $_[0]->{-neededType}}

@W3C::Database::ValueDefaultException::ISA = qw(W3C::Database::ValueException);
sub W3C::Database::ValueDefaultException::getSpecificMessage {
    return $_[0]->getTable.'.'.$_[0]->getField.': default option not selected - defaulting to "'.$_[0]->getValue.'" anyways';}

@W3C::Database::ValueNotReferenceException::ISA = qw(W3C::Database::ValueException);
sub W3C::Database::ValueNotReferenceException::getSpecificMessage {
    return $_[0]->getTable.'.'.$_[0]->getField.': "'.$_[0]->getValue.'" should not be a reference';}

@W3C::Database::NoMatchingEnumException::ISA = qw(W3C::Database::ValueException);
sub W3C::Database::NoMatchingEnumException::getSpecificMessage {
    return $_[0]->getTable.'.'.$_[0]->getField.': no enum matching "'.$_[0]->getValue.'"';}

@W3C::Database::UnrequestedDatumException::ISA = qw(W3C::Database::ValueException);
sub W3C::Database::UnrequestedDatumException::getSpecificMessage {
    return $_[0]->getTable.'.'.$_[0]->getField.': got primary key "'.$_[0]->getValue.'" for no apparent reason';}

package W3C::Database::UnresolvedLoadException;
@W3C::Database::UnresolvedLoadException::ISA = qw(W3C::Database::TableException);

sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-query') if (!$self->{-query});
    $self->missingParm('-primaryKeys') if (!$self->{-primaryKeys});
    $self->missingParm('-errorLines') if (!$self->{-errorLines});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {return '"'.$_[0]->getQuery.'" did not load '.$_[0]->getTable.' records for '.
			    join (',', @{$_[0]->getPrimaryKeys})."\n".join ("\n", @{$_[0]->getErrorLines})}
sub getQuery {return $_[0]->{-query}}
sub getPrimaryKeys {return $_[0]->{-primaryKeys}}
sub getErrorLines {return $_[0]->{-errorLines}}

package W3C::Database::IndexException;
@W3C::Database::IndexException::ISA = qw(W3C::Database::TableException);
use W3C::Util::Exception;
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-index') if (!$self->{-index});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {&throw(new W3C::Util::FunctionException);}
sub getIndex {return $_[0]->{-index}}

package W3C::Database::IndexFieldException;
@W3C::Database::IndexFieldException::ISA = qw(W3C::Database::IndexException);
use W3C::Util::Exception;
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-field') if (!$self->{-field});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {&throw(new W3C::Util::FunctionException);}
sub getField {return $_[0]->{-field}}

@W3C::Database::MissingIndexFieldException::ISA = qw(W3C::Database::IndexFieldException);
sub W3C::Database::MissingIndexFieldException::getSpecificMessage {
    return $_[0]->getTable.'~'.$_[0]->getIndex.': missing field "'.$_[0]->getField.'"';}

package W3C::Database::NoCreateException;
@W3C::Database::NoCreateException::ISA = qw(W3C::Database::IndexException);
use W3C::Util::Exception;
sub new {
    my ($proto, @parms) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new(@parms);
    $self->missingParm('-conditions') if (!$self->{-conditions});
    $self->fillInStackTrace;
    return $self;
}
sub getSpecificMessage {return $_[0]->getTable.'~'.$_[0]->getIndex.' did not match "'.join (' AND ', @{$_[0]->getConditions}).'"';}
sub getConditions {return $_[0]->{-conditions}}

package W3C::Database::StdErrorHandler;
use W3C::Util::Exception;
sub new ($) {
    my ($proto, $stderr) = @_;
    my $class = ref($proto) || $proto;
    my $self = \$stderr;
    bless ($self, $class);
    return $self;
}

sub warning ($) {
    my ($self, $exception) = @_;
    warn $exception->toString;
}

sub error ($) {
    my ($self, $exception) = @_;
    &throw($exception);
}

package W3C::Database::QuietErrorHandler;
use W3C::Util::Exception;
sub new () {
    my ($proto) = @_;
    my $class = ref($proto) || $proto;
    my $scalar = 'some scalar';
    my $self = \$scalar;
    bless ($self, $class);
    return $self;
}

sub warning ($) {
    my ($self, $exception) = @_;
}

sub error ($) {
    my ($self, $exception) = @_;
    &throw($exception);
}

package W3C::Database::ObjectDB;
use W3C::Database::Exception;

# ObjectBase data used in ObjectDB:
# FIELD_VALUES - curent values for the database fields
#                - may or may not represent the DB state on disk.
# FIELD_ORIG - copy of the last FIELD_VALUES known to be on disk
#              - used to tell when FIELD_VALUES do not represent disk state.

sub new ($$$) {
    my ($proto, $properties, $tableDesc, $tableOrder) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($properties);
    bless ($self, $class);
    $self->{TABLE_DESC} = $tableDesc;
    $self->{TABLE_ORDER} = $tableOrder;
    $self->{ERROR_HANDLER} = new W3C::Database::StdErrorHandler('handle here');
    return $self;
}

sub setErrorHandler ($) {
    my ($self, $errorHandler) = @_;
    $errorHandler = new W3C::Database::QuietErrorHandler() if (!$errorHandler);
    $self->{ERROR_HANDLER} = $errorHandler;
}

sub dbid ($) {
    my ($self) = @_;
    return $self->{DB_ID};
}

sub showSelf ($) {
    my ($self, $flags) = @_;
    my $ret = '';
    if ($flags->{-showRef}) {
	$ret .= $self.' ';
    } elsif ($flags->{-showTypes}) {
	$ret .= (ref $self).' ';
    }
    $ret .= $self->{DB_ID}.' ' if ($flags->{-showIds});
    return $ret;
}

sub createSubclass ($) {
    my ($self, $table) = @_;

    # generate new class name like MyClass::TableOne
    my $tableDesc = $self->{TABLE_DESC};
    my $tableOrder = $self->{TABLE_ORDER};
    my $interfaceClass = $tableDesc->{$table}{-class};

    # create a new interface class
    my $object = $interfaceClass->SUPER::new($self);
    bless ($object, $interfaceClass);

    # fill out the info for ObjectDB
    $object->{DB} = $self;
    $object->{TABLE_NAME} = $table;
    $object->{THIS_TABLE} = $tableDesc->{$table};
    $object->{TABLE_DESC} = $tableDesc;
    $object->{TABLE_ORDER} = $tableOrder;
    return $object;
}

# getValue - turn a value into its object and database forms

sub getValue ($$$) {
    my ($self, $value, $field, $thisTable, $flags) = @_;
    my $table = $thisTable->{-table};
    my $dbValue = $value;
    my $thisField = $thisTable->{-fields}{$field} || 
	$self->{ERROR_HANDLER}->error(new W3C::Database::NoSuchFieldException(-table => $table, 
									      -field => $field, 
									      -database => $self->{DB}));
    my $targetTable = $thisField->{-target};

    # references are either...
    if (ref $value eq 'ARRAY') {
	# ...parameters to construct another object
	$value = $self->ensure($targetTable, @$value);
	$dbValue = $value->getPrimaryKey;
    } elsif (ref $value) {
	# ...or already constructed objects
	if (defined $targetTable) {
	    if (!$value->isa($self->{TABLE_DESC}->{$targetTable}{-class})) {
		$self->{ERROR_HANDLER}->warning(new W3C::Database::ValueTypeException(-table => $table, -field => $field, 
										      -value => $value, 
										      -neededType => $targetTable, 
										      -database => $self->{DB}));
	    }
	} else {
	    $self->{ERROR_HANDLER}->warning(new W3C::Database::ValueNotReferenceException(-table => $table, 
											   -field => $field, -value => $value, 
											  -database => $self->{DB}));
	}
	$dbValue = $value->getPrimaryKey;
    } elsif (defined $value && $value && defined $targetTable) {
	$self->{ERROR_HANDLER}->warning(new W3C::Database::ValueTypeException(-table => $table, -field => $field, 
									      -value => $value, 
									      -neededType => $targetTable, 
									      -database => $self->{DB}));
    }
    
    # assume default values for fields that won't tollerate NULLs
    if (!defined $value) {
	if (exists $flags->{-default}{$field}) {
	    $dbValue = $thisField->{-default}
	} elsif (!$thisField->{-null}) {
	    $self->{ERROR_HANDLER}->warning(new W3C::Database::ValueDefaultException(-table => $table, 
										     -field => $field, -value => $value, 
										     -database => $self->{DB}));
	    $dbValue = $thisField->{-default};
	}
    }

    # type-specific mappings:
    if ($thisField->{-type} == $FieldType_ENUM) {
	if ((my $newValue = $thisField->{-toStrings}{$value})) { # @@@ also prohibits '' as an enum
	    $dbValue = $newValue;
	} elsif (exists $thisField->{-stringsTo}{$value}) {
	} else {
	    $self->{ERROR_HANDLER}->warning(new W3C::Database::NoMatchingEnumException(-table => $table, 
										       -field => $field, -value => $value, 
										       -database => $self->{DB}));
	}
    }
    return ($value, $dbValue);
}

sub ensure ($$\%;$) {
    my ($self, $table, $indexName, $fieldValues, $flags) = @_;
    my $thisTable = $self->{TABLE_DESC}->{$table};
    if (!defined $thisTable) {
	$self->{ERROR_HANDLER}->error(new W3C::Database::NoSuchTableException(-table => $table, 
									      -database => $self->{DB}));
    }
    if ((defined $indexName) && (!defined $thisTable->{-index}{$indexName})) {
	$self->{ERROR_HANDLER}->error(new W3C::Database::NoSuchIndexException(-table => $table, -field => $indexName, 
									      -database => $self->{DB}));
    }
    my $i = 0;
    my %neededKeys = $indexName ? map {($_, $i++)} @{$thisTable->{-index}{$indexName}{-sequence}} : ();

    # build cache ref and database queries
    my (@conditions, @dbUpdates, %objectUpdates, %dbImage);
    my @cacheKeys;
    foreach my $field (grep {$_ ne $thisTable->{-primaryKey}} keys %{$thisTable->{-fields}}) { # %$fieldValues) {
	my ($value, $dbValue) = $self->getValue($fieldValues->{$field}, $field, $thisTable, $flags);
	$fieldValues->{$field} = $value;

	$dbImage{$field} = $dbValue;
	$dbValue = $self->escapeWithNULL($dbValue);

	if (exists $neededKeys{$field}) {
	    # values that are part of the key
	    push (@conditions, $field.'='.$dbValue);
	    $cacheKeys[$neededKeys{$field}] = $dbValue;
	    delete $neededKeys{$field};
	} else {
	    # values that are not part of the key
	    push (@dbUpdates, $field.'='.$dbValue);
	    $objectUpdates{$field} = $value;
	}
    }
    foreach my $key (keys %neededKeys) {
	my $thisField = $thisTable->{-fields}{$key} || 
	    $self->{ERROR_HANDLER}->error(new W3C::Database::NoSuchFieldException(-table => $table, -field => $key, 
										  -database => $self->{DB}));
	my $value = $thisField->{-default};
	$dbImage{$key} = $value;
	$value = $self->escapeWithNULL($value);
	push (@conditions, $key.'='.$value);
	$cacheKeys[$neededKeys{$key}] = $value;
	if ($flags->{-default}{$key}) {
	} elsif (!$thisField->{-null}) {
	    $self->{ERROR_HANDLER}->error(new W3C::Database::MissingIndexFieldException(-table => $table, -database => $self->{DB}, 
											-index => $indexName, -field => $key));
	}
    }

    my $cache;
    if ($indexName) {
	# look for existing object in cache
	my $cache1 = '$self->{CACHE}{$table}{BY_UNIQUE}{$indexName}{'.
	    join ("\}\{",  map {'$cacheKeys['.$_.']'} (0..@{$thisTable->{-index}{$indexName}{-sequence}}-1)).'}';
#	$cache = '$self->{CACHE}{$table}{BY_UNIQUE}{$indexName}{'.join ("\}\{",  @cacheKeys).'}';
#	my $size = @cacheKeys;
#	my $object;
#	eval '$object = '.$cache; # print $cache."\n" if $object;
	my $object2 = $self->cacheUnique($table, $indexName, \%dbImage, undef, 0, $cache);
#	if ($object ne $object2) {
#	    my $object3 = $self->cacheUnique($table, $indexName, \%dbImage);
#	    $self->{ERROR_HANDLER}->error();
#	}
	if ($object2) {
	    return (0, $object2);
	}
    }

    my ($object, $created);

    if ($indexName) {
	# find the unique, if it exists
	my ($others, $selected) = $self->load($table, undef, undef, join (' AND ', @conditions));
	$created = @$selected == 0; # $#$loaded != $[;
	if ($created) {
	    if ($flags->{-exists}) {
		return (0, undef);
	    }
	    if ($flags->{-noCreate}) {
		my $ex = new W3C::Database::NoCreateException(-table => $table, -database => $self->{DB}, 
							      -index => $indexName, -conditions => [@conditions]);
		# $self->{ERROR_HANDLER}->error($ex);
		&throw($ex);
	    }
	    # create new object
	    $object = $self->createSubclass($table);
	    $object->{FIELD_VALUES} = $fieldValues;
	    push (@conditions, @dbUpdates);
	    my $update = 'INSERT INTO '.$table.' SET '.join (',', @conditions);
	    $object->{DB_ID} = $self->executeUpdateWithID($update);
	    $self->cacheUniques($object, $table, \%dbImage, 0);
	} else {
	    $object = $selected->[0];
	    if ($flags->{-replace}) {
		if (@dbUpdates > 0) {
		    my $update ='UPDATE '.$table.' SET '.join (',', @dbUpdates).
			' WHERE '.$thisTable->{-primaryKey}.'='.$object->{DB_ID};
		    $self->executeUpdateWithID($update);

		    # update {FIELD_ORIG} to reflect the new values
		    foreach my $field (keys %objectUpdates) {
			$object->{FIELD_VALUES}{$field} = $objectUpdates{$field};
		    }
		}
	    } else {
		$object = $self->getById($table, $object->{DB_ID}, undef);
	    }
	    if ($flags->{-exists}) {
		return (0, $object);
	    }
	}
    } else {
	$created = 1;
	if ($flags->{-exists}) {
	    $self->{ERROR_HANDLER}->error(new W3C::Util::ParameterException(-parameter => '-exists', 
						-message => "$table - '-exists' flag only applicable with a unique index"));
	}
	# create new object
	$object = $self->createSubclass($table);
	$object->{FIELD_VALUES} = $fieldValues;
	my $query = 'INSERT INTO '.$table.' SET '.join (',', @dbUpdates);
	$object->{DB_ID} = $self->executeUpdateWithID($query);
	$self->cacheUniques($object, $table, \%dbImage, 0);
    }

    # store primaryKey in its assigned field
    $fieldValues->{$thisTable->{-primaryKey}} = $object->{DB_ID};
    # eval {$object->show;};
    if ($@) {
	chomp $@;
	$self->{ERROR_HANDLER}->error(new W3C::Database::Exception(-message => $@, 
								   -database => $self->{DB}->show));
    }
#    if ($table eq 'RdfIds' && $object->_getId == 27) {
#	print "we are here\n";
#    }
    # copy field values for use in telling what stuff has changed
    $object->{FIELD_ORIG} = {%{$object->{FIELD_VALUES}}};

#    eval $cache.' = $object'  if ($indexName);
#    eval '$self->{CACHE}{$table}{BY_PRIMARY}{$object->{DB_ID}} = $object';
    $self->{CACHE}{$table}{BY_PRIMARY}{$object->{DB_ID}} = $object;
    return ($created, $object);
}

sub cacheUniques ($$$) {
    my ($self, $object, $table, $dbImage, $deleteFlag) = @_;
    foreach my $index (keys %{$self->{TABLE_DESC}->{$table}{-index}}) {
	$self->cacheUnique($table, $index, $dbImage, $object, $deleteFlag);
    }
}

sub cacheUnique ($$$;$) {
    my ($self, $table, $index, $dbImage, $object, $deleteFlag, $stringCache) = @_;
    my $cache0;
    if (exists $self->{CACHE}{$table}{BY_UNIQUE}{$index}) {
	$cache0 = $self->{CACHE}{$table}{BY_UNIQUE}{$index};
    } else {
	$cache0 = $self->{CACHE}{$table}{BY_UNIQUE}{$index} = {};
    }
    my $sequence = $self->{TABLE_DESC}->{$table}{-index}{$index}{-sequence};
    for (my $i = 0; $i < @$sequence; $i++) {
	my $fieldValue = $dbImage->{$sequence->[$i]};
	if (ref $fieldValue) {
	    $fieldValue = $fieldValue->getPrimaryKey;
	}
	if ($i == @$sequence - 1) {
	    if (defined $object) { # can't have an index on a non-NOT NULL field anyways
		if ($deleteFlag) {
		    delete $cache0->{$fieldValue};
		} else {
		    $cache0->{$fieldValue} = $object;
		}
	    } else {
		$cache0 = $cache0->{$fieldValue};
	    }
	} else {
	    if (exists $cache0->{$fieldValue}) {
		$cache0 = $cache0->{$fieldValue};
	    } else {
		$cache0 = $cache0->{$fieldValue} = {};
	    }
	}
    }
    return $cache0;
}

#	my @cacheKeys;
#	foreach my $field (@{$tableDesc->{-index}{$indexName}{-sequence}}) {
#	    push (@cacheKeys, $dbImage->{$field});
#	}
#	my $cache = '$self->{CACHE}{$table}{BY_UNIQUE}{$indexName}{'.
#	    join ("\}\{",  map {'$cacheKeys['.$_.']'} (0..@{$tableDesc->{-index}{$indexName}{-sequence}}-1)).'}';
#	my $cache1 = '$self->{CACHE}{$table}{BY_UNIQUE}{$indexName}{'.
#	    join ("\}\{",  map {'$dbImage->{'.$_.'}'} $tableDesc->{-index}{$indexName}{-sequence}).'}';
#	print $cache.' = $object'."\n";
#	eval $cache.' = $object';
#	if ($@) {
#	    $self->{ERROR_HANDLER}->error($@);
#	}

sub exists ($$\%;$) {
    my ($self, $table, $indexName, $fields, $flags) = @_;
    my $flags1 = {%$flags};
#    delete $flags1->{-exists};	# get rid of any 0s.
    $flags1->{-exists} = 1;	# just call ensure with -exists set
    return $self->ensure($table, $indexName, $fields, $flags1);
}

sub add ($\%;$) {
    my ($self, $table, $fields, $flags) = @_;
    return $self->ensure($table, undef, $fields, $flags);
}

# The $whereParameter is intended for internal use by ensure. It does
# not check for the existance of an object in the cache before
# blithely SELECTing for it.

sub load ($\@;\@$) {
    my ($self, $table, $ids, $tableOrder, $whereParameter) = @_;
    $tableOrder = $self->{TABLE_ORDER} if (!defined $tableOrder);
    my $selected = [];
    my $others = [];
    my $loadQueue = {};
    my $loadCount = 0;
    # copy the table order into a hash for looking up ordinals
    my $i = 0;
    my $tableOrdinals = {map {($_, $i++)} @$tableOrder};
    my $iLoadTable;
#    my $pad = ' ' x 20;

    if (!ref $table) {
	$iLoadTable = $tableOrdinals->{$table};
	if ($whereParameter) {
	    $table = {$table => []};
	} else {
	    $table = {$table => $ids};
	}
    } elsif (ref $table eq 'HASH') {
	# Start with iLoadTable pointing past end of table list.
	# Walking hash will set it back to an appropriate value.
	$iLoadTable = @$tableOrder;
    } else {
	$self->{ERROR_HANDLER}->error(new W3C::Database::Exception(-message => 'ref must be a HASH', 
								   -database => $self->{DB}));
    }

    # find the first table we need to load
    if ($whereParameter) {
    } else {
	foreach my $target (keys %$table) {
	    my $targetOrdinal = $tableOrdinals->{$target};
	    my $ids = $table->{$target};
	    # strain for the ids not already in memory
	    foreach my $id (@$ids) {
		if (my $recovered = $self->{CACHE}{$target}{BY_PRIMARY}{$id}) {
		    push (@$selected, $recovered);
		    $loadCount++;
		} else {
		    $loadQueue->{$target}{$id} = [];
		}
#		if ($table eq 'RdfIds' && $id == 16) { print "here we go\n"; }
	    }
	    $iLoadTable = $targetOrdinal if ($targetOrdinal < $iLoadTable);
	}
    }

    my $pendingException = undef;

    # iterate through the loadQueue in the specified table order
    for (my $passNo = 0; $iLoadTable < @$tableOrder; $iLoadTable++, $passNo++) {
	my $loadTable = $tableOrder->[$iLoadTable];

	# get all (known) fields for these ids
	my $where;
	my $loadIds = {};
	if ($passNo == 0 && $whereParameter) {
	    # first SELECT items may be specified by the whereParameter
	    $where = $whereParameter;
	} else {
	    # grab the ids to load from the current table

	    # null external keys: Only external keys != 0 are loaded as external
	    # keys of 0 are assumed to indicate a null reference.  Supplying a
	    # $whereParameter can circumvent this logic so applications using
	    # this interface are expected to specifically exclude them from
	    # results, or supply an error handler where the warning method
	    # discounts calls to it with an UnresolvedLoadException (See load
	    # failures below.)
	    my @loadIds = $loadQueue->{$loadTable} ? grep {$_ != 0} keys %{$loadQueue->{$loadTable}} : ();
	    next if (@loadIds == 0);
	    $loadIds = {map {($_, undef)} @loadIds};
	    $where = $self->{TABLE_DESC}->{$loadTable}{-primaryKey}.' IN ('.join (',', @loadIds).')';
	}
	my $loadTableDesc = $self->{TABLE_DESC}->{$loadTable};
	my $loadFields = $loadTableDesc->{-fields};
	my $primaryField = $loadTableDesc->{-primaryKey};
	my $loadFieldList = [$primaryField, grep {$_ ne $primaryField} keys %$loadFields]; #primary key first
	my $query = 'SELECT '.join (',', @$loadFieldList).' FROM '.$loadTable.' WHERE '.$where;
	my @rows;
	$loadCount += $self->executeArrayQuery(\@rows, $query);

	# process each record
	foreach my $record (@rows) {
	    $self->createObject($record, $loadTable, $loadTableDesc, \ $iLoadTable, $tableOrdinals, $loadFields, $loadFieldList, $loadQueue, $loadIds, $whereParameter, $passNo, $selected, $others);
	}

	# assign all non-loaded objects with debugSubclass objects
	if ((%$loadIds) > 0) {

	    # load failures - the remaining keys of %$loadIds were selected but
	    # nout found. The elements referencing these objects are updated to
	    # point to special, unitialized instances of these classes with the
	    # field BAD_EGG set to 1.

	    my @errorLines;
	    my $badIds = [keys %$loadIds];
	    my $exception = new W3C::Database::UnresolvedLoadException(-database => $self->{DB}, 
								       -query => $query, 
								       -table => $loadTable, 
								       -primaryKeys => $badIds, 
								       -errorLines => \@errorLines);
	    eval {
		if (@$badIds == 1 && $badIds->[0] == 0) {
		    # throw warnings for unresolved external keys of 0
		    # See null external keys above.
		    $self->{ERROR_HANDLER}->warning($exception);
		} else {
		    # throw errors for the rest.
		    $self->{ERROR_HANDLER}->error($exception);
		}
	    }; if ($@) {if (my $ex = &catch('W3C::Database::DropRowException')) {
		$pendingException = $ex;
	    } else {&throw()}}
	    foreach my $unloaded (keys %$loadIds) {
		my $object = $self->createObject([$unloaded], $loadTable, $loadTableDesc, \ $iLoadTable, $tableOrdinals, $loadFields, [$loadFieldList->[0]], $loadQueue, $loadIds, $whereParameter, $passNo, $selected, $others);
		$object->{BAD_EGG} = 1;
	    }
	}
    }
#    if ($loadCount != @$others + @$selected) {
#	&throw(new W3C::Util::Exception(-message => "$loadCount != $others + $selected"));
#    }
    if ($pendingException) {
	&throw($pendingException);
    }
    return ($others, $selected);
}

sub createObject {
    my ($self, $record, $loadTable, $loadTableDesc, $piLoadTable, $tableOrdinals, $loadFields, $loadFieldList, $loadQueue, $loadIds, $whereParameter, $passNo, $selected, $others) = @_;
    # create object
    my $object = $self->createSubclass($loadTable);

    # process each field in this record
    my $column = 0;
    my %dbImage;
    foreach my $field (@$loadFieldList) {
	my $value = $record->[$column++];
	$dbImage{$field} = $value;

	# check to see if this value is an external key
	my $target = $loadFields->{$field}{-target};
	if ($target) {
	    # try to find the cached object for an external key
	    if ($value == 0) {
		$object->{FIELD_VALUES}{$field} = undef;
	    } elsif ((my $referent = $self->{CACHE}{$target}{BY_PRIMARY}{$value})) {
		$object->{FIELD_VALUES}{$field} = $referent;
	    } else {
		# queue the object to have the field resolved later
		# note - I use the ordinal for a loadTable rather than 
		#        the loadTable to save a bit of space. This is 
		#        only valid if tableOrdinals lists all tables.
		# no cached object so just store the ordinal
		my $targetOrdinal = $tableOrdinals->{$target};

#			if ($target eq 'Fragments' && $value == 112) {
#			    print "here we go\n";
#			}
#			print $pad.' <- '.$target.'['.$value."]\n";
		push (@{$loadQueue->{$target}{$value}}, [$object, $field]);
		# may have to go back earlier in the load order
		$$piLoadTable = $targetOrdinal - 1 if ($targetOrdinal <= $$piLoadTable);
	    }
	} else {
	    # not an external key so just store it in the object
	    $object->{FIELD_VALUES}{$field} = $value;
	}
	if ($field eq $loadTableDesc->{-primaryKey}) {

	    if (exists $loadIds->{$value}){
		delete $loadIds->{$value};
	    } elsif (!(defined $whereParameter && $passNo == 0)) {
		# items loaded with a whereParameter are finished after the first SELECT
		# they no longer excuse the existance of unrequested data
		$self->{ERROR_HANDLER}->error(new W3C::Database::UnrequestedDatumException(-table => $loadTable, 
											   -field => $field, 
											   -value => $value, 
											   -database => $self->{DB}));
	    }

	    $object->{DB_ID} = $value;
	    $self->{CACHE}{$loadTable}{BY_PRIMARY}{$value} = $object;
#		    print ' ' x (20 - length $object->showId).$object->showId."\n";

	    # fixup everything pointing to this object
	    foreach my $updateMe (@{$loadQueue->{$loadTable}{$value}}) {
		my ($updateObject, $updateField) = @$updateMe;
		$updateObject->{FIELD_VALUES}{$updateField} = $object;
		$updateObject->{FIELD_ORIG}{$updateField} = $object;
#			print $pad.' -> '.$updateObject->showId."\n";
	    }
	    delete $loadQueue->{$loadTable}{$value};
	}
	if ($loadTableDesc->{-overrides} && 
	    $loadTableDesc->{-overrides}{$field}) {
	    if (my $interfaceClass = $loadTableDesc->{-overrides}{$field}{$value}) {
		bless ($object, $interfaceClass);
	    }
	}
    }
    $object->{FIELD_ORIG} = {%{$object->{FIELD_VALUES}}};
    $self->cacheUniques($object, $loadTable, \%dbImage, 0);
    if ($passNo == 0) {
	push (@$selected, $object);
    } else {
	push (@$others, $object);
    }
#    if ($loadTable eq 'RdfIds' && $object->_getId == 27) {
#	print "we are here\n";
#    }
    return $object
}

# delete passed ObjectBase object, not any of its leaves

sub deleteTop ($$$) {
    my ($self, $object, $fieldValues, $thisTable, $flags) = @_;
    my $table = $thisTable->{-table};
    my (%dbImage, @wheres);
    foreach my $field (keys %$fieldValues) {
	my ($value, $dbValue) = $self->getValue($fieldValues->{$field}, $field, $thisTable, $flags);
	$dbImage{$field} = $dbValue;
	push (@wheres, $field.'='.$self->escapeWithNULL($dbValue));
    }
    my $update = 'DELETE FROM '.$table.' WHERE '.join (' AND ', @wheres);
    $self->executeUpdateWithID($update);
    if ($self->{DB}->{ROWS} != 1) {
	&throw(new W3C::Database::Exception(-database => $self->{DB}, 
					     -message => $self.'::update: "'.$update.
						 '" affected '.$self->{DB}->{ROWS}.' rows'));
    }
    $self->cacheUniques($object, $table, \%dbImage, 1);
    if (my $r = $flags->{-replaceWith}) {
	$self->cacheUniques($r, $table, \%dbImage, 0);
    }
    delete $self->{CACHE}{$table}{BY_PRIMARY}{$object->{DB_ID}};
}

sub executeStructuredArrayQuery (\@\@\@\@;\@) {
    my ($self, $ret, $whats, $froms, $wheres, $tableOrder) = @_;
    $tableOrder = $self->{TABLE_ORDER} if (!defined $tableOrder);

    # dismantle structured query
    # pick out table aliases
    my %asz;
    foreach my $from (@$froms) {
	my ($field, $as) = (ref $from eq 'ARRAY') ? ($from->[0], $from->[1]) : ($from, $from);
	$asz{$as} = $field;
    }
    # get the types for the whats
    my (%targets, @columns);
    for (my $i = 0; $i < @$whats; $i++) {
	my $what = $whats->[$i];
	# if it's not a litteral (or a number)
	if ($what !~ m/^[\'\"]/ && $what !~ m/^\d+$/) {
	    my ($alias, $field, $table, $tableDesc, $fieldDesc);
	    if ($what =~ m/^(.*?)\.(.*)$/) {
		# fully qualified field specifier
		($alias, $field) = ($1, $2);
		$table = $asz{$alias} || 
		    $self->{ERROR_HANDLER}->error(new W3C::Database::Exception(-message => 
										"$what - no table alias matching \"$alias\"", 
									       -database => $self->{DB}));
		$tableDesc = $self->{TABLE_DESC}->{$table} || 
		    $self->{ERROR_HANDLER}->error(new W3C::Database::NoSuchTableException(-table => $asz{$alias}, 
											  -database => $self->{DB}));
		$fieldDesc = $tableDesc->{-fields}{$field} || 
		    $self->{ERROR_HANDLER}->error(new W3C::Database::Exception(-message => 
										"$what - does not match a field in \"$alias\"", 
									       -database => $self->{DB}));
	    } else {
		# unqualified field specifier
		my @candidates; # potential tables supplying $what
		foreach my $checkTable (keys %asz) {
		    $tableDesc = $self->{TABLE_DESC}->{$checkTable};
		    if ($fieldDesc = $tableDesc->{-fields}{$what}) {
			($alias, $field, $table) = ($checkTable, $what, $checkTable);
			push (@candidates, [$table, $fieldDesc]);
		    }
		}
		if (@candidates > 1) {
		    $self->{ERROR_HANDLER}->error(new W3C::Database::Exception(-message => 
					"$what - ambiguous field, appears in ".join (' and ', map {$_->[0]} @candidates), 
									       -database => $self->{DB}));
		} elsif (@candidates < 1) {
		    $self->{ERROR_HANDLER}->error(new W3C::Database::Exception(-message => "$what - no matching field", 
									       -database => $self->{DB}));
		}
		# if there is one and only one candidate, 
		#  $fieldDesc has been set so fall through
	    }
	    # primary keys get priority over targets - they get caught in load anyways
	    if ($field eq $tableDesc->{-primaryKey}) {
		$columns[$i] = $table;
		push (@{$targets{$table}}, $i);
	    } elsif (my $target = $fieldDesc->{-target}) {
		$columns[$i] = $target;
		push (@{$targets{$target}}, $i);
	    }
	}
    }
    my $query = 'SELECT '.join (',', @$whats).' FROM '.join (',', @$froms).' WHERE '.join (' AND ', @$wheres);
    my $count = $self->executeArrayQuery($ret, $query);
    my %tables;
    foreach my $row (@$ret) {
	for (my $i = 0; $i < @$row; $i++) {
	    if (my $table = $columns[$i]) {
		push (@{$tables{$table}}, $row->[$i]);
	    }
	}
    }
    $self->load(\%tables, undef, $tableOrder);
    foreach my $row (@$ret) {
	for (my $i = 0; $i < @$row; $i++) {
	    if (my $table = $columns[$i]) {
		$row->[$i] = $self->getById($table, $row->[$i]);
	    }
	}
    }
}

sub getFromPrimaryCache ($$) {
    my ($self, $table, $id) = @_;
    return $self->{CACHE}{$table}{BY_PRIMARY}{$id};
}

sub getById ($$;\@) {
    my ($self, $table, $id, $tableOrder) = @_;
    $tableOrder = $self->{TABLE_ORDER} if (!defined $tableOrder);
    my $ret = $self->{CACHE}{$table}{BY_PRIMARY}{$id};
    if (!$ret) {
	$self->load($table, [$id], $tableOrder);
	$ret = $self->{CACHE}{$table}{BY_PRIMARY}{$id};
    }
    return $ret;
}

sub loadExternalKey ($$$) {
    my ($self, $targetId, $referrerTable, $referrerField) = @_;
    my $query = 'SELECT '.$self->{TABLE_DESC}->{$referrerTable}{-primaryKey}.
	' FROM '.$referrerTable.' WHERE '.$referrerField.'="'.$targetId.'"';
    my @objects;
    my $count = $self->{OB}->executeQuery(\@objects, $query);
    $self->{OB}->load($referrerTable, \@objects, undef);
    my @ret;
    foreach my $id (@objects) {
	push (@ret, $self->{OB}->getById($referrerTable, $id));
    }
    return @ret;
}

1;

__END__

=head1 NAME

W3C::Database::ObjectDB - 

=head1 SYNOPSIS
 
  use W3C::Util::Properties;
  use MyClass;
  

  my $props = new W3C::Util::Properties('MailDB.prop');
  my $factory = new MyClass($props);
 
  my $object = $factory->ensure($table, $nameOfIndexKey, %fields, $flags);
  my $object = $factory->exists($table, $nameOfIndexKey, %fields, $flags);     
  my $object = $factory->add($table, %fields, $flags);     

  my @objects = $factory->load($table, @ids, @tableOrder);
  my @objects = $factory->load($table, @ids, undef );

=head1 DESCRIPTION

This module is part of the W3C::Database CPAN module. The
ObjectDB defines a set of functions that provide a consistent
object oriented database interface independent of the actual 
database being used. 

ObjectDB performs the same functions as the SQL database
server, except it is object oriented. 

=head1 METHODS COMMON TO ALL HANDLES

=over 4

=item B<exists>

    $object = $factory->exists($table, $indexName, %fields, %flags)

Returns the object if one exists in the given table for the specified conditions
in the fields hash table. If the conditions are not satisfied an undef is returned.
A valid $indexName must be entered. 0, 1 or a hash table of flags may be entered. 
The method still checks whether the object with the specifed %field conditions exist.

=item B<add>

    $object = $factory->add($table, %fields, %flags)

Adds an entry to to the specified table and returns the object.  

=item B<ensure>

   $object = $factory->ensure($table, $indexName, %fields, %flags)

What this method does depends on the flags passed. Possble valid flags are:
{-exists => 1} Checks whether for the given $table, an object exist which satisfies the
               values in the $fields hash table and the $indexName. If the object exists, 
               it is returned else an undef is returned. 

{-replace => 0}  Checks whether for the given $table an object exist which has the same value 
                 for its index key as the value supplied in the $fields hash table. If a match
                 is found the object is returned.
 
{-replace => 1} Does the same process as {-replace => 0}. If the values of the other columns in
                the $fields hash table differs from the values in the cache, the values in the
                cache are over-written by the values passed in the $fields hash table. 
                If the object does not exist, one is created and it is returned. 
                
=item B<load>

    @objects = $factory->load($table, $ids, $tableOrder);
    @objects = $factory->load($table, $ids, undef);
 
Given a table and an array of Primary Key values, returns the array of objects which have those
primary keys. $tableOrder is an optional parameter which searches the database more efficiently. 

 
=item B<getById>
  
    my $object = $factory->getById($table, $id, $tableOrder);
    my $object = $factory->getById($table, $id, undef);

Returns an object, from the specified table, whose primary key value matches 
the value of the $id paramenter. This subroutine first checks the CACHE, if 
the object is not found, the table is loaded from the database and checked.
An undef is returned if there is still no match. 

=item B<getFromPrimaryCache>

    my $object = $factory->getFromPrimaryCache($table, $id);

Checks the CACHE for an object, from the specified table, whose primary
key value matches the value of the $id parameter. If the object is not found in
the cache an undef is returned.      

=back

=head2 Caching Strategy

The cache is held in the W3C::Database::ObjectDB->{CACHE}. It is intended to
by used by the interface functions load, ensure, update, and check. The cache
maintains the image of the DB objects as the appear in the remote database. This
means that:

    my $obj1 = $objectDB->ensure('myTable', 'u_name', {'name' => 'Bob'});
    $obj1->_setName('Joe');
    my $obj2 = $objectDB->ensure('myTable', 'u_name', {'name' => 'Joe'});

will not result in $obj1 == $obj2 because the myTable where id=$obj1->_getId is
still 'Bob'. This helps maintain efficiency in the _set opperations that don't
hit the database.

=head1 AUTHOR

Eric Prud'hommeaux <eric@w3.org>

=head1 SEE ALSO

perl(1).

=head1 COPYRIGHT

=over

Copyright Massachusetts Institute of technology, 1998.

THIS SOFTWARE AND DOCUMENTATION IS PROVIDED "AS IS," AND COPYRIGHT HOLDERS MAKE NO REPRESENTATIONS
OR WARRANTIES, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO, WARRANTIES OF MERCHANTABILITY OR
FITNESS FOR ANY PARTICULAR PURPOSE OR THAT THE USE OF THE SOFTWARE OR DOCUMENTATION WILL NOT INFRINGE
ANY THIRD PARTY PATENTS, COPYRIGHTS, TRADEMARKS OR OTHER RIGHTS. 

COPYRIGHT HOLDERS WILL NOT BE LIABLE FOR ANY DIRECT, INDIRECT, SPECIAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF ANY USE OF THE SOFTWARE OR DOCUMENTATION. 

The name and trademarks of copyright holders may NOT be used in advertising or publicity pertaining 
to the software without specific, written prior permission. Title to copyright in this software and 
any associated documentation will at all times remain with copyright holders. 

=back

=cut

