#/*
# *  Copyright 2007 hkrn <hikarin@users.sourceforge.jp>
# *
# *  Licensed under the Apache License, Version 2.0 (the "License");
# *  you may not use this file except in compliance with the License.
# *  You may obtain a copy of the License at
# *
# *      http://www.apache.org/licenses/LICENSE-2.0
# *
# *  Unless required by applicable law or agreed to in writing, software
# *  distributed under the License is distributed on an "AS IS" BASIS,
# *  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# *  See the License for the specific language governing permissions and
# *  limitations under the License.
# */
#
# $Id: Qvilla.pm 363 2007-03-16 15:11:10Z hikarin $
#

package Img0ch::Maple::Qvilla;

use strict;
use Villa qw();

sub new {
    my ( $iClass, $iKernel, $path ) = @_;
    bless {
        __dirty    => {},
        __filename => $path,
        __kernel   => $iKernel,
        __removed  => {},
        __villa    => undef,
    }, $iClass;
}

sub load {
    my ( $iRepos, $path ) = @_;
    my $repos = Villa->new(
        ( $path || $iRepos->{__filename} ),
        Villa::OWRITER() | Villa::OCREAT()
    ) or $iRepos->{__kernel}->throw_exception($Villa::errmsg);

    $repos->filter_fetch_key( sub   {s/\0\z//xms} );
    $repos->filter_store_key( sub   { $_ .= "\0" } );
    $repos->filter_fetch_value( sub {s/\0\z//xms} );
    $repos->filter_store_value( sub { $_ .= "\0" } );
    $repos->tranbegin();
    $iRepos->{__villa} = $repos;
    return 1;
}

sub save {
    my ($iRepos) = @_;
    my $iKernel  = $iRepos->{__kernel};
    my $repos    = $iRepos->{__villa};

    $repos->trancommit() or $iKernel->throw_exception($Villa::errmsg);
    $repos->tranbegin()  or $iKernel->throw_exception($Villa::errmsg);
    %{ $iRepos->{__dirty} }   = ();
    %{ $iRepos->{__removed} } = ();
    return 1;
}

sub set {
    my ( $iRepos, $key, $value ) = @_;
    $iRepos->{__villa}->put( $key, $value )
        or $iRepos->{__kernel}->throw_exception($Villa::errmsg);
    $iRepos->{__dirty}->{$key} = $value;
    delete $iRepos->{__removed}->{$key};
    return;
}

*set_binary = \&set;

sub get {
    my ( $iRepos, $key ) = @_;
    my $repos = $iRepos->{__villa};
    my $dirty = $iRepos->{__dirty}->{$key};

    $dirty                       and return $dirty;
    $iRepos->{__removed}->{$key} and return '';
    $repos->vsiz($key) > 0 or return '';
    my $value = $repos->get($key)
        or $iRepos->{__kernel}->throw_exception($Villa::errmsg);
    return $value;
}

*get_binary = \&get;

sub decode_binary { shift; return $_[0] }

sub is_binary_safe {1}

sub get_int { Img0ch::Kernel::intval( $_[0]->get( $_[1] ) ) }

sub remove {
    my ( $iRepos, $key ) = @_;
    my $oldvalue = $iRepos->get($key);
    $iRepos->{__villa}->out($key)
        or $iRepos->{__kernel}->throw_exception($Villa::errmsg);
    delete $iRepos->{__dirty}->{$key};
    $iRepos->{__removed}->{$key} = 1;
    return $oldvalue;
}

sub iterate {
    my ( $iRepos, $code_ref, @args ) = @_;
    my $iKernel = $iRepos->{__kernel};
    my $dirty   = $iRepos->{__dirty};
    my $repos   = $iRepos->{__villa};
    my $remove  = $iRepos->{__removed};

    $repos->curfirst() or $iKernel->throw_exception($Villa::errmsg);
    while ( my $key = $repos->curkey() ) {
        my $value = $iRepos->get($key);
        my $status = $code_ref->( $key, \$value, @args );
        if ( $status > 0 ) {
            $repos->curput($value);
            $dirty->{$key} = $value;
            delete $remove->{$key};
        }
        elsif ( $status < 0 ) {
            $repos->curout();
            delete $dirty->{$key};
            $remove->{$key} = 1;
        }
        $repos->curnext();
    }
    %{ $iRepos->{__dirty} }   = %$dirty;
    %{ $iRepos->{__removed} } = %$remove;

    return 1;
}

*iterate_binary = \&iterate;

1;
__END__
