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	wakaba	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;