Sack/Digest/BerkeleyDB.pm

package Sack::Digest;

# digest to convert long values into integer numbers

use warnings;
use strict;

use BerkeleyDB;

our $debug = 0;
our $port = '?';

sub clean {
        foreach ( glob '/dev/shm/sack.*' ) {
                warn "[$port] clean $_ ", -s $_, " bytes\n";
                unlink $_ || warn "[$port] ERROR can't remove $_:$!";
        }
        1;
}

our ( $btree, $array );
our ( %btree, @array );
our $self;

sub open {
        ( $self, $port ) = @_;

        my $path = "/dev/shm/sack.$port";

        $btree ||= tie %btree, 'BerkeleyDB::Btree', 
                -Filename  => "$path.btree",
#               -Cachesize => 700_000_000,
                -Flags     => DB_CREATE
        || die "$path.btree $!";

        $array ||= tie @array, 'BerkeleyDB::Recno',
                -Filename  => "$path.array",
#               -Cachesize => 700_000_000,
                -Flags     => DB_CREATE,
        || die "$path.array $!";
        
        warn "[$port] BDB open $path\n";

}

sub close {
        my $error = 0;
        $error += $btree->db_close;
        undef $btree;
        $error += $array->db_close;
        undef $array;
        not $error;
}

our $seq = 0;

sub to_int {
        my ( $self, $full ) = @_;
        my $nr;


        if ( my $nr = $btree{ $full } ) {
                return $nr;
        } else {
                $seq++;
                $btree{ $full } = $seq;
                $array[ $seq ]  = $full;
                return $seq;
        }
}


sub from_int {
#       my ( $self, $d ) = @_;
        my $d = pop @_;
        my $v = $array[ $d ];
        defined $v ? $v : $d;
}

sub undigest_out {
        my ( $self, $out ) = @_;

        foreach my $k1 ( grep { m/#/ } keys %$out ) {
                my @k2 = keys %{ $out->{$k1} };
                foreach my $k2 ( @k2 ) {
                        my $v = delete $out->{$k1}->{$k2};
                        warn "# k2 $k2 = $v";
                        $out->{$k1}->{ from_int $k2 } = $v;
                }
        }

        return $out;
}

1;
1	dpavlin	33	package Sack::Digest;
2
3			# digest to convert long values into integer numbers
4
5			use warnings;
6			use strict;
7
8			use BerkeleyDB;
9
10	dpavlin	34	our $debug = 0;
11			our $port = '?';
12	dpavlin	33
13			sub clean {
14			foreach ( glob '/dev/shm/sack.*' ) {
15			warn "[$port] clean $_ ", -s $_, " bytes\n";
16			unlink $_ \|\| warn "[$port] ERROR can't remove $_:$!";
17			}
18	dpavlin	34	1;
19	dpavlin	33	}
20
21			our ( $btree, $array );
22	dpavlin	34	our ( %btree, @array );
23	dpavlin	33	our $self;
24
25			sub open {
26			( $self, $port ) = @_;
27
28			my $path = "/dev/shm/sack.$port";
29
30	dpavlin	34	$btree \|\|= tie %btree, 'BerkeleyDB::Btree',
31	dpavlin	33	-Filename => "$path.btree",
32			# -Cachesize => 700_000_000,
33	dpavlin	34	-Flags => DB_CREATE
34			\|\| die "$path.btree $!";
35	dpavlin	33
36	dpavlin	34	$array \|\|= tie @array, 'BerkeleyDB::Recno',
37	dpavlin	33	-Filename => "$path.array",
38			# -Cachesize => 700_000_000,
39			-Flags => DB_CREATE,
40	dpavlin	34	\|\| die "$path.array $!";
41	dpavlin	33
42	dpavlin	34	warn "[$port] BDB open $path\n";
43	dpavlin	33
44			}
45
46	dpavlin	34	sub close {
47			my $error = 0;
48			$error += $btree->db_close;
49			undef $btree;
50			$error += $array->db_close;
51			undef $array;
52			not $error;
53			}
54
55			our $seq = 0;
56
57			sub to_int {
58			my ( $self, $full ) = @_;
59	dpavlin	33	my $nr;
60
61
62	dpavlin	34	if ( my $nr = $btree{ $full } ) {
63			return $nr;
64			} else {
65			$seq++;
66			$btree{ $full } = $seq;
67			$array[ $seq ] = $full;
68			return $seq;
69			}
70	dpavlin	33	}
71
72	dpavlin	34
73			sub from_int {
74	dpavlin	36	# my ( $self, $d ) = @_;
75			my $d = pop @_;
76	dpavlin	34	my $v = $array[ $d ];
77			defined $v ? $v : $d;
78			}
79
80	dpavlin	36	sub undigest_out {
81			my ( $self, $out ) = @_;
82
83			foreach my $k1 ( grep { m/#/ } keys %$out ) {
84			my @k2 = keys %{ $out->{$k1} };
85			foreach my $k2 ( @k2 ) {
86			my $v = delete $out->{$k1}->{$k2};
87			warn "# k2 $k2 = $v";
88			$out->{$k1}->{ from_int $k2 } = $v;
89			}
90			}
91
92			return $out;
93			}
94
95	dpavlin	33	1;