view Yuki/YukiWikiDB.pm @ 0:a2f0a2c135cf

hg init
author Shoshi TAMAKI <shoshi@cr.ie.u-ryukyu.ac.jp>
date Sun, 06 Jun 2010 22:00:38 +0900
parents
children
line wrap: on
line source

package Yuki::YukiWikiDB;

use strict;
use Fcntl ':flock';

# 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)) {
            die "mkdir(" . $self->{dir} . ") fail";
        }
    }
    return bless($self, $class);
}

# Store
sub STORE {
    my ($self, $key, $value) = @_;
    my $filename = &make_filename($self, $key);
    &lock_store($filename, $value);
    return $value;
}

# Fetch
sub FETCH {
    my ($self, $key) = @_;
    my $filename = &make_filename($self, $key);
    my $value = &lock_fetch($filename);
    return $value;
}

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

# Delete
sub DELETE {
    my ($self, $key) = @_;
    my $filename = &make_filename($self, $key);
    unlink $filename;
    # 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";
}

sub lock_store {
    my ($filename, $value) = @_;
    open(FILE, "+< $filename") or open(FILE, "> $filename") or die "$filename cannot be created";
    eval("flock(FILE, LOCK_EX)");
    if ($@) {
        # Your platform does not support flock.
        # Implement another EXCLUSIVE LOCK here.
    }
    truncate(FILE, 0);
    # binmode(FILE);
    $value =~ s/\x0D\x0A/\n/g;
    print FILE $value;
    eval("flock(FILE, LOCK_UN)");
    if ($@) {
        # Your platform does not support flock.
        # Implement another UNLOCK here.
    }
    close(FILE);
}

sub lock_fetch {
    my ($filename) = @_;
    open(FILE, "$filename") or return(undef);
    eval("flock(FILE, LOCK_SH)");
    if ($@) {
        # Your platform does not support flock.
        # Implement another SHARED LOCK here.
    }
    local $/;
    my $value = <FILE>;
    eval("flock(FILE, LOCK_UN)");
    if ($@) {
        # Your platform does not support flock.
        # Implement another UNLOCK here.
    }
    close(FILE);
    return $value;
}

1;