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";

}

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	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	}
45
46	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	my $nr;
60
61
62	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	}
71
72
73	sub from_int {
74	# my ( $self, $d ) = @_;
75	my $d = pop @_;
76	my $v = $array[ $d ];
77	defined $v ? $v : $d;
78	}
79
80	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	1;