Sack/Digest/BerkeleyDB.pm

package Sack::Digest;

=head1 NAME

Sack::Digest - turn long fields into integers and back

=cut

use warnings;
use strict;

use BerkeleyDB;
use Digest::MD5 qw(md5);

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, $full );
our ( %btree, @array, %full );
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 $!";

        $full  ||= tie %full, 'BerkeleyDB::Btree',
                -Filename  => "$path.full",
                -Flags     => DB_CREATE,
        || die "$path.full $!";

        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;
        $error += $full->db_close;
        undef $full;
        not $error;
}

our $seq = 0;

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

        my $md5 = md5 $full;

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


sub from_int {
#       my ( $self, $d ) = @_;
        my $d = pop @_;
        my $v = $array[ $d ];
        $v = $full{ $v } if defined $v;
#       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;
}


our $_opened = 0;
sub undigest_node_k_v {
        my ( $self, $node, $k, $v ) = @_;
        $_opened ||= Sack::Digest->open( $node );
        $self->from_int( $v );
}


sub sync {
        my $error = 0;
        warn "[$port] sync";
        $error += $btree->db_sync;
        $error += $array->db_sync;
        $error += $full->db_sync;
        not $error;
}

use Data::Dump qw/dump/;

sub info {
        my $info = {
                btree => $btree->db_stat,
                array => $array->db_stat,
                full => $full->db_stat,
        };
        warn "[$port] BDB info ", dump $info;
        return $info;
}

1;
1	package Sack::Digest;
2
3	=head1 NAME
4
5	Sack::Digest - turn long fields into integers and back
6
7	=cut
8
9	use warnings;
10	use strict;
11
12	use BerkeleyDB;
13	use Digest::MD5 qw(md5);
14
15	our $debug = 0;
16	our $port = '?';
17
18	sub clean {
19	foreach ( glob '/dev/shm/sack.*' ) {
20	warn "[$port] clean $_ ", -s $_, " bytes\n";
21	unlink $_ \|\| warn "[$port] ERROR can't remove $_:$!";
22	}
23	1;
24	}
25
26	our ( $btree, $array, $full );
27	our ( %btree, @array, %full );
28	our $self;
29
30	sub open {
31	( $self, $port ) = @_;
32
33	my $path = "/dev/shm/sack.$port";
34
35	$btree \|\|= tie %btree, 'BerkeleyDB::Btree',
36	-Filename => "$path.btree",
37	# -Cachesize => 700_000_000,
38	-Flags => DB_CREATE
39	\|\| die "$path.btree $!";
40
41	$array \|\|= tie @array, 'BerkeleyDB::Recno',
42	-Filename => "$path.array",
43	# -Cachesize => 700_000_000,
44	-Flags => DB_CREATE,
45	\|\| die "$path.array $!";
46
47	$full \|\|= tie %full, 'BerkeleyDB::Btree',
48	-Filename => "$path.full",
49	-Flags => DB_CREATE,
50	\|\| die "$path.full $!";
51
52	warn "[$port] BDB open $path\n";
53
54	return $path;
55	}
56
57	sub close {
58	my $error = 0;
59	$error += $btree->db_close;
60	undef $btree;
61	$error += $array->db_close;
62	undef $array;
63	$error += $full->db_close;
64	undef $full;
65	not $error;
66	}
67
68	our $seq = 0;
69
70	sub to_int {
71	my ( $self, $full ) = @_;
72	my $nr;
73
74	my $md5 = md5 $full;
75
76	if ( my $nr = $btree{ $md5 } ) {
77	return $nr;
78	} else {
79	$seq++;
80	$full{ $md5 } = $full;
81	$btree{ $md5 } = $seq;
82	$array[ $seq ] = $md5;
83	return $seq;
84	}
85	}
86
87
88	sub from_int {
89	# my ( $self, $d ) = @_;
90	my $d = pop @_;
91	my $v = $array[ $d ];
92	$v = $full{ $v } if defined $v;
93	# warn "## from_int $d = $v\n";
94	defined $v ? $v : $d;
95	}
96
97	sub undigest_out {
98	my ( $self, $out ) = @_;
99
100	foreach my $k1 ( grep { m/#/ } keys %$out ) {
101	my @k2 = keys %{ $out->{$k1} };
102	foreach my $k2 ( @k2 ) {
103	my $v = delete $out->{$k1}->{$k2};
104	# warn "## k2 $k2 = $v";
105	$out->{$k1}->{ from_int $k2 } = $v;
106	}
107	}
108
109	return $out;
110	}
111
112
113	our $_opened = 0;
114	sub undigest_node_k_v {
115	my ( $self, $node, $k, $v ) = @_;
116	$_opened \|\|= Sack::Digest->open( $node );
117	$self->from_int( $v );
118	}
119
120
121	sub sync {
122	my $error = 0;
123	warn "[$port] sync";
124	$error += $btree->db_sync;
125	$error += $array->db_sync;
126	$error += $full->db_sync;
127	not $error;
128	}
129
130	use Data::Dump qw/dump/;
131
132	sub info {
133	my $info = {
134	btree => $btree->db_stat,
135	array => $array->db_stat,
136	full => $full->db_stat,
137	};
138	warn "[$port] BDB info ", dump $info;
139	return $info;
140	}
141
142	1;