#!/usr/bin/perl
use strict;
use warnings;
use Mooix::Root;
use Getopt::Long;
use Cwd q{realpath};

sub usage {
	print STDERR <<EOF;
Usage: mooupgrade [object] [options]
   object          An object to upgrade. Defaults to upgrading root.
   -q, --quiet     Only display error messages.
   -r, --recurse   Walk and upgrade objects from start object.
   -s, --skip=dir  Do not upgrade objects that are under a given directory.
EOF
	exit 1;
}

my $quiet=0;
my $recurse=0;
my $start=$Mooix::Root;
my $skipdir='';
GetOptions(
	'quiet|q', \$quiet,
	'recurse|r', \$recurse,
	'skip|s=s', \$skipdir,
) || usage();

my $oldversion=$Mooix::Root->system->mooinfo->dbversion;
my $newversion=$Mooix::Root->system->mooinfo->parent->dbversion;

if (@ARGV) {
	$start=Mooix::Thing->get(shift) || die "bad start object\n";
}

if (length $skipdir) {
	$skipdir=realpath($skipdir);
}

sub note {
	print "mooupgrade: @_\n" unless $quiet;
}
sub warning {
	print STDERR "mooupgrade warning: @_\n";
}

# Object moves are done in three steps. First, the object is removed, and
# replaced with a link to the new location. Then, during the upgrade,
# derived objects upgrade methods change their parents to the new object.
# Finally, at the end, the links from old to new are removed.
my @movedobjslinks;
sub moveobj {
	my $old=$Mooix::Root->id."/".shift;
	my $new=$Mooix::Root->id."/".shift;

	rmobj($old);
	if (-e $old) {
		die "mooupgrade failure: clean up $old and retry\n";
	}
	symlink($new, $old) || die "symlink $new $old($!)";
	push @movedobjslinks, $old;
}

sub finishmoves {
	foreach (@movedobjslinks) {
		unlink($_) || warn "unable to unlink $_ ($!)";
	}
}

# This will fail if the object has other files in its dir, from local
# modifications.
sub rmobj {
	my $dir=shift;
	
	if (-d $dir && ! -l $dir) {
		unlink("$dir/.mooix", "$dir/parent");
		rmdir($dir) || warn "unable to rmdir $dir ($!)";
	}
	elsif (-e $dir) {
		unlink($dir) || warn "unable to remove $dir ($!)";
	}
}

if ($oldversion > $newversion) {
	die "Downgrades not supported (from $oldversion to $newversion)!\n";
}
elsif ($newversion == $oldversion) {
	note "Old version is same as new, doing nothing.";
	# note current version so upgrades don't change it
	updateversion();
	exit;
}

my %done;

sub doobj {
	my $obj=shift;
	return if $done{$obj->index};

	if (length $skipdir && realpath($obj->id) =~ /^\Q$skipdir\E/) {
		note "skipped $obj";
	}
	else {
		if (36 > $oldversion && $obj->defines("contents") && ref $obj->contents && 
			$obj->isa($Mooix::Root->concrete->container) &&
			(! $obj->isa($Mooix::Root->concrete->room) ||
			 $obj->isa($Mooix::Root->concrete->furniture))) {
			# Containers changed to use the contentslist class. Rooms
			# did not, but the "room" subclass of furniture did.
			$obj->contents->parent($Mooix::Root->abstract->contentslist);
		}
	
		if (! $obj->implements("upgrade")) {
			warning "$obj does not implement the upgrade method, or is broken\n";
		}
		elsif (! $obj->upgrade(oldversion => $oldversion)) {
			warning "upgrading $obj failed!";
		}
		else {
			note "upgraded $obj";
		}
	}

	$done{$obj->index}=1;

	if ($recurse) {
		my @objects = grep { ref $_ eq "Mooix::Thing" }
		              map { -e $obj->id."/$_" && ( -d _ || ! -x _ ) ? $obj->$_ : undef }
			      $obj->fields;
		doobj($_) foreach (@objects);
	}
}

# Stuff that must be done before the main upgrade.

# Heartbeat object used to have the wrong parent.
if (9 > $oldversion) {
	my $heartbeat=$Mooix::Root->system->heartbeat;
	$heartbeat->parent($Mooix::Root->system->parent->heartbeat);
}

# mooamdin's contents list used to be messed up
if (12 > $oldversion) {
	my $ac=$Mooix::Root->system->admin->contents;
	chmod 0775, $ac->id;
	chmod 0664, $ac->id."/watermark";
	$ac->owner($Mooix::Root->system->admin);
}

if (27 > $oldversion) {
	# Roomcontents object went away.
	rmobj($Mooix::Root->id."/abstract/roomcontents");
}

if (48 > $oldversion) {
	# python_duck moved
	rmobj($Mooix::Root->id."/contrib/python_duck");
}

# entrance and dormitory's contents objects did not have owners set.
if (52 > $oldversion) {
	foreach my $obj ($Mooix::Root->system->entrance,
		         $Mooix::Root->system->dormitory) {
		$obj->contents->owner($obj);
	}
}

if (55 > $oldversion) {
	# single and scripted sessions went away
	foreach my $sess (qw(single scripted)) {
		rmobj($Mooix::Root->id."/abstract/sessions/$sess");
	}
}

if (58 > $oldversion) {
	# filters moved
	moveobj('abstract/messagefilter' => 'filter/base');
	moveobj('abstract/unconsciousness' => 'filter/unconsciousness');
	moveobj('concrete/dark' => 'filter/dark');
}

if (59 > $oldversion) {
	# all the sessions moved
	for my $session (qw(base html log socket tty)) {
		moveobj("abstract/sessions/$session" => "sessions/$session");
	}
	# change parent of encapsulator to something that exists
	# it will be removed later
	unlink($Mooix::Root->abstract->id."/sessions/parent");
	symlink($Mooix::Root->abstract->thingset->id, $Mooix::Root->abstract->id."/sessions/parent");
}

# Here's the main upgrade.
doobj($start);

# Stuff that can't be easily done while the moo is running.
my $init=$Mooix::Root->system->init;
if (7 > $oldversion) {
	# Prior to db version 7, the init object's startuplist and shutdownlist
	# lacked owner fields.
	$init->startuplist->owner($init);
	$init->shutdownlist->owner($init);
}
if (8 > $oldversion) {
	# Add a link to the heartbeat.
	$init->startuplist->add(object => $Mooix::Root->system->heartbeat);
	$init->shutdownlist->add(object => $Mooix::Root->system->heartbeat);
}

finishmoves();

if (59 > $oldversion) {
	# Now that the sessions are gone, and their links are gone, can
	# remove their encapsulator.
	rmobj($Mooix::Root->id."/abstract/sessions");
}

# Finally update the dbversion field of the mooinfo object.
updateversion();

sub updateversion {
	# Unlink exposes the parent's dbversion.
	if ($recurse && $start == $Mooix::Root) {
		$Mooix::Root->system->mooinfo->dbversion($newversion);
	}
}
