SWE/DB/HashedIndex.pm

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

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