#=========================================================================
#						==== ArsBaseClass ====
#
# This is the basis of an object-oriented approach to ARSPerl.  My goal
# was to simpify access to ARS schemata (see SYNOPSIS below).  This isn't
# necessarily an efficient interface to ARS.
#
# This is certainly not a complete interface to all ARS field types
# and functionality, but it shouldn't be hard to extend it...
#
# Currently, ArsBaseClass only has the ability to perform trivial queries
# (i.e., on a single field) because this was all I needed.  If this is a
# problem for you, you will probably want to implement functionality for
# more complex queries.  If you come up with something elegant, please
# tell me about it!
#
# If you're concerned about speed, this probably isn't what you want.
#
# ArsBaseClass must be used by a derived class. 
# 
# The philosophy is as follows:
#
# one runs the script "ars-gen-subclass" on a particular schema.  The
# script generates the sub-class and writes it to STDOUT.  Before you
# run "ars-gen-subclass", you should decide whether you want the
# get/set methods (which correspond to the field names) to have the
# format
#
#	this_is_a_get_set_method
#
# or
#
#	thisIsAGetSetMethod
#
# and set $METHOD_STYLE in ars-gen-subclass accordingly.
#
# Also before you run "ars-gen-subclass" edit this file and set the
# $ARSUSER, $ARSPASS, and $ARSSERVER variables appropriately.
#
# you need to edit the generated sub-class and check (at least) four
# things:
#
# 1. ars-gen-subclass creates private labels for the schema fields.  These
#    should be unique and reasonable.  Change them to whatever you like.
#    It is these that will be used as the names of access methods.  Keep
#    in mind that if you change these labels, you will have to change
#    then again if you want to re-run ars-gen-subclass.
#
# 2. set "query => 1" for the fields that you want to be queried when
#    the getRecord() method is called.  All other fields will only be
#    queried when the corresponding access method is called (delayed
#    initialization).
#
# 3. "query_field" should be set to the private label of the field
#    which is to be used for selection.  In general this should be a
#    field whose value must be unique -- thus returning a single
#    record.  If there is no such field, use the record-ID, which
#    then makes getRecord() equivalent to getRecordById(), if
#    somewhat less efficient.
#
# 4. You'll probably want to change the package name.
#
# SYNOPSIS:
#
#	use DerivedClass;
#
#	$value = 'something';
#
#	$record = DerivedClass->new;
#	$record->getRecord($value) || die "query failed for val=$value";
#
#	# change values
#	$record->customer_name('Mr. Bean');
#	$record->favorite_game('bingo');
#
#	# write back to ARS
#	$record->write;
# 
#   If you have set "query_field" to something reasonable, you can
#   condense the calls to the constructor and to getRecord() as follows:
#
#   $record = DerivedClass->new($value) || die "query failed for $value";
#
# If you perform a query and then change values, an ARS update will
# be performed when the write() method is called.  If you get a new
# object, and then set values using access methods without performing
# a query beforehand, when the write() method is called a new ARS
# record will be created.  In this case, the record-ID is returned
# by the write() method.
#
# Keep in mind that setting "query => 0" in CLASS_DATA for a subclass
# does *not* mean that that field value will never be available to you.
# It simply means a standard record-fetch will not retrieve that field
# value immediately.  If you later call the get-method for such a field
# an automatic fetch will be performed for you transparently and you
# will magically be supplied the value.  By default "ars-gen-subclass"
# marks all "diary" fields for delayed initialization.
#
# Because a schema can change after ars-gen-subclass has been used
# to dump its structure, ArsBaseClass implements the method
# "schemaChanged" to compare the dumped structure in a derived
# class to the structure in the ARS schema.  schemaChanged()
# returns nothing if the structures are consistent, and a
# scalar consisting of descriptions of inconsistencies otherwise.
#
# There are some peculiarities of accessing ARS objects which
# bear description.
#
# - If you call write() but have not modified any fields, write() does
#	nothing.
#
# - the write() method *only* actually writes *changed* data to ARS.
#
# - If you create an object, modify fields, and call write():
#
#		$obj = SubClass->new($query_value);
#		$obj->some_field("new-value");
#		$obj->write;
#
#	The data is written and the object is "reset", which means the
#	retrieved ARS data is thrown away.  However, the object "knows"
#	its record_id, such that if you continue to use it, it will behave
#	as you'd expect:
#
#	- if you read from a field, a transparent (new) query to ARS will be
#	  performed.
#
#	- of course you can modify fields and write() your changes
#
# - fields of type "diary" present a bit of a problem.  The field-value
#	returned by a get-method on an object simply returns what ars_GetEntry()
#	returns, a reference to an array containing references to hashes, which,
#	in turn, contain the keys "user", "timestamp", and "value". So
#	what happens when you write a new entry to a diary field and then
#	immediately retrieve that field, i.e.:
#
#		$obj = SubClass->new($query_value);
#		$obj->diary_field("this is a new entry");
#		$foo = $obj->diary_field;
#
#	In this case I "fake up" an array which includes the new entry.  The
#	"user" and "timestamp" values are 'n/a' (not available).  Presumably
#	these could be set to the user used to log in to ARS and the current
#	epoch-seconds value.
#
#
#		**************************************
#		*************** Methods **************
#		**************************************
#
#	write()
#		writes *modified data only* to ARS.  If called after a query
#		(i.e., after object has been loaded from ARS) then an update
#		is performed.  Otherwise a create is performed.  Returns
#		nothing after an update, the record-ID after a create.
#
#	getRecord()
#		loads data into object from ARS from the record retrieved
#		using "query_field" in CLASS_DATA.  Returns 1 on success,
#		undef on failure.
#
#	getRecordById()
#		loads data into object from ARS using the record-ID.  Returns 1
#		on success, undef on failure.
#
#	query()
#		This should generally be called from a derived class.  parameters
#		are a field-name and value.  Returns the record-ID of the first
#		match in scalar context, or a list of record-IDs in list context.
#		On failure returns undef in scalar context and empty list in list
#		context.
#
#	reload()
#		Causes all data stored in object to be thrown away and ARS data
#		to be reloaded into object.
#
#	recordModified()
#		fetches the "modified time" field from ARS and compares it to the
#		modifed-time field stored in the object.  Returns 1 if the ARS
#		data is newer than the object data.
#
#	setFields()
#		This does an end-run around the normal get/set methodology.
#		The intent was to allow a large number of fields to be
#		modified at one time without having to call the individual
#		get/set "methods".  The input is a reference to a hash whose
#		keys are valid field-names and whose corresponding values
#		are the new values for those fields.  Returns nothing.
#
#	getFields()
#		even uglier than setFields().  Retrieves all loaded or modified
#		fields and returns a reference to a hash as described above for
#		setFields().
#
#	schemaChanged()
#		checks whether the CLASS_DATA structure still corresponds to
#		the ARS schema.  If there are discrepencies, a scalar is returned
#		containing a description of all discrepencies.  Otherwise, returns
#		empty scalar.
#
#
# ** if you find this useful, please let me know! **
#
# Rob Urban <urban@tru64.org>
# May, 2003
#=========================================================================

package ArsBaseClass;

use Carp;
use ARS;

my $CTL;		# used to store the control structure of an open connection

my $DEBUG = 1;
my $VERBOSE = 1;

my $ARSUSER		= 'my-ars-user';
my $ARSPASS		= 'my-ars-pass';
my $ARSSERVER	= 'my-ars-server-name';
my $MAXRETRIEVE	= 0;
my $PRIMARY_KEY	= 1;
my $MODIFY_TIME	= 6;

my $VERSION		= '1.0';

#---------------------------------------------------------------
# login
#
# This is not a subroutine because I want _one_ login when this
# module is loaded
#---------------------------------------------------------------
eval {
	($CTL = ars_Login($ARSSERVER, $ARSUSER, $ARSPASS))
		|| die "login failed";
};
if ($@) {
	die "ARS login failed.\n";
}

#---------------------------------------------------------------
# ... and log out when done.
#---------------------------------------------------------------
END {
	if (defined($CTL)) { ars_Logoff($CTL); }
}

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

	my $self = {
		loaded	=> 0,
		dirty	=> 0,
	};

	bless($self, $class);

	if (@_) {
		$DEBUG && print "  ArsBaseClass::new(): calling getrecord on [$_[0]]\n";
		if (!defined($self->getRecord(shift))) {
			$DEBUG && print "  query failed. returning undef.\n";
			return undef;
		}
	}

	$self;
}

#------------------------------------------------------------------
# _getClassData is a placeholder. The real _getClassData() must be
# implemented in the subclass
#------------------------------------------------------------------
sub _getClassData
{
	die "_getClassData() not implemented";
}

#------------------------------------------------------------------
# This is called by the subclasses to generate reverse mappings
# for the private hash keys and also to generate a list of fields
# that should be retrieved by getRecord()
#
# It expects to find a hashref at $cd->{priv_keys}
#
# It will write to $cd->{reverse_map} and $cd->{query_list}
# and also to $cd->{priv_keys}->{$key}->{enum_rev} if the
# field is of type 'enum'
#------------------------------------------------------------------
sub init
{
	my $cd = shift;

	$DEBUG && print "** running init() for schema = [$cd->{schema}] **\n";

	# generate field list
	my @l;
	my $rev;
	foreach my $key (keys(%{$cd->{priv_keys}})) {
		#print "KEY [$key]\n";
		if (($cd->{priv_keys}->{$key}->{query}) ||
			($cd->{priv_keys}->{$key}->{id} eq $MODIFY_TIME))
		{
			push(@l, $cd->{priv_keys}->{$key}->{id});
		}

		# DEBUG stuff
		#my $rk = $cd->{priv_keys}->{$key}->{id};
		#print "setting rev->{$rk} = [$key]\n";;

		$rev->{$cd->{priv_keys}->{$key}->{id}} = $key;

		# and the reverse-maps for the enums
		if ($cd->{priv_keys}->{$key}->{type} eq 'enum') {
			my $r;
			foreach my $ekey (keys(%{$cd->{priv_keys}->{$key}->{enum}})) {
				$r->{$cd->{priv_keys}->{$key}->{enum}->{$ekey}->[0]} = $ekey;
			}
			$cd->{priv_keys}->{$key}->{enum_rev} = $r;
		}
	}
	$cd->{reverse_map} = $rev;
	$cd->{query_list} = \@l;

	# DEBUG stuff
	#dumpClassdata($cd, "end of init()");
}

#------------------------------------------------------------------
# AUTOLOAD() is used to get or set object field-values.  This is
# done by referring to the hash-keys in $CLASS_DATA->{priv_keys}
# as methods.  Since there are no methods by those names defined,
# AUTOLOAD() is called and the name of the called method is put
# in $AUTOLOAD.  AUTOLOAD() then checks if there is in fact a key
# in the {priv_keys} hash with that name.  If not, it aborts with
# an error message.
#------------------------------------------------------------------
sub AUTOLOAD
{
	my $self = shift;

	my $field = $AUTOLOAD;
	$field =~ s/^.*::([^:]+)$/$1/;		# strip package name
	return if ($field eq 'DESTROY');

	if (!ref($self) || ($self !~ /=/)) {
		confess "[private] Undefined subroutine $AUTOLOAD called at";
	}

	my $cd = $self->_getClassData;

	if (!exists($cd->{priv_keys}->{$field})) {
		confess "[private] Undefined subroutine $AUTOLOAD called at";
	}

	if (@_) {
		# setting value
		my $val = shift;
		$self->{changed_data}->{$field} = $val;
		if ($DEBUG) {
			if ($val =~ /\n/) {
				# for debugging, take only first 4 lines
				my @f = split(/\n/, $val);
				my $l = (@f < 4) ? $#f : 3;
				$val = "\n\t".join("\n\t", @f[0..$l])."\n  ";
			}
			print "  SET-FIELD [$field] = [$val]\n";
		}
		$self->{dirty} = 1;
		return;
	} else {
		return $self->_getField($field);
	}
}

#------------------------------------------------------------------
# _getField() is for the private use of AUTOLOAD().  It does many
# things:
#
# - it calls die() if an attempt is being made to read a field-value
#	before any data have been loaded from ARS (and the field has not
#	been modified)
#
# - it checks if an intervening write() was performed which would
#	require a re-loading of ARS data
#
# - it checks if a field-value has been requested that is marked
#	for delayed-initialization, and if so, performs a query to ARS
#	to get the data
#
# - it checks if a diary-field is being requested; this requires
#	special handling
#
# - finally, it checks if the field-value has been modified, and if
#	so, returns the modified value, otherwise it returns the
#	ARS-queried value
#------------------------------------------------------------------
sub _getField
{
	my ($self, $field) = @_;

	my $cd = $self->_getClassData;

	# check if trying to read from an uninitialized object
	if (!exists($self->{changed_data}->{$field}) && !exists($self->{record_id}))
	{
		die "trying to read from uninitialized object";
	}

	# check if data must be reloaded because of an intervening write()
	if (($self->{loaded} == 0) && (exists($self->{record_id}))) {
		$self->getRecordById($self->{record_id});
	}

	# getting value
	if ($self->{loaded} && !exists($self->{ars_data}->{$field})) {
		# this field had deferred initialization set
		$self->_queryField($field);
	}

	#----------------------------------------------------------
	# special case for 'diary' fields
	#----------------------------------------------------------
	if ($cd->{priv_keys}->{$field}->{type} eq 'diary') {
		my $aref;
		if (ref($self->{ars_data}->{$field})) {
			push(@{$aref}, @{$self->{ars_data}->{$field}});
		}
		if (exists($self->{changed_data}->{$field})) {
			push(@{$aref}, {
				user		=> 'n/a',
				timestamp	=> 'n/a',
				value		=> $self->{changed_data}->{$field},
			});
		}
		return $aref;
	}

	#----------------------------------------------------------
	# if field has been modified take modified value, otherwise
	# take value from ARS
	#----------------------------------------------------------
	if (exists($self->{changed_data}->{$field})) {
		# setting value
		return $self->{changed_data}->{$field};
	} elsif (exists($self->{ars_data}->{$field})) {
		return $self->{ars_data}->{$field};
	}

	# catch-all
	return undef;
}

#------------------------------------------------------------------
# _queryField() handles delayed-initialization.
#------------------------------------------------------------------
sub _queryField
{
	my ($self, $field) = @_;

	#print "delayed loading of field [$field] ...\n";

	my $cd = $self->_getClassData;
	my $schema = $cd->{schema};

	my $pk_lab = $cd->{reverse_map}->{$PRIMARY_KEY};

	my $fid = $cd->{priv_keys}->{$field}->{id};

	my $rid = $self->{ars_data}->{$pk_lab};

	my ($key, $value) = ars_GetEntry($CTL, $schema, $rid, $fid);

	# a little sanity-check
	if ($key ne $fid) { die "whoa! key=[$key], fid=[$fid]"; }

	# if there is a key in %h == undef, error
	if (!defined($key)) {
		return undef;
	}

	if ($cd->{priv_keys}->{$field}->{type} eq 'enum') {
		$self->{ars_data}->{$field} = 
			$cd->{priv_keys}->{$field}->{enum_rev}->{$value};
	} else {
		$self->{ars_data}->{$field} = $value;
	}
}

sub getRecord
{
	my $self = shift;


	my $cd = $self->_getClassData;

	my $qf = $cd->{query_field};
	my $schema = $cd->{schema};

	$DEBUG && print "  getRecord: query for [$_[0]]\n";

	my $rid = query($cd, $qf => shift);
	$DEBUG && print "  getRecord: query return rid=[$rid]\n";
	if (!defined($rid)) {
		return undef;
	}

	if (!defined($self->getRecordById($rid))) {
		die "getRecord: record disappeared";
	}

	return 1;
}

#------------------------------------------------------------------
# getRecordById() is THE function that is responsible for loading
# ARS data into an object.
#------------------------------------------------------------------
sub getRecordById
{
	my ($self, $rid) = @_;

	# reset record
	$self->{ars_data}		= {},	# ref to hash of ARS field data
	$self->{changed_data}	= {},	# ref to hash of fields updated
	$self->{dirty}			= 0,	# 1 if data needs to be written
	$self->{loaded}			= 0,

	my $data = $self->_getArsData($rid);
	if (!defined($data)) {
		delete($self->{record_id});
		return undef;
	}

	$self->{ars_data} = $data;
	$self->{loaded} = 1;
	$self->{record_id} = $rid;

	return 1;
}

#------------------------------------------------------------------
# query() fires a query at ARS and returns a hashref of key-value
# pairs.  If called in a scalar context, returns the first record-ID.
#
# If called in a list context, returns a list of record-IDs.
#------------------------------------------------------------------
sub query
{
	my ($cd, $key, $value) = @_;		# $cd contains a ref to CLASS_DATA
	
	my $schema = $cd->{schema};

	my $qualifier;
	my $field_id = $cd->{priv_keys}->{$key}->{id};
	if (!defined($value)) {
		$qualifier = "'$field_id' = NULL";
	} elsif ($cd->{priv_keys}->{$key}->{type} eq 'enum') {
		#if (defined($value) && exists($cd->{priv_keys}->{$key}
		$value = _lookupEnum($cd, $key, $value);
		$qualifier = qq['$field_id' = $value];
	} else {
		$qualifier = qq['$field_id' = "$value"];
	}

	my $q;
	# print "Q=[$qualifier]\n";
	($q = ars_LoadQualifier($CTL, $schema, $qualifier)) ||
	    die $ars_errstr;

	my @list = ars_GetListEntry($CTL, $schema, $q, $MAXRETRIEVE);
	if (!wantarray) {
		if (!@list) {
			return undef;
		} else {
			return $list[0];
		}
	}

	# if @list only has one element, or if first element is undef, error
	#if (($#list == 0) || !defined($list[0])) { return (); }
	my ($rid, $desc, @out);
	while (@list) {
		($rid, $desc, @list) = @list;
		push(@out, $rid);
	}

	return (@out);
}

sub _getArsData
{
	my ($self, $rid) = @_;

	my $res;

	my $cd = $self->_getClassData;
	my $schema = $cd->{schema};
	my $ql = $cd->{query_list};

	if (!@{$ql}) { return $res; }

	$DEBUG && print "  query: schema = [$schema], rid=[$rid]\n";
	my %h = ars_GetEntry($CTL, $schema, $rid, @{$ql});
	
	# if there is a key in %h == undef, error
	if (exists($h{undef()})) {
		return undef;
	}

	# create new hash using private field names
	foreach my $key (keys(%h)) {
		my $pkey = $cd->{reverse_map}->{$key};
		if ($cd->{priv_keys}->{$pkey}->{type} eq 'enum') {
			# this should work with ARS $NULL$ values, as it simply
			# propagates the undef
			my $tmp = $cd->{priv_keys}->{$pkey}->{enum_rev}->{$h{$key}};
			$res->{$pkey} = $tmp;
		} else {
			$res->{$pkey} = $h{$key};
		}
	}

	return $res;
}

sub dumpData
{
	my $self = shift;

	print "-- DUMP DATA --\n";
	if (exists($self->{ars_data})) {
		print "  ARS_DATA:\n";
		foreach my $key (keys(%{$self->{ars_data}})) {
			printf("\t%-30s %s\n", $key, $self->{ars_data}->{$key});
		}
	}
	if (exists($self->{changed_data})) {
		print "  CHANGED_DATA:\n";
		foreach my $key (keys(%{$self->{changed_data}})) {
			printf("\t%-30s %s\n", $key, $self->{changed_data}->{$key});
		}
	}
}

sub dumpHash
{
	my ($hr, $label) = @_;

	print "-- DUMP HASH [$label] --\n";

	foreach my $key (keys(%{$hr})) {
		printf("%-30s %s\n", $key, $hr->{$key});
	}
}

#------------------------------------------------------------------
# _convertToArsFormat() is passed a reference to a hash with keys
# matching those in FIELDS.  The keys are converted to Field-IDs, and
# in the case of enum fields, the values are converted to the numbered
# equivalents
#------------------------------------------------------------------
sub _convertToArsFormat
{
	my ($cd, $href) = @_;		# $cd contains a ref to CLASS_DATA

	my $ref;
	foreach my $key (keys(%{$href})) {
		if (!exists($cd->{priv_keys}->{$key})) {
			die "_convertToArsFormat: [$key] not found";
		}
		my $type = $cd->{priv_keys}->{$key}->{type};
		my $fid = $cd->{priv_keys}->{$key}->{id};
		#$DEBUG && print " ## converting [$key] --> [$fid]\n";
		if ($type eq 'enum') {
			if (defined($href->{$key}) &&
				(!exists($cd->{priv_keys}->{$key}->{enum}->{$href->{$key}})))
			{
				confess "no such value [$href->{$key}] in enum field [$key]";
			}
			$ref->{$fid} = $cd->{priv_keys}->{$key}->{enum}->{$href->{$key}}->[0];
		} else {
			$ref->{$fid} = $href->{$key};
		}
	}

	$ref;
}

sub _lookupEnum
{
	my ($cd, $field, $value) = @_;

	if (defined($value) &&
		!exists($cd->{priv_keys}->{$field}->{enum}->{$value}))
	{
		confess "no such value [$value] in enum field [$field]";
	}
	return $cd->{priv_keys}->{$field}->{enum}->{$value}->[0];
}

sub write
{
	my $self = shift;

	my $cd = $self->_getClassData;
	my $schema = $cd->{schema};

	my $pk_lab = $cd->{reverse_map}->{$PRIMARY_KEY};

	if (exists($self->{changed_data}->{$pk_lab})) {
		die "attempt to set/change primary key during update/create";
	}

	my $converted = _convertToArsFormat($cd, $self->{changed_data});
	#dumpHash($converted, 'converted');

	if ($DEBUG >= 10) {
		print "** aborting ARS modify because DEBUG set **\n";
		return;
	}

	my $eid;

	if (defined($self->{record_id})) {
		# this is an UPDATE
		#my $pkey = $self->{ars_data}->{$pk_lab};
		if (!$self->{dirty}) {
			# no fields updated. do nothing.
			$DEBUG && print "  write: record not dirty. no work to do.\n";
			return;
		}
		my $pkey = $self->{record_id};
		#$DEBUG && dd($converted);
		my $ret;
		$ret = ars_SetEntry($CTL, $schema, $pkey, 0, %{$converted});
		if (!$ret) {
			die "ars_SetEntry: $ars_errstr";
		}
		return;
	} else {
		# this is a CREATE
		($eid = ars_CreateEntry($CTL, $schema, %{$converted})) || 
			die $ars_errstr;

		#--------------------------------------------------------
		# set the "record_id" field so the next write() causes an
		# update to be performed
		#--------------------------------------------------------
		$self->{record_id} = $eid;
	}

	
	# reset 
	$self->{ars_data}		= {},	# ref to hash of ARS field data
	$self->{changed_data}	= {},	# ref to hash of fields updated
	$self->{dirty}			= 0,	# 1 if data needs to be written
	$self->{loaded}			= 0,

	# return the request_id
	$eid;
}

sub reload
{
	my $self;

	defined($self->{record_id})
		|| die "cannot reload an object that was never loaded";

	return $self->getRecordById($self->{record_id});
}

sub dd
{
	my $href = shift;

	print "** DUMP OF converted changed_data **\n";
	foreach my $key (keys(%{$href})) {
		print "\t$key = [$href->{$key}]\n";
	}
}

#------------------------------------------------------------------
# this method returns true if a record has been updated since the
# time it was read by this process.  Don't need it just now...
#------------------------------------------------------------------
sub recordModified
{
	my $self = shift;

	my $cd = $self->_getClassData;
	my $schema = $cd->{schema};

	my $pk_lab = $cd->{reverse_map}->{$PRIMARY_KEY};
	my $pkey = $self->{ars_data}->{$pk_lab};

	$DEBUG && print "checking if entry [$pkey] changed...\n";

	my $mt_lab = $cd->{reverse_map}->{$MODIFY_TIME};
	my $mt = $self->{ars_data}->{$mt_lab};

	# get modification time for entry
	my ($lab, $val);
	(($lab, $val) = ars_GetEntry($CTL, $schema, $pkey, $MODIFY_TIME))
		|| die $ars_errstr;
	
	$DEBUG && print "old mt = [$mt], new mt = [$val]\n";

	if ($mt eq $val) {
		# no change
		return 0;
	}

	return 1;
}

#------------------------------------------------------------------
# setFields() can be used to set a number of fields using
# a values obtained from a hash.  It sort-of does an end-run
# around the usual get/set methods.
#------------------------------------------------------------------

sub setFields
{
	my ($self, $href) = @_;

	my $cd = $self->_getClassData;

	$DEBUG && print "setFields:\n";

	foreach my $key (keys(%{$href})) {
		if (!exists($cd->{priv_keys}->{$key})) {
			die "handle field doesn't exist [$key]";
		}
		$DEBUG && print "\t$key = $href->{$key}\n";
		$self->{changed_data}->{$key} = $href->{$key};
	}

	$self->{dirty} = 1;
}


#------------------------------------------------------------------
# getFields() really shouldn't be used...
#
# returns a reference to a hash of all loaded or modified fields.
# Modified fields take precedence over values loaded from ARS. The
# value of a diary field will be either a reference to an array of
# hashes if the data comes from ARS, or a simple scalar if the field
# has been modified.
#------------------------------------------------------------------
sub getFields
{
	my $self = shift;

	my (%h1, %h2);

	if (exists($self->{ars_data})) {
		%h1 = %{$self->{ars_data}};
	}

	if (exists($self->{changed_data})) {
		%h2 = %{$self->{changed_data}};
	}

	#return (keys(%{{%h1, %h2}}));
	return {%h1, %h2};
}

#------------------------------------------------------------------
# dump() is will dump to STDOUT the contents of an object
#------------------------------------------------------------------
sub dump
{
	my ($self, $all) = @_;

	my $cd = $self->_getClassData;

	my $byid = sub {
		return $cd->{priv_keys}->{$a} <=> $cd->{priv_keys}->{$b};
	};

	foreach my $field (sort $byid keys(%{$cd->{priv_keys}})) {
		my $type = $cd->{priv_keys}->{$field}->{type};
		if ($type eq 'diary') {
			# don't dump diary-fields
			next;
		}
		if (exists($self->{changed_data}->{$field})) {
			printf("  %-25s = %s\n", $field,
				dumpFormat($cd, $field, $self->{changed_data}->{$field}));
		} elsif (exists($self->{ars_data}->{$field})) {
			printf("  %-25s = %s\n", $field,
				dumpFormat($cd, $field, $self->{ars_data}->{$field}));
		} elsif ($all) {
			printf("  %-25s = \n", $field);
		}
	}
}

sub dumpClassdata
{
	my ($cd, $str) = @_;

	my $lev = 0;
	print "### DUMP ($str) CLASS_DATA=[$cd] ###\n";
	dumpHier($cd, 1);
}

sub dumpHier
{
	my ($thing, $lev) = @_;
	my $indent = "\t" x $lev;
	#print "dumpHier: lev = $lev, indent=[$indent]\n";

	if (ref($thing)) {
		if (ref($thing) eq 'HASH') {
			foreach my $k (keys(%{$thing})) {
				if (ref($thing->{$k})) {
					print "${indent}$k = (hash)\n";
					dumpHier($thing->{$k}, $lev + 1);
				} else {
					print "${indent}$k = [$thing->{$k}]\n";
				}
			}
		} elsif (ref($thing) eq 'ARRAY') {
			foreach my $k (@{$thing}) {
				if (ref($thing->[$k])) {
					print "${indent}$k = (array)\n";
					dumpHier($thing->[$k], $lev + 1);
				} else {
					print "${indent}$k = [$thing->[$k]]\n";
				}
			}
		} else {
			die "ref=[".ref($thing)."]. huh?";
		}
	} else {
		print "${indent}$thing\n";
	}
	#print "(leaving dumpHier, lev=$lev)\n";
}

sub dumpFormat
{
	my ($cd, $field, $value) = @_;

	if ($value =~ /\n/) {
		return join("\n".' 'x30, split(/\n/, $value));
	}

	return $value;
}

sub formatDiary
{
	my $diary_ref = shift;

	my $out;
	foreach my $lent (@{$diary_ref}) {
		($u, $t, $v) = @{$lent}{'user', 'timestamp', 'value'};
		$t = localtime($t);
		$out .= "## $u, $t\n$v\n";
	}

	$out;
}

#------------------------------------------------------------------
# schemaChanged() compares the $CLASS_DATA hierarchy to the ARS
# schema data.  If there is a discrepency a description thereof
# will be returned.  If there is no discrepency, an empty scalar
# is returned.
#
# schemaChanged() can be called periodically to check whether
# the ARS schema has been modified without fixing the corresponding
# subclass.
#------------------------------------------------------------------
sub schemaChanged
{
	my $cd = shift;

	my $debug = 0;

	my $schema = $cd->{schema};

	my %fields = ars_GetFieldTable($CTL, $schema);
	
	if (defined($fields{undef()})) { die $ars_errstr; }

	# get list of all $fids I know about
	my %my_fids;
	foreach my $tmp_fid (keys(%{$cd->{reverse_map}})) {
		$my_fids{$tmp_fid} = 1;
	}

	my $errors;
	foreach my $field (keys(%fields)) {
		$debug && print "checking field [$field]\n";
		my $fid = $fields{$field};
		if (!exists($cd->{reverse_map}->{$fid})) { next; }
		$debug && print "  field exists in private data\n";
		delete($my_fids{$fid});
		my $pkey = $cd->{reverse_map}->{$fid};
		$debug && print "  private key = [$pkey]\n";
		my $lab = $cd->{priv_keys}->{$pkey}->{real};

		$debug && print "  checking if labels match\n";
		if ($field ne $lab) {
			$errors .= "[$field]: label changed from [$lab] to [$field]\n";
		}
		my $finfo = ars_GetField($CTL, $schema, $fid);
		if (!defined($finfo)) { die "$ars_errstr"; }

		$debug && print "  checking if types match\n";
		if ($finfo->{dataType} ne $cd->{priv_keys}->{$pkey}->{type}) {
			$errors .= "[$field]: type changed from [$cd->{priv_keys}->{$pkey}->{type}] to [$finfo->{dataType}]\n";
			next;
		}
		if ($finfo->{dataType} ne 'enum') { next; }

		$debug && print "  checking if enum counts match\n";
		if (@{$finfo->{limit}} != keys(%{$cd->{priv_keys}->{$pkey}->{enum}})) {
			$old_num = keys(%{$cd->{priv_keys}->{$pkey}->{enum}});
			$new_num = @{$finfo->{limit}};
			$errors .= "[$field]: number of enums changed from [$old_num] to [$new_num]\n";
			next;
		}

		$debug && print "  checking if enum labels match\n";
		my $ind = 0;
		my $end = $#{$finfo->{limit}};
		$debug && print "end = [$end]\n";
		while($ind <= $#{$finfo->{limit}}) {
			$debug && print "ind = [$ind]\n";
			my $ars_lab = $finfo->{limit}->[$ind];
			my $p_ekey = $cd->{priv_keys}->{$pkey}->{enum_rev}->{$ind};
			my $saved_lab = $cd->{priv_keys}->{$pkey}->{enum}->{$p_ekey}->[1];
			$debug && print "comparing [$ars_lab] and [$saved_lab]\n";
			if ($ars_lab ne $saved_lab) {
				$errors .= "[$field]: enum label [$ind] changed from [$saved_lab] to [$ars_lab]\n";
				last;
			}
			$ind++;
		}
	}

	if (%my_fids) {
		$errors .= "fields have disappeared from ARS:";
		#join(', ', (keys(%my_fids)));
		foreach my $fid (keys(%my_fids)) {
			my $pkey = $cd->{reverse_map}->{$fid};
			my $real = $cd->{priv_keys}->{$pkey}->{real};
			$errors .= " '$real' (id=$fid);";
		}
		$errors .= "\n";
	}

	return $errors;
}

# this is ONLY for ars-gen-subclass
sub _arsControl
{
	return $CTL;
}

1;