#!/usr/bin/perl
#use Mooix::Thing;
#use Fcntl q{:flock};
use warnings;
use strict;
run sub {
	my $this=shift;
	
	my ($object, $field, %params, @ret);
	
	my $process_fieldspec = sub {
		if (defined $object) {
			if (! defined $field) {
				$this->croak("unspecified field");
			}
			my $ret=validate($this, $field, $object, \%params);
			if (length $ret) {
				push @ret, (0, $ret);
			}
			else {
				push @ret, change($this, $field, $object, \%params);
			}
		}
	};
	
	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') {
			push @{$params{$key}}, $value;
		}
		else {
			$params{$key}=$value;
		}
	}
	$process_fieldspec->();

	return @ret;
};

# 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;
	
	if ($obj != $this) {
		return "You cannot modify other objects.";
	}
	undef $this; # should not need it now, so avoid mistakes.

	# These are just ignored.
	delete $params->{atime};
	delete $params->{mtime};
	
	if (defined $params->{mode}) {
		return "You cannot set file modes.";
	}
	
	unless (ref $obj) {
		# Since this version of the method does not support
		# creating objects, using a string for one is
		# always an error.
		return "You cannot create objects.";
	}
	
	my $file=$obj->fieldfile($field);
	
	if (defined $params->{unset}) {
		if ($obj->can($field) ||
		    (defined $file && -f $file && -x $file)) {
			return "You cannot unset a method.";
		}
		if (! $obj->defines($field)) {
			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 && -e $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.
		
		if (ref $params->{value} && grep ref, @{$params->{value}}) {
			return "You cannot set references.";
		}
	
		if ($field =~ /^[_.]/) {
			return "You cannot change private fields.";
		}

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

		if (! defined $file || ! -e $file) {
			return "No such field.";
		}

		if (defined $file && (-d $file || -k $file)) {
			return "You cannot change a reference.";
		}

		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 (-l $file) {
			return "Cannot change a symlink.";
		}
		if (! -f $file) {
			return "You cannot change that field, whatever it is.";
		}
	}

	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 (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 called, 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 $field && -e $file) {
				$obj->deletefield($field) ||
					return 0, "Permission denied.";
			}
			$ret="";
		}
		elsif (ref $params->{value}) {
			# Set.
			$ret=eval { $obj->$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->{atime} ||
	    defined $params->{mtime} ||
	    defined $params->{newobj} ||
    	    defined $params->{mode}) {
		$this->croak("internal error");
	}
	
	return (1, $ret);
}
