/[suikacvs]/webroot/swe/lib/SWE/DB/HashedIndex.pm
Suika

Contents of /webroot/swe/lib/SWE/DB/HashedIndex.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations) (download)
Sun Jul 19 03:03:16 2009 UTC (15 years, 9 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.2: +2 -2 lines
++ swe/lib/SWE/DB/ChangeLog	19 Jul 2009 03:02:59 -0000
2009-07-19  Wakaba  <wakaba@suika.fam.cx>

	* HashedIndex.pm (_for_each_id): Operator evaluation order was
	wrong.

1 wakaba 1.1 package SWE::DB::HashedIndex;
2     use strict;
3 wakaba 1.2 use warnings;
4 wakaba 1.1
5     sub new ($) {
6     my $self = bless {
7     root_directory_name => './',
8     directory_suffix => '.hi',
9     id_directory_suffix => '.id',
10     leaf_suffix => '.x',
11     }, shift;
12     return $self;
13     } # new
14    
15     require Digest::MD5;
16     require Encode;
17 wakaba 1.2
18     sub lock_file_name ($) : lvalue {
19     my $self = shift;
20    
21     $self->{lock_file_name} ||= $self->{root_directory_name} . 'index.lock';
22     } # lock_file_name
23    
24     sub lock ($) {
25     my $self = shift;
26    
27     $self->{lock} ||= do {
28     require SWE::DB::Lock;
29     my $lock = SWE::DB::Lock->new;
30     $lock->{file_name} = $self->lock_file_name;
31     $lock->lock_type ('Index');
32     $lock->lock;
33     };
34     }
35    
36     sub unlock ($) {
37     my $self = shift;
38    
39     return unless $self->{lock};
40    
41     $self->{lock}->unlock;
42     delete $self->{lock};
43     }
44 wakaba 1.1
45     sub _get_file_name ($$$$) {
46     my $self = shift;
47     my $hash = Digest::MD5::md5_hex (Encode::encode ('utf8', $_[0]));
48     my $mkdir = $_[1];
49     my $id = $_[2];
50    
51     my $dir1 = $self->{root_directory_name} . substr ($hash, 0, 2);
52     my $dir2 = $dir1 . '/' . substr ($hash, 2, 2);
53     substr ($hash, 0, 4) = '';
54     my $dir3 = $dir2 . '/' . $hash . $self->{directory_suffix};
55     my $dir4;
56    
57     my $file_name = $dir3;
58    
59     if (defined $id) {
60     $dir4 = $dir3 . '/' . int ($id / 1000) . $self->{id_directory_suffix};
61     $file_name = $dir4 . '/' . ($id % 1000) . $self->{leaf_suffix};
62     }
63    
64     unless ($mkdir) {
65     return $file_name;
66     }
67    
68     unless (-d $dir1) {
69     mkdir $dir1 or die "$0: $dir1: $!";
70     }
71    
72     unless (-d $dir2) {
73     mkdir $dir2 or die "$0: $dir2: $!";
74     }
75    
76     unless (-d $dir3) {
77     mkdir $dir3 or die "$0: $dir3: $!";
78     }
79    
80     if (defined $dir4 and not -d $dir4) {
81     mkdir $dir4 or die "$0: $dir4: $!";
82     }
83    
84     if ($self->{version_control}) {
85     $self->{version_control}->add_directory ($dir1);
86     $self->{version_control}->add_directory ($dir2);
87     $self->{version_control}->add_directory ($dir3);
88     $self->{version_control}->add_directory ($dir4) if defined $dir4;
89     }
90    
91     return $file_name;
92     } # _get_file_name
93    
94     sub _for_each_id ($$$) {
95     my $self = shift;
96     my $dir_name = $self->_get_file_name ($_[0]);
97    
98     unless (-d $dir_name) {
99     return;
100     }
101    
102     my $code = $_[1];
103    
104     opendir my $d, $dir_name or die "$0: $dir_name: $!";
105     while (defined (my $id_dir_name = readdir $d)) {
106     next unless substr ($id_dir_name, -length $self->{id_directory_suffix})
107     eq $self->{id_directory_suffix};
108    
109     my $id_high = 0+substr $id_dir_name,
110 wakaba 1.3 0, (length $id_dir_name) - (length $self->{id_directory_suffix});
111 wakaba 1.1 my $id_directory_name = $dir_name . '/' . $id_dir_name;
112     opendir my $dd, $id_directory_name or die "$0: $id_directory_name: $!";
113     while (defined (my $f_name = readdir $dd)) {
114     next unless substr ($f_name, -length $self->{leaf_suffix})
115     eq $self->{leaf_suffix};
116    
117     my $id = $id_high * 1000 +
118 wakaba 1.3 substr $f_name, 0, (length $f_name) - (length $self->{leaf_suffix});
119 wakaba 1.1 my $file_name = $id_directory_name . '/' . $f_name;
120     $code->($id, $file_name);
121     }
122     close $dd;
123     }
124     close $d;
125     } # _for_each_id
126    
127     sub get_data ($$) {
128     my $self = shift;
129    
130     my $r = {};
131     local $/ = undef;
132    
133     $self->_for_each_id ($_[0], sub ($$) {
134     my ($id, $id_file_name) = @_;
135    
136     open my $file, '<:encoding(utf8)', $id_file_name
137     or die "$0: $id_file_name: $!";
138     $r->{$id} = <$file>;
139     close $file;
140     });
141    
142     return $r;
143     } # get_data
144    
145     sub get_count ($$) {
146     my $self = shift;
147    
148     my $r = 0;
149    
150     $self->_for_each_id ($_[0], sub {
151     $r++;
152     });
153    
154     return $r;
155     } # get_count
156    
157     sub add_data ($$$;$) {
158     my $self = shift;
159     my $file_name = $self->_get_file_name ($_[0], 1, $_[1]);
160     my $value = $_[2] // '';
161    
162     open my $file, '>:encoding(utf8)', $file_name or die "$0: $file_name: $!";
163     print $file $value;
164     close $file;
165    
166     $self->{version_control}->add_file ($file_name) if $self->{version_control};
167     } # add_data
168    
169     sub delete_data ($$$) {
170     my $self = shift;
171     my $file_name = $self->_get_file_name ($_[0], 0, $_[1]);
172    
173     unlink $file_name or die "$0: $file_name: $!" if -f $file_name;
174    
175     $self->{version_control}->remove_file ($file_name) if $self->{version_control};
176     } # delete_data
177    
178     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24