TM::Synchronizable::MapSphere - Topic Maps, trait for a syncing a hierarchical TM repository

   use TM;
   use base qw(TM);
   use Class::Trait ('TM::MapSphere',
                     'TM::Synchronizable::MLDBM' => {
   		         exclude => [ "sync_in", "sync_out" ]
   		     },
                     'TM::Synchronizable::MapSphere');

package TM::Synchronizable::MapSphere;

use strict;
use warnings;

use TM;

use Data::Dumper;

use Class::Trait 'base';
use Class::Trait 'TM::ResourceAble';
use TM::MapSphere;

#our @REQUIRES = qw(source_in source_out);

# provides sync_in/out

use constant MAX_DEPTH => 99;

sub sync_in {
    my $self  = shift;
    my $pref  = shift || '/';                                                            # prefix determines from where we would want to start to sync
    my $depth = shift || MAX_DEPTH;

#warn "sync in mapsphere last mod : ".$self->last_mod;
#warn "sync in mapsphere mtime    : ".$self->mtime;
    $self->source_in if $pref eq '/'                                                     # but only if we start at the top
                     && $self->last_mod < $self->mtime + 1;                              # and the usual exercise + benefit of doubt

    _sync_in_children ($self, $self, '/', $pref, $depth - 1);                            # now we find all children, sync_in them and mount them

sub _sync_in_children {
    my $top   = shift; 									 # will be passed through all recursivel leves
    my $map   = shift; 									 # current map whose children we seek
    my $path  = shift; 									 # the current path for mounting
    my $pref  = shift;                                                                   # the prefix, only under it we seriously do something
    my $depth = shift;

#warn "_sync_in_children $top $map $path $pref ($depth)";

    return unless $depth;                                                                # if we have reached our limit, we stop

    foreach my $m ( $map->instances ($map->mids (\ TM::PSI->TOPICMAP)) ) {
        (my $id = $m) =~ s|.+/(.+)|$1|;                                                  # throw away the baseuri stuff
#warn "id $id";
	my $newpath = $path . "$id/";                                                    # child will have this path
#warn "consider $newpath, compare it with $pref";
	if ($newpath =~ /^$pref/) {                                                      # only if the prefix is matched we seriously do something
#warn "--- $newpath within prefix $pref";

	    my $mid = $map->midlet ($m);                                                     # get the topic itself
#warn Dumper $mid;
	    my ($url)            = @{$mid->[TM->INDICATORS]}                        or next; # if there is no subject indicator, we could not load it anyway
	    my ($baseuri)        =   $mid->[TM->ADDRESS]                            or next; # if there is no subject address, we could not load it anyway

	    my ($implementation) = map { $_->[ TM->PLAYERS ]->[1]->[0] }
	                           $map->match (TM->FORALL, char => 1, topic => $m, type => $map->mids (\ TM::MapSphere->IMPLEMENTATION))
		or next;
	    
	    my $child;
#warn "-- implementation $implementation";
	    eval {
		$child = $implementation->new (url => $url, baseuri => $baseuri );
	    }; $TM::log->logdie (scalar __PACKAGE__ .": cannot instantiate '$implementation' (maybe 'use' it?) for URL '$url' ($@)") if $@;
	    
	    $child->sync_in;
#warn "---- synced in";
	    $top->mount ($newpath => $child, 1);                                          # finally mount this thing into the current, force it in case
#warn "-------mounted $newpath";
	    _sync_in_children ($top, $child, $newpath, $pref, $depth-1);                  # go down recursively (depth TTL included)
#warn "---- back from children";
	}
    }
#warn "children done";
}
}

sub sync_out {
    my $self  = shift;
    my $pref  = shift || '/';
    my $depth = shift || MAX_DEPTH;

# warn __PACKAGE__ . "sync_out";
# warn "calling $self source out";

#warn "sync out mapsphere last mod : ".$self->last_mod;
#warn "sync out mapsphere mtime    : ".$self->mtime;
    if (   $pref eq '/'
	&& $self->mtime < $self->last_mod) {                                             # there was a change internally
#warn "really sync out mapspheric root";
	my $mt = delete $self->{mounttab};                                               # this make sure that only the map is source'd out (MLDBM would take EVERYTHING)
	$self->source_out if $self->last_mod > $self->mtime;
	$self->{mounttab} = $mt;                                                         # reinstate mount table
    }

    my $mt = $self->{mounttab};
    foreach my $path (grep ($_ ne '/', keys %$mt)) {                                     # all children (not the root)
#warn "--- considering $path for sync_out";	
	next unless $path =~ /^$pref/;
	my @segs = $path =~ /(\/)/g;
	next if scalar @segs > $depth;
#warn "--- really chosen $path for sync_out";	
	$mt->{$path}->sync_out;
    }
}

our $VERSION  = 0.02;
our $REVISION = '$Id: MapSphere.pm,v 1.3 2006/11/25 08:46:59 rho Exp $';

1;

__END__