lib/Sack/Digest.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";

        return $path;
}

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 ];
#       warn "## from_int $d = $v\n";
        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;
}

sub sync {
        warn "[$port] sync";
        $btree->db_sync;
        $array->db_sync;
}

1;
1	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	our $debug = 0;
11	our $port = '?';
12
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	1;
19	}
20
21	our ( $btree, $array );
22	our ( %btree, @array );
23	our $self;
24
25	sub open {
26	( $self, $port ) = @_;
27
28	my $path = "/dev/shm/sack.$port";
29
30	$btree \|\|= tie %btree, 'BerkeleyDB::Btree',
31	-Filename => "$path.btree",
32	# -Cachesize => 700_000_000,
33	-Flags => DB_CREATE
34	\|\| die "$path.btree $!";
35
36	$array \|\|= tie @array, 'BerkeleyDB::Recno',
37	-Filename => "$path.array",
38	# -Cachesize => 700_000_000,
39	-Flags => DB_CREATE,
40	\|\| die "$path.array $!";
41
42	warn "[$port] BDB open $path\n";
43
44	return $path;
45	}
46
47	sub close {
48	my $error = 0;
49	$error += $btree->db_close;
50	undef $btree;
51	$error += $array->db_close;
52	undef $array;
53	not $error;
54	}
55
56	our $seq = 0;
57
58	sub to_int {
59	my ( $self, $full ) = @_;
60	my $nr;
61
62
63	if ( my $nr = $btree{ $full } ) {
64	return $nr;
65	} else {
66	$seq++;
67	$btree{ $full } = $seq;
68	$array[ $seq ] = $full;
69	return $seq;
70	}
71	}
72
73
74	sub from_int {
75	# my ( $self, $d ) = @_;
76	my $d = pop @_;
77	my $v = $array[ $d ];
78	# warn "## from_int $d = $v\n";
79	defined $v ? $v : $d;
80	}
81
82	sub undigest_out {
83	my ( $self, $out ) = @_;
84
85	foreach my $k1 ( grep { m/#/ } keys %$out ) {
86	my @k2 = keys %{ $out->{$k1} };
87	foreach my $k2 ( @k2 ) {
88	my $v = delete $out->{$k1}->{$k2};
89	# warn "## k2 $k2 = $v";
90	$out->{$k1}->{ from_int $k2 } = $v;
91	}
92	}
93
94	return $out;
95	}
96
97	sub sync {
98	warn "[$port] sync";
99	$btree->db_sync;
100	$array->db_sync;
101	}
102
103	1;