# This is code for dealing with the moo's database - dumping it out, loading it
# up, testing its version.

package Db;
use Thing;
use Error;
use ActiveUser;
use ThingList;
use Data::Dumper;
use strict;
use POSIX ":sys_wait_h";

# This is the version of the db we are at now.
my $currentversion=13;

# FIXME: This is a huge hack. See, Data::Dumper is inflexible. It won't let
# me tell it to call a function with parameters, instead of referencing a
# variable. So the best I can make it do is call $Db->FindByNum(foo) to get
# something's number. And that means we have to make an object to handle that
# method call. And the object can't be lexically scoped.
no strict 'vars';
$Db=bless({},"Db");
use strict 'vars';

# Used by the database when loading to find object numbers.
sub FindByNum {
	shift;
	ThingList::FindByNum(@_);
}

# Passed a filename of a database to write to, dumps out the database to the
# file in a safe manner. An optional second parameter can contain a string
# explaining why it was dumped.
# Note that this won't work unless the active user is a Wizard,
# becuase objects will refuse to dump themselves out.
# Note also that this logs everyone out! It's a good idea to fork before
# calling it.
sub DumpToFile {
	my $fn=shift;
	my $reason=shift;
	
	my $newfn="$fn.temp";

	# It's important to log out everyone before dumping.
	my $person;
	foreach $person (ThingList::FindByType("Person")) {
		if ($person->connected) {
			$person->logout;
		}
	}

	# Set up the Data::Dumper we will use to do the work.
	my $dumper=Data::Dumper->new([]);
	$dumper->Indent(1);
	# Construct a hash of all objects in the moo, which will be passed on
	# to the Data::Dumper so it doesn't print out dummy subs for their
	# closures.
	my $object;
	my %seenhash=();
	foreach $object (ThingList::All()) {
		if ($object) {
			$seenhash{'Db->FindByNum('.$object->id.')'} = $object;
		}
	}
	$dumper->Seen(\%seenhash);

	# Save to temp file first.
	open (DUMP_OUT,">$newfn") || return Error->new("Db write error: $!");
	if ($reason) {
		$reason=~s/\n/ /g;
		print DUMP_OUT "# $reason\n";
	}
	print DUMP_OUT "# Dump of perlmoo database on ".localtime()."\n".
		"Db::Version('$currentversion');\n";
	foreach $object (ThingList::All()) {
		next if !$object || $object->nodump;
		print DUMP_OUT "Db::MakeThing('".ref($object)."', id => ".$object->id.");\n";
	}
	foreach $object (ThingList::All()) {
		next if !$object || $object->nodump;
		$dumper->Values([$object->all]);
		$dumper->Names(['$temp']);
		print DUMP_OUT $dumper->Dumpxs; # TODO: detect if this isn't supported.
		print DUMP_OUT "\$Db->FindByNum(".$object->id.")->merge_all(\$temp);\n\n";
	}
	print DUMP_OUT "\n1\n";
	close DUMP_OUT || return Error->new("Error closing new db file: $!");
	
	# Now, rename the file.
	rename($newfn,$fn) || return Error->new("Error renaming $newfn to $fn: $!");

	return 1;
}

# Loads up the database from the passed file.
sub LoadFromFile {
	my $file=shift;

	if (! -e $file) {
		return Error->new("$file does not exist.");
	}
	if (! -r $file) {
		return Error->new("$file is not readable.");
	}

	Version("0"); # assume worst case.
	require $file;
}

# The db calls this when it's loading to construct a new thing. Pass thing
# type as a string, plus any parameters to pass on to the thing's constructor.
sub MakeThing {
	my $type=shift;

	my %params=@_;
	if ($params{id} && ThingList::FindByNum($params{id})) {
		ThingList::FindByNum($params{id})->merge_all(\%params);
		# Ensure correct type.
		if (ref ThingList::FindByNum($params{id}) ne $type) {
			require "$type.pm";
			bless(ThingList::FindByNum($params{id}),$type);
		}
	}
	else {
		require "$type.pm";
		$type->new(@_);
	}	
}

# Version checking stuff.
{
	my $dbversion=undef;

	# Call after loading the database.
	# Returns true if the database's version will work ok still.
	sub TestVersion {
		# FIXME: why do I need an explicit reference into this package here?
		return 1 if ($dbversion == $currentversion);
	}		

	# Get/set version.
	sub Version {
		my $version=shift;
		if (defined($version)) {
			$dbversion=$version;
		}
		return $dbversion;
	}
}

# Fork a new copy of the moo to do the dump in the background.
# Pass it the reason to dump, the number of backups to keep, and an optional
# filename to dump to.
# If passed a fourth parameter that is true, doesn't fork. Only do that
# if you're ready to stop the whole server during the dump, and log all users
# off, and exit!
#
# This will not allow 2 children to dump at once. If a child is already
# dumping, it won't fork a new one, and it will return undef. Normally it
# returns the pid of the child it forks.
{
	my $childpid=undef;

	sub DumpDb {
		my $reason=shift;
		my $numbackups=shift;
		my $fn=shift || "db.pl";
		my $nofork=shift;
	
		if (!$nofork) {
			# Test to see if a child is running.
			if ($childpid && ! waitpid($childpid,&WNOHANG)) {
				Utils::Log("notice","Not forking a db dumper because child $childpid is already running ($reason).");
				return undef;
			}
			else {		
				Utils::Log("notice","Forking a db dumper ($reason).");
				$childpid=fork;
				return $childpid if $childpid; # parent
			}
		}

		Utils::Log("notice","Dumping database to $fn.");

		# First, rotate any backup databases we kept.
		my $x;
		for ($x=$numbackups - 1; $x > 0; $x--) {
			rename("$fn.$x", "$fn.".($x+1));
		}
		if ($numbackups > 0) {
			rename("$fn", "$fn.1");
		}
		
		# Need wizard perms.
		my $wiz=Utils::SuWizard();
	
		my $ret=Db::DumpToFile("$fn", "$reason");
		if (Error::iserror($ret)) {
			Utils::Log("notice",$ret->message);
		}
		else {
			Utils::Log("notice","Database dump complete.");
		}
		
		if (!$nofork) {
			exit;
		}
	}
}	

1