TM::Serializable::AsTMa - Topic Maps, trait for parsing AsTMa instances.

  # this is not an end-user package
  # see the source in TM::Materialized::AsTMa how this can be used

package TM::Serializable::AsTMa;

use strict;
use warnings;

use Class::Trait 'base';
use Class::Trait 'TM::Serializable';

use Data::Dumper;

sub deserialize {
    my $self    = shift;
    my $content = shift;

    if ($content =~ /^\s*%version\s+2/s) {                                     # this is version 2.x
	use TM::AsTMa::Fact2;
	my $ap = new TM::AsTMa::Fact2 (store => $self);
	$ap->parse ($content);

    } else {                                                                   # assume it is 1.x
	use TM::AsTMa::Fact;
	my $ap = new TM::AsTMa::Fact (store => $self);
	$ap->parse ($content);                                                 # we parse content into the ap object component 'store'
    }
    return $self;
}

sub serialize  {
    my ($self, %opts) = @_;
    $opts{version}     ||=1;
#   $opts{omit_trivia} ||=1;
    $opts{omit_infrastructure} ||=1;
    
    return _serializeAsTMa1 ($self, %opts) if $opts{version} eq 1;

    $TM::log->logdie(scalar __PACKAGE__ .": serialization not implemented for AsTMa version ".$opts{version} );

#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;
#}

sub _serializeAsTMa1 {
    my $self = shift;
    my %opts = @_;

    my ($THING, $US, $CLASS, $INSTANCE, $VALUE, $ISA, $NAME, $OCCURRENCE) =
	('thing', 'us', 'class', 'instance', 'value', 'isa', 'name', 'occurrence');

#    my ($PLAYERS, $ROLES, $URI, $LID, $ADDRESS, $NAME, $OCC, $ASSOC, $SCOPE, $TYPE, $KIND, $INDICATORS) =  # sadly, this makes a difference in speed
#	(TM->PLAYERS, TM->ROLES, TM::Literal->URI, TM->LID, TM->ADDRESS, TM->NAME, TM->OCC, TM->ASSOC, TM->SCOPE, TM->TYPE, TM->KIND, TM->INDICATORS);

    my $baseuri = $self->{baseuri};

    my $debase = sub {
	$_[0] =~ s/^$baseuri//;
	return $_[0];
    };

    my %assocs;
    my %topics;                                  # the work stats: collect info from the assertions.

#    warn scalar $self->asserts (\ '+all -infrastructure');

ASSOCS:
    for my $m ($self->asserts (\ '+all -infrastructure')) {
	my $kind  = $m->[TM->KIND];
	my $type  = $m->[TM->TYPE];
	my $scope = $m->[TM->SCOPE];
	my $lid   = $m->[TM->LID];

	$scope = $US eq $scope ? undef : &$debase ($scope);

	if ($kind == TM->ASSOC) {
	    if ( $type eq $ISA ) {
		my ($p, $c) = map { &$debase ( $_) } @{ $m->[TM->PLAYERS] };
		push @{$topics{$p}->{children}}, $c;
		push @{$topics{$c}->{parents}},  $p;

	    } else {
		my %thisa;

		$thisa{type}      = &$debase ($type);
		$thisa{scope}     = $scope;

		if (my ($reifier)     = $self->is_reified ($m)) {
		    $thisa{reifiedby} = &$debase ($reifier);
		}

		{
		    my ($ps, $rs) = ($m->[TM->PLAYERS], $m->[TM->ROLES]);
		    for (my $i = 0; $i < @$ps; $i++) {
			push @{  $thisa{roles}->{ &$debase ($rs->[$i]) }  }, &$debase ($ps->[$i]);
		    }
		}

		$assocs{$lid} = \%thisa;
	    }

	} elsif ($kind == TM->NAME) {
	    my ($thing, $value) = @{ $m->[TM->PLAYERS] };
	    $thing = &$debase ($thing);
	    
	    $TM::log->logdie (scalar __PACKAGE__ .": astma 1.x does not offer reification of basenames (topic $thing)\n")
		if $self->is_reified ($m);

	    push @{$topics{$thing}->{bn}}, [ $value->[0], $type eq $NAME ? undef : &$debase($type), $scope ];
	    
	} elsif ($kind == TM->OCC) {
	    my ($thing, $value) = @{ $m->[TM->PLAYERS] };
	    $thing = &$debase ($thing);
	    
	    $TM::log->logdie (scalar __PACKAGE__ .": astma 1.x does not offer reification of occurrences (topic $thing)\n")
		if $self->is_reified ($m);

	    my $key= $value->[1] eq TM::Literal->URI ? "oc" : "in";
	    push @{$topics{$thing}->{ $key }}, [ $value->[0], $type eq $OCCURRENCE ? undef : &$debase($type), $scope ];
	}
    }
##warn Dumper \%topics;
    foreach my $tt ($self->toplets (\ '+all -infrastructure') ) {                     # then from the topics
	my $t = $tt->[TM->LID];
	my $tn = &$debase ($t);

	$topics{$tn} ||= {}; 
	
	$TM::log->logdie (scalar __PACKAGE__ .": astma 1.x does not offer variants (topic $tn)\n")
	    if ($self->variants ($t));
	
        $topics{$tn}->{sins} = $tt->[TM->INDICATORS] if @{ $tt->[TM->INDICATORS] } > 0;
	if ($tt->[TM->ADDRESS] and !$self->retrieve($tt->[TM->ADDRESS])) {
	    # external target? attach as active 'reifies' to local topic
	    # target is an internal topic? attach as passive 'is-reified-by' to the target,
	    # to avoid the ugly/base-specific 'x reifies tm://y'
	    my $target = $tt->[TM->ADDRESS];
	    if ($self->toplet($target))
	    {
		$topics{&$debase($target)}->{raddr}=$tn;
	    }
	    else
	    {
		$topics{$tn}->{addr}=$target;
	    }
	}
    } 
#--- finally the actual dumping of the actual information ---------------------------------------------------
    my @result; # will collect lines here
    push @result, "# originally from ".($self->{url} =~ /^inline:/ ? "inline" : $self->{url}) unless $opts{omit_provenance};
    push @result, "# base $baseuri";
    push @result, "";

    push @result, "%trace ".$opts{trace} if $opts{trace};

TOPICS:
    for my $t (sort keys %topics) {
	my $tn = $topics{$t};

	if ($opts{omit_infrastructure}) {
	    next TOPICS if $TM::infrastructure->{mid2iid}->{ $t };
	}
	if ($opts{omit_trivia}) {
	    next TOPICS unless keys %$tn;
	}

	push @result,
        $t                                                                                   # the id
	.($tn->{parents} ? " (".join(" ",@{$tn->{parents}}).")" : "")                        # optionally the types (....)
        .($tn->{addr}     ? " reifies ". $tn->{addr}              : "")                      # optionally the subject address
	.($tn->{raddr}?(" is-reified-by ".$tn->{raddr}):""); # subject address, passive.
	
	foreach my $k (qw(bn in oc)) {
	    push @result, 
		map {  $k.($_->[2]?(" @ ".$_->[2]):"")
			 .($_->[1]?(" (".$_->[1].")"):"")
                         .": ". _multiline ($_->[0]) } 
		(@{$tn->{$k}});
	}
sub _multiline {
    if ($_[0] =~ /\n/s) {
	return "<<<\n$_[0]\n<<<";
    } else {
	return $_[0];
    }
}

	if ($tn->{sins}) {
	    map { push @result, "sin: ".$_; } (@{$tn->{sins}});
	}
	push @result,"";                                                                     # will end up as empty line
    }
    map {
	my $a = $_;
	push @result,"(".$a->{type}.")"
                     .($a->{scope}     ? " @".$a->{scope}                  : "")
                     .($a->{reifiedby} ? " is-reified-by ".$a->{reifiedby} : "");
	map 
	{ 
	    push @result, 
	    "$_: ".join(" ",@{$a->{roles}->{$_}});  
	} (sort keys %{$a->{roles}});
	push @result,"";
    }
    map       { $assocs{ $_ } }
         sort { $assocs{$b}->{type} cmp $assocs{$a}->{type} } 
         keys %assocs;
    return join("\n",@result)."\n\n";
}
}

our $VERSION  = '0.6';
our $REVISION = '$Id: rho';

1;

__END__

# not sure what it does, will check later
#	    if ($tn->{reifies}) {
#		next TOPICS if grep { $_ && $tn->{reifies} eq $_ } @iaddr;
#	    }
	}