lib/Yuki/YukiWikiDB.pm

package Yuki::YukiWikiDB;

my $debug = 1;

# Constructor
sub new {
    return shift->TIEHASH(@_);
}

# tying
sub TIEHASH {
    my ($class, $dbname) = @_;
    my $self = {
        dir => $dbname,
        keys => [],
    };
    if (not -d $self->{dir}) {
        if (!mkdir($self->{dir}, 0777)) {
            print "mkdir(" . $self->{dir} . ") fail\n" if ($debug);
            return undef;
        }
    }
    return bless($self, $class);
}

# Store
sub STORE {
    my ($self, $key, $val) = @_;
    my $file = &make_filename($self, $key);
    if (open(FILE,"> $file")) {
        binmode(FILE);
        print FILE $val;
        close(FILE);
        return $self->{$key} = $val;
    } else {
        print "$file create error.";
    }
}

# Fetch
sub FETCH {
    my ($self, $key) = @_;
    my $file = &make_filename($self, $key);
    if (open(FILE, $file)) {
        local $/;
        $self->{$key} = <FILE>;
        close(FILE);
    }
    return $self->{$key};
}

# Exists
sub EXISTS {
    my ($self, $key) = @_;
    my $file = &make_filename($self, $key);
    return -e($file);
}

# Delete
sub DELETE {
    my ($self, $key) = @_;
    my $file = &make_filename($self, $key);
    unlink $file;
    return delete $self->{$key};
}

sub FIRSTKEY {
    my ($self) = @_;
    opendir(DIR, $self->{dir}) or die $self->{dir};
    @{$self->{keys}} = grep /\.txt$/, readdir(DIR);
    foreach my $name (@{$self->{keys}}) {
        $name =~ s/\.txt$//;
        $name =~ s/[0-9A-F][0-9A-F]/pack("C", hex($&))/eg;
    }
    return shift @{$self->{keys}};
}

sub NEXTKEY {
    my ($self) = @_;
    return shift @{$self->{keys}};
}

sub make_filename {
    my ($self, $key) = @_;
    my $enkey = '';
    foreach my $ch (split(//, $key)) {
        $enkey .= sprintf("%02X", ord($ch));
    }
    return $self->{dir} . "/$enkey.txt";
}

1;
1	package Yuki::YukiWikiDB;
2
3	my $debug = 1;
4
5	# Constructor
6	sub new {
7	return shift->TIEHASH(@_);
8	}
9
10	# tying
11	sub TIEHASH {
12	my ($class, $dbname) = @_;
13	my $self = {
14	dir => $dbname,
15	keys => [],
16	};
17	if (not -d $self->{dir}) {
18	if (!mkdir($self->{dir}, 0777)) {
19	print "mkdir(" . $self->{dir} . ") fail\n" if ($debug);
20	return undef;
21	}
22	}
23	return bless($self, $class);
24	}
25
26	# Store
27	sub STORE {
28	my ($self, $key, $val) = @_;
29	my $file = &make_filename($self, $key);
30	if (open(FILE,"> $file")) {
31	binmode(FILE);
32	print FILE $val;
33	close(FILE);
34	return $self->{$key} = $val;
35	} else {
36	print "$file create error.";
37	}
38	}
39
40	# Fetch
41	sub FETCH {
42	my ($self, $key) = @_;
43	my $file = &make_filename($self, $key);
44	if (open(FILE, $file)) {
45	local $/;
46	$self->{$key} = <FILE>;
47	close(FILE);
48	}
49	return $self->{$key};
50	}
51
52	# Exists
53	sub EXISTS {
54	my ($self, $key) = @_;
55	my $file = &make_filename($self, $key);
56	return -e($file);
57	}
58
59	# Delete
60	sub DELETE {
61	my ($self, $key) = @_;
62	my $file = &make_filename($self, $key);
63	unlink $file;
64	return delete $self->{$key};
65	}
66
67	sub FIRSTKEY {
68	my ($self) = @_;
69	opendir(DIR, $self->{dir}) or die $self->{dir};
70	@{$self->{keys}} = grep /\.txt$/, readdir(DIR);
71	foreach my $name (@{$self->{keys}}) {
72	$name =~ s/\.txt$//;
73	$name =~ s/[0-9A-F][0-9A-F]/pack("C", hex($&))/eg;
74	}
75	return shift @{$self->{keys}};
76	}
77
78	sub NEXTKEY {
79	my ($self) = @_;
80	return shift @{$self->{keys}};
81	}
82
83	sub make_filename {
84	my ($self, $key) = @_;
85	my $enkey = '';
86	foreach my $ch (split(//, $key)) {
87	$enkey .= sprintf("%02X", ord($ch));
88	}
89	return $self->{dir} . "/$enkey.txt";
90	}
91
92	1;