SWE/DB/HashedIndex.pm

package SWE::DB::HashedIndex;
use strict;
use warnings;

sub new ($) {
  my $self = bless {
    root_directory_name => './',
    directory_suffix => '.hi',
    id_directory_suffix => '.id',
    leaf_suffix => '.x',
  }, shift;
  return $self;
} # new

require Digest::MD5;
require Encode;

sub lock_file_name ($) : lvalue {
  my $self = shift;
  
  $self->{lock_file_name} ||= $self->{root_directory_name} . 'index.lock';
} # lock_file_name

sub lock ($) {
  my $self = shift;

  $self->{lock} ||= do {
    require SWE::DB::Lock;
    my $lock = SWE::DB::Lock->new;
    $lock->{file_name} = $self->lock_file_name;
    $lock->lock_type ('Index');
    $lock->lock;
  };
}

sub unlock ($) {
  my $self = shift;

  return unless $self->{lock};

  $self->{lock}->unlock;
  delete $self->{lock};
}

sub _get_file_name ($$$$) {
  my $self = shift;
  my $hash = Digest::MD5::md5_hex (Encode::encode ('utf8', $_[0]));
  my $mkdir = $_[1];
  my $id = $_[2];
  
  my $dir1 = $self->{root_directory_name} . substr ($hash, 0, 2);
  my $dir2 = $dir1 . '/' . substr ($hash, 2, 2);
  substr ($hash, 0, 4) = '';
  my $dir3 = $dir2 . '/' . $hash . $self->{directory_suffix};
  my $dir4;

  my $file_name = $dir3;

  if (defined $id) {
    $dir4 = $dir3 . '/' . int ($id / 1000) . $self->{id_directory_suffix};
    $file_name = $dir4 . '/' . ($id % 1000) . $self->{leaf_suffix};
  }

  unless ($mkdir) {
    return $file_name;
  }
  
  unless (-d $dir1) {
    mkdir $dir1 or die "$0: $dir1: $!";
  }

  unless (-d $dir2) {
    mkdir $dir2 or die "$0: $dir2: $!";
  }

  unless (-d $dir3) {
    mkdir $dir3 or die "$0: $dir3: $!";
  }

  if (defined $dir4 and not -d $dir4) {
    mkdir $dir4 or die "$0: $dir4: $!";
  }

  if ($self->{version_control}) {
    $self->{version_control}->add_directory ($dir1);
    $self->{version_control}->add_directory ($dir2);
    $self->{version_control}->add_directory ($dir3);
    $self->{version_control}->add_directory ($dir4) if defined $dir4;
  }

  return $file_name;
} # _get_file_name

sub _for_each_id ($$$) {
  my $self = shift;
  my $dir_name = $self->_get_file_name ($_[0]);
  
  unless (-d $dir_name) {
    return;
  }
  
  my $code = $_[1];

  opendir my $d, $dir_name or die "$0: $dir_name: $!";
  while (defined (my $id_dir_name = readdir $d)) {
    next unless substr ($id_dir_name, -length $self->{id_directory_suffix})
        eq $self->{id_directory_suffix};
   
    my $id_high = 0+substr $id_dir_name,
        0, length $id_dir_name - length $self->{id_directory_suffix};
    my $id_directory_name = $dir_name . '/' . $id_dir_name;
    opendir my $dd, $id_directory_name or die "$0: $id_directory_name: $!";
    while (defined (my $f_name = readdir $dd)) {
      next unless substr ($f_name, -length $self->{leaf_suffix})
          eq $self->{leaf_suffix};
      
      my $id = $id_high * 1000 +
          substr $f_name, 0, length $f_name - length $self->{leaf_suffix};
      my $file_name = $id_directory_name . '/' . $f_name;
      $code->($id, $file_name);
    }
    close $dd;
  }
  close $d;
} # _for_each_id

sub get_data ($$) {
  my $self = shift;

  my $r = {};
  local $/ = undef;

  $self->_for_each_id ($_[0], sub ($$) {
    my ($id, $id_file_name) = @_;
    
    open my $file, '<:encoding(utf8)', $id_file_name
        or die "$0: $id_file_name: $!";
    $r->{$id} = <$file>;
    close $file;
  });

  return $r;
} # get_data

sub get_count ($$) {
  my $self = shift;

  my $r = 0;

  $self->_for_each_id ($_[0], sub {
    $r++;
  });

  return $r;
} # get_count

sub add_data ($$$;$) {
  my $self = shift;
  my $file_name = $self->_get_file_name ($_[0], 1, $_[1]);
  my $value = $_[2] // '';
  
  open my $file, '>:encoding(utf8)', $file_name or die "$0: $file_name: $!";
  print $file $value;
  close $file;
  
  $self->{version_control}->add_file ($file_name) if $self->{version_control};
} # add_data

sub delete_data ($$$) {
  my $self = shift;
  my $file_name = $self->_get_file_name ($_[0], 0, $_[1]);

  unlink $file_name or die "$0: $file_name: $!" if -f $file_name;
  
  $self->{version_control}->remove_file ($file_name) if $self->{version_control};
} # delete_data

1;
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			0, length $id_dir_name - length $self->{id_directory_suffix};
111			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			substr $f_name, 0, length $f_name - length $self->{leaf_suffix};
119			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;