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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
#------------------------------------------------------------------------------------------------
# build a 'persistent' mapsphere (persistent is over invocations here)
package MyMapSphere;
use TM::Tau::Filter;
use base qw(TM::Tau::Filter);
use Class::Trait qw(TM::MapSphere);
sub source_in {
my $self = shift;
#warn "MyMapSphere source in";
$self->{left}->source_in;
die unless $self->{_path_to_be}; # just make sure its there
$self->mount (delete $self->{_path_to_be}, $self->{left});
#warn "mount done";
}
sub mtime {
return time + 1; # here we also are very eager to do things
}
1;
package MyPersistentMapSphereFilter;
our $ms = new MyMapSphere (baseuri => 'tm:');
sub new {
my $class = shift; # we do not really care about that one
my %opts = @_;
#warn "got URL $opts{url}";
(my $path = $opts{url}) =~ s/^tm://;
$ms->{_path_to_be} = $path; # !!! NB: Here I _know_ that I am the only one fiddling around, this is NOT thread-safe!!
return $ms;
}
1;
package MyPersistentMapSphere;
sub new {
my $class = shift; # dont care
my %opts = @_;
#warn "new got URL $opts{url}";
(my $path = $opts{url}) =~ s/^tm://;
#warn "got path $path";
return $MyPersistentMapSphereFilter::ms->is_mounted ($path);
}
1;
use strict;
use warnings;
#use Class::Trait 'debug';
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More qw(no_plan);
use Data::Dumper;
sub _chomp {
my $s = shift;
chomp $s;
return $s;
}
#-- doing something with maps, preparations
my ($tmp1, $tmp2);
use IO::File;
use POSIX qw(tmpnam);
do { $tmp1 = tmpnam() . '.atm' ; } until IO::File->new ($tmp1, O_RDWR|O_CREAT|O_EXCL);
do { $tmp2 = tmpnam() ; } until IO::File->new ($tmp2, O_RDWR|O_CREAT|O_EXCL);
END { unlink ($tmp1, $tmp2) || warn "cannot unlink tmp files '$tmp1' and '$tmp2'"; }
tmpmap ('
aaa is-a bbb
ccc is-a bbb
(zzz)
xxx: aaa
yyy: ccc
');
sub tmpmap {
my $astma = shift;
my $fh = IO::File->new ("> $tmp1") || die "so what?";
print $fh $astma."\n";
$fh->close;
}
sub tmpres {
my $fh = IO::File->new ($tmp2) || die "cannot reopen what I just wrote";
local $/ = undef;
my $s = <$fh>;
close $fh;
# now make sure we have something different there
$fh = IO::File->new (">$tmp2") || die "cannot reopen for rewriting";
print $fh "xxx";
close $fh;
return $s;
}
#== TESTS =====================================================================
use TM::Tau;
$TM::Tau::filters{'^tm:/.*'} = 'MyPersistentMapSphereFilter';
$TM::Tau::sources{'^tm:/.*'} = 'MyPersistentMapSphere';
{ # add a first map, right hand side
my $t = new TM::Tau ("file:$tmp1 > tm:/rumsti/");
}
ok ($MyPersistentMapSphereFilter::ms->tids ('rumsti'), 'mem persistent mapsphere: map has been mounted');
ok ($MyPersistentMapSphereFilter::ms->is_mounted ('/rumsti/')->tids ('aaa'), 'mem persistent mapsphere: map has values');
for (0..5) { # stress testing: adding, retracting, re-adding, all right-hand side
{ # add another
new TM::Tau ("file:$tmp1 > tm:/ramsti/");
}
ok ($MyPersistentMapSphereFilter::ms->tids ('rumsti'), 'mem persistent mapsphere: map still mounted');
ok ($MyPersistentMapSphereFilter::ms->is_mounted ('/rumsti/')->tids ('aaa'), 'mem persistent mapsphere: map has still values');
ok ($MyPersistentMapSphereFilter::ms->tids ('ramsti'), 'mem persistent mapsphere: new map mounted');
ok ($MyPersistentMapSphereFilter::ms->is_mounted ('/ramsti/')->tids ('aaa'), 'mem persistent mapsphere: new map has values');
#warn Dumper $MyPersistentMapSphereFilter::ms;
$MyPersistentMapSphereFilter::ms->umount ('/ramsti/');
}
for (0..5) {
{ # left-hand side also
new TM::Tau ("tm:/rumsti/ > tm:/remsti/");
}
ok ($MyPersistentMapSphereFilter::ms->tids ('remsti'), 'mem persistent mapsphere: copied map mounted');
ok ($MyPersistentMapSphereFilter::ms->is_mounted ('/remsti/')->tids ('aaa'), 'mem persistent mapsphere: copied map has values');
$MyPersistentMapSphereFilter::ms->umount ('/remsti/');
}
__END__
{ # test mapsphere
my $tm = new TM::Tau ("file:$tmp > tm:/test/");
$tm->{map}->sync_out;
like ($tm->{mapsphere}->{maps}->{'/test/'}->tids ('aaa'), qr/aaa$/, 'map established in mapsphere');
}
|
