1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
package MyMapSphere2;
use TM::ResourceAble::MLDBM;
use base qw(TM::ResourceAble::MLDBM);
use Class::Trait qw(TM::MapSphere);
1;
#-- test suite
use strict;
use warnings;
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More qw(no_plan);
use Data::Dumper;
$Data::Dumper::Indent = 1;
use Time::HiRes;
my @tmp;
foreach (qw(0 1 2)) {
use IO::File;
use POSIX qw(tmpnam);
do { $tmp[$_] = tmpnam() ; } until IO::File->new ($tmp[$_], O_RDWR|O_CREAT|O_EXCL);
}
use File::Temp qw/ tempfile tempdir /;
my $tmpdir = tempdir (CLEANUP => 1);
END { unlink (@tmp) || warn "cannot unlink tmp files '@tmp'"; }
#== TESTS =====================================================================
{
# first basic MLDBM functionality
{ # start a sphere and add a topic
my $tm = new MyMapSphere2 (file => $tmpdir.'/db');
$tm->internalize ('aaa' => 'http://AAA/');
ok ($tm->mids ('aaa'), 'found topic');
}
{ # check whether it is still there
my $tm = new MyMapSphere2 (file => $tmpdir.'/db');
ok ($tm->mids ('aaa'), 'found topic again');
}
{ # now also mount an unsync'ed map
my $tm = new MyMapSphere2 (file => $tmpdir.'/db');
use TM::Materialized::AsTMa;
$tm->mount ('/xxx/' => new TM::Materialized::AsTMa (inline => "ccc (ddd)\n\n"));
ok ($tm->is_mounted ('/xxx/'), 'found child mounted');
ok ($tm->mids ('xxx'), 'found child map topic');
ok (eq_set ([ $tm->instances ('topicmap') ],
[ 'tm://nirvana/xxx' ]), 'regained map instance');
}
{ # is the map still there?
my $tm = new MyMapSphere2 (file => $tmpdir.'/db');
ok ($tm->is_mounted ('/xxx/'), 'found child mounted, again');
ok ($tm->mids ('xxx'), 'found child map topic, again');
my $mt = $tm->mounttab;
my $child = $mt->{'/xxx/'};
ok (!$child->mids ('ccc'), 'child map not synced in');
$child->sync_in;
$tm->mounttab ($mt);
# touch ($tm, '/xxx/');
# sub touch {
# my $self = shift;
# my $path = shift;
# my $mt = $self->{mounttab};
# my $ch = $mt->{$path};
# $mt->{$path} = undef;
# $mt->{$path} = $ch;
# $self->{mounttab} = $mt;
# }
ok ( $child->mids ('ccc'), 'child map synced in');
}
{ # check whether the map is mounted & contains it sync'ed content
my $tm = new MyMapSphere2 (file => $tmpdir.'/db');
#warn Dumper $tm;
my $child = $tm->is_mounted ('/xxx/');
ok ( $child->mids ('ccc'), 'child map synced in, again');
}
{ # now umount xxx again
my $tm = new MyMapSphere2 (file => $tmpdir.'/db');
$tm->umount ('/xxx/');
ok (!$tm->is_mounted ('/xxx/'), 'found child unmounted immediatly');
}
{ # and check it is still unmounted
my $tm = new MyMapSphere2 (file => $tmpdir.'/db');
ok (!$tm->is_mounted ('/xxx/'), 'found child unmounted after reload');
}
}
|
