TM::IndexAble - Topic Maps, Trait to provide lazy and eager indices

      my $tm = new TM...                           # get any map
      use Class::Trait;
      Class::Trait->apply ($tm, "TM::IndexAble");  # apply the trait

      # add a lazy cache for subclassing and instanceOf
      $tm->index ({ axis => 'taxo' });
      $tm->index ({ axis => 'taxo', closed => 0}); # the same, lazy is NOT closed

      # add eager cache (= index) for taxonometrics
      $tm->index ({ axis => 'taxo', closed => 1}); # eager is closed, will take some time

      # add index for characteristics
      $tm->index ({ axis => 'char'});
      $tm->index ({ axis => 'char', closed => 1}); # can be closed as well

      # ditto for reification
      $tm->index ({ axis => 'reify'});
      $tm->index ({ axis => 'reify', closed => 1});

      # create index/caches, but separate from map itself
      $tm->index ({ axis => 'reify', closed => 0, detached => {} });




      my %stats = $tm->index;                      # get current indices + statistics

package TM::IndexAble;

use strict;
use warnings;

use Data::Dumper;
use Class::Trait 'base';

#    map
#   +---+
#   |   |
#   |   |                                cache
#   |   | index  +-----+ <axis>_data   +-------+                                         <axis>_data     # can be local or detached
#   |   |------->|     |-------------->|       | key = query                             <axis>_hits     # integer
#   +---+        |     | <axis>        |       | value = array ref of LIDs               <axis>_requests # integer
#                |     |-->HASH(0x123) |       |
#                +-----+               |       |
#                                      +-------+

our %cachesets;   # here the detached ones go

#   +---+                 index (detached)                                               # provided by caller
#   |   |  HASH(0x123)  +-------+         cache
#   |   |-------------->|       |       +-------+
#   |   |               |       |------>|       |
#   |   |               |       |       |       |

sub index {
    my $self = shift;

    my $index = ($self->{index} || {});                                                  # local handle on all things indexed

    foreach my $idx (@_) {                                                               # whatever we are given by the user
	my @a = _expand_axes ($idx->{axis});


	my $index2;  # could be detached or local
	if (my $detached  = $idx->{detached}) {                                          # if user provided a detachable index, we take that
	    $cachesets{"$detached"} = $detached;                                         # register that locally (as key this will be stringified)
	    $index->{$_}  = "$detached" foreach @a;                                      # and memorize that the real information is in a detached one, not inside the map
	    $index2       = $detached;                                                   # from now on we work with that
	} else {
	    $index2       = $index;
	}

	foreach my $a (@a) {                                                             # walk over all axes now

#warn "indexable index $a";
	    $index2->{"${a}_hits"}     //= 0;                                            # initialize stats
	    $index2->{"${a}_requests"} //= 0;

	    next if $index2->{"${a}_closed"};                                            # if we already got a closed one, we do not touch it
#warn "AFTER CLOSED!";

	    $index2->{"${a}_data"} //= {}; # we need to have a place for data

	    next unless $idx->{closed};                                                  # only continue here when we want to close it
	    my $data = $index2->{"${a}_data"};                                           # this is a potentially expensive operation

	    if ($a eq 'reify') {                                                         # this is a special case
		my $mid2iid = $self->{mid2iid};                                          # not necessarily cheap
		
		%$data = map  { $mid2iid->{$_}->[TM->ADDRESS] => $_ }                    # invert the index
		         grep { $mid2iid->{$_}->[TM->ADDRESS] }                          # only those which "reify" something survive
		         keys %{$mid2iid};                                               # all toplet tids
		    
	    } else {
		my $enum = $TM::forall_handlers{$a}->{enum}                              # how to generate all assertions of that axes
		           or die "unsupported index axes $a";                           # complain if enumeration is not yet supported
		my $key  = $TM::forall_handlers{$a}->{key};                              # how to derive a full cache key from one assertion
		    
		my %as;                                                                  # collect the assertions for that axis $a
		map { push @{ $as{ &$key ($self, $_) } } , $_->[TM->LID] }               # sort them according to the key
		    &$enum ($self) ;                                                     # generate all assertions fitting this axis
		    
		map { $data->{$_} = $as{$_} }                                            # store the corresponding lists into the cache
		    keys %as;                                                            # walk through keys
	    }
#warn "after axis $a ". Dumper $data;
	    $index2->{"${a}_data"}   = $data;                                            # this is only for MLDBM backed indices (yes, I know a PITA)
	    $index2->{"${a}_closed"} = 1;
	}

    }
    $self->{index} = $index;                                                             # kick MLDBM in the ...
#    warn Dumper ($self->{index}, \%cachesets);

    return _collect_stats ($index) if (wantarray);

sub _collect_stats {
    my $index = shift;
    my %s;
    map { 
	$s{ $1 }->{$2} = $index->{$_} if $_ =~ /(.+)_(.+)/
        }
        keys %{$index};

    %s = (%s , map { _collect_stats ($_) } # and compute the stats from there
	       map { $cachesets{ $index->{$_} } }  # these are detached ones, get them
	       grep { $_ !~ /_/ }         # but only look for those without a _
	       keys %{$index}                       # go back to all indices
	);
    return %s;
    }
}

sub _expand_axes {
    my $a = shift;
    use feature 'switch';
    given ( $a ) {
	when ('taxo') {                                                              # "taxo" shortcuts some axes
	    return qw(subclass.type superclass.type class.type instance.type);
	}
	when ('char') {                                                              # char shortcut
	    return qw(char.topic char.value char.type char.type.value char.topic.type);
	}
	when ('reify') {                                                             # this is a special one
	    return qw(reify);
	}
	default {                                                                    # take that as-is
	    return ( $a );
	}
    }
}

sub deindex {
    my $self = shift;

    my $index = $self->{index};
#warn "deindex cacheset keys before ".Dumper [ keys %cachesets ];
#warn Dumper $index;
    foreach my $a (map { _expand_axes ($_) } @_) {
#warn "deleting " . $a;
	if (ref ($a)) {                                                        # this is a hash ref, obviously the index
	    delete $cachesets{ "$a" };
            map { delete $index->{$_} }                                        # delete those index entries
                grep { $index->{$_} eq "$a" }                                  # which carry data from the {} we passed in
                keys %$index;
	} elsif (ref ($index->{$a})) {                                         # not detached
	    delete $index->{$a};                                               # so we simply get rid of it
	} else {                                                               # this is also a detached one, but this time via an axis (not the index itself)
	    my $h = delete $index->{$a};                                       # get the hash (stringified) and in one go delete it
	    delete $cachesets{$h};
	}
    }
#warn "deindex cacheset keys before ".Dumper [ keys %cachesets ];
#warn Dumper $index;
    $self->{index} = $index;
}

#-- trait mixins

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{$_} }                                             # lookup that key in the incoming query
                @skeys;                                                        # take these query keys
    my $key   = "$skeys:" . join ('.', 
				  map { ref ($_) ? @$_ : $_ }                  # if we have a value, take that and its datatype
				  @svals);

#warn "i match ".$skeys;
#warn "i match whole key >>$key<<";
    my $index = $self->{index};                                                # just a handle

    if (my $detached = $index->{$skeys}) {                                     # axis is pointing to a detached
	$index = $cachesets{ $index->{$skeys} };
    }
#warn Dumper $index;
    unless ( my $data = $index->{"${skeys}_data"} ) {
#warn "no index";
	return TM::_dispatch_forall ($self, \%query, $skeys, @svals);

    } else {
#warn "-> using index! $data";
	$index->{"${skeys}_requests"}++;
#warn "DATA keys ".scalar keys %$data;
#warn "DATA ".Dumper $data;	
	if (my $lids = $data->{ $key }) {
#warn "and HIT";
	    $index->{"${skeys}_hits"}++;

	    my $asserts = $self->{assertions};                                 # just in case we have a tied hash ... we create a handle
	    return map { $asserts->{$_} } @$lids;                              # and return fully fledged assocs
	}
	return () if $index->{"${skeys}_closed"};                              # the end of wisdom     ?????????????????????????? SUSPICIOUS
	my @as = TM::_dispatch_forall ($self, \%query, $skeys, @svals);
	$data->{ $key } = [ map { $_->[TM->LID] } @as ];
	return @as;
    }
}



sub is_reified {
    my $self = shift;                                                          # the map
    my $a    = shift;                                                          # the thing (assertion or otherwise)

    my $index = $self->{index};
    if (my $detached = $index->{'reify'}) {                                     # axis is pointing to a detached
	$index = $cachesets{ $index->{'reify'} };
    }

    unless ( my $data = $index->{'reify_data'} ) {                             # if an index over reify has NOT been activated
	return $self->_is_reified ($a);                                        # we look only at the source map

    } else {                                                                   # we have an index!
	$index->{'reify_requests'}++;                                          # bookkeeping

	my $k = ref ($a) ? $a->[TM->LID] : $a;
	if (my $tid = $data->{ $k }) {                                         # cache always holds list references
	    $index->{'reify_hits'}++;                                          # bookkeeping
	    return ($tid);
	}
	return () if $index->{'reify_closed'};                                 # the end of wisdom
#	warn "no hit!";
	my @tids = $self->_is_reified ($a);                                    # returns a list (strangely)
	$data->{ $k } = $tids[0];                                              # tuck it into the cache
	return @tids;                                                          # and give it back to the caller
    }
}

our $VERSION = 0.7;

1;

__END__