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	package SWE::DB::HashedIndex;
2	use strict;
3	use warnings;
4
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
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
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;