TM - Topic Maps, Base Class

    my $tm = new TM (baseuri => 'tm://whatever/');   # empty map

    # add a toplet (= minimal topic, only identification, no characteristics)
    # by specifying an internal ID
    $tm->internalize ('aaa');                        # only internal identifier
    $tm->internalize ('bbb' =>   'http://bbb/');     # with a subject address
    $tm->internalize ('ccc' => \ 'http://ccc/');     # with a subject indicator

    # without specifying an internal ID (will be auto-generated)
    $tm->internalize (undef =>   'http://ccc/');     # with a subject address
    $tm->internalize (undef => \ 'http://ccc/');     # with a subject indicator

    # get rid of toplet(s)
    $tm->externalize ('tm://whatever/aaa', ...);

    # find full URI of a toplet
    my $tid  = $tm->tids ('person');                     # returns tm://whatever/person
    my @tids = $tm->tids ('person', ...)                 # for a whole list

    my $tid  = $tm->tids (  'http://bbb/');              # with subject address
    my $tid  = $tm->tids (\ 'http://ccc/');              # with subject indicator

    my @ts   = $tm->toplets;                             # get all toplets
    my @ts   = $tm->toplets (\ '+all -infrastructure');  # only those you added

    my @as   = $tm->asserts (\ '+all -infrastructure');  # only those you added

    my @as   = $tm->retrieve;                            # all assertions
    my $a    = $tm->retrieve ('23ac4637....345');        # returns only that one assertion
    my @as   = $tm->retrieve ('23ac4637....345', '...'); # returns all these assertions

    # create standalone assertion
    my $a = Assertion->new (type    => 'is-subclass-of',
                            roles   => [ 'subclass', 'superclass' ],
                            players => [ 'rumsti', 'ramsti' ]);
    $tm->assert ($a);                                    # add that to map

    # create a name
    my $n = Assertion->new (kind    => TM->NAME,
                            type    => 'name',
                            scope   => 'us', 
                            roles   => [ 'thing', 'value' ],
                            players => [ 'rumsti', new TM::Literal ('AAA') ])
    # create an occurrence
    my $o = Assertion->new (kind    => TM->OCC,
                            type    => 'occurrence',
                            scope   => 'us',
                            roles   => [ 'thing', 'value' ],
                            players => [ 'rumsti', new TM::Literal ('http://whatever/') ])

    $tm->assert ($n, $o);                                # throw them in

    $tm->retract ($a->[TM->LID], ...);                   # get rid of assertion(s)

    my @as = $tm->retrieve ('id..of...assertion');       # extract particular assertions

    # find particular assertions
    # generic search patterns
    my @as = $tm->match_forall (scope   => 'tm://whatever/sss');

    my @bs = $tm->match_forall (type    => 'tm://whatever/ttt',
                                roles   => [ 'tm://whatever/aaa', 'tm://whatever/bbb' ]);

    # specialized search patterns (see TM::Axes)
    my @cs = $tm->match_forall (type    => 'is-subclass-of', 
			        arole   => 'superclass', 
			        aplayer => 'tm://whatever/rumsti', 
			        brole   => 'subclass');

    my @ds = $tm->match_forall (type    => 'isa',
                                class   => 'tm://whatever/person');

    # perform merging, cleanup, etc.
    $tm->consolidate;

    # check internal consistency of the data structure
    die "panic" if $tm->insane;

    # taxonomy stuff
    warn "what a subtle joke" if $tm->is_a ($tm->tids ('gw_bush', 'moron'));

    die "what a subtle joke"
        unless $tm->is_subclass ($tm->tids ('politician', 'moron'));

    # returns Mr. Spock if Volcans are subclassing Aliens
    warn "my best friends: ". Dumper [ $tm->instancesT ($tm->tids ('alien')) ];

   new TM (....,
           consistency => [ TM->Subject_based_Merging,
                            TM->Indicator_based_Merging ]);

   # dogmatic way to produce it
   my $to = Toplet->new (lid   => $baseuri . 'my-lovely-cat',
                         saddr => 'http://subject-address.com/',
                         sinds => []);

   # also good and well
   my $to = [ $baseuri . 'my-lovely-cat', 
              'http://subject-address.com/',
               [] ];

   # better
   my $to = $tm->internalize ('my-lovely-cat' => 'http://subject-address.com/');

   warn "indicators: ", join (", ", @{$to->sinds});

   warn "locator:    ", $to->[TM->ADDRESS];

   # general association
   $a = Assertion->new (type => 'is-subclass-of', 
                        roles   => [ 'subclass', 'superclass' ], 
                        players => [ 'rumsti',   'ramsti' ])




   warn $a->scope . " is the same as " . $a->[TM->SCOPE];

   # create a name
   use TM::Literal;
   $n = Assertion->new (kind    => TM->NAME,
                        type    => 'name',
                        scope   => 'us', 
                        roles   => [ 'thing', 'value' ],
                        players => [ 'rumsti', 
                                     new TM::Literal ('AAA') ]);

   # create an occurrence
   use TM::Literal;
   $n = Assertion->new (kind    => TM->OCC,
                        type    => 'occurrence',
                        scope   => 'us',
                        roles   => [ 'thing', 'value' ],
                        players => [ 'rumsti', 
                                     new TM::Literal ('http://whatever/') ]);

package TM;

use strict;
use warnings;

require Exporter;
use base qw(Exporter);

our $VERSION  = '1.56';

use Data::Dumper;
# !!! HACK to suppress an annoying warning about Data::Dumper's VERSION not being numerical
$Data::Dumper::VERSION = '2.12108';
# !!! END of HACK

use Class::Struct;
use Time::HiRes;
use TM::PSI;

use Log::Log4perl;
Log::Log4perl::init( \ q(

log4perl.rootLogger=DEBUG, Screen

log4perl.appender.Screen=Log::Log4perl::Appender::Screen
log4perl.appender.Screen.layout=Log::Log4perl::Layout::PatternLayout
log4perl.appender.Screen.layout.ConversionPattern=[%r] %F %L %c - %m%n

#log4perl.rootLogger=DEBUG, LOGFILE

#log4perl.appender.LOGFILE=Log::Log4perl::Appender::File
#log4perl.appender.LOGFILE.filename=/tmp/tm.log
#log4perl.appender.LOGFILE.mode=append

#log4perl.appender.LOGFILE.layout=PatternLayout
#log4perl.appender.LOGFILE.layout.ConversionPattern=[%r] %F %L %c - %m%n
		       		       ) );

our $log = Log::Log4perl->get_logger("TM");

our $infrastructure;                                                                    # default set = core + topicmaps_inc + astma_inc

use constant {
    Subject_based_Merging   => 1,
    Indicator_based_Merging => 2,
    TNC_based_Merging       => 3,
};

sub new {
  my $class = shift;
  my %self  = @_;

  $self{consistency} ||= [ Subject_based_Merging, Indicator_based_Merging ];
  $self{baseuri}     ||= 'tm://nirvana/';
  $self{baseuri}      .= '#' unless $self{baseuri} =~ m|[/\#:]$|;

  my $self = bless \%self, $class;

  unless ($self->{mid2iid}) {                                                          # we need to do fast cloning of basic vocabulary
      %{ $self->{mid2iid} }    = %{ $infrastructure->{mid2iid} };                      # shallow clone
      %{ $self->{assertions} } = %{ $infrastructure->{assertions} };                   # shallow clone
  }
  $self->{last_mod} = 0;                                                               # book keeping
  $self->{created}  = Time::HiRes::time;

  return $self;
}

sub DESTROY {}                                                                    # not much to do here

sub baseuri {
    my $self = shift;
    return $self->{baseuri};
}

sub consistency {
  my $self   = shift;
  my @params = @_;

  $self->{consistency} = [ @params ] if @params;
  return @{$self->{consistency}};
}

sub last_mod {
    my $self = shift;
    return $self->{last_mod};
}

# NOTE: Below there much is done regarding speed. First the toplets are swept detecting which have
# to be merged. This is not done immediately (as this is an expensive operation), instead a 'merger' hash
# is built. Note how merging information A -> B and A -> C is morphed into A -> B and B -> C using
# the _find_free function.

# That merger hash is then consolidated by following edges until their end, so that there are no
# cycles.

sub consolidate {
  my $self = shift;
  my $cons = @_ ? [ @_ ] : $self->{consistency};                           # override
  my $indi = grep ($_ == Indicator_based_Merging, @{$self->{consistency}});
  my $subj = grep ($_ == Subject_based_Merging,   @{$self->{consistency}});
  my $tnc  = grep ($_ == TNC_based_Merging,       @{$self->{consistency}});

#warn "cond indi $indi subj $subj tnc $tnc";

  my %SIDs; # holds subject addresses found
  my %SINs; # holds subject indicators found
  my %BNs;  # holds basename + scope found

#warn Dumper $cons;

#== find merging points and memorize this in mergers =======================================================================
  my %mergers;                                                             # will contain the merging edges
  my $mid2iid = $self->{mid2iid};                                          # shortcut
  my $asserts = $self->{assertions};                                       # shortcut
  my $baseuri = $self->{baseuri};                                          # shortcut

MERGE:
  foreach my $this (keys %{$mid2iid}) {
#warn "looking at $this";
      my $thism = $mid2iid->{$this};
#warn "SIDs: ". Dumper \%SIDs;
#warn "SINs: ". Dumper \%SINs;
#-- based on subject indication ------------------------------------------------------------------------------------------
      if ($indi) {
	  foreach my $sin (@{$thism->[TM->INDICATORS]}) {                  # walk over the subject indicators
	      if (my $that  = $SINs{$sin}) {                               # $that is now a key pointing to a merging partner
#warn "merging (IND) $this >> $that"; #. Dumper $thism, $thatm;
		  _add_merge (\%mergers, $baseuri, $this, $that);

              } else {                                                     # no merging, so enter the sins
                  $SINs{$sin} = $this;
	      }
	  }
      }

sub _add_merge {
    my $mergers = shift;
    my $bu      = shift;
    my $this    = shift;
    my $that    = shift;

    ($this, $that) = ($that, $this) if $this =~ /^$bu/;                    # we swap them to favor that which resembles the baseURI
    $mergers->{_find_free ($this, $mergers)} = $that;                      # find a free place to make that mapping
}

sub _find_free {
    my $this = shift;
    my $mergers = shift;
    
    my $this2 = $this;
    my $this3;
    while ($this3 = $mergers->{$this2}) {
	if ($this3 eq $this || $this3 eq $this2) {       # loop, we do not need it
	    return $this3;
	} else {
	    $this2 = $this3;                             # we follow the trail
	}
    }
    return $this2;                                       # this2 was the end of the trail
}

#-- based on subject address ---------------------------------------------------------------------------------------------
      if ($subj) {
	  if (my $sid = $thism->[TM->ADDRESS]) {
	      if (my $that = $SIDs{$sid}) {                                # found partner => should be merged
#warn "merging (ADDR) $this >> $that";
		  _add_merge (\%mergers, $baseuri, $this, $that);
###### old		  $mergers{_find_free ($this, \%mergers)} = $that;
		  # must obviously both have the same subject address, so, no reason to touch this
	      } else {                                                     # there is no partner, first one with this subject address
		  $SIDs{$sid} = $this;
	      }
	  }
      }
#warn "after 1 on '$this' ";#.Dumper $mid2iid;
  }
#-- based on TNC ---------------------------------------------------------------------------------------------
   if ($tnc) {
      my ($THING, $VALUE) = ('thing', 'value');
      foreach my $a (values %$asserts) {
	  next unless $a->[TM->KIND] == TM->NAME;                          # we are only interested in basenames
#warn "checking assertion ".Dumper $a;
	  my ($v) = get_x_players ($self, $a, $VALUE);                     # if we get back a longer list, bad luck
	  my $bn_plus_scope = $v->[0] .                                    # the basename is a string reference
                              $a->[TM->SCOPE];                             # relative to the scope
	  my ($this) = get_x_players ($self, $a, $THING);                  # thing which plays 'topic'
#warn "    --> player is $this";
	  if (my $that = $BNs{$bn_plus_scope}) {                           # if we have seen it before
#warn "  -> SEEN";
	      _add_merge (\%mergers, $baseuri, $this, $that);
#### old      $mergers{_find_free ($this, \%mergers)} = $that;
	  } else {                                                         # it is new to use, we store it into %BNs
#warn "  -> NOT SEEN";
	      $BNs{$bn_plus_scope} = $this;
#warn "BNs ".Dumper \%BNs;
	  }
      }
  }
#== consolidate mergers: no cycles, trail followed through ======================================================
#warn "mergers ".Dumper \%mergers;

  for (2..2) { # at most 2, theoretical only one should be sufficient
      my $changes = 0;
      foreach my $h (keys %mergers) {
#warn "working on $h";
	  if ($mergers{$h} eq $h) { # micro loop
	      delete $mergers{$h};
	  } elsif (defined $mergers{$mergers{$h}} && $mergers{$mergers{$h}} eq $h) {
	      delete $mergers{$h};
	  } else {
	      my $h2 = $mergers{$h};
	      my %seen = ($h => 1,  $h2 => 1); # loop avoidance
#warn "seeen start".Dumper \%seen;
	      while ($mergers{$h2} and !$seen{$mergers{$h2}}++) { $h2 = $mergers{$h} = $mergers{$h2}; $changes++;}
#warn "half consolidated (chagens $changes)" .Dumper $H;
	  }
      }
#      warn "consoli loop $_: changes: $changes";
#      warn "early finish" if $_ == 1 and $changes == 0;
      last if $changes == 0;
#      die "not clean" if $_ == 2 and $changes > 0;
  }

#warn "consolidated mergers ".Dumper \%mergers;


#== actual merging ========================================================================================

  # recanonicalize affected assertions
  {
      my $changed = _relabel (\%mergers, $self->baseuri, values %$asserts );
      while (my ($k, $a) = each %$changed) {
	  delete $asserts->{ $k };
#	  delete $mid2iid->{ $k };
#	  $mid2iid->{ $a->[TM->LID] } = [ $a->[TM->LID], undef, [] ];
	  $asserts->{ $a->[TM->LID] } = $a;
      }
  }

  foreach my $that (keys %mergers) {
      my $this  = $mergers{$that};
      my $thism = $mid2iid->{$this};
      my $thatm = $mid2iid->{$that};                           # shorthand
      next if $thatm == $thism;                  # we already have merged

      $log->logdie ("two different subject addresses for two topics to be merged ($this, $that)")
	  if $thism->[TM->ADDRESS] and $thatm->[TM->ADDRESS] and 
	     $thism->[TM->ADDRESS] ne  $thatm->[TM->ADDRESS];

#warn "merge now $that > $this";
             $thism->[TM->ADDRESS]  ||=   $thatm->[TM->ADDRESS];                 # first subject address
      {                                                                          # then indicators
	  my $Is = $thism->[TM->INDICATORS];                                     # reference to thism indicators
	  push @$Is, @{$thatm->[TM->INDICATORS]};                                # add the others to it
	  { my %X; map { $X{$_}++ } @$Is; @$Is = keys %X; }                      # make that unique
      }
      $mid2iid->{$that} = $thism;                                                # finally
  }
#warn "after post-merger ". Dumper $mid2iid;

  $self->{mid2iid}  = $mid2iid;                                                  # this makes tie happy, in the case the map is tied
  $self->{last_mod} = Time::HiRes::time;
}

sub clear {
    my $self    = shift;

    my %mid2iid    = %{ $infrastructure->{mid2iid} };                            # shallow clone
    my %assertions = %{ $infrastructure->{assertions} };                         # shallow clone

    $self->{mid2iid}    = \%mid2iid;                                             # making it explicit keeps MLDBM happy
    $self->{assertions} = \%assertions;                                          # ditto
    $self->{last_mod}   = Time::HiRes::time;                                     # book keeping
    return $self;                                                                # convenience for chaining
}

sub add {
    my $self    = shift;
    my $baseuri = $self->{baseuri};
    my $mid2iid = $self->{mid2iid};                                            # shorthand
    my $asserts = $self->{assertions};

    foreach (@_) {                                                             # deal with one store after the other
	my $baseuri2 = $_->{baseuri};

	my %changes;                                                           # will contain old -> new internal identifier mappings
	while (my ($k, $v) = each %{$_->{mid2iid}}) {

	    if ($infrastructure->{mid2iid}->{$k}) {                            # infrastructure toplets are sacrosanct
	    } else {
		(my $k2 = $k) =~ s/^$baseuri2/$baseuri/;                       # replace baseuri2 prefix

		$k2  = $k if $mid2iid->{$k2};                                  # if there is a collision, bounce back to original
		$k2 .= '1' while $mid2iid->{$k2};                              # while there is still a collision ... (this only in case of same baseuris)
#		$k2 = $baseuri.sprintf ("uuid-%010d", $TM::toplet_ctr++)
#		    if $mid2iid->{$k2};                                        # if there is a collision, create generic one

		$changes{$k}    = $k2;
		$v->[TM->LID]   = $k2;                                         # use that key as canonical one
		$mid2iid->{$k2} = $v;                                          # ...add what the other has
	    }
	}
#warn Dumper \%changes;
	my $changed = _relabel (\%changes, $baseuri, values %{ $_->{assertions} } );
#warn Dumper $changed;
	while (my ($k, $a) = each %$changed) {
#	    delete $mid2iid->{ $k };
#	    $mid2iid->{ $a->[TM->LID] } = [ $a->[TM->LID], undef, [] ]; # put the new one in here
	    $asserts->{ $a->[TM->LID] } = $a;                                  # and also in the assertions part
	}
    }
    $self->{mid2iid}    = $mid2iid;                                            # make MLDBM happy
    $self->{assertions} = $asserts;                                            # ditto
    $self->{last_mod}   = Time::HiRes::time;
}


sub _relabel {
    my $changes = shift;
    my $baseuri = shift;

    my %changed;                                                                          # we record here old LID -> newly relabelled assertion
    foreach my $a (@_) {
	my ($this, $that);
#warn "working on ".Dumper $a;
        $a->[TM->SCOPE]  = $that if $that = $changes->{ $a->[TM->SCOPE] }; $this ||= $that;
	$a->[TM->TYPE]   = $that if $that = $changes->{ $a->[TM->TYPE]  }; $this ||= $that;
	
	map { $_ = $this = $that if $that = $changes->{ $_ } } @{ $a->[TM->ROLES]   };
	map { $_ = $this = $that if $that = $changes->{ $_ } } @{ $a->[TM->PLAYERS] };
#warn "$this for ".Dumper $a;
	$changed{ $a->[TM->LID] } = $a if $this;                                          # something has changed

	$a->[TM->CANON] = 0; canonicalize (undef, $a);
	$a->[TM->LID]   = mklabel ($a);
	
    }
    return \%changed;
}

sub diff {
    my ($newmap,$oldmap,$options)=@_;
    return undef if (!$oldmap || !$newmap);

    my ($base)=$oldmap->baseuri;
    $log->logdie ("comparison of maps with different bases not supported yet!")
	if ($newmap->baseuri ne $base);

    my (%plus,%minus,%modified);
    # a lot of comparison/translation can be skipped if tids are the only identity
    my $xlatneeded= grep($_==TM->Subject_based_Merging || 
			 $_==TM->Indicator_based_Merging,@{$options->{consistency}});

    # first walk the maps to match old and new items
    my (%seen,%locators,%indicators);
    for my $map ($oldmap,$newmap) {
	my $key   = ($map eq $oldmap ? "old":"new");
	my $value = ($map eq $oldmap ? 1:2);

	for my $m (map { $_->[TM->LID] } ($map->toplets(\ '+all'))) {
	    # get the topic-aspects (tid, locators and identifiers)
	    # for finding unchanged/new/old topics
	    my $midlet=$map->toplet($m);
	    $locators{$key}->{$midlet->[TM->ADDRESS]}=$m
		if ($midlet->[TM->ADDRESS]);
	    map { $indicators{$key}->{$_}=$m } (@{$midlet->[TM->INDICATORS]});
	    $seen{$m}|=$value;
	}
	for my $a (map { $_->[TM->LID] } $map->asserts (\ '+all')) {
	    $seen{$a}|=$value;
	}
    }

    # identify same topics
    # first identity: same topic ids 
    my %old2new = map { ($_,$_) } grep { $seen{$_} == 3 } keys %seen;
    my $foundxlat;
    if (grep($_==TM->Subject_based_Merging,@{$options->{consistency}}))
    {
	# second: same locators
	# note that this overwrites topic identitites!
	# scenario: old has topica/loc x; new has topica/no loc and topicb/loc x
	map { $foundxlat||=($locators{old}->{$_} ne $locators{new}->{$_});
	      $old2new{$locators{old}->{$_}}=$locators{new}->{$_}; 
              } 
	(grep(exists $locators{new}->{$_}, keys %{$locators{old}}));
    }
    if (grep($_==TM->Indicator_based_Merging,@{$options->{consistency}}))
    {
	# final: matching indicators
	# note that this overwrites topic and locator identitites, similar scenario as above
	map { $foundxlat||=($indicators{old}->{$_} ne $indicators{new}->{$_});
	      $old2new{$indicators{old}->{$_}}=$indicators{new}->{$_}; } 
	(grep(exists $indicators{new}->{$_}, keys %{$indicators{old}}));
    }
    # no need to bother with translating assertions if there are no changed-tid identities
    $xlatneeded=0 if ($xlatneeded && !$foundxlat); 

    # produce list of missing/new topics
    my %new2old=($xlatneeded?(reverse %old2new):%old2new);
    my (%checkmidlet,%plusass,%minusass);
    for my $t (keys %seen)
    {
	if ($seen{$t}==2 && !$new2old{$t})
	{
	    # identical assertions with new lids are not detected here
	    # but later (via minusass)
	    # new assertion-lids happen with identified renamed players (lid is computed over values!)
	    $newmap->retrieve($t)?$plusass{$t}=1:$plus{$t}=[];
	}
	elsif ($seen{$t}==1 && !$old2new{$t}) 
	{
	    $oldmap->retrieve($t)?$minusass{$t}=1:$minus{$t}=[];
	}
	else
	{
	    # we work along the old tids (when not the same)
	    $checkmidlet{$seen{$t}==2?$new2old{$t}:$t}=1;
	}
    }
    undef %seen; undef %locators; undef %indicators;

#warn "check midlets ".Dumper \ %checkmidlet;

    # weed out the topics/midlets that are unchanged
    # and all the identical assertions
    my @checkassertion;
    for my $t (keys %checkmidlet) {

	if ($t =~ /^[A-F0-9]{32}$/i) {
	    my $oa=$oldmap->retrieve($t);
	    my $on=$newmap->retrieve($old2new{$t});
	    
	    if ($oa && $on && $oa->[TM->LID] ne $on->[TM->LID]) {
		push @checkassertion,$t;
	    }
	} else {
	    my $ot = $oldmap->toplet($t);
	    my $nt = $newmap->toplet($old2new{$t});

	    unless (_toplets_eq ($ot, $nt)) {
		$modified{$t}->{identities}=1;
		$modified{$t}->{plus}||=[];
		$modified{$t}->{minus}||=[];
	    }

	    # note: new toplet() returns internal id as well, which we DON'T want to check on here!
	    sub _toplets_eq 
	    {
		my ($a,$b)=@_;
		
		my ($A, $B) = ($a->[TM->ADDRESS] ||'', $b->[TM->ADDRESS] ||'');       # just convert undef into ''
		return 0 unless $A eq $B;                                             # different subject address?
		my %SIDS;
		map { ++$SIDS{$_} } @{$a->[TM->INDICATORS]}, @{$b->[TM->INDICATORS]};   # we KNOW that the lists are UNIQUE, do we?
		return 0 if grep { $_ != 2 } values %SIDS;                            # if it is not exactly 2 (one from a, one from b), then not equal
		return 1; # we're happy: different LIDs don't interest us here
	    }
	    
	}
    }

#warn "modified ".Dumper \%modified;

    my %old2newid;    
    my %identities; 
    if ($xlatneeded)
    {
	# now do the translation for assertions: rebuild old assertions
	# into new namespace and compute the id
	# don't waste time: do this only on the assertions that may be required
	# minusass (or plusass) must be checked to find assertions with renamed-but-identical players
	for my $t (@checkassertion,keys %minusass)
	{
	    my $m=$oldmap->retrieve($t);
	    my ($lid,$scope,$kind,$type,$roles,$players)=
		@{$m}[TM->LID,TM->SCOPE,TM->KIND,TM->TYPE,TM->ROLES,TM->PLAYERS];

	    # if any of the topics is untranslatable, then skip the remaining work
	    # as it can't successfully compare anyway...
	    $scope=$old2new{$scope} || next;
	    $type=$old2new{$type} || next;
	    my @newroles = map { ref($_)?$_:$old2new{$_} || next; } (@{$roles});
	    my @newplayers = map { ref($_)?$_:$old2new{$_} || next; } (@{$players});

	    my $n=Assertion->new(scope=>$scope,
				 kind=>$kind,
				 type=>$type,
				 roles=>\@newroles,players=>\@newplayers);
	    $newmap->canonicalize($n);
	    my $newid=TM::mklabel($n);
	    $old2newid{$t}=$newid;

	    if ($plusass{$newid}) # we found a matching assertion, wohee!
	    {
		delete $plusass{$newid};
		delete $minusass{$t};
		# remember that this assertion was re-id'd (directly or indirectly via players)
		# this is done for standalone assocs just the same as for bn/oc characteristics
		$identities{$t}=$newid;
	    }
	}
    }

    # finally, find and attach the modified assertions to their topics
    # attributes: to the topic
    # associations: to the type-topic

    for my $key ("plus","minus")
    {
	my ($unmodified,$map,$candidates);
	if ($key eq "plus")
	{
	    $unmodified=\%plus; $map=$newmap; $candidates=\%plusass;
	}
	else
	{
	    $unmodified=\%minus; $map=$oldmap; $candidates=\%minusass;
	}
	
	for my $t (keys %{$candidates})
	{
	    my $m=$map->retrieve($t);
	    my ($oldwho,$who,$what);
	    if ($m->[TM->KIND] ne TM->ASSOC)
	    {
		# bn or oc: attach to referenced topic
		$who=($map->get_x_players($m,"thing"))[0];
		$what=$t;
	    }
	    elsif ($m->[TM->TYPE] eq "isa")
	    {
		# isa associations get attached to the instance topic
		$who=($map->get_x_players($m,"instance"))[0];
		$what=$t;
	    }
	    else 
	    {			
		# general assoc: gets attached to type topic
		$who=$m->[TM->TYPE];
		$what=$t;
	    }

	    # if this assertion belongs to a topic that is marked gone/new, we save it with that topic
	    if ($unmodified->{$who})
	    {
		push @{$unmodified->{$who}},$what;
	    }
	    else # if this belongs to a modified topic: more details please (new/old ass)
	    {
		# we access things along the old id axis...
		if ($key eq "plus")
		{
		    $who=$new2old{$who};
		}
		$modified{$who}->{$key}||=[];
		push @{$modified{$who}->{$key}},$what;
	    }
	}
    }

    map { $identities{$_}=$old2new{$_} if ($_ ne $old2new{$_}); } (keys %old2new);

    my $returnvalue={
	    'identities'=>\%identities,
	    'plus'=>\%plus,
	    'minus'=>\%minus,
	    'modified'=>\%modified,
	};

    # pull in the midlets and assertions that have been affected,
    # so that the resulting datastructure can be frozen and used together with oldmap
    # to (re)create newmap
    if ($options->{include_changes})
    {
	# one problem, though is naming: midlets can have changed but their name doesn't
	# reflect that: we need two midlet datastructures here.
	# (assertions are fine, their names always reflect their content uniquely)

	my (%plusm,%minusm,%ass,$a);
	map { $plusm{$_} = $newmap->toplet($_) } keys %plus;
	map { $ass{ $_->[TM->LID] } = $_ }
  	   map { $newmap->retrieve($_) }
           map { @$_ }
           values %plus;
	map { $minusm{$_} = $oldmap->toplet($_) } keys %minus;
	map { $ass{ $_->[TM->LID] } = $_ }
  	   map { $oldmap->retrieve($_) }
           map { @$_ }
           values %minus;

	for my $k (keys %modified)
	{
	    # these are corresponding topics with differing midlet (contents)
	    if ($modified{$k}->{identities})
	    {
		$plusm{$k}  = $newmap->toplet($old2new{$k});
		$minusm{$k} = $oldmap->toplet($k);
	    }
	    map { $plusm{$_} =$newmap->toplet($_); $a=$newmap->retrieve($_) and $ass{$_}=$a; } (@{$modified{$k}->{plus}}); 
	    map { $minusm{$_}=$oldmap->toplet($_); $a=$oldmap->retrieve($_) and $ass{$_}=$a; } (@{$modified{$k}->{minus}}); 
	}

	$returnvalue->{plus_midlets}  =\%plusm;
	$returnvalue->{minus_midlets} =\%minusm;
	$returnvalue->{assertions}    =\%ass;
    }

    return $returnvalue;
}

our @ESSENTIALS = qw(mid2iid assertions baseuri variants);

sub melt {
    my $self = shift;
    my $tm2  = shift;

    @{$self}{@ESSENTIALS} = @{$tm2}{@ESSENTIALS};
    $self->{last_mod} = Time::HiRes::time;
}

sub insane {
    my $self = shift;

    my $mid2iid = $self->{mid2iid};
    my $asserts = $self->{assertions};

# Test 1: all toplet LIDs point to something in mid2iid which refers to themselves
    foreach my $k (keys %$mid2iid) {
	my $t = $mid2iid->{$k};
	return "toplet LID $k not in mid2iid" 
	    unless $mid2iid->{ $t->[TM->LID] };
	return "LID $k inconsistent with toplet LID"
	    unless $mid2iid->{ $t->[TM->LID] } == $t;
	return "key $k looks like assertion, but has not assertions entry" 
	    if $k =~ /[[:xdigit:]]{16}/ and !$asserts->{$k};
    }
## Test 2: all assertions are toplets
#    foreach my $k (keys %$asserts) {
#	return "assertion $k has no toplet entry"
#	    unless $mid2iid->{ $asserts->{$k}->[TM->LID] };
#	return "assertion $k toplet entry has a different LID"
#	    unless $mid2iid->{ $asserts->{$k}->[TM->LID] }->[TM->LID] eq $k;
#    }
    return undef; # pass all tests
}

struct 'Toplet' => [
    lid         => '$',
    saddr       => '$',
    sinds       => '$',
];

use constant {
#   LID        => 0,
    ADDRESS    => 1,
    INDICATORS => 2
};

our $toplet_ctr = 0;

sub internalize {
    my $self    = shift;
    my $baseuri = $self->{baseuri};

#warn "internalize base: $baseuri";

    my @mids;
    my $mid2iid = $self->{mid2iid};
    while (@_) {
	my ($k, $v) = (shift, shift);                              # assume to get here undef => URI   or   ID => URI   or ID => \ URI   or ID => undef
#warn "internalize $k, $v"; # if ! defined $k;
	# make sure that $k contains a mid

	$k = undef if defined $k && $k eq 'undef';                 # perl 5.10 will stringify undef => ....

	if (defined $k) {
	    if ($mid2iid->{$k}) {                                  # this identifier is already in the map
                # null
	    } elsif ($k =~ /^$baseuri/) {                          # ha, perfect, another identifier already in form
		# null                                             # keep it as it is
	    } elsif ($k =~ /^\w+:/) {                              # some other absURL
		if (my $k2 = $self->tids ($k)) {                   # we already had it
		    ($k, $v) = ($k2, $k);
		} else {                                           # it is unknown so far
		    ($k, $v) = ($baseuri.sprintf ("uuid-%010d", $toplet_ctr++), $k);
		}
	    } elsif (my $k2 = $self->tids ($k)) {
		$k = $k2;                                          # then we already have it, maybe under a different mid, take that

	    } else {                                               # this means we have a relURI and it is not from that map
		$k = $baseuri.$k;                                  # but now it is
	    }

	} elsif (ref ($v) eq 'Assertion') {                        # k is not defined, lets look at v, but if that is an assertion
	    $k = $baseuri.sprintf ("uuid-%010d", $toplet_ctr++);   # generate a new one
	} elsif (my $k2 = $self->tids ($v)) {                      # k is not defined, lets look at v; we already had it
	    $k = $k2;                                              # this will be k then
	} else {                                                   # it is unknown so far
	    $k = $baseuri.sprintf ("uuid-%010d", $toplet_ctr++);   # generate a new one
	}

#warn "really internalizing '$k' '$v'";
	push @mids, $k;

	$v = $v->[TM->LID] if ref ($v) eq 'Assertion';             # for internal reification we use the assertion's LID

	$mid2iid->{$k} ||= [ $k, undef, [] ];                      # now see that we have an entry in the mid2iid table
	my $kentry = $mid2iid->{$k};                               # keep this as a shortcut

	if ($v) {
	    if (ref($v)) {                                         # being a reference means that we have a subject indication
		push @{$kentry->[TM->INDICATORS]}, $$v             # append it to the list
		    unless grep {$$v eq $_} @{$kentry->[TM->INDICATORS]};   # if not yet there
	    } elsif ($kentry->[TM->ADDRESS]) {                     # this is a subject address and, oh, there is already a subject address, not good
		$log->logdie ("duplicate subject address '$v' for '$k'") unless $v eq $kentry->[TM->ADDRESS];
	    } else {                                               # everything is fine, we can set it
		$kentry->[TM->ADDRESS] = $v;                 
	    }
	}
	$mid2iid->{$k} = $kentry;                                  # necessary if mid2iid is tied itself
    }
    $self->{mid2iid}  = $mid2iid;                                  #!! needed for Berkeley DBM recognize changes on deeper levels
    $self->{last_mod} = Time::HiRes::time;
    return wantarray ? @mids : $mids[0];
}

sub midlet {
    return toplet (@_);
}

sub toplet {
    my $self = shift;
    my $mid2iid = $self->{mid2iid};

    if (wantarray) {
	return (map { defined $_ ? $mid2iid->{$_} : $_ } @_);
    } else {
	return $mid2iid->{$_[0]};
    }
}

sub midlets {
    return toplets (@_);
}

sub toplets {
    my $self = shift;
    my $mid2iid = $self->{mid2iid};

    if ($_[0]) {                                                # if there is some parameter
	if (ref ($_[0]) ) {                                     # whoohie, a search spec
            my $spec = ${$_[0]};
            my $l = []; # will be list
            while ($spec =~ s/([+-])(\w+)//) {
                if ($2 eq 'all') {
                    $l = _mod_list ($1 eq '+', $l, keys %$mid2iid);
                } elsif ($2 eq 'infrastructure') {
                    $l = _mod_list ($1 eq '+', $l, keys %{$infrastructure->{mid2iid}});
                } else {
                    $log->logdie (scalar __PACKAGE__ .": specification '$2' unknown");
                }
            }
            $log->logdie (scalar __PACKAGE__ .": unhandled specification '$spec' left") if $spec =~ /\S/;
            return map { $mid2iid->{$_} } @$l;
	} else {
	    my $m = $mid2iid;
	    return @$m{$self->tids (@_)};                        # make all these fu**ing identifiers map-absolute
	}
    } else {                                                     # if the list was empty, we assume every thing in the map
	return values %$mid2iid;
    }

sub _mod_list {
    my $pm = shift; # non-zero for +
    my $l  = shift;
    if ($pm) {
	return [ @$l, @_ ];
    } else {
	my %minus;
	@minus{ @_ } = (1) x @_;
        return [ grep { !$minus{$_} } @$l ];
    }
}
sub _mk_uniq {
    my %uniq;
    @uniq {@_} = (1) x @_;
    return keys %uniq;
}

}

sub mids {
    return tids (@_);
}

sub tids {
    my $self    = shift;
    my $mid2iid = $self->{mid2iid};                                    # shorthand

    my @ks;
  MID:
    foreach my $k (@_) {
	if (! defined $k) {                                            # someone put in undef
	    push @ks, undef;

	} elsif (ref ($k)) {                                           # would be subject indicator ref
	    my $kk = $$k;
	    foreach my $k2 (keys %{$mid2iid}) {
		if (grep ($_ eq $kk, 
			  @{$mid2iid->{$k2}->[TM->INDICATORS]}
			  )) {
		    push @ks, $mid2iid->{$k2}->[TM->LID];              # LID points to 'canonical' internal identifier
		    next MID;
		}
	    }
	    push @ks, undef;

	} elsif (my $kk = $mid2iid->{$k}) {                            # we already have something which looks like a tid
	    push @ks, $kk->[TM->LID];                                  # give back the 'canonical' one

	} elsif ($k =~ /(^\w+:)|(^[A-F0-9]{32}$)/i) {                  # must be some other uri or assoc id, must be subject address
	    no warnings;
	    my @k2 = grep ($mid2iid->{$_}->[TM->ADDRESS] eq $k, keys %{$mid2iid});
	    push @ks,  @k2 ? $mid2iid->{$k2[0]}->[TM->LID] : undef;    # we take the first we find

	} else {                                                       # only a string, like 'aaa'
	    my $k2 = $self->{baseuri}.$k;                              # make it absolute, and...
	    push @ks, $mid2iid->{$k2}                                  # see whether there is something
                        ? $mid2iid->{$k2}->[TM->LID] : undef;          # and then take canonical LID
	}
    }
#warn "mids ".Dumper (\@_)." returning ".Dumper (\@ks);
    return wantarray ? @ks : $ks[0];
}

sub externalize {
    my $self = shift;

    my $mid2iid = $self->{mid2iid};
    my @doomed = map { delete $mid2iid->{$_} } @_;
    $self->{mid2iid} = $mid2iid; ## !! needed for Berkeley DBM recognize changes on deeper levels
    $self->{last_mod} = Time::HiRes::time;
    return @doomed;
}

struct 'Assertion' => [
    lid         => '$',
    scope       => '$',
    type        => '$',
    kind        => '$', # redundant, but very useful
    roles       => '$',
    players     => '$',
    canon       => '$',
];

use constant {
    LID     => 0,
    SCOPE   => 1,
    TYPE    => 2,
    KIND    => 3,
    ROLES   => 4,
    PLAYERS => 5,
    CANON   => 6
};

# values for 'kind'
use constant {
    ASSOC    => 0,
    NAME     => 1,
    OCC      => 2,
};

sub assert {
    my $self = shift;
    my ($THING, $US) = ('thing', 'us');

#warn "sub $THING assert $self".ref ($self);

    my @tids;                                                  # first collect all emerging tids from the assertions
    foreach (@_) {
	unless ($_->[CANON]) {
	    push @tids, $_->[TYPE]  || $THING;
	    push @tids, $_->[SCOPE] || $US;
	    push @tids, @{$_->[ROLES]};
	    push @tids, grep { ! ref ($_) } @{$_->[PLAYERS]};
	}
    }
    @tids = $self->internalize ( map { $_ => undef } @tids);   # then convert them into proper usable tids

    my $asserts = $self->{assertions};                         # load (MLDBM kicker)
    foreach (@_) {                                             # only now use all the information to complete the assertions
	unless ($_->[CANON]) {
	    $_->[KIND]  ||= ASSOC;
	    $_->[TYPE]    = shift @tids;
	    $_->[SCOPE]   = shift @tids;
	    $_->[ROLES]   = [ map { shift @tids } @{$_->[ROLES]} ];
	    $_->[PLAYERS] = [ map { $_ = ref ($_) ? $_ : shift @tids } @{$_->[PLAYERS]}  ];

	    canonicalize (undef, $_);

	    $_->[LID]   ||= mklabel ($_);
	}
	$asserts->{$_->[LID]} = $_;
    }
    $self->{assertions} = $asserts;                            ### HACK ALERT: needed for Berkeley DBM recognize changes on deeper levels
    $self->{last_mod} = Time::HiRes::time;
    return @_;
}

sub retrieve {
    my $self    = shift;
    my $asserts = $self->{assertions};

    if (wantarray()) {
	return map { $asserts->{$_} } @_;
    } else {
	return $asserts->{$_[0]};
    }
}

sub asserts {
    my $self = shift;
    my $asserts = $self->{assertions};

    if ($_[0]) {
	if (ref ($_[0])) {
	    my $spec = ${$_[0]};
	    my $l = []; # will be list
	    while ($spec =~ s/([+-])(\w+)//) {
		if ($2 eq 'all') {
		    $l = _mod_list ($1 eq '+', $l,                                      keys %$asserts);

		} elsif ($2 eq 'associations') {
		    $l = _mod_list ($1 eq '+', $l, map  { $_->[TM->LID] } 
                                                   grep { $_->[TM->KIND] == TM->ASSOC } values %$asserts);
		} elsif ($2 eq 'names') {
		    $l = _mod_list ($1 eq '+', $l, map  { $_->[TM->LID] }
                                                   grep { $_->[TM->KIND] == TM->NAME }  values %$asserts);
		} elsif ($2 eq 'occurrences') {
		    $l = _mod_list ($1 eq '+', $l, map  { $_->[TM->LID] }
                                                   grep { $_->[TM->KIND] == TM->OCC }   values %$asserts);
		} elsif ($2 eq 'infrastructure') {
		    $l = _mod_list ($1 eq '+', $l,                                      keys %{$TM::infrastructure->{assertions}} );
		} else {
		    $log->logdie (scalar __PACKAGE__ .": specification '$2' unknown");
		}
	    }
	    $log->logdie (scalar __PACKAGE__ .": unhandled specification '$spec' left") if $spec =~ /\S/;
	    return map { $asserts->{$_} } @$l;
	} else {
	    return $asserts->{@_};
	}
    } else {
	return values %$asserts;
    }
}

sub is_asserted {
    my $self  = shift;
    my $a     = shift;

    unless ($a->[CANON]) {
	absolutize   ($self, $a);
	canonicalize (undef, $a);
	$a->[TM->LID] = mklabel ($a);
    }
    return $self->{assertions}->{ $a->[TM->LID] };
}

sub retract {
  my $self = shift;

# TODO: does delete $self->{assertions}->{@_} work?
  my $assertions = $self->{assertions};
  map { 
      delete $assertions->{$_} # delete them from the primary store
  } @_; 
  $self->{assertions} = $assertions; ##!! needed for Berkeley DBM recognize changes on deeper levels
  $self->{last_mod} = Time::HiRes::time;
}

use constant {
    EXISTS => 1,
    FORALL => 0
    };

our %exists_handlers = (); # they should be written at some point

our %forall_handlers = (
			'' => {
			    code => sub { # no params => want all of them
				my $self   = shift;
				return values %{$self->{assertions}};
			    },
			    desc => 'returns all assertions',
			    params => {},
			},

			'nochar' => {
			    code => sub {
				my $self   = shift;
				return
				    grep ($_->[KIND] <= ASSOC,
					  values %{$self->{assertions}});
			    },
			    desc   => 'returns all associations (so no names or occurrences)',
			    params => { 'nochar' => '1'}
			},
#-- taxos ---------------------------------------------------------------------------------------------
			'subclass.type' => {
			    code => sub {
				my $self   = shift;
				my $st     = shift;
				my ($ISSC, $SUBCLASS) = ('is-subclass-of', 'subclass');
				return () unless shift eq $ISSC;
				return
				    grep ( $self->is_x_player   ($_, $st, $SUBCLASS),
 				    grep ( $_->[TYPE] eq $ISSC,
				    values %{$self->{assertions}}));
			    },
			    desc => 'returns all assertions where there are subclasses of a given toplet',
			    params => { 'type' => 'is-subclass-of', subclass => 'which toplet should be the superclass'},
			    key => sub {
				my $self = shift;
				my $a    = shift;
				my ($ISSC, $SUBCLASS) = ('is-subclass-of', 'subclass');
				return "subclass.type:". ($self->get_x_players   ($a, $SUBCLASS))[0] . '.' . $ISSC;
			    },
			    enum => sub {
				my $self = shift;
				my ($ISSC) = ('is-subclass-of');
				return
 				    grep { $_->[TYPE] eq $ISSC }
				    values %{$self->{assertions}};
			    }
			},
			
			'superclass.type' => {
			    code => sub {
				my $self   = shift;
				my $st     = shift;
				my ($ISSC, $SUPERCLASS) = ('is-subclass-of', 'superclass');
				return () unless shift eq $ISSC;
				return
				    grep ( $self->is_x_player   ($_, $st, $SUPERCLASS),
				    grep ( $_->[TYPE] eq $ISSC,
				    values %{$self->{assertions}}));
			    },
			    desc => 'returns all assertions where there are superclasses of a given toplet',
			    params => { 'type' => 'is-subclass-of', superclass => 'which toplet should be the subclass'},
			    key => sub {
				my $self = shift;
				my $a    = shift;
				my ($ISSC, $SUPERCLASS) = ('is-subclass-of', 'superclass');
				return "superclass.type:". ($self->get_x_players   ($a, $SUPERCLASS))[0] . '.' . $ISSC;
			    },
			    enum => sub {
				my $self = shift;
				my ($ISSC) = ('is-subclass-of');
				return
 				    grep { $_->[TYPE] eq $ISSC }
				    values %{$self->{assertions}};
			    }
			},

			'class.type' => {
			    code => sub {
				my $self   = shift;
				my $t      = shift;
				my ($ISA, $CLASS) = ('isa', 'class');
				return () unless shift eq $ISA;
				return
				    grep ( $self->is_x_player   ($_, $t, $CLASS),
				    grep ( $_->[TYPE] eq $ISA,
				    values %{$self->{assertions}}));
			    },
			    desc => 'returns all assertions where there are instances of a given toplet',
			    params => { type => 'isa', class => 'which toplet should be the class'},
			    key => sub {
				my $self = shift;
				my $a    = shift;
				my ($ISA, $CLASS) = ('isa', 'class');
				return "class.type:". ($self->get_x_players   ($a, $CLASS))[0] . '.' . $ISA;
			    },
			    enum => sub {
				my $self = shift;
				my ($ISA) = ('isa');
				return
 				    grep { $_->[TYPE] eq $ISA }
				    values %{$self->{assertions}};
			    }
			},

			'instance.type' => {
			    code => sub {
				my $self   = shift;
				my $i      = shift;
				my ($ISA, $INSTANCE) = ('isa', 'instance');
				return () unless shift eq $ISA;
				return
				    grep ( $self->is_x_player   ($_, $i, $INSTANCE),
				    grep ( $_->[TYPE] eq $ISA,
				    values %{$self->{assertions}}));
			    },
			    desc => 'returns all assertions where there are classes of a given toplet',
			    params => { type => 'isa', instance => 'which toplet should be the instance'},
			    key => sub {
				my $self = shift;
				my $a    = shift;
				my ($ISA, $INSTANCE) = ('isa', 'instance');
				return "instance.type:". ($self->get_x_players   ($a, $INSTANCE))[0] . '.' . $ISA;
			    },
			    enum => sub {
				my $self = shift;
				my ($ISA) = ('isa');
				return
 				    grep { $_->[TYPE] eq $ISA }
				    values %{$self->{assertions}};
			    }
			},
#--
			'char.irole' => {
			    code => sub {
				warn "char.irole is deprecated. use char.topic instead";
				my $self   = shift;
				my $topic  = $_[1];
				return undef unless $topic;
				return
				    grep ($self->is_player ($_, $topic) &&                              # TODO: optimize this grep away (getting chars is expensive)
				          NAME <= $_->[KIND] && $_->[KIND] <= OCC,
				    values %{$self->{assertions}});
			    },
			    desc => 'deprecated: return all assertions which are characteristics for a given toplet',
			    params => { char => '1', irole => 'the toplet for which characteristics are sought'}
			},

			'char.topic' => {
			    code => sub {
				my $self   = shift;
				my $topic  = $_[1];
				return
				    grep (NAME <= $_->[KIND] && $_->[KIND] <= OCC &&
				          $_->[PLAYERS]->[0] eq $topic,                                   # first role is always the 'thing'
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions which are characteristics for a given toplet',
			    params => { char => '1', topic => 'the toplet for which characteristics are sought'},
			    key => sub {
				my $self = shift;
				my $a    = shift;
				return "char.topic:1.". $a->[PLAYERS]->[0];
			    },
			    enum => sub {
				my $self = shift;
				return
				    grep { $_->[KIND] != ASSOC }
				    values %{ $self->{assertions} };
			    }
			},

			'char.value' => {
			    code => sub {
				my $self   = shift;
				my $value  = $_[1];
				return
				    grep (NAME <= $_->[KIND] && $_->[KIND] <= OCC &&
					  $_->[PLAYERS]->[1]->[0] eq $value->[0] &&                       # second role is always the value
					  $_->[PLAYERS]->[1]->[1] eq $value->[1],                         # test value AND type
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions which are characteristics for some topic of a given value',
			    params => { char => '1', value => 'the value for which all characteristics are sought'},
			    key => sub {
                                my $self = shift;
                                my $a    = shift;
                                return "char.value:1.". $a->[PLAYERS]->[1]->[0] . '.' . $a->[PLAYERS]->[1]->[1];
                            },
                            enum => sub {
                                my $self = shift;
                                return
                                    grep { $_->[KIND] != ASSOC }
				    values %{ $self->{assertions} };
                            }
			},

			'char.type' => {
			    code => sub {
				my $self   = shift;
				my $type   = $_[1];
				return
				    grep { $self->is_subclass ($_->[TYPE], $type ) }
				    grep { $_->[KIND] != ASSOC }
				    values %{$self->{assertions}};
			    },
			    desc => 'return all assertions which are characteristics for some given type',
			    params => { char => '1', type => 'the characteristic type'},
			    key => sub {
                                my $self = shift;
                                my $a    = shift;
                                return "char.type:1.". $a->[TYPE];
                            },
                            enum => sub {
                                my $self = shift;
                                return
                                    grep { $_->[KIND] != ASSOC }
				    values %{ $self->{assertions} };
                            }
			},

			'char.type.value' => {
			    code => sub {
				my $self   = shift;
				my $type   = $_[1];
				my $value  = $_[2];
				return
				    grep { $self->is_subclass ($_->[TYPE], $type ) }
				    grep (NAME <= $_->[KIND] && $_->[KIND] <= OCC &&
					  $_->[PLAYERS]->[1]->[0] eq $value->[0] &&                       # second role is always the value
					  $_->[PLAYERS]->[1]->[1] eq $value->[1],                         # test value AND type
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions which are characteristics for some topic of a given value for some given type',
			    params => { char => '1', type => 'the characteristic type', value => 'the value for which all characteristics are sought'},
			    key => sub {
                                my $self = shift;
                                my $a    = shift;
                                return "char.type.value:1.". $a->[TYPE] . '.' . $a->[PLAYERS]->[1]->[0] . '.' . $a->[PLAYERS]->[1]->[1];
                            },
                            enum => sub {
                                my $self = shift;
                                return
                                    grep { $_->[KIND] != ASSOC }
				    values %{ $self->{assertions} };
                            }
			},

			'char.topic.type' => {
			    code => sub {
				my $self   = shift;
				my $topic  = $_[1];
				my $type   = $_[2];
				return
				    grep ($self->is_subclass ($_->[TYPE], $type),
				    grep ($_->[PLAYERS]->[0] eq $topic &&                         # first role is always the 'thing'
					  NAME <= $_->[KIND] && $_->[KIND] <= OCC,
				    values %{$self->{assertions}}));
			    },
			    desc => 'return all assertions which are a characteristic of a given type for a given topic',
			    params => { char => '1', topic => 'the toplet for which these characteristics are sought', type => 'type of characteristic' },
			    key => sub {
                                my $self = shift;
                                my $a    = shift;
                                return "char.topic.type:1.". $a->[PLAYERS]->[0] . '.' . $a->[TYPE] ;
                            },
                            enum => sub {
                                my $self = shift;
                                return
                                    grep { $_->[KIND] != ASSOC }
				    values %{ $self->{assertions} };
                            }
			},

			'lid' => {
			    code => sub {
				my $self   = shift;
				my $lid    = $_[1];
				return
				    $self->{assertions}->{$lid} || ();
			    },
			    desc => 'return one particular assertions with a given ID',
			    params => { lid => 'the ID of the assertion' }
			},

			'type' => {
			    code => sub {
				my $self   = shift;
				my $type   = $_[0];
				return 
				    grep ($self->is_subclass ($_->[TYPE], $type),
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions with a given type',
			    params => { type => 'the type of the assertion' }
			},
			
			'iplayer' => {
			    code => sub {
				my $self   = shift;
				my $ip     = $_[0];
				return 
				    grep ($self->is_player ($_, $ip), 
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions where a given toplet is a player',
			    params => { iplayer => 'the player toplet' }
			},

			'iplayer.type' => {
			    code => sub {
				my $self      = shift;
				my ($ip, $ty) = @_;
				return 
				    grep ($self->is_player ($_, $ip)          &&
					  $self->is_subclass ($_->[TYPE], $ty),
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions of a given type where a given toplet is a player',
			    params => { iplayer => 'the player toplet', type => 'the type of the assertion' }
			},

			'iplayer.irole' => {
			    code => sub {
				my $self      = shift;
				my ($ip, $ir) = @_;
				return 
				    grep ($self->is_player ($_, $ip, $ir), 
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions where a given toplet is a player of a given role',
			    params => { iplayer => 'the player toplet', irole => 'the role toplet (incl subclasses)' },
			},

			'iplayer.irole.type' => {
			    code => sub {
				my $self           = shift;
				my ($ip, $ir, $ty) = @_;
				return 
				    grep ($self->is_subclass ($_->[TYPE], $ty) && 
					  $self->is_player ($_, $ip, $ir), 
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions of a given type where a given toplet is a player of a given role',
			    params => { iplayer => 'the player toplet', 
					irole => 'the role toplet (incl subclasses)',
					type => 'the type of the assertion' }
			},

			'irole.type' => {
			    code => sub {
				my $self      = shift;
				my ($ir, $ty) = @_;
				return
				    grep ($self->is_role ($_, $ir)             &&
					  $self->is_subclass ($_->[TYPE], $ty),
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions of a given type where there is a given role',
			    params => { irole => 'the role toplet (incl subclasses)', type => 'the type of the assertion' }
			},

			'irole' => {
			    code => sub {
				my $self      = shift;
				my ($ir)      = @_;
				return
				    grep ($self->is_role ($_, $ir),
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions where there is a given role',
			    params => { irole => 'the role toplet (incl subclasses)' }
			},

			'aplayer.arole.brole.type' => {
			    code => sub {
				my $self   = shift;
				my ($ap, $ar, $br, $ty) = @_;
				return
				    grep ( $self->is_role     ($_, $br),
				    grep ( $self->is_player   ($_, $ap, $ar),
				    grep ( $self->is_subclass ($_->[TYPE], $ty),
				    values %{$self->{assertions}})));
			    },
			    desc => 'return all assertions of a given type where a given toplet plays a given role and there exist another given role',
			    params => { aplayer => 'the player toplet for the arole', 
					arole => 'the role toplet (incl subclasses) for the aplayer',
					brole => 'the other role toplet (incl subclasses)',
					type => 'the type of the assertion'
					}
			},
			
			'aplayer.arole.bplayer.brole.type' => {
			    code => sub {
				my $self  = shift;
				my ($ap, $ar, $bp, $br, $ty) = @_;
				return
				    grep ( $self->is_player ($_, $bp, $br),
			            grep ( $self->is_player ($_, $ap, $ar),
			            grep ( $self->is_subclass ($_->[TYPE], $ty),
				    values %{$self->{assertions}})));
			    },
			    desc => 'return all assertions of a given type where a given toplet plays a given role and there exist another given role with another given toplet as player',
			    params => { aplayer => 'the player toplet for the arole', 
					arole => 'the role toplet (incl subclasses) for the aplayer',
					brole => 'the other role toplet (incl subclasses)',
					bplayer => 'the player for the brole',
					type => 'the type of the assertion'
					}
			},

			'anyid' => {
			    code => sub {
				my $self   = shift;
				my $lid    = shift;
				return
				    grep (
				     $self->is_subclass ($_->[TYPE], $lid) ||   # probably not a good idea
					  $_->[TYPE]  eq         $lid           ||   # this seems a bit safer
					  $_->[SCOPE] eq         $lid           ||
					  $self->is_player ($_, $lid)           ||
					  $self->is_role   ($_, $lid)           ,
				    values %{$self->{assertions}});
			    },
			    desc => 'return all assertions where a given toplet appears somehow',
			    params => { anyid => 'the toplet' }
			}
		    
			);

sub _allinone {
    my $self     = shift;
    my $exists   = shift;
    my $template = Assertion->new (@_);                              # we create an assertion on the fly
#warn "allinone ".Dumper $template;
    $self->absolutize   ($template);  
#warn "allinone2".Dumper $template;
    $self->canonicalize ($template);                                # of course, need to be canonicalized
#warn "allinone3".Dumper $template;

#warn "in store match template ".Dumper $template;
    my @mads;
  ASSERTION:
    foreach my $m (values %{$self->{assertions}}) {                 # arbitrary AsTMa! queries TBD, can be faster as well
	
	next if defined $template->[KIND]  &&                       # is kind defined
                $m->[KIND]  ne $template->[KIND];                   #    and does it match?
#warn "after kind";
	next if defined $template->[SCOPE] && 
                $m->[SCOPE] ne $self->tids ($template->[SCOPE]);    # does scope match?
#warn "after scope";
	next if defined $template->[TYPE]  &&                       
                !$self->is_subclass ($m->[TYPE], $self->tids ($template->[TYPE]));         # does type match (including subclassing)?
#warn "after type";
			       
	my ($rm, $rc) = ($m->[ROLES],   $template->[ROLES]);
	push @mads, $m and next ASSERTION             if ! @$rc;     # match ok, if we have no roles
#warn "after push roles";
	next ASSERTION if @$rm != @$rc;                              # quick check: roles must be of equal length
#warn "after roles";
	my ($pm, $pc) = ($m->[PLAYERS], $template->[PLAYERS]);
	push @mads, $m and next ASSERTION             if ! @$pc;     # match ok, if we have no players
	next if @$pm != @$pc;                                        # quick check: roles and players must be of equal length
#warn "after players equal length ".Dumper ($pm, $pc);

#######	$pm = [ $self->tids (@$pm) ];                                
	for (my $i = 0; $i < @{$rm}; $i++) {                         # order is canonicalized, would not want to test all permutations
#warn "before role tests : is $rm->[$i] subclass of $rc->[$i]?";
	    next ASSERTION if defined $rc->[$i] && !$self->is_subclass ($rm->[$i], $rc->[$i]);              # go to next assertion if that does not match
#warn "after role ok";
	    next ASSERTION if defined $pc->[$i] && $pm->[$i] ne $pc->[$i];
	}
#warn "after players  roles";
	return (1) if $exists;                                       # with exists that's it
	push @mads, $m;                                              # with forall we do continue to collect
    }
#warn "we return ".Dumper \@mads;
    return @mads;                                                    # and return what we got
}

#sub _fat_mama {
#    use Proc::ProcessTable;
#    my $t = new Proc::ProcessTable;
##warn Dumper [ $t->fields ]; exit;
#    my ($me) = grep {$_->pid == $$ }  @{ $t->table };
##warn "size: ".  $me->size;
#    return $me->size / 1024.0 / 1024.0;
#}



sub match_forall {
    my $self   = shift;
    my %query  = @_;
#warn "forall ".Dumper \%query;

    my @skeys = sort keys %query;                                                           # all fields make up the key
    my $skeys = join ('.', @skeys);
    my @svals = map { $query{$_} } @skeys;

    if (my $idxs = $self->{indices}) {                                                      # there are indices to help me
	my $key   = "$skeys:" . join ('.', @svals);
	foreach my $idx (@$idxs) {
	    if (my $lids  = $idx->is_cached ($key)) {                                       # if result was cached, lets take the list of lids
#		warn "using cached for $key". Dumper $lids;
		return map { $self->{assertions}->{$_} } @$lids;                            # and return fully fledged
	    }
	}
	# obviously we have not found it                                                    # not defined means not cache => recompute
	my @as = _dispatch_forall ($self, \%query, $skeys, @svals);                         # do it the hard way
	$idxs->[0]->do_cache ($key, [ map { $_->[LID] } @as ]);                             # save it for later, simply use the first [0]
	return @as;
    } else {                                                                                # no cache, let's do the ochsentour
	return _dispatch_forall ($self, \%query, $skeys, @svals);
    }

sub _dispatch_forall {
    my $self  = shift;
    my $query = shift;
    my $skeys = shift;

    if (my $handler = $forall_handlers{$skeys}) {                                           # there is a constraint and we have a handler
	return &{$handler->{code}} ($self, @_); 
    } else {                                                                                # otherwise
	return _allinone ($self, 0, %$query);                                               # we use a generic handler, slow but should do the trick
    }
}

}

sub match_exists {
    my $self   = shift;
    my %query  = @_;

#warn "exists ".Dumper $query;

    my @skeys = sort keys %query;                                                           # all fields make up the key
    my $skeys = join ('.', @skeys);

#warn "keys for this $skeys";
    if (my $handler = $exists_handlers{$skeys}) {                                           # there is a constraint and we have a handler
	return &{$handler->{code}} ($self, map { $query{$_} } @skeys); 
    } else {                                                                                # otherwise
	return _allinone ($self, 1, %query);                                                # we use a generic handler, slow but should do the trick
    }
}

sub match {
    my $self   = shift;
    my $exists = shift; # FORALL or EXIST, DOES NOT work yet

    return $exists ? match_exists ($self, @_) : match_forall ($self, @_);
}