#!/opt/SUNWmail/gtw/perl/bin/perl -ww

# $Id: mockdir,v 1.36.14.1 1998/02/06 18:05:50 kevin Exp $

my $legal = <<'EOF';
This is UNPUBLISHED PROPRIETARY SOURCE CODE of Wingra Technologies
Incorporated; the contents of this file may not be disclosed to third parties,
copied or duplicated in any form, in whole or in part, without the prior
written permission of Wingra Technologies Incorporated.

Permission is hereby granted solely to the licensee for use of this source code
in its unaltered state. This source code may not be modified by licensee
except under specific direction of Wingra Technologies Incorporated. This
source code may not be given under any circumstances to non-licensees in any 
form, including source or binary. Unauthorized modification of this source 
constitutes breach of contract, which voids any potential pending support 
responsibilities by Wingra Technologies Incorporated. Divulging the exact or 
paraphrased contents of this source code to unlicensed parties either directly 
or indirectly constitutes violation of federal and international copyright and 
trade secret laws, and will be duly prosecuted to the fullest extent permitted 
under law.

This software is provided by Wingra Technologies Incorporated ``as is'' and any
express or implied warranties, including, but not limited to, the implied
warranties of merchantability and fitness for a particular purpose are
disclaimed.  In no event shall the regents or contributors be liable for any
direct, indirect, incidental, special, exemplary, or consequential damages
(including, but not limited to, procurement of substitute goods or services;
loss of use, data, or profits; or business interruption) however caused and on
any theory of liability, whether in contract, strict liability, or tort
(including negligence or otherwise) arising in any way out of the use of this
software, even if advised of the possibility of such damage.
EOF

BEGIN
{
    my $os;
    my $addPath;
    $os = `uname -s`;
    chomp $os;
    $os = lc $os;
 
    if (not defined($ENV{"__GETROOT__"}))
    {
	$! = -2;
	print STDERR "Environment variable __GETROOT__ must be set!\n";
	die "RUNTIME error encountered";
    }

    $addPath = `$ENV{"__GETROOT__"} / libDir`;
    chomp $addPath;
    unshift(@INC, $addPath);

    $addPath = `$ENV{"__GETROOT__"} / perlDir`;
    chomp $addPath;
    unshift(@INC, $addPath . "/lib/" . $os . "/5.002");
    unshift(@INC, $addPath . "/lib");
    unshift(@INC, $addPath . "/lib/site_perl/" . $os);
    unshift(@INC, $addPath . "/lib/site_perl");

}

require 5.002;		# uses perl5 features heavily
use DB_File;		# DB has record-size limits
use Fcntl;		# I forget why this is here; I wonder if it can be axed
use Getopt::Long 2.2;	# long-style command-line parser
use File::Basename;	# for parsing filenames
use strict;		

use Dirsync;		# abspath
use MsvLog;		# Missive-style logging
use MDEF;		# Missive Directory Exchange Format

=head1 NAME

mockdir - do operations on a Missive-format Berkeley DB mail directory

=head1 SYNOPSIS

B<mockdir> 
(B<-debug>) 
(B<-help>) 
(B<-input> I<inputfile>)
(B<-output> I<outputfile>)
[ B<-load> | B<-dump> | B<-diff> | B<-sync> ] 
(B<-reset>) 
(B<-md> I<filename>)
B<-channel> I<channel>
(B<-usedattrs> I<filename>) 
(B<-log> (I<filename>))

=head1 DESCRIPTION

Does various mail directory operations on a pair of Berkeley DB databases.

=head1 OPTIONS

=over 5

=item B<-debug>

Print out debugging information.

=item B<-help>

Displays a brief help message.

=item B<-input>

Specify the input file. Required for B<-load>.

=item B<-output>

Specify the output file. Required for B<-dump> and B<-diff>.

=item B<-load>

Load the input data file into the databases. Will accept a properly marked-up 
incremental or complete update.

=item B<-dump>

Dump a complete copy of the database into the output file. 

=item B<-diff>

Compares the old copy of the directory with the most recent information and
generates a list of changes.

=item B<-sync>

In the abstract, copies the data in the main directory into the old directory.
In actuality, uses a system of virtual links to save space.

=item B<-reset>

Resets the database completely. If given in combination with another operation,
the reset occurs first. Be careful...

=item B<-md> I<database>

Optional. Specifies the name of the pairs of databases to be used. If the
option given is I<foo>, the files I<foo> and I<foo.old> are presumed to exist, 
and will be created otherwise. (Defaults to "I<md>".)

=item B<-channel> I<channel>

I<Required>. Specifies the directory to store the database in, if B<-md>
doesn't specify a complete path name.

=item B<-usedattrs> I<filename>

Optional. If supplied a list of all attributes used in the mapping process 
are read from this file. Only attributes defined here are allowed to be 
used. See I<map_filter> for more information.

=item B<-log> (I<filename>)

Optional. If supplied, the given log file is opened and various informative,
warning and error messages are written. If no argument is supplied, the
default log file name is used.

=head1 INTERNALS

Each record is keyed by Native Address, with the values of the form:

"Field1\001Value1\001Field2\001Value2\001Field3\001Value3\001".

This is a compact way to store the information, and can be imported into an
associative array thusly:

S<%record = split(/\001/, $string);>

The old MD is represented as another DB file, which records the _original_
versions of changes. This means that the mail MD is always up-to-date, but
the version as of the previous sync can always be reconstucted. So, the 
following sequence is a fair abstractions:

	Add A
	Add B
	Add C
	Sync
	Delete A
	Modify B
	Add D

The result is that MD = B', C, D and oldMD = A, B

=cut

# declare all globals for strict
my $filtered = 0;	# number of entries filtered by filter_attrs()
my $result;		# result of func calls
my $debug;		# $::opt_debug is too damned long
my $md;			# mail directory file name
my $log;		# ref to MsvLog object
my $oper;		# current operation
my %usedattrs;		# used attributes
my $input;		# input MDEF ref
my $output;		# output MDEF ref
my %md;			# mail directory (tied) 
my %omd;
my $dsmTRANS = -3; 	# Transient error, restartable
my $dsmCONFIG = -2; 	# Configuration error, not restartable


undef $::opt_debug;
undef $::opt_help;
undef $::opt_diff;
undef $::opt_sync;
undef $::opt_reset;

$result = GetOptions("debug", "help", "load", "loadall", "dump", 
    "diff", "reset", "sync", "md=s", "channel=s", "input=s", "output=s", 
    "usedattrs=s", "log:s");

$! = $dsmCONFIG;
die "Usage: $0 (-debug) (-help) [ -load | -dump | -diff | -sync ]\n" .
    "\t(-reset) -md <database> (-usedattrs <filename>) (-log (<filename>))\n" .
    "\t[ -input <inputfile> | -output <outputfile>] -channel <channel>\n"
    if ($::opt_help or (!$::opt_load and !$::opt_loadall and !$::opt_dump and 
	!$::opt_diff and !$::opt_sync and !$::opt_reset)
	or !$::opt_channel);

# "opt_" is too annoying to type...
if (defined($::opt_debug)) {
  $debug = 1;
} else {
  # redirect STDOUT and STDERR
  open (STDOUT, ">/dev/null") || die ("Unable to redirect STDOUT!");
  open (STDERR, ">/dev/null") || die ("Unable to redirect STDERR!");
}

# define some base pathnames
# define some base pathnames
my $p_bin = `$ENV{"__GETROOT__"} / binDir`;
chomp($p_bin);
$p_bin .= "/";

my $p_etc = `$ENV{"__GETROOT__"} / cfgDir`;
chomp($p_etc);
$p_etc .= "/";

my $p_ds = `$ENV{"__GETROOT__"} / dirsyncDir`;
chomp($p_ds);
$p_ds .= "/";

my $p_dsc = $p_ds . lc($::opt_channel) . "/";

my $p_log = `$ENV{"__GETROOT__"} / logDir`;
chomp($p_log);
$p_log .= "/dirsync/";

# default log directory may not exist, so create it if not there
mkdir($p_log,0770) if ( ! -d $p_log );

# $md is the name of the database to use 
$md = defined($::opt_md) ? &abspath($p_dsc, $::opt_md) : &abspath($p_dsc, "md");
print STDERR "database: $md\n" if $debug;

# open the log file, keepopen
if (defined($::opt_log))
{
    my ($basename) = File::Basename::basename($0);

    # generate a log file name if none provided
    if ($::opt_log eq "")
    {
	$::opt_log = $p_log . MsvLog->logname(lc($::opt_channel));
    }

    $log = new MsvLog(&abspath($p_dsc, $::opt_log), "$basename\[$$\]", 1);
    $! = $dsmCONFIG;
    die $log . "\n" if (ref($log) eq "SCALAR");

    $result = $log->report(MsvLog::NLS("i"), MsvLog::NLS("Starting"));
    $log->abort($dsmTRANS, $$result) if (ref($result) eq "SCALAR"); # just check once...
}
else
{
    $log = stub MsvLog;
}

# default option is "none", which will force a OPERATION= line at the 
# beginning of output
$oper = "none";

# check for an attribute list
if ($::opt_usedattrs)
{
    print STDERR "got usedattrs: $::opt_usedattrs\n" if $debug;
    open(ATTRS, &abspath($p_dsc, $::opt_usedattrs))
	|| $log->abort($dsmCONFIG, 
		     MsvLog::NLS("Can't open attribute list: %1\$s"),
		       &abspath($p_dsc, $::opt_usedattrs));

    foreach $_ (<ATTRS>)
    {
	chomp;
	$usedattrs{$_} = 1;
    }
}

# this is not exclusive with the below!
if ($::opt_reset)
{
    print STDERR "Resetting the Mail Directory!\n" if $debug;

    &reset_md;
}

# now, choose what to run 
if ($::opt_load)
{
    print STDERR "Loading...\n" if $debug;

    $log->abort($dsmCONFIG, MsvLog::NLS("No filename specified with -input!")) unless $::opt_input;
    $input = MDEF->open(&abspath($p_dsc, $::opt_input), "r");
    if (ref($input) eq "SCALAR") {$log->abort($dsmCONFIG, $$input);}
    &load_md;
}
elsif ($::opt_loadall) # undocumented, but will force a complete update
{
    print STDERR "Loading all...\n" if $debug;

    $log->abort($dsmCONFIG, MsvLog::NLS("No filename specified with -input!")) unless $::opt_input;
    $input = MDEF->open(&abspath($p_dsc, $::opt_input), "r");
    if (ref($input) eq "SCALAR") {$log->abort($dsmCONFIG, $$input);}
    &load_complete_md;
}
elsif ($::opt_dump)
{
    print STDERR "Dumping...\n" if $debug;

    $log->abort($dsmCONFIG, MsvLog::NLS("No filename specified with -output!")) 
	unless $::opt_output;
    $output = MDEF->open(&abspath($p_dsc, $::opt_output), "w");
    if (ref($output) eq "SCALAR") {$log->abort($dsmTRANS, $$output);}
    &dump_md;
}
elsif ($::opt_diff)
{
    print STDERR "Diffing...\n" if $debug;

    $log->abort($dsmCONFIG, MsvLog::NLS("No filename specified with -output!")) 
	unless $::opt_output;
    $output = MDEF->open(&abspath($p_dsc, $::opt_output), "w");
    if (ref($output) eq "SCALAR") {$log->abort($dsmTRANS, $$output);}
    &diff_md;
}
elsif ($::opt_sync)
{
    &sync_md;
}
elsif ($::opt_reset)
{
    # already did the reset...
    ;
}
else
{
    $log->abort($dsmCONFIG, MsvLog::NLS("No valid option?!"));
}

$log->report(MsvLog::NLS("i"), MsvLog::NLS("Exiting normally"));

# Function: load_md
# Arguments: none
# Returns: nothing
# Description: Loads a mail directory DB file with the file from 
#              stdin. Does adds, modifies, and deletes. 
sub load_md
{
    my %mdkey;	# MD keys, with entries uppercased
    my ($processed, $added, $modified, $deleted) = (0, 0, 0, 0);	# stats
    my $key;	# index variable
    my @record;	# record from input file
    my @lines;	# processed version of @record
    my $string;	# concat'd version of @lines, for db

    tie %md, 'DB_File', $md, O_RDWR|O_CREAT, 0750, $DB_HASH;
    tie %omd, 'DB_File', "$md.old", O_RDWR|O_CREAT, 0750, $DB_HASH;

    # generate a cached list of md keys, with the key uc'd
    foreach $key (keys %md)
    {
	$mdkey{uc $key} = $key;
    }

    # get a record
    while (@record = $input->read_entry())
    {
	# check for error from read_entry
	if (ref($record[0]) eq "SCALAR") {$log->abort($dsmCONFIG, ${$record[0]});}

	$oper = shift(@record);
	($oper) = ($oper =~ /operation\s*=\s*(\w+)/i);

	# check for operation=replace
	if ($oper eq "replace")
	{
	    # ack! we really want to be running an entirely different
	    #  routine! abort! abort!

	    $log->report(MsvLog::NLS("i"), MsvLog::NLS("Loading complete update to database"));

	    # reset the directories
	    untie %md;
	    untie %omd;
	    # reset the input file
	    $input = MDEF->open(&abspath($p_dsc, $::opt_input), "r");
	    if (ref($input) eq "SCALAR") {$log->abort($dsmCONFIG, $$input);}
	    return &load_complete_md;
	}

	# ok, at this point we've got @record, which contains a complete, 
	#  valid record to be stored

	$processed++;
	@lines = ();
	$key = "";

	# now, add each line into an ABABAB form list to be imported into 
	#  %md
	foreach $_ (@record)
	{
	    # remove line-initial = or + (they're redundant, and conflict
	    # with the detection of Native Address), but keep -
	    s/^[=+]//;

	    # replace " = " with "\001"
	    s/\s*=\s*/\001/;

	    if (/\001$/)	# if \001 is the last symbol
	    {
		# then put some space back for split/join
		$_ .= " ";
	    }

	    # if we've got the native address field, store it for use as the
	    #  key in %md
	    $key = $' if (lc($`) eq lc("Native Address"));

	    # now fix the case of the key to match the md, if it exists
	    if (defined($mdkey{uc $key}))
	    {
		$key = $mdkey{uc $key};
	    }

	    @lines = (@lines, $_);
	}

	if (!defined($key))
	{
	    $log->report(MsvLog::NLS("I"), MsvLog::NLS("Missing Native Address in an input record!"));
	    $key = "bogus";
	}

	# convert our newfound record into a single object, storing the key 
	#  field
	$string = join("\001", @lines);
	print STDERR "string = $string\n" if $debug;
	print STDERR "oper   = $oper\n" if $debug;

	# here's where we decide about add/modify/delete
	if (lc($oper) eq "add" or lc($oper) eq "change")
	{
	    # if this record hasn't been modified...
	    if (lc($omd{$key}) eq "link")
	    {
		    if ($md{$key})
		    {
			# if it's being overwritten/modified, copy the old
			#  record on top

			print STDERR "Copying $key to omd...\n" if $debug;
			$omd{$key} = $md{$key};
		    }
	    }

	    $md{$key} = &filter_attrs($string);

	    $added++;
	}
	elsif (lc($oper) eq "modify")
	{
	    # loop through the topics, looking for +s, -s, matches, etc...

	    # newargs is the hash table of new entry/value pairs, with
	    #  deletions defined by a lack of a value (or just spaces)
	    my %newargs = split(/\001/, join("\001", @lines));
	    my $newarg;		# index into %newargs

	    # args is the hash table of the original record's entry/value
	    #  pairs. It will be updated and returned to the %md.
	    my %args = split(/\001/, $md{$key});

	    print STDERR "newargs = ", join(" ", %newargs), "\n" if $debug;
	    print STDERR "args    = ", join(" ", %args), "\n" if $debug;

	    foreach $newarg (keys %newargs)
	    {
		# check for explicit delete
		if (substr($newarg, 0, 1) eq "-")
		{
		    print STDERR "explicitly deleting $newarg\n" if $debug;

		    $newarg = substr($newarg, 1);
		    $newargs{$newarg} = "";

		    # now we've created an element without the - that the
		    # code below will see as being a deletion. Yee haw!
		}

		# if there's a consequent, set it, otherwise, delete it
		if ($newargs{$newarg} =~ /\w/)
		{
		    # copy the new attrib/value pair into the old array
		    $args{$newarg} = $newargs{$newarg};
		    print STDERR "setting $newarg = ", $newargs{$newarg}, 
			"\n" if $debug;
		}
		else
		{
		    delete $args{$newarg} if defined($args{$newarg});
		    print STDERR "deleting $newarg\n" if $debug;
		}
	    }

	    # if this record hasn't been modified...
	    if (lc($omd{$key}) eq "link")
	    {
		if ($md{$key})
		{
		    # if it's being overwritten/modified, copy the old
		    #  record on top

		    print STDERR "Copying unmodified $key to omd...\n" 
			if $debug;
		    $omd{$key} = $md{$key};
		}
	    }

	    # now return the new data to the %md.
	    $md{$key} = &filter_attrs(join("\001", %args));

	    $modified++;
	}
	elsif (lc($oper) eq "delete")
	{
	    if (defined($md{$key}))
	    {
		if (defined($omd{$key}) and lc($omd{$key}) eq "link")
		{
		    $omd{$key} = $md{$key};
		}

		delete $md{$key};

		$deleted++
	    }
	}
	else
	{
	    $log->abort($dsmCONFIG, MsvLog::NLS("No valid OPTion?!"));
	}
    }
    
#if (($processed == 0) && (!$::opt_loadundos))
#{
#$log->report("i", "No records found in input file, deleting all entries in MD");
#return &load_complete_md;
#}     
    
    $log->report(MsvLog::NLS("i"), MsvLog::NLS("Processed %1\$s records (%2\$s filtered):"), $processed, $filtered);
    $log->report(MsvLog::NLS("i"), MsvLog::NLS("%1\$s additions/replacements"), $added);
    $log->report(MsvLog::NLS("i"), MsvLog::NLS("%1\$s modifications"), $modified);
    $log->report(MsvLog::NLS("i"), MsvLog::NLS("%1\$s deletions"), $deleted);

    untie %omd;
    untie %md;
}

# Function: load_complete_md
# Arguments: none
# Returns: nothing
# Description: Similar to load_md, but it assumes the input file is a complete
#              copy of a mail dir. rather than a diff. It will generate the
#              diff on the fly, storing the old versions in md.old.
sub load_complete_md
{
    my $processed = 0;
    my $key;
    my $val;
    my @record;
    my @lines;
    my $string;
    my $link;
    my @links;
    my %mdkey;	# MD keys, with entries uppercased

    tie %md, 'DB_File', $md, O_RDWR|O_CREAT, 0750, $DB_HASH;
    tie %omd, 'DB_File', "$md.old", O_RDWR|O_CREAT, 0750, $DB_HASH;

    # first, dereference ALL links in omd, storing names of what changed
    foreach $key (keys %omd)
    {
	# store list of all keys, also, keyed on uppercased version
	$mdkey{uc $key} = $key;

	$val = $omd{$key};

	if (lc($val) eq "link")
	{
	    $log->abort($dsmCONFIG, MsvLog::NLS("Dangling link: %1\$s"), $key) unless defined($md{$key});

	    $omd{$key} = $md{$key};
	    push(@links, $key);
	}
    }

    # reset the md
    %md = ();

    # slam the data into md

    while (@record = $input->read_entry())
    {
	# check for error from read_entry
	if (ref($record[0]) eq "SCALAR") {$log->abort($dsmCONFIG, ${$record[0]});}

	# the first line in a record from read_entry is always the current
	#  operation
	$oper = shift(@record);
	($oper) = ($oper =~ /operation\s*=\s*(\w+)/i);

	# and it had damn well better be "replace"!
	if ($oper ne "replace")
	{
	    $log->report(MsvLog::NLS("I"), 
		MsvLog::NLS("Got an operation directive in a non-incremental file"));
	    $oper = "replace";
	}

	# ok, at this point we've got @record, which contains a complete, 
	#  valid record to be stored

	$processed++;
	@lines = ();

	# now, add each line into an ABABAB form list to be imported into 
	#  %md
	foreach $_ (@record)
	{
	    # replace " = " with "\001"
	    s/\s*=\s*/\001/;

	    # if we've got the native address field, store it for use as the
	    #  key in %md
	    $key = $' if (lc($`) eq lc("Native Address"));

	    # now fix the case of the key to match the md, if it exists
	    if (defined($key) && defined($mdkey{uc $key}))
	    {
		$key = $mdkey{uc $key};
	    }

	    @lines = (@lines, $_);
	}

	# convert our newfound record into a single object, storing the key 
	#  field
	$string = join("\001", @lines);
	print STDERR "string = $string\n" if $debug;
	print STDERR "key    = $key\n" if $debug;

	# since this MUST be a complete data file, do as if it's an "add"
	$md{$key} = &filter_attrs($string);
    }

    # Now what we've got is a pair of data files, but with no links. If we
    #  quit now, everything looks like a change (oops).

    # so, we put the links back
    foreach $link (@links)
    {
	if ($md{$link} eq $omd{$link})
	{
	    print STDERR "put back a link: $link\n" if $debug;
	    $omd{$link} = "link";
	}
    }

    $log->report(MsvLog::NLS("i"), MsvLog::NLS("Processed  %1\$s records (%2\$s filtered)"), $processed, $filtered);

    untie %omd;
    untie %md;
}

# Function: dump_md
# Arguments: none
# Returns: nothing
# Description: Just opens and prints out the contents of the MD in the form we
#              got it in.
sub dump_md
{
    my ($dumped, $links) = (0, 0);
    my @record;
    my ($key, $val);
    my $v;
    my %vals;

    tie %md, 'DB_File', $md, O_RDONLY, 0750, $DB_HASH;

    foreach $key (keys %md)
    {
	$val = $md{$key};
	@record = ();

	if (lc($val) eq "link")
	{
	    $links++;
	}
	else
	{
	    # generate an associative array out of the string (ooh)
	    %vals = split(/\001/, $val);

	    # now just loop through...
	    foreach $v (keys %vals)
	    {
		push(@record, $v . "=" . $vals{$v});
	    }

	    $output->write_entry("operation=change", @record);
	}

	$dumped++;
    }

    $log->report(MsvLog::NLS("i"), MsvLog::NLS("Dumped %1\$s records"), $dumped);
    $log->report(MsvLog::NLS("i"), MsvLog::NLS("Ignored %1\$s links"), $links);

    untie %md;
}

# Function: reset_md
# Arguments: none
# Returns: nothing
# Description: Deletes all data from the DB file.
sub reset_md
{
    tie %md, 'DB_File', $md, O_RDWR|O_CREAT, 0750, $DB_HASH;
    tie %omd, 'DB_File', "$md.old", O_RDWR|O_CREAT, 0750, $DB_HASH;

    %md = ();
    %omd = ();

    $log->report(MsvLog::NLS("I"), MsvLog::NLS("Reset old and current directories"));

    untie %omd;
    untie %md;
}

# Function: sync_md
# Arguments: none
# Returns: nothing
# Description: Synchronizes the old copy of a mail dir db file with the new
#              copy. All old entries are reset to just be "link". This should
#              probably be run as one of the last steps in a sync process.
sub sync_md
{
    my $links = 0;
    my $key;

    tie %md, 'DB_File', $md, O_RDONLY, 0750, $DB_HASH;
    tie %omd, 'DB_File', "$md.old", O_RDWR|O_CREAT, 0750, $DB_HASH;

    %omd = ();

    foreach $key (keys %md)
    {
	$omd{$key} = "link";
	$links++;
    }

    $log->report(MsvLog::NLS("i"), MsvLog::NLS("Re-sync'ed directory:"));
    $log->report(MsvLog::NLS("i"), MsvLog::NLS("%1\$s links created"), $links);

    untie %omd;
    untie %md;
}

# Function: diff_md
# Arguments: none
# Returns: nothing
# Description: Performs a "diff"-like operation on a pair of databases. 
#              Generates a list of operations and modifications.
sub diff_md
{
    my ($processed, $adds, $modifies, $deletes) = (0, 0, 0, 0);
    my @mdkeys;
    my @omdkeys;
    my %seen;
    my $key;

    tie %md, 'DB_File', $md, O_RDONLY, 0750, $DB_HASH;
    tie %omd, 'DB_File', "$md.old", O_RDONLY, 0750, $DB_HASH;

    @mdkeys = keys %md;
    @omdkeys = keys %omd;

    # appease -w
    %seen = ();

    # merge the two lists and iterate
    foreach $key (@mdkeys, @omdkeys)
    {
	print STDERR "processing $key...\n" if $debug;
	$processed++;

	unless ($seen{$key}++)	# only do this once per key
	{
	    if (defined($md{$key}) and !defined($omd{$key}))	# add
	    {
		$oper = "add";

		&print_record($key);
		$adds++;
	    }
	    elsif (!defined($md{$key}) and defined($omd{$key}))	# delete
	    {
		$oper = "delete";

		&print_deleted_record($key);
		$deletes++;
	    }
	    elsif (defined($omd{$key}) and $omd{$key} ne "link")	# modify
	    {
		$oper = "modify";
		
		&print_diff_record($key);
		$modifies++;
	    }
	}
    }

    $log->report(MsvLog::NLS("i"), MsvLog::NLS("Compared %1\$s records:"), $processed);
    $log->report(MsvLog::NLS("i"), MsvLog::NLS("%1\$s additions"), $adds);
    $log->report(MsvLog::NLS("i"), MsvLog::NLS("%1\$s modifications"), $modifies);
    $log->report(MsvLog::NLS("i"), MsvLog::NLS("%1\$s deletions"), $deletes);
}

# Function: print_diff_record
# Arguments: a key to index into the default databases
# Returns: nothing
# Description: Generates a list of changes to an individual record. Note that
#              the algorithm is very similar to diff_md, but at one layer 
#              of abstraction lower.
sub print_diff_record
{
    my (%newvals, %oldvals);
    my (@mdelems, @omdelems);
    my %seen;
    my $key;
    my @record = ();
    my $modified = 0; # Has this really been modified?

    # generate associative arrays out of the old and new fields
    %newvals = split(/\001/, $md{$_[0]});
    %oldvals = split(/\001/, $omd{$_[0]});

    @mdelems = keys(%newvals);
    @omdelems = keys(%oldvals);

    # appease -w
    %seen = ();

    foreach $key (@mdelems, @omdelems)
    {
	print STDERR "processing $key...\n" if $debug;

	unless ($seen{$key}++)	# only do this once per key
	{
	    if (defined($newvals{$key}) and !defined($oldvals{$key}))	# add
	    {
		push(@record, "+" . $key . "=" . $newvals{$key});
		$modified = 1;
	    }
	    elsif (!defined($newvals{$key}) and defined($oldvals{$key}))# delete
	    {
		push(@record, "-" . $key . "=" . $oldvals{$key});
		$modified = 1;
	    }
	    elsif (defined($newvals{$key}) and defined($oldvals{$key}))	# modify
	    {
		if ($newvals{$key} eq $oldvals{$key})
		{
		    push(@record, "=" . $key . "=" . $newvals{$key});
		}
		else
		{
		    push(@record, $key . "=" . $newvals{$key});
		    $modified = 1;
		}
	    }
	    else
	    {
		$log->abort($dsmCONFIG, "Logical error in print_diff_record!");
	    }
	}
    }

    if ($modified)
    {
        $output->write_entry("operation=$oper", @record);
    }
}

# Function: print_record, print_deleted_record
# Arguments: a key to index into the default database
# Returns: nothing
# Description: Prints a simple version of the current main (not old) database.
#              The deleted version does the same, except with the old
#              database.
sub print_record
{
    my $val;		# value of the record in the database (with \001s)
    my $v;		# keys for the record
    my %vals;		# the record as a hash
    my @record = ();	# the structure to create to send to the MDEF ref

    $val = $md{$_[0]};

    # generate an associative array out of the string (ooh)
    %vals = split(/\001/, $val);

    # now just loop through...
    foreach $v (keys %vals)
    {
	push(@record, $v . "=" . $vals{$v});
    }

    $output->write_entry("operation=$oper", @record);
}
sub print_deleted_record
{
    my $val;		# value of the record in the database (with \001s)
    my $v;		# keys for the record
    my %vals;		# the record as a hash
    my @record = ();	# the structure to create to send to the MDEF ref

    $val = $omd{$_[0]};

    # generate an associative array out of the string (ooh)
    %vals = split(/\001/, $val);

    # now just loop through...
    foreach $v (keys %vals)
    {
	push(@record, $v . "=" . $vals{$v});
    }

    $output->write_entry("operation=$oper", @record);
}

# Function: filter_attrs
# Arguments: a record in string-format
# Returns: a filtered version of the same record
# Description: If -usedattrs is defined, it filters out any invalid attributes
#              from the record and returns the modified record. If it's not
#              defined, just returns the argument.
sub filter_attrs
{
    my $rawrecord = $_[0];	# the record
    my %record;				# a split version of $rawrecord
    my $key;				# index into %record
    my $anyfiltered = 0;	# boolean - did we filter any attributes?

    if ($::opt_usedattrs)
    {
	%record = split(/\001/, $rawrecord);

	foreach $key (keys %record)
	{
	    # delete the attribute unless it is involved in a mapping
	    if (!$usedattrs{$key})
	    {
		delete $record{$key};
		$anyfiltered++;
	    }
	}

	$filtered++ if $anyfiltered;

	return join("\001", %record);
    }
    else
    {
	return $rawrecord;
    }
}

