script/t/db-fs-lf.t

#!/usr/bin/perl
use strict;
use warnings;
use Test;
use FindBin q($Bin);
BEGIN {plan tests => 6}
use SuikaWiki::DB::FileSystem::LeafFile;

my $dir = $Bin.'/db.tmp';
#mkdir $dir or die "$0: $dir: $!" unless -d $dir;

sub filename ($;$) {
  my ($key, $suffix) = (shift, shift || '.txt');
  $dir.'/'.join ('.ns/', map {s/(.)/sprintf '%02X', ord $1/ges;$_} @$key).$suffix;
}

my $db = new SuikaWiki::DB::FileSystem::LeafFile
           base_directory => $dir,
           directory_suffix => '.ns',
           file_suffix => '.txt';

unshift @{$db->{event}->{error}}, sub {
  my ($self, $event) = @_;
  unless ({qw/fatal 1 stop 1 warn 1/}->{$event->{error}->{-def}->{level}}) {
    warn "DEBUG: ". $event->{error}->stringify;
  }
} if $^W;

$db->set (test => ['Key'] => 'Value');

ok $db->get (test => ['Key']), 'Value';
ok $db->get (test => ['other']), undef;

$db->set (test => ['Key'] => 'Value2');
ok $db->get (test => ['Key']), 'Value2';

$db->set (test => ['Key', 'Sub'] => 'SubValue');
ok $db->get (test => ['Key', 'Sub']), 'SubValue';

$db->close;

undef $db;

my $file = filename (['Key']);
ok -e $file, 1, 'Value is written on disk';
unlink $file or warn "$0: $file: $!";

$file = filename (['Key', 'Sub']);
ok -e $file, 1, 'Namespaced value is written on disk';
unlink $file or warn "$0: $file: $!";

$file = filename (['Key'], '.ns');
rmdir $file or warn "$0: $file: $!";

1	wakaba	1.1	#!/usr/bin/perl
2			use strict;
3			use warnings;
4			use Test;
5			use FindBin q($Bin);
6			BEGIN {plan tests => 6}
7			use SuikaWiki::DB::FileSystem::LeafFile;
8
9			my $dir = $Bin.'/db.tmp';
10			#mkdir $dir or die "$0: $dir: $!" unless -d $dir;
11
12			sub filename ($;$) {
13			my ($key, $suffix) = (shift, shift \|\| '.txt');
14			$dir.'/'.join ('.ns/', map {s/(.)/sprintf '%02X', ord $1/ges;$_} @$key).$suffix;
15			}
16
17			my $db = new SuikaWiki::DB::FileSystem::LeafFile
18			base_directory => $dir,
19			directory_suffix => '.ns',
20			file_suffix => '.txt';
21
22			unshift @{$db->{event}->{error}}, sub {
23			my ($self, $event) = @_;
24			unless ({qw/fatal 1 stop 1 warn 1/}->{$event->{error}->{-def}->{level}}) {
25			warn "DEBUG: ". $event->{error}->stringify;
26			}
27			} if $^W;
28
29			$db->set (test => ['Key'] => 'Value');
30
31			ok $db->get (test => ['Key']), 'Value';
32			ok $db->get (test => ['other']), undef;
33
34			$db->set (test => ['Key'] => 'Value2');
35			ok $db->get (test => ['Key']), 'Value2';
36
37			$db->set (test => ['Key', 'Sub'] => 'SubValue');
38			ok $db->get (test => ['Key', 'Sub']), 'SubValue';
39
40			$db->close;
41
42			undef $db;
43
44			my $file = filename (['Key']);
45			ok -e $file, 1, 'Value is written on disk';
46			unlink $file or warn "$0: $file: $!";
47
48			$file = filename (['Key', 'Sub']);
49			ok -e $file, 1, 'Namespaced value is written on disk';
50			unlink $file or warn "$0: $file: $!";
51
52			$file = filename (['Key'], '.ns');
53			rmdir $file or warn "$0: $file: $!";
54