#!/usr/bin/perl
# For installing something, like a package. Has to be a verb of the avatar
# so it can call safechange with a small enough callstack to succeed in
# adding objects to the portfolio.
# 
# Can be used on objects that have an install method.
#use Mooix::Thing;
#use Mooix::Verb;
#use Mooix::Root;
use warnings;
use strict;
run sub {
	my $this=shift;
	%_=@_;
	my $package = $_{direct_object};
	my $session = $_{session};
	my $destination = $this->portfolio;
	
	if (! $destination) {
		fail "You have no portfolio.";
	}
	
	if (! ref $package) {
		fail "direct object required";
	}

	if (! $package->implements('install')) {
		exit Mooix::Verb::SKIP;
	}

	# Get the serialisation for the package contents.
	my @s = $package->install(destination => $destination, session => $session);
	if (! @s) {
		fail "Install failed.";
	}

	# Look through the serialisation:
	# Make sure it only adds objects, and does not modify existing objects.
	# For each stanza, work out if it creates an object, and record
	# that in an array.
	# Also, remove any owner settings, store them for later.
	# Setting owners before the objects are all the way set up can
	# prevent the avatar from being able to write to the object.
	my (@s_owners, @s_rest, @stanza);
	my $newid=0;
	
	my @newobj_stanzas;
	my $stanza=0;

	my ($obj, $field);

	my $process=sub {
		return unless defined $obj;
		if ($newid) {
			# Don't let an object be added outside the
			# destination, say to some other thingset.
			my $id=$obj;
			if (! ($id =~ s/^$destination\/+//) || $id =~ /\//) {
				fail "The package wants to add an object to something that is not your portfolio. Not allowing this unsafe operation.";
			}
		}
		else {
			if (ref Mooix::Thing->get($obj)) {
				fail "The package seems to want to modify an existing object ($obj). Not allowing this unsafe operation.";
			}
		}

		if ($field eq 'owner') {
			push @s_owners, @stanza;
		}
		else {
			push @s_rest, @stanza;
		}

		$newobj_stanzas[$stanza++] = ($field eq 'parent');
	};

	for (my $i=0; $i < @s; $i+=2) {
		if ($s[$i] eq 'object') {
			$process->();
			$obj=$s[$i+1];
			$field=undef;
			$newid=0;
			@stanza=();
		}
		elsif ($s[$i] eq 'field') {
			$field=$s[$i+1];
		}
		elsif ($s[$i] eq 'newid') {
			$newid=$s[$i+1];
		}
		
		push @stanza, $s[$i], $s[$i+1];
	}
	$process->();
	
	# Pass the serialisation (sans owners) on to safechange, to
	# actually create the objects. Parse results for both newly created
	# objects, and warnings.
	my @ret = $this->safechange(@s_rest);
	if (! @ret) {
		fail "Install failed.";
	}
	my @newobjs;
	$stanza=0;
	while (@ret) {
		my $stat = shift @ret;
		my $msg = shift @ret;

		if ($newobj_stanzas[$stanza++]) {
			push @newobjs, ref $msg ? $msg : '';
		}
		
		if (! $stat) {
			$session->write("Warning: $msg");
		}
	}
	
	# Now the new objects must be initted, and upgraded to the current
	# moo dbversion. Which should come first is hard to say, I have put
	# init first.
	foreach my $obj (grep ref, @newobjs) {
		if (! $obj->init) {
			$session->write("$obj failed to init");
		}
	}
	if ($package->dbversion < $Mooix::Root->system->mooinfo->dbversion) {
		foreach my $obj (grep ref, @newobjs) {
			if (! $obj->upgrade(oldversion => $package->dbversion)) {
				$session->write("$obj failed up upgrade");
			}
		}
	}
	
	# Now that the objects are all set up, fix up the owners.
	if (@s_owners) {
		# This is tricky because the serialisation probably uses
		# mooix:#n backreferences to the objects created. Since
		# it's broken in two, those won't work. Go through and fix
		# them up to use real references.
		my @s_munged;
		while (@s_owners) {
			my $key = shift @s_owners;
			my $value = shift @s_owners;
			
			if ($value =~ /^mooix:#(\d+)$/) {
				$value = $newobjs[$1 - 1];
			}
			if ($key ne 'backref') {
				push @s_munged, $key, $value;
			}
		}
		
		@ret = $this->safechange(@s_munged);
		if (! @ret) {
			$session->write("Failed to set owner links properly.");
		}
		while (@ret) {
			my $stat = shift @ret;
			my $msg = shift @ret;
			
			if (! $stat) {
				$session->write("Warning: $msg");
			}
		}
	}
	
	# Top-level, newly created objects.
	my @toplevel=grep { ref && $_->encapsulator == $this->portfolio } @newobjs;
	
	if (! @toplevel) {
		fail "Install failed.";
	}
	
	# Move objects with no location to the avatar.
	foreach my $obj (@toplevel) {
		if (! $obj->location) {
			if (! $obj->physics->move(object => $obj, to => $this)) {
				# Maybe they cannot hold it?
				$obj->physics->move(object => $obj, to => $this->location);
			}
		}
	}
	
	# Final message.
	my @refstrings = $this->refstring(@toplevel);
	$session->write("Installed ".
		join(" and ", map { 
				$_->prettyname." (".shift(@refstrings).")"
			} @toplevel).
		".");
	
	# Make "it" or "them" point to the new objects.
	print "$_\n" foreach @toplevel;
	exit Mooix::Verb::SETITREF;
}
