#!/usr/bin/perl
# There is a lot of duplicaton between this and its super method in avatar.
# I decided just to duplicate the code, because of speed and simplicity
# issues.
# 
# Programmers have identical code, except some of the sanity checks are
# ifdefed out. This file is processed for the ifdefs to produce the
# programmer's safechange method.
#
#use Mooix::Thing;
#use Fcntl q{:flock};
#use Mooix::Root;
use warnings;
use strict;
my @objs; # newly created objects, for backreferences
run sub {
	my $this=shift;
	
	my ($object, $field, %params, @ret);
	
	my $process_fieldspec = sub {
		if (defined $object && ! ref $object && length $object) {
			my $br=backref($object);
			if (! defined $br) {
				if ($field eq 'parent') {
					# Failed to create an object. Keep the
					# @objs list consistent.
					push @objs, undef;
				}
				return
			}
			elsif (length $br) {
				$object=$br;
			}
		}
		
		if (defined $object && length $object) {
			if (! defined $field) {
				$this->croak("unspecified field");
			}
			my $ret=validate($this, $field, $object, \%params);
			if (length $ret) {
				push @ret, (0, "$object->$field\: $ret");
				if ($field eq 'parent') {
					# Failed to create an object. Keep the
					# @objs list consistent.
					push @objs, undef;
				}
			}
			else {
				push @ret, change($this, $field, $object, \%params);
			}
		}
	};
	
	my $backref=0;
	while (@_) {
		my $key=shift;
		my $value=shift;
		if ($key eq 'object') {
			$process_fieldspec->();

			$object=$value;
			%params=();
			$field=undef;
		}
		elsif ($key eq 'field') {
			$field=$value;
		}
		elsif ($key eq 'value') {
			if ($backref) {
				my $br = backref($value);
				if (defined $br && ! ref $br) {
					$this->croak("malformed backref, \"$value\"");
				}
				$value=$br;
			}
			push @{$params{$key}}, $value;
			$backref=0;
		}
		elsif ($key eq 'backref') {
			$backref=$value;
		}
		else {
			$params{$key}=$value;
		}
	}
	$process_fieldspec->();

	return @ret;
};
		
# Returns undef if the backref points to an object that failed to be made,
# and "" if the string is not a backref.
sub backref {
	my $s=shift;

	if ($s =~ /^mooix:#(\d+)(\/.*)?$/) {
		my $id=$1;
		my $field=$2;
		if (! defined $field) {
			return $objs[$id - 1];
		}
		else {
			if (ref $objs[$id - 1]) {
				my $dir=$objs[$id - 1]->id."/".$field;
				my $obj=Mooix::Thing->get($dir);
				return $obj ? $obj : "mooix:$dir";
			}
			else {
				return undef;
			}
		}
	}
	else {
		return "";
	}
}

sub getavatar {
	my $a=$Mooix::Root->abstract->avatar;
	if (! ref $a) {
		die "cannot find avatar!";
	}
	return $a;
}

sub splitid {
	my $id=shift;
	my ($dir, $file) = $id =~ m#^mooix:(.+)/([^/]+)/*$#;
	return $dir, $file;
}
	
# Check a change for validity (and maybe munge value and other params).
# Returns empty string if ok, error message on error.
sub validate {
	my $this=shift;
	my $field=shift;
	my $obj=shift;
	my $params=shift;
	
	my $file;
	if (ref $obj) {
		$file=$obj->fieldfile($field);
	}
	
	if ($field eq 'parent') {
		if (! ref $params->{value} || ! @{$params->{value}}) {
			return "Parent object not specified.";
		}

		my $parent = @{$params->{value}}[0];

		if (! ref $parent) {
			return "Bad parent object.";
		}
		
#ifndef programmer		
		if ($parent->isa(getavatar())) {
			return "You cannot create avatars.";
		}
#endif

		# If the obj is a string value, then they want to create a
		# new object.
		if (! ref $obj) {
			# See where the object is to be added.
			my ($edir, $hint) = splitid($obj);
			if (! defined $edir || ! defined $hint ||
			    ! length  $edir || ! length $hint) {
				return "Bad object id.";
			}
			my $encapsulator = Mooix::Thing->get($edir);
			if (! ref $encapsulator) {
				return "Bad object id.";
			}

#ifndef programmer
			# Should be under the portfolio.
			my $portfolio = $this->portfolio;
			my $o=$encapsulator;
			while (ref $o) {
				last if $o == $portfolio;
				$o=$o->encapsulator;
			}
			if (! ref $o) {
				return "You can only create new objects in your portfolio.";
			}
#endif
			
			# Now creating an object is effectively the same
			# as adding a field to its encapsulator, and so 
			# all the checks below need to be done on said
			# field. Unless the encapsulator is a thingset, and
			# newid was passed, then we can skip them since the
			# thingset will decide the id.
			if (! exists $params->{newid} || ! $params->{newid}) {
				$field = $hint;
				$obj = $encapsulator;

				# The new field should not already exist.
				if ($obj->defines($field)) {
					return "Object already exists.";
				}
				# If a parent has a field by this name, it
				# must be an object too.
				$file = $obj->fieldfile($field);
				unless (defined $file && -x $file && -d $file &&
				        -e "$file/.mooix") {
					return "Cannot replace an inherited field with an object.";
				}
				
				# No inheritance, because an object is
				# being added as a field, the field is not
				# being modified.
				$file = $obj->id."/".$field;

			}
			else {
#ifndef programmer
				# Slightly over-strict.
				if ($encapsulator != $portfolio) {
					return "newid used for encapsulator != portfolio";
				}
#endif
				if (! $encapsulator->isa($Mooix::Root->abstract->thingset)) {
					return "newid used for object not a thingset";
				}
				return ""; # valid; skip rest of unnecessary checks
			}
		}
		else {
			# They want to change the parent of an object.
			# I'm not going to try to do it here, there are
			# too many locking issues in doing it safely. The
			# reparent_verb knows how it was called and can do
			# locking safely.
			return "Use the reparent command to change an object's parent.";
		}
	}
	
	if (! ref $obj) {
		return "Expected an object reference, but got a string ($obj).";
	}
	
	
	if (defined $params->{mode}) {
		if ($params->{mode} eq '1644' || $params->{mode} eq '1664') {
#ifndef programmer
			# Builders can make sticky reference fields, but only
			# if not being made directly on their avatars, and
			# the current field (probably inherited) is
			# already a reference.
			if ($obj == $this) {
				return "Cannot modify one of your avatar's references.";
			}
			if (! defined $file) {
				return "Cannot create a new sticky reference list.";
			}
			if (! -k $file && ! (-l $file && -d $file)) {
				return "Cannot turn a field into a sticky reference list.";
			}
#endif
		}
		else {
			# Ignore the high bit, if any, and check to see if the
			# mode allows the owner to read the file. Due to
			# limitations in mood, if a file cannot be read, its
			# permissions cannot be changed, and this check
			# prevents unreadable files from being set up.
			if ((oct($params->{mode}) & ~07000) < 0400) {
				return "The requested mode is not allowed.";
			}

#ifndef programmer
			# Check for executable, setuid, setgid.
			if ((oct($params->{mode}) & ~00666) > 0) {
				return "Invalid mode.";
			}

			# Let's not allow removal of the executable, setuid,
			# or sticky bits either.
			if (defined $file) {
				my $mode=(stat($file))[2] & 01777;
				if (! $mode) {
					return "Permission denied.";
				}
				if (($mode & ~00666) > 0) {
					return "You cannot change the permissions of a method.";
				}
			}
#endif
		}
	}
	
	if (defined $params->{unset}) {
#ifndef programmer
		if ($obj->can($field) ||
		    (defined $file && -f $file && -x $file)) {
			return "You cannot unset a method.";
		}
#endif
		if (! $obj->defines($field)) {
			if ($obj->fieldfile($field)) {
				return "That field is inherited.";
			}
			else {
				return "That field is not set.";
			}
		}
	}
	
	# Validate the value if there is a validation method for this
	# field. If it validates, it is automatically safe.
	my $validator=$field."_validate";
	my $vmeth = $obj->fieldfile($validator);
	if ((ref $params->{value} || defined $params->{unset}) &&
	    defined $vmeth && -x $vmeth) {
		my @ret=$obj->$validator(@{$params->{value}});
		return join(" ", @ret) if $?;
		$params->{value}=\@ret; # validator result becomes new value
		# Note that we allow validators to return object refs.
	}
	else {
		# Otherwise, go on with all checks of the field.

#ifndef programmer
		if ($field =~ /^[_.].*-(safe|opaque)$/) {
			return "Permission denied.";
		}
		
		if ($field =~ /^[_.]/ && defined $file) {
			return "You cannot change private fields.";
		}

		if ($field =~ /\// || $field eq '..') {
			return "Nothing doing!";
		}

		if ($obj == $this && defined $file && (-d $file || -k $file)) {
			return "You cannot change one of your own reference fields.";
		}
		
		if ($obj == $this &&
		    ref $params->{value} && grep ref, @{$params->{value}}) {
			return "You cannot set references on your avatar.";
		}

		my $safefield=".$field-safe";
		if (defined $file && -f $file && -x $file) {
			# They're trying to set a method..
			if (! $obj->$safefield) {
				return "Cannot change a method.";
			}
			if (defined $params->{mode}) {
				return "Cannot change the mode of a method.";
			}
			if ($params->{noexec}) {
				return "Cannot change a method.";
			}
		}
		else {
			# Notice if there's a .field-safe with a false value.
			my $safefile=$obj->fieldfile($safefield);
			if (defined $safefile && -e $safefile && ! $obj->$safefield) {
				return "You cannot change that field.";
			}
		}
		
		# Perl internal methods..
		if ($obj->can($field)) {
			return "Cannot change a method.";
		}

		if (defined $file && -l $file) {
			# Changing a reference is allowed, but the vew
			# value must also be a reference.
			if (! ref $params->{value} ||
			    grep ! ref, @{$params->{value}}) {
				return "Cannot convert a reference to a string.";
			}
		}
		elsif (defined $file && -e $file && ! -f $file) {
			return "You cannot change that field, whatever it is.";
		}
#endif
	}

	return ""; # valid
}

# Do a change, returns a result pair.
sub change {
	my $this=shift;
	my $field=shift;
	my $obj=shift;
	my $params=shift;

	my $ret;
	
	if ($field eq 'parent') {
		# Creating a new object (parent changing is not supported
		# by this method).
		my $parent = @{$params->{value}}[0];
		my ($edir, $hint) = splitid($obj);
		my $encapsulator = Mooix::Thing->get($edir);
	    
		if (exists $params->{newid} && $params->{newid}) {
			# Adding to a thingset.
			my $id = $encapsulator->newid(mkdir => 1, hint => $hint);
			if ($id) {
				$obj = $parent->new(id => $id, owner => $this, noinit => 1);
			}
		}
		else {
			$obj = $encapsulator->create(
				id => $hint,
				parent => $parent,
				owner => $this,
				noinit => 1
			);
		}

		# Add to list for backrefs, even if no object was made.
		push @objs, ref $obj ? $obj : undef;
			
		if (! ref $obj) {
			return 0, "Failed to create object.";
		}

		# Don't fall through to the mode setting code below;
		# that's not supported for object dirs.
		return (1, $obj);
	}
	elsif (ref $params->{value} || defined $params->{unset}) {
		my $lock=$obj->getlock(LOCK_EX, $field);
		my @oldval=$obj->safegetfield($field);
		
		# Note that there might be a value when unsetting if the
		# validate method was caled, and returned a value. Or it
		# might have returned nothing, to indicate go ahead and
		# unset it.
		if (defined $params->{unset} && ! ref $params->{value} ||
		    ! @{$params->{value}}) {
			# Unset.
			my $file=$obj->id."/".$field;
			if (defined $file && -e $file) {
				$obj->deletefield($field) ||
					return 0, "Permission denied.";
			}
			$ret='';
		}
		elsif (ref $params->{value}) {
			if (defined $params->{mode} && @{$params->{value}} == 1 &&
			    ($params->{mode} eq '1644' || $params->{mode} eq '1664')) {
				# The special case of being asked to set
				# up a sticky reference list of only one
				# element. Have to fool setfield into not
				# just making a symlink..
				$ret=$obj->setfield($field, @{$params->{value}}, "");
				# .. it'll be turned sticky below.
				$ret=Mooix::Thing->get($ret);
			}
			else {
				# Set.
				my $safefield=".$field-safe";
				if ($obj->$safefield) {
					$?=0;
					$ret=eval { $obj->$field(@{$params->{value}}) };
					if ($@) {
						return 0, "Permission denied.";
					}
				}
				else {
					# setfield is method and etc safe
					$ret=$obj->setfield($field, @{$params->{value}});
				}
			}
			if ($?) {
				return 0, "Permission denied.";
			}
		}
		
		# Run onset method if there is one.
		my $onset=$field."_onset";
		my $onsetfile=$obj->fieldfile($onset);
		if (defined $onsetfile && -e $onsetfile) {
			$obj->$onset(@oldval);
		}
	}
	
	if (defined $params->{mode}) {
		if (! $obj->setmode(field => $field, mode => $params->{mode})) {
			return 0, "Unable to set mode of $field.";
		}
		$ret=$params->{mode} unless defined $ret;
	}
	
	# TODO atime and mtime setting.
	
	return (1, $ret);
}
