lib/Sack/Digest.pm

package Sack::Digest;

# digest to convert long values into integer numbers

use warnings;
use strict;

use BerkeleyDB;

our $port;

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

our $seq = 0;
our ( $btree, $array );
our $self;

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

        clean;

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

        $btree = BerkeleyDB::Btree->new(
                -Filename  => "$path.btree",
#               -Cachesize => 700_000_000,
                -Flags     => DB_CREATE,
        ) || die "$path.btree $!";

        $array = BerkeleyDB::Recno->new(
                -Filename  => "$path.array",
#               -Cachesize => 700_000_000,
                -Flags     => DB_CREATE,
        ) || die "$path.array $!";
        

        warn "[$port] BDB open $path\n";
}

sub digest {
        my $nr;

        $btree->db_get( $_[0] => $nr    ) == 0 && return $nr;

        $btree->db_put( $_[0] => ++$seq ) == 0 || die "$_[0] [$seq] $!";
        $array->db_put(  $seq => $_[0]  ) == 0 || die "[$seq] $_[0] $!";
        return $seq;
}

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			our $port;
11
12			sub clean {
13			foreach ( glob '/dev/shm/sack.*' ) {
14			warn "[$port] clean $_ ", -s $_, " bytes\n";
15			unlink $_ \|\| warn "[$port] ERROR can't remove $_:$!";
16			}
17			}
18
19			our $seq = 0;
20			our ( $btree, $array );
21			our $self;
22
23			sub open {
24			( $self, $port ) = @_;
25
26			clean;
27
28			my $path = "/dev/shm/sack.$port";
29
30			$btree = BerkeleyDB::Btree->new(
31			-Filename => "$path.btree",
32			# -Cachesize => 700_000_000,
33			-Flags => DB_CREATE,
34			) \|\| die "$path.btree $!";
35
36			$array = BerkeleyDB::Recno->new(
37			-Filename => "$path.array",
38			# -Cachesize => 700_000_000,
39			-Flags => DB_CREATE,
40			) \|\| die "$path.array $!";
41
42
43			warn "[$port] BDB open $path\n";
44			}
45
46			sub digest {
47			my $nr;
48
49			$btree->db_get( $_[0] => $nr ) == 0 && return $nr;
50
51			$btree->db_put( $_[0] => ++$seq ) == 0 \|\| die "$_[0] [$seq] $!";
52			$array->db_put( $seq => $_[0] ) == 0 \|\| die "[$seq] $_[0] $!";
53			return $seq;
54			}
55
56			1;