/[Sack]/trunk/lib/Sack/Digest/BerkeleyDB.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Diff of /trunk/lib/Sack/Digest/BerkeleyDB.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/lib/Sack/Digest.pm revision 36 by dpavlin, Wed Sep 23 22:22:18 2009 UTC trunk/lib/Sack/Digest/BerkeleyDB.pm revision 85 by dpavlin, Tue Sep 29 18:04:29 2009 UTC
# Line 1  Line 1 
1  package Sack::Digest;  package Sack::Digest::BerkeleyDB;
2    
3  # digest to convert long values into integer numbers  =head1 NAME
4    
5    Sack::Digest::BerkeleyDB - turn long fields into integers and back
6    
7    =cut
8    
9  use warnings;  use warnings;
10  use strict;  use strict;
11    
12  use BerkeleyDB;  use BerkeleyDB;
13    use Digest::MD5 qw(md5);
14    use Data::Dump qw/dump/;
15    
16    
17  our $debug = 0;  our $debug = 0;
18  our $port = '?';  our $port = '?';
19    
20  sub clean {  sub new {
21          foreach ( glob '/dev/shm/sack.*' ) {          my $class = shift;
22                  warn "[$port] clean $_ ", -s $_, " bytes\n";          my $self  = bless {@_}, $class;
23                  unlink $_ || warn "[$port] ERROR can't remove $_:$!";          die "no port" unless defined $self->{port};
24          }          $port = $self->{port};
25          1;  
26            $self->clean if $self->{clean};
27    
28            $self->open;
29    
30            return $self;
31  }  }
32    
 our ( $btree, $array );  
 our ( %btree, @array );  
 our $self;  
33    
34  sub open {  sub open {
35          ( $self, $port ) = @_;          my $self = shift;
36    
37          my $path = "/dev/shm/sack.$port";          my $path = "/dev/shm/sack.$self->{port}";
38    
39          $btree ||= tie %btree, 'BerkeleyDB::Btree',          $self->{db_md5_nr} ||= tie my %md5_nr, 'BerkeleyDB::Btree',
40                  -Filename  => "$path.btree",                  -Filename  => "$path.md5_nr",
41  #               -Cachesize => 700_000_000,  #               -Cachesize => 700_000_000,
42                  -Flags     => DB_CREATE                  -Flags     => DB_CREATE
43          || die "$path.btree $!";          || die "$path.md5_nr $!";
44    
45          $array ||= tie @array, 'BerkeleyDB::Recno',          $self->{md5_nr} = \%md5_nr;
46                  -Filename  => "$path.array",  
47    
48            $self->{db_nr_md5} ||= tie my @nr_md5, 'BerkeleyDB::Recno',
49                    -Filename  => "$path.nr_md5",
50  #               -Cachesize => 700_000_000,  #               -Cachesize => 700_000_000,
51                  -Flags     => DB_CREATE,                  -Flags     => DB_CREATE,
52          || die "$path.array $!";          || die "$path.nr_md5 $!";
53            
54            $self->{nr_md5} = \@nr_md5;
55    
56    
57            $self->{db_md5}  ||= tie my %md5, 'BerkeleyDB::Btree',
58                    -Filename  => "$path.md5",
59                    -Flags     => DB_CREATE,
60            || die "$path.md5 $!";
61    
62            $self->{md5} = \%md5;
63    
64          warn "[$port] BDB open $path\n";          warn "[$port] BDB open $path\n";
65    
66  }  }
67    
68    
69  sub close {  sub close {
70            my $self = shift;
71          my $error = 0;          my $error = 0;
72          $error += $btree->db_close;          foreach ( qw( md5 md5_nr nr_md5 ) ) {
73          undef $btree;                  my $db = delete $self->{"db_$_"} || next;
74          $error += $array->db_close;                  warn "[$port] close $_\n";
75          undef $array;                  $error += $db->db_close;
76          not $error;          }
77            return not $error;
78  }  }
79    
80    
81    sub clean {
82            my $self = shift;
83            $self->close;
84            foreach ( glob "/dev/shm/sack.$port.*" ) {
85                    warn "[$port] clean $_ ", -s $_, " bytes\n";
86                    unlink $_ || warn "[$port] ERROR can't remove $_:$!";
87            }
88            1;
89    }
90    
91    
92  our $seq = 0;  our $seq = 0;
93    
94  sub to_int {  sub to_int {
95          my ( $self, $full ) = @_;          my ( $self, $full ) = @_;
96          my $nr;          my $nr;
97    
98            my $md5 = md5 $full;
99    
100          if ( my $nr = $btree{ $full } ) {          if ( my $nr = $self->{md5_nr}->{ $md5 } ) {
101                  return $nr;                  return $nr;
102          } else {          } else {
103                  $seq++;                  $seq++;
104                  $btree{ $full } = $seq;                  $self->{md5}   ->{ $md5 } = $full;
105                  $array[ $seq ]  = $full;                  $self->{md5_nr}->{ $md5 } = $seq;
106                    $self->{nr_md5}->[ $seq ] = $md5;
107                  return $seq;                  return $seq;
108          }          }
109  }  }
110    
111    
112  sub from_int {  sub from_int {
113  #       my ( $self, $d ) = @_;          my ( $self, $d ) = @_;
114          my $d = pop @_;          my $v = $self->{nr_md5}->[ $d ];
115          my $v = $array[ $d ];          $v = $self->{md5}->{ $v } if defined $v;
116    #       warn "## from_int $d = $v\n";
117          defined $v ? $v : $d;          defined $v ? $v : $d;
118  }  }
119    
# Line 84  sub undigest_out { Line 124  sub undigest_out {
124                  my @k2 = keys %{ $out->{$k1} };                  my @k2 = keys %{ $out->{$k1} };
125                  foreach my $k2 ( @k2 ) {                  foreach my $k2 ( @k2 ) {
126                          my $v = delete $out->{$k1}->{$k2};                          my $v = delete $out->{$k1}->{$k2};
127                          warn "# k2 $k2 = $v";  #                       warn "## k2 $k2 = $v";
128                          $out->{$k1}->{ from_int $k2 } = $v;                          $out->{$k1}->{ $self->from_int($k2) } = $v;
129                  }                  }
130          }          }
131    
132          return $out;          return $out;
133  }  }
134    
135    
136    sub undigest_node_k_v {
137            my ( $self, $node, $k, $v ) = @_;
138            $self->from_int( $v );
139    }
140    
141    
142    sub sync {
143            my $self = shift;
144            warn "[$port] sync";
145    
146            return
147                    not $self->{db_md5_nr}->db_sync
148                     +  $self->{db_nr_md5}->db_sync
149                     +  $self->{db_md5}->db_sync
150            ;
151    }
152    
153    
154    sub info {
155            my $self = shift;
156            my $info;
157            $info->{$_} = $self->{"db_$_"}->db_stat foreach qw( md5_nr nr_md5 md5 );
158            warn "[$port] BDB info [$seq] ", dump( map { $info->{$_}->{bt_nkeys} } keys %$info );
159            return $info;
160    }
161    
162    sub lookup {
163            my ( $self, $name, $key ) = @_;
164            die "no lookup $name" unless $self->{$name};
165            die "no key" unless $key;
166    #warn "XXXX $self->{$name}";
167            my $v = $name eq 'nr_md5' ? $self->{ $name }->[$key] : $self->{ $name }->{$key} ;
168            warn "### lookup $name $key = $v\n";
169            return $v;
170    }
171    
172  1;  1;
Legend:
Removed from v.36  
changed lines
  Added in v.85
  ViewVC Help
Powered by ViewVC 1.1.26