/[Sack]/trunk/lib/Sack/Digest.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.pm

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

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