#!/usr/bin/perl
#use Mooix::Thing;
#use Mooix::Root;
use warnings;
use strict;

# Just a list of object id numbers. The ids are alocated sequentially, in
# the order objects appear in the data file.
my @objects;

# A complex nasted has structure that holds all the data about all the
# objects. Objects are keyed using the object id numbers.
my %objects;

# Collects warnings to return.
my @warnings;

# Given something that might be an object reference, see if it is just a
# reference to a scalar. If so, convert it the number of the object in the
# @objects hash that matches the scalar.
sub objref {
	my $offset=shift;
	my $ref=shift;
	if (ref $ref eq "SCALAR") {
		for (my $i=0; $i < @objects; $i++) {
			if ($objects[$i] == $$ref) {
				return $i+$offset;
			}
		}
		return "";
	}
	return $ref;
}

# Given a value that might be an object reference, return a set of commands
# suitable for serialisation, like value => $value, with the backref flag
# set if necessary.
sub serval {
	my $val=shift;
	if (ref $val eq "SCALAR") {
		for (my $i=0; $i < @objects; $i++) {
			if ($objects[$i] == $$val) {
				return (backref => 1, value => "mooix:#".$i);
			}
		}
		return value => "";
	}
	return value => $val;
}

# Given a list of object ids, rearranges them so that encapsulated objects
# come after their encapsulators, and so that child objects come after
# their parents. If there are cycles or conflicts, adds to @warnings, and
# discards all objects in the cycle. Returns the ordered list of object
# ids.
sub order {
	my @in=@_;
	my @out;
	
	# If course this is really just a topological sort of a graph.
	# Build directed graph.
	my %edges;
	foreach my $id (@in) {
		foreach my $parent (@{$objects{$id}->{fields}->{parent}}) {
			push @{$edges{$id}}, objref(1, $parent);
		}
		if (exists $objects{$id}->{encapsulator}) {
			push @{$edges{$id}}, objref(1, $objects{$id}->{encapsulator});
		}
	}

	# Topo-sort the graph, until all done or only cycles remain.
	my %unseen = map { $_ => 1 } @in;
	my (%done, $cycle);
	do {
		$cycle=1;
		foreach my $item (@in) {
			next if $done{$item} ||
			        grep $unseen{$_}, @{$edges{$item}};
			delete $unseen{$item};
			push @out, $item;
			$done{$item}=1;
			$cycle=0;
		}
	} while (keys %unseen && ! $cycle);

	# Any items with cycles are left in %unseen.
	if (%unseen) {
		push @warnings, "The following objects had cycles, and will be ignored: ".
			join(", ", map { $objects{$_}->{fieldname} } keys %unseen)." ".
			"Perhaps the data is corrupt?";
	}
	
	return @out;
}

run sub {
	my $this=shift;
	%_=@_;
	
	my $destination = $_{destination};
	if (! ref $destination) {
		$destination = $this;
	}
	
	my @lines;
	while (@_) {
		my $key=shift;
		my $value=shift;
		if ($key eq 'line') {
			push @lines, $value;
		}
	}

	# Populate object hash, and unmunge references.
	my ($id, $lastfield);
	my $linenum=0;
	my $objnum=0;
	foreach my $line (@lines) {
		$linenum++;
		
		$line =~ s/^\s+//;
		$line =~ s/\s$//;

		if ($line =~ /^\[(.*)\]$/) {
			my $fieldname=$1;
			$id=++$objnum;
			push @objects, $id;
			$objects{$id}->{fieldname} = $fieldname;
		}
		elsif ($line =~ /^([^\s]+)(?:\s+(.*))?/) {
			my $field=$1;
			my $value=$2;

			if (! defined $id) {
				push @warnings, "Data before header on line $linenum.";
				next;
			}
			
			if (defined $value) {
				if ($value =~ /^"(.*)"$/) {
					$value=$1;
				}
				elsif ($value =~ /^mooix:#(\d+)$/) {
					my $a=$1; # stupid perl...
					$value=\$a;
				}
				elsif ($value =~ /^mooix:(.*)/) {
					if ($value =~ /^mooix:ROOT(.*)/) {
						$value=$Mooix::Root.$1;
					}

					my $obj = Mooix::Thing->get($value);
					if (! ref $obj) {
						push @warnings, "Field $field refers to a nonexistant object, \"$value\", on line $linenum.";
					}
					$value=$obj;
				}
			}

			if ($field eq '(in)') {
				if (ref $value) {
					$objects{$id}->{encapsulator} = $value;
				}
				else {
					push @warnings, "Bad encapsulator on line $linenum.";
				}
			}
			elsif ($field eq '(mode)') {
				$objects{$id}->{modes}->{$lastfield} = $value;
			}
			elsif ($field =~ /^\(.*\)$/) {
				push @warnings, "Ignoring unrecognised control field, \"$field\", on line $linenum.";
			}
			else {
				push @{$objects{$id}->{fields}->{$field}}, $value;
			}
			
			$lastfield=$field;
		}
		elsif ($line ne "") {
			push @warnings, "Cannot parse line $linenum.";
		}
	}
	
	if (! @objects) {
		return; # parse error
	}
	
	# Scan for very broken objects.
	my @o;
	foreach my $id (@objects) {
		if (! $objects{$id}->{fields} ||
		    ! $objects{$id}->{fields}->{parent}) {
			push @warnings, "Object \"".$objects{$id}->{fieldname}.
				"\" has no parent field.";
		}
		elsif (grep { ! objref(0, $_) } @{$objects{$id}->{fields}->{parent}}) {
			push @warnings, "Object \"".$objects{$id}->{fieldname}.
				"\" has a broken parent reference.";
		}
		else {
			push @o, $id
		}
	}

	# Order objects for output, with header always first, rest have
	# parents and encapsulators first.
	@objects=(1, order grep { $_ != 1 } @o);
	
	# Generate the serialisation in two passes. The first makes all the
	# objects, and the second populates them.
	my @s;
	my $destset = ref $destination && $destination->isa($Mooix::Root->abstract->thingset);
	foreach my $id (@objects) {
		# Work out the destination object id.
		my $destid = $destination."/".$objects{$id}->{fieldname};
		if (exists $objects{$id}->{encapsulator}) {
			$destid="mooix:#".objref(0, $objects{$id}->{encapsulator}).
				"/".$objects{$id}->{fieldname};
		}
		$objects{$id}->{destid}=$destid;
		
		# First, create the object, by outputting a stanza for its
		# parent field.
		push @s, object => $destid;
		push @s, field => "parent";
		foreach my $parent (@{$objects{$id}->{fields}->{parent}}) {
			push @s, serval($parent);
		}

		if ($destset && ! $objects{$id}->{encapsulator}) {
			push @s, newid => 1;
		}
	}
	my $s=0;
	foreach my $id (@objects) {
		foreach my $field (keys %{$objects{$id}->{fields}}) {
			next if $field eq 'parent';
			if ($id == 1) {
				# Use absolute refs for the header, always,
				# for simplicity.
				push @s, object => $objects{$id}->{destid};
			}
			else {
				# Use relative refs for all other objects,
				# since their destination may be used only
				# as a hint.
				push @s, object => "mooix:#$s";
			}
			push @s, field => $field;
			foreach my $value (@{$objects{$id}->{fields}->{$field}}) {
				# Undef values are for empty fields.
				next unless defined $value;
				push @s, serval($value);
			}
			
			if (exists $objects{$id}->{modes}->{$field}) {
				push @s, mode => $objects{$id}->{modes}->{$field};
			}
		}
		$s++
	}

	push @s, map { (warning => $_) } @warnings;
	
	return @s;
}
