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
|
use Data::Dumper;
use Test::More qw(no_plan);
use Test::Exception;
unless ($ENV{MEMCACHEDS}) {
diag ("no MEMCACHEDS environment variable defined, tests skipped");
ok (1, 'so be it');
exit;
}
diag ("working with $ENV{MEMCACHEDS}");
my @servers = split /\s+/, $ENV{MEMCACHEDS}; #qw(monda:11211);
use_ok ('TM::ResourceAble::MemCached');
# TODO invalid server
# TODO clear map optionally
use constant DONE => 1;
my $nrt = keys %{ $TM::infrastructure->{mid2iid} };
my $nra = keys %{ $TM::infrastructure->{assertions} };
if (DONE) {
throws_ok {
my $tm = new TM::ResourceAble::MemCached (baseuri => 'http://whereever/');
} qr/servers/, 'memcached missing';
# throws_ok {
# use Fcntl;
# my $tm = new TM::ResourceAble::MemCached (baseuri => 'http://whereever/',
# servers => \@servers,
# mode => O_TRUNC);
# } qr/no.+map/, 'no map';
use Fcntl;
my $tm = new TM::ResourceAble::MemCached (baseuri => 'http://whereever/',
servers => \@servers,
mode => O_TRUNC | O_CREAT,
);
isa_ok ($tm, 'TM');
is ($tm->baseuri, 'http://whereever/', 'baseuri recover');
ok ($tm->tids ('isa'), 'found isa');
#warn Dumper $tm->{assertions};
}
if (DONE) {
my $tm = new TM::ResourceAble::MemCached (baseuri => 'http://whereever/',
servers => \@servers,
mode => O_TRUNC,
);
is ((scalar $tm->asserts), $nra, 'default asserts');
is ((scalar $tm->toplets), $nrt, 'default toplets');
}
if (DONE) {
my $tm = new TM::ResourceAble::MemCached (baseuri => 'http://whereever/',
servers => \@servers,
mode => O_TRUNC,
);
$tm->internalize ('rumsti' => 'http://rumsti');
$tm->internalize ('rumsti' => \ 'http://ramsti');
# warn Dumper $tm->toplet ('http://whereever/rumsti');
# exit;
is ($tm->tids ( 'rumsti'), 'http://whereever/rumsti', 'found rumsti');
ok ($tm->tids ( 'rumsti'), 'found rumsti');
ok ($tm->tids ( 'http://rumsti'), 'found rumsti');
ok ($tm->tids (\ 'http://ramsti'), 'found rumsti');
$tm->internalize ('ramsti');
my $a = Assertion->new (type => 'is-subclass-of',
roles => [ 'subclass', 'superclass' ],
players => [ $tm->tids ('rumsti', 'ramsti') ]);
$tm->assert ($a); # add that to map
is ((scalar $tm->asserts), $nra+1, 'asserts');
is ((scalar $tm->toplets), $nrt+2, 'toplets');
#warn Dumper $tm->{assertions};
}
if (DONE) { # regain
my $tm = new TM::ResourceAble::MemCached (baseuri => 'http://whereever/',
servers => \@servers);
#warn Dumper $tm->{mid2iid};
is ((scalar $tm->asserts), $nra+1, 'asserts');
is ((scalar $tm->toplets), $nrt+2, 'toplets');
is ($tm->tids ( 'rumsti'), 'http://whereever/rumsti', 'refound rumsti');
ok ($tm->tids ( 'rumsti'), 'refound rumsti');
# warn Dumper $tm->toplet ('http://whereever/rumsti');
ok ($tm->tids ( 'http://rumsti'), 'refound rumsti');
ok ($tm->tids (\ 'http://ramsti'), 'refound rumsti');
}
if (DONE) { # second map, no crosstalk
my $tm = new TM::ResourceAble::MemCached (baseuri => 'http://whatever/',
servers => \@servers);
$tm->internalize ('rumsti' => 'http://rumsti');
$tm->internalize ('rumsti' => \ 'http://ramsti');
$tm->internalize ('romsti');
my $a = Assertion->new (type => 'is-subclass-of',
roles => [ 'subclass', 'superclass' ],
players => [ $tm->tids ('rumsti', 'romsti') ]);
$tm->assert ($a); # add that to map
#warn Dumper $tm->{mid2iid};
is ((scalar $tm->asserts), $nra+1, 'asserts, 2nd map');
is ((scalar $tm->toplets), $nrt+2, 'toplets, 2nd map');
{
my $tm2 = new TM::ResourceAble::MemCached (baseuri => 'http://whereever/',
servers => \@servers);
is ((scalar $tm2->asserts), $nra+1, 'asserts, 1st map');
is ((scalar $tm2->toplets), $nrt+2, 'toplets, 1st map');
}
}
|