#  Copyright (c) 1997-2006
#  Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
#  http://www.math.tu-berlin.de/polymake,  mailto:polymake@math.tu-berlin.de
#
#  This program is free software; you can redistribute it and/or modify it
#  under the terms of the GNU General Public License as published by the
#  Free Software Foundation; either version 2, or (at your option) any
#  later version: http://www.gnu.org/licenses/gpl.txt.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#----------------------------------------------------------------------------
#  $Project: polymake $$Id: Object.pm 7557 2007-01-12 17:48:17Z gawrilow $

use strict;
use namespaces;

use Poly::PropertyValue;
use Poly::File;

package Poly::Object;
use Poly::Ext;

use Struct (
   [ '$name' => 'undef' ],	# unique(?) object name
   '@contents',			# PropertyValues in the chronological (file) order
   '%dictionary',		# Property => index in @contents
   [ '$persistent' => 'undef' ],# some object with load() and save() methods
   '@transactions',		# Transaction
   '%failed_rules',		# Rule => undef  rules should not be applied to the object any more
   '$changed',			# Object changed since last load() or save()
);

####################################################################################

package Poly::Transaction;

use Struct (
   '$content_end',		# length of Object->contents at the transaction start
   '%backup',			# overwritten data: content_index => old PropertyValue
   [ '$activeRule' => 'undef' ],# Rule
   '$keep_overwritten',		# boolean  true in verification mode
   '$changed',			# boolean  object was changed during the transaction
   '%run_rules',		# Rule => exit code  rules already executed
   '%extra',			# additional parameters for context-specific use
);

sub new {		# CLASS, Object =>
   my $self=&_new;
   my ($object)=@_;
   $self->content_end=$#{$object->contents};
   $self->keep_overwritten= do {
      my $trans=$object->transactions->[0];
      defined($trans) && $trans->keep_overwritten && $trans->extra->{inherit_keep_overwritten}
   };
   return $self;
}

sub merge {
   my ($self, $trans)=@_;
   while (my ($content_index, $old_pv)=each %{$trans->backup}) {
      if ($content_index <= $self->content_end) {
	 $self->backup->{$content_index} ||= $old_pv;
      }
   }
   while (my ($rule, $code)=each %{$trans->run_rules}) {
      $self->run_rules->{$rule}=$code;
   }
   $self->changed |= $trans->changed;
}
####################################################################################
package Poly::Object;

sub new {
   my $self=&_new;
   if (@_==1  and  is_object($_[0])) {
      my $ph=shift;
      if ($ph->can("save")) {
	 $self->persistent=$ph;
      } else {
	 croak( ref($ph), " doesn't implement the persistency handler interface" );
      }
   } else {
      if (@_%2) {
	 $self->name=shift;
      }
      $self->begin_transaction;
      if (@_) {
	 while (my ($prop_name, $value)=splice @_, 0, 2) {
	    my ($prop)=$self->prototype->property($prop_name);	# allow undeclared properties
	    if (exists $self->dictionary->{$prop}) {
	       croak( "multiple values for property '$prop_name'" );
	    } else {
	       my $pv=new Poly::PropertyValue($prop, $value, $self);
	       push @{$self->contents}, $pv;
	       $self->dictionary->{$prop}=$#{$self->contents};
	       if ($prop->temporary) {
		  need_cleanup($self, $#{$self->contents});
	       }
	    }
	 }
	 $self->transactions->[0]->changed=1;
      }
   }
   $self;
}
####################################################################################
sub load {
   my $self=is_object($_[0]) ? shift : &_new;
   ( $self->persistent ||= do {
        my $ph=shift;
	is_object($ph) ? $ph : new File($ph);
     }
   )->load($self, @_);
   $self;
}
####################################################################################
sub exists {	# 'request' || [request] => boolean
   my ($self, $req)=@_;
   if (!is_ARRAY($req)) {
      $req=$self->prototype->encode_read_request($req);
   }

   foreach my $prop (@$req) {
      if (defined (my $content_index=$self->dictionary->{$prop})) {
	 return 1 if defined($self->contents->[$content_index]);
      }
   }

   0
}
####################################################################################
sub isa {
   my ($self, $proto_name)=@_;
   my $object_pkg=namespaces::lookup_class($self, $proto_name);
   $object_pkg && UNIVERSAL::isa($self, $object_pkg->prototype->object_type);
}
####################################################################################
sub lookup_pv {		# 'request' || [request] => PropertyValue
   my ($self, $req)=@_;
   my $proto=$self->prototype;
   if (!is_ARRAY($req)) {
      $req=$proto->encode_read_request($req);
   }

   foreach my $prop (@$req) {
      if (defined (my $content_index=$self->dictionary->{$prop})) {
	 if (my $trans=$self->transactions->[0] and
	     !defined($self->contents->[$content_index]->value)) {
	    if (defined($trans->activeRule) and
		$content_index > $trans->content_end || exists $trans->backup->{$content_index}) {
	       die "rule '", $trans->activeRule->header, "' attempts to read its output property ", $prop->name,
	           " before it is created\n";
	    }
	 }
	 return $self->contents->[$content_index];
      }
   }
   undef;
}

sub lookup {
   my $pv=&lookup_pv;
   $pv && $pv->value;
}
####################################################################################
sub put {
   my ($self, $prop, $data)=@_;
   my $trans=$self->transactions->[0];
   confess( "Poly::Object::put out of transaction scope" ) if !defined $trans;

   my $pv=new PropertyValue($prop, $data, $self);
   my $content_index=$self->dictionary->{$prop};
   if (defined $trans->activeRule) {
      # creating a property in a rule
      if (!defined $content_index  or
	  $content_index<=$trans->content_end && !exists $trans->backup->{$content_index}) {
	 die "attempt to create property '", $prop->name, "' which is not declared as a rule target\n";
      }
      $self->contents->[$content_index]=$pv;

   } elsif (defined $content_index) {
      # overwriting an existing property
      my $old_pv=$self->contents->[$content_index];
      $self->contents->[$content_index]=$pv;
      $trans->backup->{$content_index} ||= $old_pv;
      $trans->changed=1 if $trans->keep_overwritten;
      return;

   } else {
      # new property created outside of a production rule
      push @{$self->contents}, $pv;
      $self->dictionary->{$prop}=$content_index=$#{$self->contents};
   }

   if ($prop->temporary) {
      need_cleanup($self, $content_index);
   } else {
      $trans->changed=1;
   }
   defined(wantarray) && $pv->value;
}
####################################################################################
sub add {
   my ($self, $prop, $data)=@_;
   croak( "multiple values for property ", $prop->name, "\n" )
      if exists $self->dictionary->{$prop};
   my ($value, $conv)=new PropertyValue($prop, $data, $self);
   push @{$self->contents}, $value;
   $self->dictionary->{$prop}=$#{$self->contents};
   if ($conv) {
      $self->changed=1;
      $main::scope->cleanup->{$self} ||= [ undef ];
   }
}
####################################################################################
sub take {
   my ($self, $prop_name, $data)=@_;

   if (@_==2) {
      # empty property
      $data=[ ];
   } elsif (defined($data) and !ref($data)) {
      # mixed data stream
      my (@data);
      foreach my $line (@_[2..$#_]) {
	 foreach (split /\n/, $line) {
	    s/^\s+//;
	    next if length==0;
	    if (substr($_,0,1) ne "#") {
	       push @data, "$_\n";
	    }
	 }
      }
      $data=\@data;
   }

   my $trans=$self->transactions->[0] || $self->begin_transaction;
   my $prop=
      defined($trans->activeRule)
      ? $self->prototype->property($prop_name)
      : ( $self->prototype->property($prop_name) )[0];	# let it create a new property if undeclared
   $self->put($prop, $data);
}
####################################################################################
sub remove($$) {
   my ($self, $prop_name)=@_;
   my $trans=$self->transactions->[0];
   confess( "Poly::Object::remove out of transaction scope" ) if !defined $trans;
   my $prop=$self->prototype->property($prop_name);
   if (defined (my $content_index=delete $self->dictionary->{$prop})) {
      $trans->backup->{$content_index} ||= $self->contents->[$content_index];
      undef $self->contents->[$content_index];
      $trans->changed=1;
   } elsif (defined $trans->activeRule) {
      die "attempt to remove property '$prop_name' not declared as a rule source\n";
   }
}
####################################################################################
sub begin_transaction {
   my ($self, $active_rule)=@_;
   my $trans=new Transaction($self);
   unshift @{$self->transactions}, $trans;

   if (defined $active_rule) {
      $trans->activeRule=$active_rule;
      if (ref($active_rule->output)) {
	 # is a production rule

	 foreach my $prop (@{$active_rule->output}) {
	    my $pv=new PropertyValue($prop);
	    if (defined (my $content_index=$self->dictionary->{$prop})) {
	       $trans->backup->{$content_index}=$self->contents->[$content_index];
	       $self->contents->[$content_index]=$pv;
	    } else {
	       push @{$self->contents}, $pv;
	       $self->dictionary->{$prop}=$#{$self->contents};
	    }
	 }
      }
   }
   return $trans;
}
####################################################################################
sub remember_failed_rules {
   my ($self, $trans)=@_;
   while (my ($rule, $code)=each %{$trans->run_rules}) {
      if ($code==$Poly::Rule::exec_failed) {
	 $self->failed_rules->{$rule}=1;
      }
   }
}
####################################################################################
sub commit {
   my ($self)=@_;
   my $trans=shift @{$self->transactions};
   confess( "Poly::Object::commit out of transaction scope" ) if !defined $trans;

   if ($trans->keep_overwritten) {
      commit_overwrite($self, $trans);
   } else {
      commit_ignore($self, $trans);
   }

   if (@{$self->transactions}) {
      $self->transactions->[0]->merge($trans);
   } else {
      if (!$self->changed and
	  $self->changed = $trans->changed || $#{$self->contents} > $trans->content_end) {
	 $main::scope->cleanup->{$self} ||= [ undef ];
      }
      remember_failed_rules($self,$trans);
   }
}
####################################################################################
sub commit_ignore {
   my ($self, $trans)=@_;
   my $proto=$self->prototype;

   while (my ($index, $old_pv)=each %{$trans->backup}) {
      my $pv=$self->contents->[$index];
      next if !defined($pv) || !defined (my $old_value=$old_pv->value);

      my $prop=$pv->property;
      if (defined (my $diff_sub=$prop->diff)) {
	 my @need_diff=grep { $_ > $trans->content_end } map { $self->dictionary->{$_} } @{$prop->diff_sensitive};
	 if (@need_diff) {
	    my $diff=eval { select_method($diff_sub, $self)->($self->contents->[$index]->value, $old_value) };
	    if ($@) {
	       $self->rollback($trans);
	       die "calculation of diff(".$prop->name.") failed: $@";
	    }
	    if (defined $diff) {
	       # make new properties created together with $prop (which is going to be discarded soon) compatible
	       # with the old version of $prop
	       foreach my $other_index (@need_diff) {
		  my $other_pv=$self->contents->[$other_index];
		  if (defined($other_pv->value)) {
		     my $other_prop=$other_pv->property;
		     dbg_print( "applying diff(".$prop->name.") to ", $other_prop->name ) if $Switches::v>=2;
		     eval {
			$other_pv->set_value( select_method($other_prop->apply_diff->{$prop}, $self)
					      ->($other_pv->value, $diff) )
		     };
		     if ($@) {
			$self->rollback($trans);
			die "applying diff(".$prop->name.") to ".$other_prop->name." failed: $@";
		     }
		  }
	       }
	    }
	 }
      }

      $self->contents->[$index]=$old_pv;
      delete $trans->backup->{$index};
   }
}
####################################################################################
sub equal_floats($$) {
   no integer;
   my ($x1, $x2)=@_;
   my $a=max(abs($x1),abs($x2));
   $a<=1e-7 or abs($x1-$x2)<=1e-7*$a;
}

sub equal_lines($$) {
   my ($l1, $l2)=@_;
   return 1 if $l1 eq $l2;
   return 0 if $l1 !~ /^[-+\d.eE\s]+$/ or $l2 !~ /^[-+\d.eE\s]+$/;
   my @d1=split /\s+/, $l1;
   my @d2=split /\s+/, $l2;
   return 0 if $#d1 != $#d2;
   for (my $i=0; $i<=$#d1; ++$i) {
      return 0 if !equal_floats($d1[$i], $d2[$i]);
   }
   1;
}

sub plain_compare($$) {
   my ($new, $old)=@_;
   if (ref($new) ne ref($old)) {
      return "type mismatch: new " . ref($new) . " old " . ref($old) . "\n";
   }
   if (ref($new) eq "ARRAY") {
      if ($#$new != $#$old) {
	 return "length mismatch: new " . ($#$new+1) . " old " . ($#$old+1) . "\n";
      }
      my $diff="";
      for (my $i=0; $i<=$#$new; ++$i) {
	 if (!equal_lines($new->[$i], $old->[$i])) {
	    $diff .= "line $i mismatch: new <";
	    $_=$new->[$i]; chomp; $diff.=$_;
	    $diff .= "> old <";
	    $_=$old->[$i]; chomp; $diff.=$_;
	    $diff .= ">\n";
	 }
      }
      return $diff;
   }
   if (ref($new)) {
      die "don't know how to compare ", ref($new), "\n";
   }
   !equal_lines($new, $old)
   && "value mismatch: new <$new> old <$old>\n";
}
####################################################################################
sub commit_overwrite {
   my ($self, $trans)=@_;
   my (%add_to_backup, %compared);
   my $proto=$self->prototype;
   my $errors="";
   while (my ($index, $old_pv)=each %{$trans->backup}) {
      my $pv=$self->contents->[$index];
      $compared{$index}=undef, next if !defined $pv;

      # first simple check: defined-ness must not change
      my $prop=$pv->property;
      my $old_value=$old_pv->value;
      my $is_defined=defined($pv->value);

      if ($is_defined != defined($old_value)) {
	 $errors .= "verification of '" . $prop->name . "' failed:\n" .
	            "new <" . ($is_defined ? "defined value" : "UNDEFINED ") .
		    "> old <" . ($is_defined ? "UNDEFINED" : "defined value") . ">\n";
	 $compared{$index}=undef, next;
      }
      $compared{$index}=undef, next unless $is_defined;

      if (defined (my $diff_sub=$prop->diff)) {
	 my $diff=eval { select_method($diff_sub, $self)->($old_value, $pv->value) };
	 $compared{$index}=undef;
	 if ($@) {
	    $errors .= "verification of ".$prop->name." failed: $@";
	    next;
	 } elsif ($Switches::v) {
	    dbg_print( "verification of ".$prop->name." successful" );
	 }

	 if (defined $diff) {
	    foreach my $other_prop (@{$prop->diff_sensitive}) {
	       my $other_index=$self->dictionary->{$other_prop};

	       # is the sensitive property older than this transaction?
	       if (defined ($other_index)
		   and $other_index <= $trans->content_end
		   and defined (my $other_pv=$self->contents->[$other_index])) {
		  $compared{$other_index}=undef, next if !defined $other_pv->value;	# no need to synchronize UNDEF

		  if (defined (my $other_old_pv=$trans->backup->{$other_index})) {
		     # got overwritten together with the generator: prepare the old value for comparison
		     if (defined $other_old_pv->value) {
			my $cmp_value=eval {
			   select_method($other_prop->apply_diff->{$prop}, $self)->($other_old_pv->value, $diff)
		        };
			if ($@ && $Switches::v) {
			   warn_print( "applying diff(".$prop->name.") to ".$other_prop->name." failed: $@",
			               "verification not performed" );
			}
			$compared{$other_index}=$cmp_value;
		     }

		  } else {
		     # must be synchronized
		     my $new_value=eval {
			select_method($other_prop->apply_diff->{$prop}, $self)->($other_pv->value, $diff)
		     };
		     if ($@) {
			warn_print( "applying diff(".$prop->name.") to ".$other_prop->name." failed: $@" ) if $Switches::v;
			delete $self->dictionary->{$other_prop};
			undef $self->contents->[$other_index];
			$compared{$other_index}=undef;
		     } else {
			$self->contents->[$other_index]=new PropertyValue($other_prop, $new_value);
		     }
		     $add_to_backup{$other_index}=$other_pv;
		  }
	       }
	    }
	 }
      }
   }

   while (my ($index, $old_pv)=each %{$trans->backup}) {
      my $old_value;
      if (exists $compared{$index}) {
	 next unless defined($old_value=$compared{$index});
      } else {
	 $old_value=$old_pv->value;
      }
      my $pv=$self->contents->[$index];
      my $diff=plain_compare($pv->value, $old_value);
      if (length($diff)) {
	 $errors .= "verification of ".$pv->property->name." failed:\n$diff";
      } elsif ($Switches::v) {
	 dbg_print( "verification of ".$pv->property->name." successful" );
      }
   }

   if (length($errors)) {
      $self->rollback($trans);
      die $errors;
   }
   while (my ($index, $pv)=each %add_to_backup) {
      $trans->backup->{$index} ||= $pv;
   }
}
####################################################################################
sub restore($$) {
   my ($self, $trans)=@_;
   while (my ($index, $pv)=each %{$trans->backup}) {
      if (!defined($self->contents->[$index])) {
	 $self->dictionary->{$pv->property}=$index;
      }
      $self->contents->[$index]=$pv;
   }
   %{$trans->backup}=();
}
####################################################################################
sub rollback {	# [ Transaction (only if called from commit) => ]
   my ($self, $trans)=@_;
   $trans ||= shift @{$self->transactions};
   confess( "Poly::Object::rollback out of transaction scope" ) if !defined $trans;

   restore($self, $trans);
   my $limit=$trans->content_end;
   foreach my $pv (@{$self->contents}[$limit+1..$#{$self->contents}]) {
      delete $self->dictionary->{$pv->property} if ref($pv);
   }
   $#{$self->contents}=$limit;
   remember_failed_rules($self,$trans);
}
####################################################################################
# private:
sub rollback_open {
   my ($self)=@_;
   if (@{$self->transactions}) {
      $self->rollback($self->transactions->[-1]);
      @{$self->transactions}=();
   }
}
####################################################################################
sub cleanup {
   my ($self, $index)=@_;
   rollback_open($self);
   if (defined($index)) {
      my $gap=0;
      for (my $last=$#{$self->contents};  $index<=$last;  ++$index) {
	 my $pv=$self->contents->[$index];
	 if (ref($pv)) {
	    my $prop=$pv->property;
	    if ($prop->temporary) {
	       delete $self->dictionary->{$prop};
	       ++$gap;
	    } elsif ($gap) {
	       $self->contents->[$index-$gap]=$self->contents->[$index];
	       $self->dictionary->{$prop}=$index-$gap;
	    }
	 } else {
	    ++$gap;
	 }
      }
      $#{$self->contents}-=$gap;
   }
   if ($self->changed && defined($self->persistent)  &&  @{$self->contents}) {
      $self->persistent->save($self);
      $self->changed=0;
   }
}
####################################################################################
sub save {
   # if with optional TRUE argument, then save temporaries too
   cleanup($_[0], $_[1] ? 0 : undef);
}
####################################################################################
sub need_cleanup {
   my ($self, $index)=@_;
   my $cleanup_action=($main::scope->cleanup->{$self} ||= [ undef ]);
   if (is_ARRAY($cleanup_action)) {
      assign_min($cleanup_action->[0], $index);
   }
}
####################################################################################
sub DESTROY {
   my $self=shift;
   if ($main::scope  and  my $action=delete $main::scope->cleanup->{$self}) {
      cleanup($self, @$action);
   }
}
####################################################################################

use Poly::Scheduler;

sub eval_input_list($$) {	# [ Property ] => true if ready
   my ($self, $input_list)=@_;
   my ($content_index, $pv);
   foreach my $prop (@$input_list) {
      return 1 if defined ($content_index=$self->dictionary->{$prop})
               && defined ($pv=$self->contents->[$content_index]);
   }
   0
}
####################################################################################
sub provide_request {
   my ($self, $request)=@_;
   my $request_rule=create Rule('request', $request, $Poly::Rule::is_function);
   my $chain=initial RuleChain($self,$request_rule);
   if ((my $success=$chain && $chain->resolve($self)) <= 0) {
      my @lacking;
      foreach my $input_list (@$request) {
	 if (! $self->eval_input_list($input_list)) {
	    push @lacking, "'" . join(" | ", map { $_->name } @$input_list) . "'";
	 }
      }
      die $success==0 ? "available data insufficient to make " : "no more rules available to make ",
          join(", ", @lacking), "\n";
   }
}
####################################################################################
# private:
sub _give {
   my $self=shift;
   my $give=pop @_;
   my $req=is_ARRAY($_[0]) ? \@_ : [ map { $self->prototype->encode_read_request($_) } @_ ];
   if (!@{$self->transactions} || !$self->transactions->[0]->activeRule) {
      provide_request($self, $req);
   }
   if (wantarray) {
      map { $give->($self,$_) } @$req;
   } elsif (defined wantarray  and  @$req==1) {
      $give->($self,@$req);
   }
}
sub give_pv {
   push @_, \&lookup_pv;
   &_give;
}
sub give {
   push @_, \&lookup;
   &_give;
}
####################################################################################
sub give_schedule {
   my $self=shift;
   my $request=is_ARRAY($_[0]) ? \@_ : [ map { $self->prototype->encode_read_request($_) } @_ ];
   my $request_rule=create Rule('request', $request, $Poly::Rule::is_function);
   my $chain=initial RuleChain($self,$request_rule);
   return $chain->resolve($self, 0);
}
####################################################################################
sub create_prop_accessor {
   my $prop=shift;
   my $accessor=sub : method { _prop_set_accessor($prop) ? &put : &get };
   declare_lvalue($accessor);
   $accessor;
}
####################################################################################
sub get {
   my ($self, $prop)=@_;
   my $content_index=$self->dictionary->{$prop};
   if (defined $content_index) {
      _get_alternatives();
   } else {
      my @alt=_get_alternatives();
    TRY_ALT: {
	 foreach my $alt_prop (@alt) {
	    $alt_prop=$self->prototype->lookup_property($alt_prop)
	    || die "unknown property $alt_prop\n";
	    last TRY_ALT if defined ($content_index=$self->dictionary->{$alt_prop});
	 }
	 my $trans=$self->transactions->[0];
	 if (defined($trans) && $trans->activeRule) {
	    if (@alt) {
	       die "attempt to access undefined properties ", join(" | ", map { $_->name} $prop, @alt), "\n";
	    } else {
	       die "attempt to access an undefined property ", $prop->name, "\n";
	    }
	 }
	 unshift @alt, $prop;
	 provide_request($self, [ \@alt ]);
	 foreach $prop (@alt) {
	    last if defined ($content_index=$self->dictionary->{$prop});
	 }
      }
   }
   $self->contents->[$content_index]->value;
}

####################################################################################
sub verify {
   my $self=shift;
   my $trans=$self->begin_transaction;
   $trans->keep_overwritten=1;
   $trans->extra->{inherit_keep_overwritten}=1;
   my $scope=new Scope();
   $scope->cleanup->{$self}=\&rollback_open;

   my $proto=$self->prototype;
   my (@request, $preferred);
 REQ:
   foreach (@_) {
      if (defined (my $prop=$proto->lookup_property($_))) {
	 if (defined (my $content_index=$self->dictionary->{$prop})) {
	    my $pv=$self->contents->[$content_index];
	    if (defined($pv)) {
	       $trans->backup->{$content_index}=$pv;
	       $self->contents->[$content_index]=undef;
	       push @request, [ $prop ];
	       next;
	    } else {
	       # maybe just repeating argument?
	       foreach my $seen (@request) {
		  next REQ if $seen == $prop;
	       }
	    }
	 }
	 die "cannot verify non-existing property $_\n";

      } elsif (defined (my $label=$proto->application->prefs->find_label($_))) {
	 $label->set_temp_preferred($scope);
	 $preferred=1;

      } else {
	 die "unknown property or label: '$_'\n";
      }
   }

   my $chain=new InitRuleChain($self, create Rule('verify', \@request, $Poly::Rule::is_function));
   restore($self, $trans);
   my $success= defined($chain) && do {
      $chain->gather_rules($self);
      $chain->constrain_to_preferred if $preferred;
      $chain->resolve($self, !$Switches::n);
   };
   if ($Switches::n && $success) {
      print $success->report, "\n";

   } elsif ($success <= 0) {
      if ($success<0) {
	 my @lacking;
	 foreach my $input_list (@request) {
	    my $prop=$input_list->[0];
	    my $content_index=$self->dictionary->{$prop};
	    if (! exists $trans->backup->{$content_index}) {
	       push @lacking, $prop->name;
	    }
	 }
	 die "no more rules available to verify " . join(", ", @lacking);
      } else {
	 die $preferred ? "no matching rules\n" : "data insufficient for verification\n";
      }
   }
}
####################################################################################
sub take_verify {
   my $self=shift;
   $main::scope->cleanup->{$self}=\&rollback_open;
   my $trans=$self->begin_transaction;
   $trans->keep_overwritten=1;
   $trans->extra->{inherit_keep_overwritten}=1;

   $self->begin_transaction;
   while (@_) {
      $self->take(splice @_, 0, 2);
   }
   $self->commit;
}

declare @EXPORT_METHODS=qw( verify );

1

# Local Variables:
# c-basic-offset:3
# End: