#!/usr/bin/perl
# Given a database, try to convert it to new format.

use vars qw{$sourcedir $dbdir};
use UNIVERSAL qw(isa);
$dbdir="./db";

# Source config file.
foreach ('./',$ENV{HOME}.'/.','/usr/local/etc/','/etc/') {
	if (-e "${_}perlmoo.conf") { do "${_}perlmoo.conf" ; last }
}
push @INC,$sourcedir if $sourcedir;

require Db;
require Thing;
require ThingList;
require Wizard;
require Generics;

my $fn=shift || "$dbdir/db.pl";

print "Loading standard perlmoo base db..\n";
require "basedb.pl";

# Store the generic help object, which might be clobbered - the db used to 
# have something else as object #13.
my $genhelp=ThingList::FindByNum(13);
# In fact, let's remove it entirely.
ThingList::remove($genhelp);

print "Loading $fn..\n";
Db::LoadFromFile($fn);

my $wizard=Wizard->new;
$wizard->nodump(1);
ActiveUser::setactive($wizard);

$dbversion=Db::Version();
print "Seems to be a version $dbversion database.\n";
if ($dbversion < 5) {
	exit print STDERR "** I can't deal with a database format this old. I'm sorry, you'll probably have to re-make your database from scratch. :-(\n";
}

if ($dbversion < 6) {
	print STDERR "** You may want to remove the example ball object, #13, from your database. It's no longer part of the perlmoo core.\n";
}

if ($dbversion < 8) {
	# Object number 13 is now taken by the generic help object. If we have
	# an old object #13, relocate it.
	my $num13=ThingList::FindByNum(13);
	if ($num13) {
		ThingList::remove($num13);
		my $newid=ThingList::GetId();
		print STDERR "** Moving old object #13 to #$newid to make way for generic help object.\n";
		$all=$num13->all;
		$$all{id}=$newid;
		$num13->all($all);
		ThingList::add($num13);
		ThingList::add($genhelp);
	}
	
	# The default description of the LoginRoom changed now that we have help.
	my $lr=ThingList::FindByType('LoginRoom');
	if ($lr) {
		print STDERR "** Updating login room description.\n";
		my $lrd=$lr->description;
		$lrd=~s!See http://kitenet.net/programs/perlmoo/workdir/README.basics for basic commands!Once you log in, type "help intro" to get started!ig;
		$lr->description($lrd);		
	}
	
	# Aliases were a hash. They're a list now.
	print STDERR "** Changing aliases property from hash to list.\n";
	my $thing;
	foreach $thing (ThingList::All()) {
		my $aliases=$thing->aliases;
		if (ref($aliases) eq 'HASH') {
			my @aliases=(keys %$aliases);
			$thing->aliases([@aliases]);
		}
	}
}
else {
	# Need to merge in anything that's new in the the help object
	# from basedb.pl - which we didn't let merge above.
	if ($genhelp) {
		my $all=$genhelp->all;
		# FIXME: this is sorta backwards. I'm letting the help
		# texts from basedb.pl overwrite whatever changes the
		# user may have made. I'm still updating those texts a lot,
		# so I guess that's ok. The real fix is outlined in the TODO
		# file.
		my $newhelp=ThingList::FindByType('HelpObject');
		if ($newhelp) {
			$newhelp->merge_all($all);
		}
	}
}

if ($dbversion < 9) {
	# $loginroom generics specification was accidentially null.
	my $generic=ThingList::FindByType('Generics');
	if ($generic) {
		my $genlogin=$generic->findgeneric('loginroom');
		if (!$genlogin) {
			print STDERR "** Fixing \$loginroom generic object specification.\n";
			my $genlogin=ThingList::FindByType('LoginRoom');
			$generic->loginroom_gen($genlogin);
		}
	}
}

if ($dbversion < 10) {
	# Guests may have not been deleted properly when the moo shut down.
	my @guests=ThingList::FindByType('Guest');
	if (@guests) {
		print STDERR "** Removing stale guests.\n";
		foreach (@guests) {
			$_->remove;
		}
	}
}

if ($dbversion < 11) {
	# Programmers used to have less perms.
	my @programmers=ThingList::FindByType('Programmer');
	print STDERR "** Allowing programmers to use rand.\n";
	foreach (@programmers) {
		$_->compartment->permit_only(qw{:default entereval rand});
	}
}

if ($dbversion < 12) {
	# Objects may have had bogus tell property set accidentially, which
	# it's a good idea to delete.
	print STDERR "** Removing tell properties.\n";
	foreach (ThingList::All()) {
		# Have to do this the hard way.
		$all=$_->all;
		delete $$all{'tell'};
		$_->all($all);
	}
}

if ($dbversion < 13) {
	# Verbs used to be represented as a hash by command name and
	# arguemnts. Now it's just by command name.
	print STDERR "** Changing how verbs are stored in the database.\n";
	foreach (ThingList::All()) {
		my @verbs=$_->listverbs;
		$_->verbs({});
		my $v;
		foreach $v (@verbs) {
			$_->addverb($v) if $v;
		}
	}

	# That change forced me to change how the look verbs are defined..
	my $generic=ThingList::FindByType('Generics');
	if ($generic) {
		my $genroom=$generic->findgeneric('room');
		print STDERR "** Removing look verb defintions and help.\n";
		foreach (ThingList::All()) {
			if ($_ != $genroom) {
				# Check to see if this is a normal look defintion.
				# If it's calls something other than verb_look,
				# it may be calling an in-db look verb, and if so
				# we want to keep it.
				my $verb=$_->removeverb("l*ook");
				if ($verb && $verb->sub ne 'verb_look') {
					$_->addverb($verb);
				}
				
				$_->removehelp("look");
			}
		}
		print STDERR "** Updating generic room look verb definition.\n";
		$genroom->addverb(Verb->new(
			sub => 'verb_look',
			command => 'l*ook',
			direct_object => 'any',
			preposition => 'any',
			indirect_object => 'any',
		));
		
		# The go verb had a bad prototype.
		my $genexit=$generic->findgeneric('exit');
		print STDERR "** Fixing go verb prototype on generic exit.\n";
		$gen_exit->addverb(Verb->new(
			sub => 'verb_go',
		        command => 'go',
		        direct_object => 'this',
		        preposition => 'any',
		        indirect_object => 'any',
		));
	}
}

open (IN,$fn) || die "$fn $!";
open (OUT,">$fn.old") || die "$fn.old $!";
while (<IN>) {
	print OUT $_;
}
close IN;
close OUT;

print "Saving to $fn\n";
Db::DumpToFile("$fn");
