#!/usr/bin/perl
#use Mooix::Thing;
#use Mooix::Root;
use warnings;
use strict;
			
my $maxfieldname=8;
sub pp {
	my $field=shift;
	my $value=shift;
	return $field." ".(" " x ($maxfieldname - length $field)).$value;
}

run sub {
	my $this=shift;
	%_=@_;

	if (! grep ref, $this->objects) {
		return; # error
	}
	
	# Set fields that will go into serialisation.
	# This also serves as a test to see if the caller can modify the
	# package. We don't want non-package owners getting dumps of the
	# objects in it.
	eval { $this->dbversion($Mooix::Root->system->mooinfo->dbversion) };
	if ($@) {
		return; # error
	}
	$this->mooname($Mooix::Root->system->mooinfo->mooname);
	$this->hostname($Mooix::Root->system->mooinfo->hostname);
	$this->date(scalar localtime);
	$this->format($this->format); # force into serialisation
	$this->installs(Mooix::Thing->prettylist(grep ref, $this->objects));
	
	# Get all the serialisations.
	my @s = $this->serialise;
	foreach my $obj (grep { ref $_ && $_ != $this } $this->objects) {
		push @s, $obj->serialise;
	}

	# Get backreference list. (Actually, they're just local references;
	# can be forward references too..)
	my $stanza=0;
	my %backref;
	for (my $c=0; $c < @s; $c+=2) {
		if ($s[$c] eq 'object') {
			if (! exists $backref{$s[$c+1]->index}) {
				$backref{$s[$c+1]->index} = "mooix:#".++$stanza;
			}
		}
	}
	
	# Convert serialisation to object hash. Also determine width of
	# longest fieldname in any object, and munge references.
	my (@objects, %objects, $object, $field, $skip, $isref);
	while (@s) {
		my $key=shift @s;
		my $value=shift @s;

		if ($key eq 'object') {
			$object=$value;
			push @objects, $object unless exists $objects{$object};
			$field="";
		}
		elsif ($key eq 'field') {
			$field=$value;
			# Just in case an object got into the serialisation
			# stream twice (as happens when the package
			# contains itself), make sure we don't end up with
			# doubled fields by deleting the old one.
			if ($field eq 'parent') {
				delete $objects{$object}
			}
			$skip=0;
			$isref=0;
			if (length $field > $maxfieldname) {
				$maxfieldname=length $field;
			}
			$objects{$object}->{empties}->{$field} = 1;
		}
		elsif ($key eq 'value') {
			delete $objects{$object}->{empties}->{$field};
			
			# Skip some fields of the package object.
			if ($object == $this &&
			       ($field eq 'mass' || 
				$field eq 'volumne' ||
				$field eq 'hitpoints' ||
				$field eq 'data')) {
				$skip=1;
				next;
			}

			if (ref $value) {
				# Reference munging.
				if (exists $backref{$value->index}) {
					$value = $backref{$value->index};
				}
				elsif ($field eq 'location' ||
				       $field eq 'owner') {
					# Skip owner and location fields
					# if they're not objects in the
					# package.
					$skip=1;
					next;
				}
				elsif ($value =~ /^\Q$Mooix::Root\E(.*)/) {
					$value="mooix:ROOT".$1;
				}
				$value="$value"; # stringify
				$isref=1;
			}
			elsif ($value !~ /^\w+$/) {
				# quote values that are not simple words
				$value='"'.$value.'"';
			}
			else {
				$value=$value;
			}
			push @{$objects{$object}->{fields}->{$field}}, $value;
		}
		elsif ($key eq 'mode') {
			next if $skip;
			# Skip standard modes for references and regular
			# fields. Not for sticky reference lists, since the
			# mode is all that makes it what it is.
			if ($isref) {
				next if $value == 755;
			}
			else {
				next if $value == 644;
			}
			$objects{$object}->{mode}->{$field} = $value;
		}
	}

	# Generate data.
	my @data;
	foreach my $object (@objects) {
		my ($base) = $object =~ m#.*/([^/]+)#;
		
		push @data, "" if @data; # blank line
		push @data, "[$base]";

		# Encapsulated objects need to tell what object they're
		# within.
		if ($object->encapsulator && $backref{$object->encapsulator->index}) {
			push @data, pp("(in)", $backref{$object->encapsulator->index});

		}
		
		foreach my $field (sort keys %{$objects{$object}->{fields}},
				        keys %{$objects{$object}->{empties}}) {
			# If the object location is not included, skip the
			# preposition field too, to save space.
			if ($field eq 'preposition' && 
			    ! defined $objects{$object}->{fields}->{location}) {
				next;
			}
			if (exists $objects{$object}->{fields}->{$field}) {
				foreach my $value (@{$objects{$object}->{fields}->{$field}}) {
					push @data, pp($field, $value);
				}
			}
			elsif ($field ne '.mooix' || exists $objects{$object}->{mode}->{$field}) {
				# Display empty fields too, except the
				# .mooix field can be omitted, if it has no
				# special permissions.
				push @data, pp($field, "");
			}

			if (exists $objects{$object}->{mode}->{$field}) {
				push @data, pp("(mode)", $objects{$object}->{mode}->{$field});
			}
		}
	}
	return @data;
};
