package CGI::Armature::Bridge;

use strict;

sub new {
    my $class = shift;
    my $object_ref = shift;
    my $method_map = shift;
    my $self = {
        object=>$object_ref,
    };
    $self-{$_} = $method_map->{$_} for keys %$method_map;
    return bless($self, $class);
}

1;

##</code><code>##

package CGI::Armature::Serializer;

use strict;
use vars '@ISA';
BEGIN {
    require CGI::Armature::Bridge;
    @ISA = 'CGI::Armature::Bridge';
}

sub serialize {
    my $self = shift;
    my $hash = shift;
    my $method = $self->{serialize};
    return $self->{object}->$method($hash);
}

sub deserialize {
    my $self = shift;
    my $data = shift;
    my $method = $self->{deserialize};
    return $self->{object}->$method($data);
}

1;

##</code><code>##

use CGI::Armature::Serializer;
use XML::Simple;

my $serialize_map = {
    serialize=>'XMLin',
    deserialize=>'XMLout',
};

my $serializer = CGI::Armature::Serializer->new(
    XML::Simple->new(suppressempty=>q{}, noattr=>1),
    $serialize_map,
);

##</code><code>##

use CGI::Armature::Serializer;
use YAML;

my $serialize_map = {
    serialize=>'Dump',
    deserialize=>'Load',
};

my $serializer = CGI::Armature::Serializer->new(
    YAML->new(),
    $serialize_map,
);

##</code><code>##

$data = $serializer->serialize($data_hash);

$data_hash = $serializer->deserialize($data);

##</code><code>##

package CGI::Armature::Storage;

use strict;
use vars '@ISA';
BEGIN {
    require CGI::Armature::Bridge;
    @ISA = 'CGI::Armature::Bridge';
}

sub fetch {
    my $self = shift;
    my $id = shift;
    my $method = $self->{fetch};
    return $self->{object}->$method($id);
}

sub store {
    my $self = shift;
    my $id = shift;
    my $value = shift;
    my $method = $self->{store};
    $self->{object}->$method($id, $value);
}

sub fetch_ids {
    my $self = shift;
    my $method = $self->{fetch_ids};
    return $self->{object}->$method();
}

sub delete {
    my $self = shift;
    my $id = shift;
    my $method = $self->{delete};
    $self->{object}->$method($id);
}

1;

##</code><code>##

package CGI::Armature::Database;

use strict;

use Fcntl;
use DB_File::Lock;
use CGI::Armature::PathInfo;

my %path_info = CGI::Armature::PathInfo::get_paths();

sub new {
    my $class = shift;
    my ($dbfile) = @_;
    die "need dbfile" unless $dbfile;
    my $self = {
        dbfile=>$dbfile,
    };
    return bless($self, $class);
}

sub create {
    my $self = shift;
    my %db_file;
    my $locking = {
        mode=>'write',
        lockfile_name=>"$path_info{sessionpath}/exclusive.lock",
    };
    tie(
        %db_file, 
        'DB_File::Lock', 
        "$path_info{sessionpath}/$self->{dbfile}", 
        O_RDWR|O_CREAT, 
        0600,
        $DB_HASH,
        $locking,
    ) or die "Couldn't tie DB_File $path_info{sessionpath}/$self->{dbfile} $!; aborting";
    untie %db_file;
}

sub delete {
    my $self = shift;
    my $key = shift;
    my %db_file;
    my $locking = {
        mode=>'write',
        lockfile_name=>"$path_info{sessionpath}/exclusive.lock",
    };
    tie(
        %db_file, 
        'DB_File::Lock', 
        "$path_info{sessionpath}/$self->{dbfile}", 
        O_RDWR, 
        0600,
        $DB_HASH,
        $locking,
    ) or die "Couldn't tie DB_File $path_info{sessionpath}/$self->{dbfile} $!; aborting";
    delete $db_file{$key};
    untie %db_file;
}

sub set_value {
    my $self = shift;
    die "not enough values for set_value" unless @_ == 2;
    my ($key, $value) = @_;
    my %db_file;
    my $locking = {
        mode=>'write',
        lockfile_name=>"$path_info{sessionpath}/exclusive.lock",
    };
    tie(
        %db_file, 
        'DB_File::Lock', 
        "$path_info{sessionpath}/$self->{dbfile}", 
        O_RDWR, 
        0600,
        $DB_HASH,
        $locking,
    ) or die "Couldn't tie DB_File $path_info{sessionpath}/$self->{dbfile} $!; aborting";
    $db_file{$key} = $value;
    untie %db_file;
}

sub get_value {
    my $self = shift;
    my $key = shift;
    my %db_file;
    my $locking = {
        mode=>'read',
        lockfile_name=>"$path_info{sessionpath}/exclusive.lock",
    };
    tie(
        %db_file, 
        'DB_File::Lock', 
        "$path_info{sessionpath}/$self->{dbfile}", 
        O_RDONLY, 
        0600,
        $DB_HASH,
        $locking,
    ) or die "Couldn't tie DB_File $path_info{sessionpath}/$self->{dbfile} $!; aborting";
    my $value = $db_file{$key};
    untie %db_file;
    return $value;
}

sub get_keys {
    my $self = shift;
    my %db_file;
    my $locking = {
        mode=>'read',
        lockfile_name=>"$path_info{sessionpath}/exclusive.lock",
    };
    tie(
        %db_file, 
        'DB_File::Lock', 
        "$path_info{sessionpath}/$self->{dbfile}", 
        O_RDONLY, 
        0600,
        $DB_HASH,
        $locking,
    ) or die "Couldn't tie DB_File $path_info{sessionpath}/$self->{dbfile} $!; aborting";
    my @keys =  keys %db_file;
    untie %db_file;
    return \@keys;
}

1;

##</code><code>##

use CGI::Armature::Storage;
use CGI::Armature::Database;

my $storage_map = {
    fetch=>'get_value',
    store=>'set_value',
    fetch_ids=>'get_keys',
    delete=>'delete',
};

my $storage = CGI::Armature::Storage->new(
    CGI::Armature::Database->new('session_id.db'),
    $storage_map,
);

my $data = $storage->fetch($session_id);