| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Search::InvertedIndex; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# $RCSfile: InvertedIndex.pm,v $ $Revision: 1.31 $ $Date: 2000/01/25 19:53:26 $ $Author: snowhare $ |
|
4
|
|
|
|
|
|
|
|
|
5
|
1
|
|
|
1
|
|
7319
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
41
|
|
|
6
|
1
|
|
|
1
|
|
5
|
use Carp; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
97
|
|
|
7
|
1
|
|
|
1
|
|
13044
|
use Class::NamedParms; |
|
|
1
|
|
|
|
|
3116
|
|
|
|
1
|
|
|
|
|
43
|
|
|
8
|
1
|
|
|
1
|
|
3768
|
use Class::ParmList qw (simple_parms parse_parms); |
|
|
1
|
|
|
|
|
2252
|
|
|
|
1
|
|
|
|
|
103
|
|
|
9
|
1
|
|
|
1
|
|
3206
|
use Search::InvertedIndex::AutoLoader; |
|
|
1
|
|
|
|
|
5
|
|
|
|
1
|
|
|
|
|
50
|
|
|
10
|
1
|
|
|
1
|
|
8
|
use vars qw (@ISA $VERSION); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
1136
|
|
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
@ISA = qw(Class::NamedParms); |
|
13
|
|
|
|
|
|
|
$VERSION = '1.14'; |
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# Used to catch attempts to open the same -map |
|
16
|
|
|
|
|
|
|
# to multiple objects simultaneously and to |
|
17
|
|
|
|
|
|
|
# store the object refs for the map databases. |
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $open_maps = {}; |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# DATABASE SECTIONING CONSTANTS. |
|
22
|
|
|
|
|
|
|
my $DATABASE_STRINGIFIER = 'stringifier'; |
|
23
|
|
|
|
|
|
|
my $DATABASE_VERSION = 'database_version'; |
|
24
|
|
|
|
|
|
|
my $DATABASE_FIX_LEVEL = 'database_fix_level'; |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
my $INDEX = 'i_'; |
|
27
|
|
|
|
|
|
|
my $INDEX_ENUM = 'ie_'; |
|
28
|
|
|
|
|
|
|
my $INDEX_ENUM_DATA = 'ied_'; |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
my $GROUP = 'g_'; |
|
31
|
|
|
|
|
|
|
my $GROUP_ENUM = 'ge_'; |
|
32
|
|
|
|
|
|
|
my $GROUP_ENUM_DATA = 'ged_'; |
|
33
|
|
|
|
|
|
|
my $INDEXED_KEY_LIST = '_a_'; |
|
34
|
|
|
|
|
|
|
my $INDEX_ENUM_GROUP_CHAIN = '_b_'; |
|
35
|
|
|
|
|
|
|
my $KEYED_INDEX_LIST = '_c_'; |
|
36
|
|
|
|
|
|
|
my $KEY_TO_KEY_ENUM = '_d_'; |
|
37
|
|
|
|
|
|
|
my $KEY_ENUM_TO_KEY_AND_CHAIN = '_e_'; |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
my $PRELOAD_GROUP_ENUM_DATA = 'pged_'; |
|
40
|
|
|
|
|
|
|
my $UPDATE_GROUP_COUNTER = '_a_'; |
|
41
|
|
|
|
|
|
|
my $UPDATE_DATA = '_b_'; |
|
42
|
|
|
|
|
|
|
my $UPDATE_SORTBLOCK_A = '_c_'; |
|
43
|
|
|
|
|
|
|
my $UPDATE_SORTBLOCK_B = '_d_'; |
|
44
|
|
|
|
|
|
|
my $UPDATE_GROUP_PREFIX_NAME = '09a2184 xjkjeru 827i^131 mqwj;z'; |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $NULL_ENUM = '-' x 12; |
|
47
|
|
|
|
|
|
|
my $ZERO_ENUM = '0' x 12; |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
#################################################################### |
|
50
|
|
|
|
|
|
|
# _pack_list($hash_ref); |
|
51
|
|
|
|
|
|
|
# |
|
52
|
|
|
|
|
|
|
# Internal method. Not for access outside of the module. |
|
53
|
|
|
|
|
|
|
# |
|
54
|
|
|
|
|
|
|
# Packs the passed hash ref of enum keys and signed 16 bit int values |
|
55
|
|
|
|
|
|
|
# into a dense binary structure. There is an endian dependancy |
|
56
|
|
|
|
|
|
|
# here. |
|
57
|
|
|
|
|
|
|
# |
|
58
|
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
sub _pack_list { |
|
60
|
|
|
|
|
|
|
# my ($hash_ref) = @_; |
|
61
|
|
|
|
|
|
|
|
|
62
|
0
|
|
|
0
|
|
|
my @data_list = %{$_[0]}; |
|
|
0
|
|
|
|
|
|
|
|
63
|
0
|
0
|
|
|
|
|
return '' if (@data_list == 0); |
|
64
|
0
|
|
|
|
|
|
my $list_length = int (@data_list / 2); |
|
65
|
0
|
|
|
|
|
|
pack ("H12s" x $list_length,@data_list); |
|
66
|
|
|
|
|
|
|
} |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
#################################################################### |
|
69
|
|
|
|
|
|
|
# _unpack_list($packed_list); |
|
70
|
|
|
|
|
|
|
# |
|
71
|
|
|
|
|
|
|
# Internal method. Not for access outside of the module. |
|
72
|
|
|
|
|
|
|
# |
|
73
|
|
|
|
|
|
|
#Unpacks the passed dense binary structure into |
|
74
|
|
|
|
|
|
|
#an anonymous hash of enum keys and signed 16 bit int values. |
|
75
|
|
|
|
|
|
|
#There is an endian dependancy here. |
|
76
|
|
|
|
|
|
|
# |
|
77
|
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub _unpack_list { |
|
79
|
0
|
|
|
0
|
|
|
my ($bin_pack) = @_; |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
# if (not defined $bin_pack) { |
|
82
|
|
|
|
|
|
|
# croak (__PACKAGE__ . "::_unpack_list() - did not pass a binary structure for unpacking\n"); |
|
83
|
|
|
|
|
|
|
# } |
|
84
|
|
|
|
|
|
|
|
|
85
|
0
|
|
|
|
|
|
my $list_length = length($bin_pack)/8; |
|
86
|
0
|
|
|
|
|
|
my $hash_ref = {}; |
|
87
|
0
|
0
|
|
|
|
|
return {} if ($list_length == 0); |
|
88
|
0
|
|
|
|
|
|
%$hash_ref = unpack("H12s" x $list_length,$bin_pack); |
|
89
|
0
|
|
|
|
|
|
return $hash_ref; |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head1 NAME |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Search::InvertedIndex - A manager for inverted index maps |
|
95
|
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
97
|
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
use Search::InvertedIndex; |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
my $database = Search::InvertedIndex::DB::DB_File_SplitHash->new({ |
|
101
|
|
|
|
|
|
|
-map_name => '/www/search-engine/databases/test-maps/test', |
|
102
|
|
|
|
|
|
|
-multi => 4, |
|
103
|
|
|
|
|
|
|
-file_mode => 0644, |
|
104
|
|
|
|
|
|
|
-lock_mode => 'EX', |
|
105
|
|
|
|
|
|
|
-lock_timeout => 30, |
|
106
|
|
|
|
|
|
|
-blocking_locks => 0, |
|
107
|
|
|
|
|
|
|
-cachesize => 1000000, |
|
108
|
|
|
|
|
|
|
-write_through => 0, |
|
109
|
|
|
|
|
|
|
-read_write_mode => 'RDWR'; |
|
110
|
|
|
|
|
|
|
}); |
|
111
|
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
my $inv_map = Search::Inverted->new({ -database => $database }); |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
########################################################## |
|
115
|
|
|
|
|
|
|
# Example Update |
|
116
|
|
|
|
|
|
|
########################################################## |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
my $index_data = "Some scalar - complex structure refs are ok"; |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
my $update = Search::InvertedIndex::Update->new({ |
|
121
|
|
|
|
|
|
|
-group => 'keywords', |
|
122
|
|
|
|
|
|
|
-index => 'http://www.nihongo.org/', |
|
123
|
|
|
|
|
|
|
-data => $index_data, |
|
124
|
|
|
|
|
|
|
-keys => { |
|
125
|
|
|
|
|
|
|
'some' => 10, |
|
126
|
|
|
|
|
|
|
'scalar' => 20, |
|
127
|
|
|
|
|
|
|
'complex' => 15, |
|
128
|
|
|
|
|
|
|
'structure' => 15, |
|
129
|
|
|
|
|
|
|
'refs' => 15, |
|
130
|
|
|
|
|
|
|
'are' => 15, |
|
131
|
|
|
|
|
|
|
'ok' => 15, |
|
132
|
|
|
|
|
|
|
}, |
|
133
|
|
|
|
|
|
|
}); |
|
134
|
|
|
|
|
|
|
my $result = $inv_map->update({ -update => $update }); |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
########################################################## |
|
137
|
|
|
|
|
|
|
# Example Query |
|
138
|
|
|
|
|
|
|
# '-nodes' is an anon list of Search::InvertedIndex::Query |
|
139
|
|
|
|
|
|
|
# objects (this allows constructing complex booleans by |
|
140
|
|
|
|
|
|
|
# nesting). |
|
141
|
|
|
|
|
|
|
# |
|
142
|
|
|
|
|
|
|
# '-leafs' is an anon list of Search::InvertedIndex::Query::Leaf |
|
143
|
|
|
|
|
|
|
# objects (used for individual search terms). |
|
144
|
|
|
|
|
|
|
# |
|
145
|
|
|
|
|
|
|
########################################################## |
|
146
|
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
my $query_leaf1 = Search::InvertedIndex::Query::Leaf->new({ |
|
148
|
|
|
|
|
|
|
-key => 'complex', |
|
149
|
|
|
|
|
|
|
-group => 'keywords', |
|
150
|
|
|
|
|
|
|
-weight => 1, |
|
151
|
|
|
|
|
|
|
}); |
|
152
|
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
my $query_leaf2 = Search::InvertedIndex::Query::Leaf->new({ |
|
154
|
|
|
|
|
|
|
-key => 'structure', |
|
155
|
|
|
|
|
|
|
-group => 'keywords', |
|
156
|
|
|
|
|
|
|
-weight => 1, |
|
157
|
|
|
|
|
|
|
}); |
|
158
|
|
|
|
|
|
|
my $query_leaf3 = Search::InvertedIndex::Query::Leaf->new({ |
|
159
|
|
|
|
|
|
|
-key => 'gold', |
|
160
|
|
|
|
|
|
|
-group => 'keywords', |
|
161
|
|
|
|
|
|
|
-weight => 1, |
|
162
|
|
|
|
|
|
|
}); |
|
163
|
|
|
|
|
|
|
my $query1 = Search::InvertedIndex::Query->new({ |
|
164
|
|
|
|
|
|
|
-logic => 'and', |
|
165
|
|
|
|
|
|
|
-weight => 1, |
|
166
|
|
|
|
|
|
|
-nodes => [], |
|
167
|
|
|
|
|
|
|
-leafs => [$query_leaf1,$query_leaf2], |
|
168
|
|
|
|
|
|
|
}); |
|
169
|
|
|
|
|
|
|
my $query2 = Search::InvertedIndex::Query->new({ |
|
170
|
|
|
|
|
|
|
-logic => 'or', |
|
171
|
|
|
|
|
|
|
-weight => 1, |
|
172
|
|
|
|
|
|
|
-nodes => [$query1], |
|
173
|
|
|
|
|
|
|
-leafs => [$query_leaf3], |
|
174
|
|
|
|
|
|
|
}); |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
my $result = $inv_map->search({ -query => $query2 }); |
|
177
|
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
########################################################## |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
$inv_map->close; |
|
181
|
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
183
|
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
Provides the core of an inverted map based search engine. By |
|
185
|
|
|
|
|
|
|
mapping 'keys' to 'indexes' it provides ultra-fast look ups |
|
186
|
|
|
|
|
|
|
of all 'indexes' containing specific 'keys'. This produces |
|
187
|
|
|
|
|
|
|
highly scalable behavior where thousands, or even millions |
|
188
|
|
|
|
|
|
|
of records can be searched extremely quickly. |
|
189
|
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Available database drivers are: |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
Search::InvertedIndex::DB::DB_File_SplitHash |
|
193
|
|
|
|
|
|
|
Search::InvertedIndex::DB::Mysql |
|
194
|
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Check the POD documentation for each database driver to |
|
196
|
|
|
|
|
|
|
determine initialization requirements. |
|
197
|
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=head1 CHANGES |
|
199
|
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
1.00 1999.06.16 - Initial release |
|
201
|
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
1.01 1999.06.17 - Documentation fixes and fix to 'close' method in |
|
203
|
|
|
|
|
|
|
Search::InvertedIndex::DB::DB_File_SplitHash |
|
204
|
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
1.02 1999.06.18 - Major bugfix to locking system. |
|
206
|
|
|
|
|
|
|
Performance tweaking. Roughly 3x improvement. |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
1.03 1999.06.30 - Documentation fixes. |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
1.04 1999.07.01 - Documentation fixes and caching system bugfixes. |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
1.05 1999.10.20 - Altered ranking computation on search results |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
1.06 1999.10.20 - Removed 'use attrs' usage to improve portability |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
1.07 1999.11.09 - "Cosmetic" changes to avoid warnings in Perl 5.004 |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
1.08 2000.01.25 - Bugfix to 'Search::InvertedIndex::DB:DB_File_SplitHash' submodule |
|
219
|
|
|
|
|
|
|
and documentation additions/fixes |
|
220
|
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
1.09 2000.03.23 - Bugfix to 'Search::InvertedIndex::DB:DB_File_SplitHash' submodule |
|
222
|
|
|
|
|
|
|
to manage case where 'open' is not performed before close is called. |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
1.10 2000.07.05 - Delayed loading of serializer and added option to select |
|
225
|
|
|
|
|
|
|
which serializer (Storable or Data::Dumper) to use at instance 'new' time. |
|
226
|
|
|
|
|
|
|
This should allow module to be loaded by mod_perl via the 'PerlModule' |
|
227
|
|
|
|
|
|
|
conf directive and enable use on platforms that do not support |
|
228
|
|
|
|
|
|
|
'Storable' (such as Macintosh). |
|
229
|
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
1.11 2000.11.29 - Added 'Search::InvertedIndex::DB::Mysql' (authored by |
|
231
|
|
|
|
|
|
|
Michael Cramer ) database driver |
|
232
|
|
|
|
|
|
|
to package. |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
1.12 2002.04.09 - Squashed bug in removal of an index from a group when the index doesn't |
|
235
|
|
|
|
|
|
|
exist in that group that caused index counts for the group to be decremented |
|
236
|
|
|
|
|
|
|
in error. |
|
237
|
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
1.13 2003.09.28 - Interim release. Fixed false error return from 'first_key_in_group' for a group |
|
239
|
|
|
|
|
|
|
that has not yet had any keys set. Tightened calling |
|
240
|
|
|
|
|
|
|
parm parses. Tweaked performance of preload updating code. |
|
241
|
|
|
|
|
|
|
Added taint fix for stringifier identifier. |
|
242
|
|
|
|
|
|
|
This release was driven by the taint issue and code bug as crisis items. |
|
243
|
|
|
|
|
|
|
Hopefully a 1.14 release will be in the not too distant future. |
|
244
|
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
1.14 2003.11.14 - Patch to the MySQL database driver to accomodate changes in DBD::mysql. |
|
246
|
|
|
|
|
|
|
Addition of a test for MySQL functionality. Patch and test thanks to |
|
247
|
|
|
|
|
|
|
Kate L Pugh. |
|
248
|
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=head2 Public API |
|
250
|
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=cut |
|
252
|
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
#################################################################### |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=over 4 |
|
256
|
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=item C $database_object [,'-search_cache_size' =E 1000, -search_cache_dir =E '/var/tmp/search_cache', -stringifier =E ['Storable','Data::Dumper'], ] });> |
|
258
|
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Provides the interface for obtaining a new Search::InvertedIndex |
|
260
|
|
|
|
|
|
|
object for manipulating a inverted database. |
|
261
|
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
Example 1: |
|
263
|
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
my $database = Search::InvertedIndex::DB::DB_File_SplitHash->new({ |
|
265
|
|
|
|
|
|
|
-map_name => '/www/databases/test-map_names/test', |
|
266
|
|
|
|
|
|
|
-multi => 4, |
|
267
|
|
|
|
|
|
|
-file_mode => 0644, |
|
268
|
|
|
|
|
|
|
-lock_mode => 'EX', |
|
269
|
|
|
|
|
|
|
-lock_timeout => 30, |
|
270
|
|
|
|
|
|
|
-blocking_locks => 0, |
|
271
|
|
|
|
|
|
|
-cachesize => 1000000, |
|
272
|
|
|
|
|
|
|
-write_through => 0, |
|
273
|
|
|
|
|
|
|
-read_write_mode => 'RDONLY', |
|
274
|
|
|
|
|
|
|
}); |
|
275
|
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
my $inv_map = Search::InvertedIndex->new({ |
|
277
|
|
|
|
|
|
|
'-database' => $database, |
|
278
|
|
|
|
|
|
|
'-search_cache_size' => 1000, |
|
279
|
|
|
|
|
|
|
'-search_cache_dir' => '/var/tmp/search_cache', |
|
280
|
|
|
|
|
|
|
-stringifier => ['Storable','Data::Dumper'], |
|
281
|
|
|
|
|
|
|
}); |
|
282
|
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
Parameter explanations: |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
-database - A database interface object. Defined database interfaces |
|
287
|
|
|
|
|
|
|
are currently Search::InvertedIndex::DB::DB_File_SplitHash |
|
288
|
|
|
|
|
|
|
and Search::InvertedIndex::DB::Mysql. (Required) |
|
289
|
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
-stringifier - Declares the stringifier used to store information in the |
|
291
|
|
|
|
|
|
|
underlaying database. Currently defined stringifiers are |
|
292
|
|
|
|
|
|
|
'Storable' and 'Data::Dumper'. The default is to use |
|
293
|
|
|
|
|
|
|
'Storable' with fallback to 'Data::Dumper'. (Optional) |
|
294
|
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
-search_cache_size - Sets the number of cached searched to hold in the search cache (Optional) |
|
296
|
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
-search_cache_dir - Sets the directory to be used for the search cache |
|
298
|
|
|
|
|
|
|
(Required if search_cache_size is set to something other than 0) |
|
299
|
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
The -database parameter is required and must be a 'Search::InvertedIndex::DB::...' |
|
301
|
|
|
|
|
|
|
type database object. The other two parameters are optional and define the |
|
302
|
|
|
|
|
|
|
location and size of the search cache. If omitted, no search caching will be done. |
|
303
|
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
The optional '-stringifier' parameter can be used to override the default |
|
305
|
|
|
|
|
|
|
use of 'Storable' (with fallback to 'Data::Dumper') as the stringifier used |
|
306
|
|
|
|
|
|
|
for storing data by the module. Specifiying -stringifier => 'Data::Dumper' |
|
307
|
|
|
|
|
|
|
would specify using 'Data::Dumper' (only) as the stringifier while |
|
308
|
|
|
|
|
|
|
specifiying -stringifier => ['Data::Dumper','Storable'] would specify |
|
309
|
|
|
|
|
|
|
to use Data::Dumper by preference (but to fall back to 'Storable' if Data::Dumper |
|
310
|
|
|
|
|
|
|
was not available). If a database was created using a particular serializer, |
|
311
|
|
|
|
|
|
|
it will automatically detect it and attempt to use the correct one. |
|
312
|
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
=back |
|
314
|
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
=cut |
|
316
|
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
sub new { |
|
318
|
0
|
|
|
0
|
1
|
|
my $proto = shift; |
|
319
|
0
|
|
|
|
|
|
my $package = __PACKAGE__; |
|
320
|
0
|
|
0
|
|
|
|
my $class = ref ($proto) || $proto || $package; |
|
321
|
0
|
|
|
|
|
|
my $self = Class::NamedParms->new(qw (-database -thaw -freeze -stringifier)); |
|
322
|
0
|
|
|
|
|
|
bless $self,$class; |
|
323
|
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
# Check the passed parms and set defaults as necessary |
|
325
|
0
|
|
|
|
|
|
my $parms = parse_parms({ -parms => \@_, |
|
326
|
|
|
|
|
|
|
-legal => ['-search_cache_size', '-search_cache_dir'], |
|
327
|
|
|
|
|
|
|
-required => ['-database'], |
|
328
|
|
|
|
|
|
|
-defaults => { -search_cache_size => 0, |
|
329
|
|
|
|
|
|
|
-search_cache_dir => undef, |
|
330
|
|
|
|
|
|
|
-stringifier => [qw(Storable Data::Dumper)], |
|
331
|
|
|
|
|
|
|
}, |
|
332
|
|
|
|
|
|
|
}); |
|
333
|
0
|
0
|
|
|
|
|
if (not defined $parms) { |
|
334
|
0
|
|
|
|
|
|
my $error_message = Class::ParmList->error; |
|
335
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::new() - $error_message\n"); |
|
336
|
|
|
|
|
|
|
} |
|
337
|
|
|
|
|
|
|
|
|
338
|
0
|
|
|
|
|
|
my ($database,$search_cache_dir,$search_cache_size,$stringifier) = |
|
339
|
|
|
|
|
|
|
$parms->get(qw (-database -search_cache_dir -search_cache_size -stringifier)); |
|
340
|
|
|
|
|
|
|
|
|
341
|
0
|
0
|
|
|
|
|
$stringifier = [$stringifier] if ('ARRAY' ne ref($stringifier)); |
|
342
|
|
|
|
|
|
|
|
|
343
|
0
|
|
|
|
|
|
$self->search_cache_dir($search_cache_dir); |
|
344
|
0
|
|
|
|
|
|
$self->search_cache_size($search_cache_size); |
|
345
|
0
|
|
|
|
|
|
$self->set({ -database => $database, }); |
|
346
|
|
|
|
|
|
|
|
|
347
|
0
|
|
|
|
|
|
$database->open; |
|
348
|
0
|
|
|
|
|
|
$self->_select_stringifier(@$stringifier); |
|
349
|
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# # auto-fix corrupted group key/index counters |
|
351
|
|
|
|
|
|
|
# my $database_fix_level = $database->get({ -key => $DATABASE_FIX_LEVEL}); |
|
352
|
|
|
|
|
|
|
# $database_fix_level = 0 unless ((defined $database_fix_level) and ($database_fix_level ne '')); |
|
353
|
|
|
|
|
|
|
# my $database_lock_mode = $database->status('-lock_mode'); |
|
354
|
|
|
|
|
|
|
# if (($database_lock_mode eq 'EX') and ($database_fix_level < '2')) { |
|
355
|
|
|
|
|
|
|
# if ($database->put({ -key => $DATABASE_FIX_LEVEL, -value => '1' })) { |
|
356
|
|
|
|
|
|
|
# # OK. We are opened EX and writable. Time to fix things |
|
357
|
|
|
|
|
|
|
# require Search::InvertedIndex::FixGroups; |
|
358
|
|
|
|
|
|
|
# # Code here XXXXXXXXXXXXXXXXXXXXXXXXXXXXX |
|
359
|
|
|
|
|
|
|
# } |
|
360
|
|
|
|
|
|
|
# } |
|
361
|
|
|
|
|
|
|
|
|
362
|
0
|
|
|
|
|
|
return $self; |
|
363
|
|
|
|
|
|
|
} |
|
364
|
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
##################################################################### |
|
366
|
|
|
|
|
|
|
# |
|
367
|
|
|
|
|
|
|
# $self->_select_stringifier(@stringifier_list); |
|
368
|
|
|
|
|
|
|
# |
|
369
|
|
|
|
|
|
|
# Selects the serializer to use for data serialization in the database |
|
370
|
|
|
|
|
|
|
# |
|
371
|
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub _select_stringifier { |
|
373
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
374
|
|
|
|
|
|
|
|
|
375
|
0
|
|
|
|
|
|
my @stringifier = @_; |
|
376
|
|
|
|
|
|
|
|
|
377
|
0
|
|
|
|
|
|
my $db = $self->get(-database); |
|
378
|
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# We use whatever the *database* may already have used in preference |
|
380
|
|
|
|
|
|
|
# to any requests for a stringifier. This will prevent wierdness like the database |
|
381
|
|
|
|
|
|
|
# breaking because 'Storable' was installed after it was created |
|
382
|
|
|
|
|
|
|
# using 'Data::Dumper'.This is backward compatible with old databases |
|
383
|
|
|
|
|
|
|
# created with this because old database defaulted to 'Storable' |
|
384
|
0
|
|
|
|
|
|
my $declared_stringifier = $db->get({ -key => $DATABASE_STRINGIFIER }); |
|
385
|
0
|
0
|
|
|
|
|
if (defined $declared_stringifier) { |
|
386
|
0
|
|
|
|
|
|
@stringifier = ($declared_stringifier); |
|
387
|
|
|
|
|
|
|
} |
|
388
|
|
|
|
|
|
|
|
|
389
|
|
|
|
|
|
|
# We delay the load of stringification modules to here to make it |
|
390
|
|
|
|
|
|
|
# compatible with PerlModule for mod_perl and to allow a choice |
|
391
|
|
|
|
|
|
|
# of stringification modules |
|
392
|
0
|
|
|
|
|
|
my $have_stringifier; |
|
393
|
0
|
|
|
|
|
|
foreach my $module_name (@stringifier) { |
|
394
|
0
|
0
|
|
|
|
|
if ($module_name !~ m/^(Storable|Data::Dumper)$/) { |
|
395
|
0
|
|
|
|
|
|
croak ('[' . localtime(time) . "] [error] " . __PACKAGE__ . |
|
396
|
|
|
|
|
|
|
"::_select_stringifier() - Stringifier of '$module_name' is not supported."); |
|
397
|
|
|
|
|
|
|
} |
|
398
|
0
|
|
|
|
|
|
my $untainted_module_name = $1; |
|
399
|
0
|
|
|
|
|
|
eval "use $untainted_module_name;"; |
|
400
|
0
|
0
|
|
|
|
|
next if ($@); |
|
401
|
0
|
|
|
|
|
|
$have_stringifier = $untainted_module_name; |
|
402
|
0
|
|
|
|
|
|
last; |
|
403
|
|
|
|
|
|
|
} |
|
404
|
0
|
0
|
|
|
|
|
if (not defined $have_stringifier) { |
|
405
|
0
|
|
|
|
|
|
croak('[' . localtime(time) . "] [error] " . __PACKAGE__ . |
|
406
|
|
|
|
|
|
|
"::_select_stringifier() - Unable to load stringification modules. Tried: " . join (' ',@stringifier)); |
|
407
|
|
|
|
|
|
|
} |
|
408
|
0
|
|
|
|
|
|
my ($thaw,$freeze); |
|
409
|
0
|
0
|
|
|
|
|
if ($have_stringifier eq 'Storable') { |
|
|
|
0
|
|
|
|
|
|
|
410
|
0
|
|
|
|
|
|
$thaw = \&Storable::thaw; |
|
411
|
0
|
|
|
|
|
|
$freeze = \&Storable::nfreeze; |
|
412
|
|
|
|
|
|
|
} elsif ($have_stringifier eq 'Data::Dumper') { |
|
413
|
0
|
|
|
|
|
|
my $dumper = Data::Dumper->new(['blecherous']); |
|
414
|
0
|
|
|
0
|
|
|
$thaw = sub { my $value = shift; |
|
415
|
0
|
|
|
|
|
|
local $^W; |
|
416
|
1
|
|
|
1
|
|
7
|
no strict 'vars'; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
43435
|
|
|
417
|
0
|
|
|
|
|
|
my $thawed = eval $value; |
|
418
|
0
|
|
|
|
|
|
return $thawed; }; |
|
|
0
|
|
|
|
|
|
|
|
419
|
0
|
0
|
|
|
|
|
if ($dumper->can('Dumpxs')) { |
|
420
|
0
|
|
|
0
|
|
|
$freeze = sub { my $value = shift; |
|
421
|
0
|
|
|
|
|
|
local $Data::Dumper::Purity = 1; |
|
422
|
0
|
|
|
|
|
|
local $Data::Dumper::Indent = 0; |
|
423
|
0
|
|
|
|
|
|
my $frozen = Data::Dumper::DumperX($value); |
|
424
|
0
|
|
|
|
|
|
return $frozen; }; |
|
|
0
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
} else { |
|
426
|
0
|
|
|
0
|
|
|
$freeze = sub { my $value = shift; |
|
427
|
0
|
|
|
|
|
|
local $Data::Dumper::Purity = 1; |
|
428
|
0
|
|
|
|
|
|
local $Data::Dumper::Indent = 0; |
|
429
|
0
|
|
|
|
|
|
my $frozen = Data::Dumper::Dumper($value); |
|
430
|
0
|
|
|
|
|
|
return $frozen; }; |
|
|
0
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
} |
|
433
|
|
|
|
|
|
|
} else { |
|
434
|
0
|
|
|
|
|
|
croak('[' . localtime(time) . "] [error] " . __PACKAGE__ . |
|
435
|
|
|
|
|
|
|
"::_select_stringifier() - Unsupported stringification module ($have_stringifier)"); |
|
436
|
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
} |
|
438
|
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
# This may well fail if the database was opened read only. We don't care if it does. |
|
440
|
|
|
|
|
|
|
# A silent failure is *ok*. |
|
441
|
0
|
0
|
0
|
|
|
|
if ((not defined $declared_stringifier) and ('EX' eq $db->status('-lock_mode'))) { |
|
442
|
0
|
|
|
|
|
|
$db->put({ -key => $DATABASE_STRINGIFIER, -value => $have_stringifier }); |
|
443
|
0
|
|
|
|
|
|
my $database_version = $db->get({ -key => $DATABASE_VERSION }); |
|
444
|
0
|
0
|
|
|
|
|
if (not defined $database_version) { |
|
445
|
0
|
|
|
|
|
|
$db->put({ -key => $DATABASE_VERSION, -value => $VERSION }); |
|
446
|
|
|
|
|
|
|
} |
|
447
|
|
|
|
|
|
|
} |
|
448
|
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
$self->set({ |
|
450
|
0
|
|
|
|
|
|
-thaw => $thaw, |
|
451
|
|
|
|
|
|
|
-freeze => $freeze, |
|
452
|
|
|
|
|
|
|
}); |
|
453
|
|
|
|
|
|
|
} |
|
454
|
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
#################################################################### |
|
456
|
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
=over 4 |
|
458
|
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
=item C 'EX|SH|UN' [, -lock_timeout => 30] [, -blocking_locks => 0] });> |
|
460
|
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
Changes a lock on the underlaying database. |
|
462
|
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
Forces 'sync' if the stat is changed from 'EX' to a lower lock state |
|
464
|
|
|
|
|
|
|
(i.e. 'SH' or 'UN'). Croaks on errors. |
|
465
|
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
Example: |
|
467
|
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
$inv->lock({ -lock_mode => 'EX' [, -lock_timeout => 30] [, -blocking_locks => 0], |
|
469
|
|
|
|
|
|
|
}); |
|
470
|
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
The only _required_ parameter is the -lock_mode. The other |
|
472
|
|
|
|
|
|
|
parameters can be inherited from the object state. If the |
|
473
|
|
|
|
|
|
|
other parameters are used, they change the object state |
|
474
|
|
|
|
|
|
|
to match the new settings. |
|
475
|
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=back |
|
477
|
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
=cut |
|
479
|
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
sub lock { |
|
481
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
482
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
483
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
484
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::lock() - No database opened for use\n"); |
|
485
|
|
|
|
|
|
|
} |
|
486
|
0
|
|
|
|
|
|
$db->lock(@_); |
|
487
|
|
|
|
|
|
|
} |
|
488
|
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
#################################################################### |
|
490
|
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=over 4 |
|
492
|
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
=item C |
|
494
|
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
Returns the requested status line for the database. Allowed requests |
|
496
|
|
|
|
|
|
|
are '-open', and '-lock'. |
|
497
|
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
Example 1: |
|
499
|
|
|
|
|
|
|
my $status = $inv_map->status(-open); # Returns either '1' or '0' |
|
500
|
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
Example 2: |
|
502
|
|
|
|
|
|
|
my $status = $inv_map->status(-lock_mode); # Returns 'UN', 'SH' or 'EX' |
|
503
|
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
=back |
|
505
|
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
=cut |
|
507
|
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
sub status { |
|
509
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
510
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
511
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
512
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::status() - No database opened for use\n"); |
|
513
|
|
|
|
|
|
|
} |
|
514
|
0
|
|
|
|
|
|
$db->status(@_); |
|
515
|
|
|
|
|
|
|
} |
|
516
|
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
#################################################################### |
|
518
|
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=over 4 |
|
520
|
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
=item C $update });> |
|
522
|
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
Performs an update on the map. This is designed for |
|
524
|
|
|
|
|
|
|
adding/changing/deleting a bunch of related information |
|
525
|
|
|
|
|
|
|
in a single block update. It takes a |
|
526
|
|
|
|
|
|
|
Search::InvertedIndex::Update object as input. It assumes |
|
527
|
|
|
|
|
|
|
that you wish to remove all references to the specified index |
|
528
|
|
|
|
|
|
|
and replace them with a new list of references. It can also |
|
529
|
|
|
|
|
|
|
will update the -data for the -index. If -data is passed |
|
530
|
|
|
|
|
|
|
and the -index does not already exist, a new index record |
|
531
|
|
|
|
|
|
|
will be created. It is a fatal error to pass a non-existant |
|
532
|
|
|
|
|
|
|
index without a -data parm to initialize it. It is also |
|
533
|
|
|
|
|
|
|
a fatal error to pass an update for a non-existant -group. |
|
534
|
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
Passing an empty -keys has the effect of deleting the |
|
536
|
|
|
|
|
|
|
index from group (but not from the system). |
|
537
|
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
Example: |
|
539
|
|
|
|
|
|
|
|
|
540
|
|
|
|
|
|
|
my $update = Search::InvertedIndex::Update->new(...); |
|
541
|
|
|
|
|
|
|
$inv_map->update({ -update => $update }); |
|
542
|
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
It is much faster to update a index using the update |
|
544
|
|
|
|
|
|
|
method than the add_entry_to_group method in most cases |
|
545
|
|
|
|
|
|
|
because the batching of changes allows for efficiency |
|
546
|
|
|
|
|
|
|
optimizations when there is more than one key. |
|
547
|
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=back |
|
549
|
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
=cut |
|
551
|
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
sub update { |
|
553
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
554
|
|
|
|
|
|
|
|
|
555
|
0
|
|
|
|
|
|
my ($update) = simple_parms(['-update'],@_); |
|
556
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
557
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
558
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update() - No database opened for use\n"); |
|
559
|
|
|
|
|
|
|
} |
|
560
|
0
|
|
|
|
|
|
my ($index,$index_data,$group,$key_list) = $update->get(qw(-index -data -group -keys)); |
|
561
|
0
|
0
|
0
|
|
|
|
if ((not defined $index) or ($index eq '')) { |
|
562
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update() - No -index set.\n"); |
|
563
|
|
|
|
|
|
|
} |
|
564
|
0
|
0
|
0
|
|
|
|
if ((not defined $group) or ($group eq '')) { |
|
565
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update() - No -group set.\n"); |
|
566
|
|
|
|
|
|
|
} |
|
567
|
0
|
0
|
|
|
|
|
if (not defined $key_list) { |
|
568
|
0
|
|
|
|
|
|
$key_list = {}; |
|
569
|
|
|
|
|
|
|
} |
|
570
|
0
|
|
|
|
|
|
my $new_keys = 0; |
|
571
|
0
|
|
|
|
|
|
while (my ($key,$ranking) = each %$key_list) { |
|
572
|
0
|
|
|
|
|
|
$ranking = int($ranking+0.5); |
|
573
|
0
|
0
|
0
|
|
|
|
if (($ranking < -32768) or ($ranking > 32767)) { |
|
574
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update() - Invalid ranking value of '$ranking' for key '$key'. Only values from -32768 to +32767 are allowed\n"); |
|
575
|
|
|
|
|
|
|
} |
|
576
|
0
|
|
|
|
|
|
$new_keys++; |
|
577
|
|
|
|
|
|
|
} |
|
578
|
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
# Get the group_enum for this group |
|
580
|
0
|
|
|
|
|
|
my $group_enum = $db->get({ -key => "$GROUP$group" }); |
|
581
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
582
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::update() - Attempted to add an entry to the undeclared -group '$group'\n"); |
|
583
|
|
|
|
|
|
|
} |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
# Delete the existing -index/-group data |
|
586
|
0
|
|
|
|
|
|
$self->remove_index_from_group({ -group => $group, '-index' => $index}); |
|
587
|
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
# Create the -index and store the -data record for the -index as needed |
|
589
|
0
|
|
|
|
|
|
my $index_enum; |
|
590
|
0
|
0
|
|
|
|
|
if (defined $index_data) { |
|
591
|
0
|
|
|
|
|
|
$index_enum = $self->add_index({ '-index' => $index, -data => $index_data }); |
|
592
|
|
|
|
|
|
|
} else { |
|
593
|
0
|
|
|
|
|
|
$index_enum = $db->get({ -key => "$INDEX$index" }); |
|
594
|
0
|
0
|
|
|
|
|
if (not defined $index_enum) { |
|
595
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::update() - Attempted to add a new index to the system without setting its -data\n"); |
|
596
|
|
|
|
|
|
|
} |
|
597
|
|
|
|
|
|
|
} |
|
598
|
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
# Add keys to the group if needed. |
|
600
|
0
|
|
|
|
|
|
my $indexed_keys = {}; |
|
601
|
0
|
|
|
|
|
|
while (my ($key,$ranking) = each %$key_list) { |
|
602
|
0
|
|
|
|
|
|
$ranking = int($ranking+0.5); |
|
603
|
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
# Add the key to the group, if necessary. |
|
605
|
0
|
|
|
|
|
|
my $key_enum = $self->add_key_to_group ({ -group => $group, -key => $key }); |
|
606
|
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
# Add the ranking to the running key_enum indexed record |
|
608
|
0
|
|
|
|
|
|
$indexed_keys->{$key_enum} = $ranking; |
|
609
|
|
|
|
|
|
|
|
|
610
|
|
|
|
|
|
|
# Add the index_enum to the list of index_enums for this key_enum |
|
611
|
0
|
|
|
|
|
|
my $keyed_record = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$key_enum" }); |
|
612
|
0
|
0
|
|
|
|
|
$keyed_record = '' if (not defined $keyed_record); |
|
613
|
0
|
|
|
|
|
|
my $keyed_indexes = _unpack_list($keyed_record); |
|
614
|
0
|
|
|
|
|
|
$keyed_indexes->{$index_enum} = $ranking; |
|
615
|
0
|
|
|
|
|
|
$keyed_record = _pack_list($keyed_indexes); |
|
616
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}$KEYED_INDEX_LIST$key_enum", -value => $keyed_record })) { |
|
617
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update() - Failed to save updated '$GROUP_ENUM_DATA${group_enum}$KEYED_INDEX_LIST$key_enum' -> (list of ranked indexes)\n"); |
|
618
|
|
|
|
|
|
|
} |
|
619
|
|
|
|
|
|
|
} |
|
620
|
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
# increment the _number_of_indexes counter and create |
|
622
|
|
|
|
|
|
|
# a new INDEXED_KEY_LIST for this index_enum if we |
|
623
|
|
|
|
|
|
|
# assigned new keys for this group for the index |
|
624
|
|
|
|
|
|
|
# This is where we gain a big chunk of our performance advantage from. |
|
625
|
0
|
0
|
|
|
|
|
if ($new_keys) { |
|
626
|
0
|
|
|
|
|
|
my $indexed_record = _pack_list($indexed_keys); |
|
627
|
0
|
|
|
|
|
|
my $number_of_group_indexes = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_indexes" }); |
|
628
|
0
|
0
|
|
|
|
|
if (not defined $number_of_group_indexes) { |
|
629
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update () - Database may be corrupt. Failed to locate '$GROUP_ENUM_DATA${group_enum}_number_of_indexes' record for group '$group'\n"); |
|
630
|
|
|
|
|
|
|
} |
|
631
|
0
|
|
|
|
|
|
$number_of_group_indexes++; |
|
632
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_indexes", -value => $number_of_group_indexes })) { |
|
633
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update () - Database may be corrupt. Unable to update '$GROUP_ENUM_DATA${group_enum}_number_of_indexes' record to '$number_of_group_indexes' for group '$group'\n"); |
|
634
|
|
|
|
|
|
|
} |
|
635
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$index_enum", -value => $indexed_record })) { |
|
636
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update() - Failed to save updated '$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$index_enum' -> (list of ranked keys)\n"); |
|
637
|
|
|
|
|
|
|
} |
|
638
|
|
|
|
|
|
|
} |
|
639
|
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
# Update the INDEX_ENUM_GROUP_CHAIN as necessary |
|
641
|
|
|
|
|
|
|
# Check if the index already exists in the group |
|
642
|
0
|
|
|
|
|
|
my ($chain) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum" }); |
|
643
|
0
|
0
|
|
|
|
|
if (not defined $chain) { |
|
644
|
|
|
|
|
|
|
# Add the index_enum to the index chain for the group |
|
645
|
0
|
|
|
|
|
|
my $old_first_index_enum = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum" }); |
|
646
|
0
|
|
|
|
|
|
my $first_index_enum_record = "$NULL_ENUM $NULL_ENUM"; |
|
647
|
0
|
0
|
0
|
|
|
|
if (defined ($old_first_index_enum) and ($old_first_index_enum ne $NULL_ENUM)) { # Record formated as: prev next index |
|
648
|
0
|
|
|
|
|
|
my $old_first_index_enum_record = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum" }); |
|
649
|
0
|
0
|
|
|
|
|
if (not defined $old_first_index_enum_record) { |
|
650
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update() - Unable to read '$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum' record. Database may be corrupt.\n"); |
|
651
|
|
|
|
|
|
|
} |
|
652
|
0
|
|
|
|
|
|
$old_first_index_enum_record =~ s/^$NULL_ENUM/$index_enum/; |
|
653
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum", |
|
654
|
|
|
|
|
|
|
-value => $old_first_index_enum_record, })) { |
|
655
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update() - Unable to update 'prev' enum reference for '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum'\n"); |
|
656
|
|
|
|
|
|
|
} |
|
657
|
0
|
|
|
|
|
|
$first_index_enum_record = "$NULL_ENUM $old_first_index_enum"; |
|
658
|
|
|
|
|
|
|
} |
|
659
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum", -value => $first_index_enum_record })) { |
|
660
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update() - Unable to save '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum' -> '$first_index_enum_record' to map\n"); |
|
661
|
|
|
|
|
|
|
} |
|
662
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum", -value => $index_enum })) { |
|
663
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update() - Unable to save '$GROUP_ENUM_DATA${group_enum}_first_index_enum' -> '$index_enum' map entry.\n"); |
|
664
|
|
|
|
|
|
|
} |
|
665
|
|
|
|
|
|
|
} |
|
666
|
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
668
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
669
|
|
|
|
|
|
|
} |
|
670
|
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
#################################################################### |
|
672
|
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
=over 4 |
|
674
|
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
=item C $update });> |
|
676
|
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
'preload_update' places the passed 'update' object data into a pending |
|
678
|
|
|
|
|
|
|
queue which is not reflected in the searchable database until the |
|
679
|
|
|
|
|
|
|
'update_group' method has been called. This allows the |
|
680
|
|
|
|
|
|
|
loading process to be streamlined for maximum performance |
|
681
|
|
|
|
|
|
|
on large full updates. This method is not appropriate to |
|
682
|
|
|
|
|
|
|
incremental updates as the 'update_group' method destroys |
|
683
|
|
|
|
|
|
|
the previous searchable data set on execution. |
|
684
|
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
It also places the database effectively offline during the update, |
|
686
|
|
|
|
|
|
|
so this is not a suitable method for updating a 'online' database. |
|
687
|
|
|
|
|
|
|
Updates should happen on an 'offline' copy that is then swapped |
|
688
|
|
|
|
|
|
|
into place with the 'online' database. |
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
Example: |
|
691
|
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
my $update = Search::InvertedIndex::Update->new(...); |
|
693
|
|
|
|
|
|
|
$inv_map->preload_update({ -update => $update }); |
|
694
|
|
|
|
|
|
|
. |
|
695
|
|
|
|
|
|
|
. |
|
696
|
|
|
|
|
|
|
. |
|
697
|
|
|
|
|
|
|
$inv_map->update_group({ -group => 'test' }); |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
=back |
|
700
|
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
=cut |
|
702
|
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
sub preload_update { |
|
704
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
705
|
|
|
|
|
|
|
|
|
706
|
0
|
|
|
|
|
|
my ($update) = simple_parms(['-update'],@_); |
|
707
|
0
|
|
|
|
|
|
my ($db,$freeze) = $self->get(qw(-database -freeze)); |
|
708
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
709
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::preload_update() - No database opened for use\n"); |
|
710
|
|
|
|
|
|
|
} |
|
711
|
0
|
|
|
|
|
|
my ($index,$index_data,$group,$key_list) = $update->get(qw(-index -data -group -keys)); |
|
712
|
0
|
0
|
0
|
|
|
|
if ((not defined $index) or ($index eq '')) { |
|
713
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::preload_update() - No -index set.\n"); |
|
714
|
|
|
|
|
|
|
} |
|
715
|
0
|
0
|
0
|
|
|
|
if ((not defined $group) or ($group eq '')) { |
|
716
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::preload_update() - No -group set.\n"); |
|
717
|
|
|
|
|
|
|
} |
|
718
|
0
|
0
|
|
|
|
|
$key_list = {} if (not defined $key_list); |
|
719
|
0
|
|
|
|
|
|
my $new_keys = 0; |
|
720
|
0
|
|
|
|
|
|
while (my ($key,$ranking) = each %$key_list) { |
|
721
|
0
|
|
|
|
|
|
$ranking = int($ranking+0.5); |
|
722
|
0
|
0
|
0
|
|
|
|
if (($ranking < -32768) or ($ranking > 32767)) { |
|
723
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::preload_update() - Invalid ranking value of '$ranking' for key '$key'. Only values from -32768 to +32767 are allowed\n"); |
|
724
|
|
|
|
|
|
|
} |
|
725
|
0
|
|
|
|
|
|
$new_keys++; |
|
726
|
|
|
|
|
|
|
} |
|
727
|
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
# Get the group_enum for this group |
|
729
|
0
|
|
|
|
|
|
my $group_enum = $db->get({ -key => "$GROUP$group" }); |
|
730
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
731
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::preload_update() - Attempted to add an entry to the undeclared -group '$group'\n"); |
|
732
|
|
|
|
|
|
|
} |
|
733
|
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
# Increment the update record counter |
|
735
|
0
|
|
|
|
|
|
my $update_counter = $db->get({ -key => "$PRELOAD_GROUP_ENUM_DATA$group_enum$UPDATE_GROUP_COUNTER" }); |
|
736
|
0
|
0
|
|
|
|
|
if (not defined $update_counter) { |
|
737
|
0
|
|
|
|
|
|
$update_counter = $ZERO_ENUM; |
|
738
|
|
|
|
|
|
|
} |
|
739
|
0
|
|
|
|
|
|
$update_counter = $self->_increment_enum($update_counter); |
|
740
|
0
|
0
|
|
|
|
|
if (not defined $db->put({ -key => "$PRELOAD_GROUP_ENUM_DATA$group_enum$UPDATE_GROUP_COUNTER", |
|
741
|
|
|
|
|
|
|
-value => "$update_counter" })) { |
|
742
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::preload_update() - Failed to save incremented UPDATE_GROUP_COUNTER for group '$group'\n"); |
|
743
|
|
|
|
|
|
|
} |
|
744
|
0
|
|
|
|
|
|
my $update_record = &$freeze($update); |
|
745
|
0
|
0
|
|
|
|
|
if (not defined $db->put({ -key => "$PRELOAD_GROUP_ENUM_DATA$group_enum$UPDATE_DATA$update_counter", |
|
746
|
|
|
|
|
|
|
-value => $update_record })) { |
|
747
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::preload_update() - Failed to save preloaded Update record for group '$group'\n"); |
|
748
|
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
} |
|
750
|
|
|
|
|
|
|
} |
|
751
|
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
#################################################################### |
|
753
|
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=over 4 |
|
755
|
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
=item C $group });> |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
This clears all the data from the preload area for the specified |
|
759
|
|
|
|
|
|
|
group. |
|
760
|
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
=back |
|
762
|
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
=cut |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
sub clear_preload_update_for_group { |
|
766
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
767
|
|
|
|
|
|
|
|
|
768
|
0
|
|
|
|
|
|
my ($group) = simple_parms(['-group'],@_); |
|
769
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
770
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
771
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::clear_preload_update_for_group() - No database opened for use\n"); |
|
772
|
|
|
|
|
|
|
} |
|
773
|
0
|
0
|
0
|
|
|
|
if ((not defined $group) or ($group eq '')) { |
|
774
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::clear_preload_update_for_group() - No -group set.\n"); |
|
775
|
|
|
|
|
|
|
} |
|
776
|
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
# Get the group_enum for this group |
|
778
|
0
|
|
|
|
|
|
my $original_group = $group; |
|
779
|
0
|
|
|
|
|
|
my $original_group_enum = $db->get({ -key => "$GROUP$group" }); |
|
780
|
0
|
0
|
|
|
|
|
if (not defined $original_group_enum) { |
|
781
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::clear_preload_update_for_group() - Attempted to clear preload queue for the undeclared -group '$group'\n"); |
|
782
|
|
|
|
|
|
|
} |
|
783
|
0
|
|
|
|
|
|
my $update_counter = $db->get({ -key => "$PRELOAD_GROUP_ENUM_DATA$original_group_enum$UPDATE_GROUP_COUNTER" }); |
|
784
|
0
|
0
|
|
|
|
|
if (not defined $update_counter) { |
|
785
|
0
|
|
|
|
|
|
return 1; |
|
786
|
|
|
|
|
|
|
} |
|
787
|
0
|
|
|
|
|
|
my $counter = $ZERO_ENUM; |
|
788
|
0
|
|
|
|
|
|
while ($counter lt $update_counter) { |
|
789
|
0
|
|
|
|
|
|
$counter = $self->_increment_enum($counter); |
|
790
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$PRELOAD_GROUP_ENUM_DATA$original_group_enum$UPDATE_DATA$counter" })) { |
|
791
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::clear_preload_update_for_group() - Failed to delete record '$PRELOAD_GROUP_ENUM_DATA$original_group_enum$UPDATE_DATA$counter'\n"); |
|
792
|
|
|
|
|
|
|
} |
|
793
|
|
|
|
|
|
|
} |
|
794
|
|
|
|
|
|
|
|
|
795
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$PRELOAD_GROUP_ENUM_DATA$original_group_enum$UPDATE_GROUP_COUNTER" })) { |
|
796
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::clear_preload_update_for_group() - Failed to delete record '$PRELOAD_GROUP_ENUM_DATA$original_group_enum$UPDATE_GROUP_COUNTER'\n"); |
|
797
|
|
|
|
|
|
|
} |
|
798
|
|
|
|
|
|
|
|
|
799
|
0
|
|
|
|
|
|
1; |
|
800
|
|
|
|
|
|
|
} |
|
801
|
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
#################################################################### |
|
803
|
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
=over 4 |
|
805
|
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
=item C $group[, -block_size =E 65536] });> |
|
807
|
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
This clears the specifed group and loads all |
|
809
|
|
|
|
|
|
|
preloaded data (updates batch loaded through |
|
810
|
|
|
|
|
|
|
the 'preload_update' method pending finalization. |
|
811
|
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
This is by far the fastest way to load a large set of |
|
813
|
|
|
|
|
|
|
data into the search system - but it is an 'all or nothing' |
|
814
|
|
|
|
|
|
|
approach. No 'incremental' updating is possible via this |
|
815
|
|
|
|
|
|
|
interface - the update_group completely erases all previously |
|
816
|
|
|
|
|
|
|
searchable data from the group and replaces it with the |
|
817
|
|
|
|
|
|
|
pending 'preload'ed data. |
|
818
|
|
|
|
|
|
|
|
|
819
|
|
|
|
|
|
|
Examples: |
|
820
|
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
$inv_map->update_group({ -group => 'test' }); |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
$inv_map->update_group({ -group => 'test', -block_size => 65536 }); |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
-block_size determines the 'chunking factor' used to limit the amount |
|
826
|
|
|
|
|
|
|
of memory the update uses (it corresponds roughly to the number of |
|
827
|
|
|
|
|
|
|
line entry items to be processed in memory at one time). Higher |
|
828
|
|
|
|
|
|
|
'-block_size's will improve performance until you run out of real |
|
829
|
|
|
|
|
|
|
memory. The default is 65536. |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
Since an exclusive lock should be held during the entire process, |
|
832
|
|
|
|
|
|
|
the database is essentially inaccessible until the update is |
|
833
|
|
|
|
|
|
|
complete. It is probably inadvisable to use this method of |
|
834
|
|
|
|
|
|
|
updating without keeping an 'online' and a seperate 'offline' |
|
835
|
|
|
|
|
|
|
database and copy over the 'offline' to 'online' after |
|
836
|
|
|
|
|
|
|
completion of the mass update on the 'offline' database. |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
=back |
|
839
|
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
=cut |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
sub update_group { |
|
843
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
844
|
|
|
|
|
|
|
|
|
845
|
0
|
|
|
|
|
|
my $parms = parse_parms ({ -parms => \@_, |
|
846
|
|
|
|
|
|
|
-legal => ['-block_size'], |
|
847
|
|
|
|
|
|
|
-required => ['-group'], |
|
848
|
|
|
|
|
|
|
-defaults => { -block_size => 65536 }, |
|
849
|
|
|
|
|
|
|
}); |
|
850
|
0
|
0
|
|
|
|
|
if (not defined $parms) { |
|
851
|
0
|
|
|
|
|
|
my $error_message = Class::ParmList->error; |
|
852
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - $error_message\n"); |
|
853
|
|
|
|
|
|
|
} |
|
854
|
0
|
|
|
|
|
|
my ($db,$thaw) = $self->get('-database','-thaw'); |
|
855
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
856
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - No database opened for use\n"); |
|
857
|
|
|
|
|
|
|
} |
|
858
|
0
|
|
|
|
|
|
my ($group,$block_size) = $parms->get(-group,-block_size); |
|
859
|
0
|
0
|
0
|
|
|
|
if ((not defined $group) or ($group eq '')) { |
|
860
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - No -group set.\n"); |
|
861
|
|
|
|
|
|
|
} |
|
862
|
0
|
0
|
0
|
|
|
|
if ((not defined $block_size) or ($block_size != int ($block_size)) or ($block_size <= 0)) { |
|
|
|
|
0
|
|
|
|
|
|
863
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - Illegal -block_size set: Must be an integer greater than 0.\n"); |
|
864
|
|
|
|
|
|
|
} |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
# Get the original group_enum for this group |
|
867
|
0
|
|
|
|
|
|
my $original_group = $group; |
|
868
|
0
|
|
|
|
|
|
my $original_group_enum = $db->get({ -key => "$GROUP$group" }); |
|
869
|
0
|
0
|
|
|
|
|
if (not defined $original_group_enum) { |
|
870
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::update_group() - Attempted to add an entry to the undeclared -group '$group'\n"); |
|
871
|
|
|
|
|
|
|
} |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
# Add in the new updated group enum we will use to store the mass update in. |
|
874
|
|
|
|
|
|
|
# The double creation cycle clears any garbage that might have been |
|
875
|
|
|
|
|
|
|
# left from a previous incomplete update |
|
876
|
0
|
|
|
|
|
|
$group = "$UPDATE_GROUP_PREFIX_NAME$group"; |
|
877
|
0
|
|
|
|
|
|
$self->add_group({ -group => $group }); |
|
878
|
0
|
|
|
|
|
|
$self->remove_group({ -group => $group }); |
|
879
|
0
|
|
|
|
|
|
my $group_enum = $self->add_group({ -group => $group }); |
|
880
|
|
|
|
|
|
|
|
|
881
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
882
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::update_group() - Failed to create -group '$original_group' update group\n"); |
|
883
|
|
|
|
|
|
|
} |
|
884
|
0
|
|
|
|
|
|
my $update_counter = $db->get({ -key => "$PRELOAD_GROUP_ENUM_DATA$original_group_enum$UPDATE_GROUP_COUNTER" }); |
|
885
|
0
|
|
|
|
|
|
my $counter = $ZERO_ENUM; |
|
886
|
0
|
0
|
|
|
|
|
$update_counter = $counter if (not defined $update_counter); |
|
887
|
0
|
|
|
|
|
|
my $block_element_counter = 0; |
|
888
|
0
|
|
|
|
|
|
my $block_data = []; |
|
889
|
0
|
|
|
|
|
|
my $block_counter = 0; |
|
890
|
0
|
|
|
|
|
|
my $record_size = 32; # 12+1+12+1+6 (key_enum + ':' + index_enum + ':' + ranking (6 digits with sign)) |
|
891
|
0
|
|
|
|
|
|
while ($counter lt $update_counter) { |
|
892
|
0
|
|
|
|
|
|
$counter = $self->_increment_enum($counter); |
|
893
|
0
|
|
|
|
|
|
my $update_record = $db->get({ -key => "$PRELOAD_GROUP_ENUM_DATA$original_group_enum$UPDATE_DATA$counter" }); |
|
894
|
0
|
|
|
|
|
|
my $update = &$thaw($update_record); |
|
895
|
0
|
|
|
|
|
|
my ($index,$index_data,$alleged_group,$key_list) = $update->get(qw(-index -data -group -keys)); |
|
896
|
0
|
0
|
|
|
|
|
if (not defined $key_list) { |
|
897
|
0
|
|
|
|
|
|
$key_list = {}; |
|
898
|
|
|
|
|
|
|
} |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
# Create the -index and store the -data record for the -index as needed |
|
901
|
0
|
|
|
|
|
|
my $index_enum; |
|
902
|
0
|
0
|
|
|
|
|
if (defined $index_data) { |
|
903
|
0
|
|
|
|
|
|
$index_enum = $self->add_index({ '-index' => $index, -data => $index_data }); |
|
904
|
|
|
|
|
|
|
} else { |
|
905
|
0
|
|
|
|
|
|
$index_enum = $db->get({ -key => "$INDEX$index" }); |
|
906
|
0
|
0
|
|
|
|
|
if (not defined $index_enum) { |
|
907
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::update_group() - Attempted to add a new index to the system without setting its -data\n"); |
|
908
|
|
|
|
|
|
|
} |
|
909
|
|
|
|
|
|
|
} |
|
910
|
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
# Add the -index to the update group |
|
912
|
0
|
|
|
|
|
|
$self->add_index_to_group({ -group => $group, '-index' => $index }); |
|
913
|
|
|
|
|
|
|
|
|
914
|
0
|
|
|
|
|
|
my $new_keys = 0; |
|
915
|
0
|
|
|
|
|
|
my $indexed_keys = {}; |
|
916
|
0
|
|
|
|
|
|
while (my ($key,$ranking) = each %$key_list) { |
|
917
|
0
|
|
|
|
|
|
$new_keys++; |
|
918
|
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
# Add the key to the group, if necessary. |
|
920
|
0
|
|
|
|
|
|
my $key_enum = $self->add_key_to_group ({ -group => $group, -key => $key, -database => $db }); |
|
921
|
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
# Add the ranking to the running key_enum indexed record |
|
923
|
0
|
|
|
|
|
|
$indexed_keys->{$key_enum} = $ranking; |
|
924
|
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
# Save a record for key sorting |
|
926
|
0
|
0
|
|
|
|
|
if ($ranking < 0) { |
|
927
|
0
|
|
|
|
|
|
$ranking = sprintf('%0.5ld',$ranking); |
|
928
|
|
|
|
|
|
|
} else { |
|
929
|
0
|
|
|
|
|
|
$ranking = sprintf('+%0.5ld',$ranking); |
|
930
|
|
|
|
|
|
|
} |
|
931
|
0
|
|
|
|
|
|
my $update_sort_value = "$key_enum:$index_enum:$ranking"; |
|
932
|
0
|
|
|
|
|
|
push (@$block_data,$update_sort_value); |
|
933
|
0
|
|
|
|
|
|
$block_element_counter++; |
|
934
|
0
|
0
|
|
|
|
|
if ($block_element_counter == $block_size) { |
|
935
|
0
|
|
|
|
|
|
my $update_sort_key = "$PRELOAD_GROUP_ENUM_DATA$group_enum$UPDATE_SORTBLOCK_A$block_counter"; |
|
936
|
0
|
|
|
|
|
|
my $update_sort_value = join (' ',reverse sort @$block_data); # Largest 'value' to smallest 'value' |
|
937
|
0
|
|
|
|
|
|
$block_element_counter = 0; |
|
938
|
0
|
|
|
|
|
|
$block_data = []; |
|
939
|
0
|
|
|
|
|
|
$block_counter++; |
|
940
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => $update_sort_key, -value => $update_sort_value })) { |
|
941
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::update_group() - Failed to save UPDATE_SORTBLOCK_A record '$update_sort_key': size of record " . length($update_sort_value)." $!\n"); |
|
942
|
|
|
|
|
|
|
} |
|
943
|
|
|
|
|
|
|
} |
|
944
|
|
|
|
|
|
|
} |
|
945
|
|
|
|
|
|
|
|
|
946
|
|
|
|
|
|
|
# Create a new INDEXED_KEY_LIST for this index_enum if we |
|
947
|
|
|
|
|
|
|
# assigned new keys for this group for the index |
|
948
|
|
|
|
|
|
|
# This is where we gain a big chunk of our performance advantage from. |
|
949
|
0
|
0
|
|
|
|
|
if ($new_keys) { |
|
950
|
0
|
|
|
|
|
|
my $indexed_record = _pack_list($indexed_keys); |
|
951
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$index_enum", |
|
952
|
|
|
|
|
|
|
-value => $indexed_record })) { |
|
953
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - Failed to save updated '$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$index_enum' -> (list of ranked keys)\n"); |
|
954
|
|
|
|
|
|
|
} |
|
955
|
|
|
|
|
|
|
} |
|
956
|
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
# Update the INDEX_ENUM_GROUP_CHAIN as necessary |
|
958
|
|
|
|
|
|
|
# Check if the index already exists in the group |
|
959
|
0
|
|
|
|
|
|
my ($chain) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum" }); |
|
960
|
0
|
0
|
|
|
|
|
if (not defined $chain) { |
|
961
|
|
|
|
|
|
|
# Add the index_enum to the index chain for the group |
|
962
|
0
|
|
|
|
|
|
my $old_first_index_enum = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum" }); |
|
963
|
0
|
|
|
|
|
|
my $first_index_enum_record = "$NULL_ENUM $NULL_ENUM"; |
|
964
|
0
|
0
|
0
|
|
|
|
if (defined ($old_first_index_enum) and ($old_first_index_enum ne $NULL_ENUM)) { # Record formated as: prev next index |
|
965
|
0
|
|
|
|
|
|
my $old_first_index_enum_record = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum" }); |
|
966
|
0
|
0
|
|
|
|
|
if (not defined $old_first_index_enum_record) { |
|
967
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - Unable to read '$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum' record. Database may be corrupt.\n"); |
|
968
|
|
|
|
|
|
|
} |
|
969
|
0
|
|
|
|
|
|
$old_first_index_enum_record =~ s/^$NULL_ENUM/$index_enum/; |
|
970
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum", |
|
971
|
|
|
|
|
|
|
-value => $old_first_index_enum_record, })) { |
|
972
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - Unable to update 'prev' enum reference for '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum'\n"); |
|
973
|
|
|
|
|
|
|
} |
|
974
|
0
|
|
|
|
|
|
$first_index_enum_record = "$NULL_ENUM $old_first_index_enum"; |
|
975
|
|
|
|
|
|
|
} |
|
976
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum", -value => $first_index_enum_record })) { |
|
977
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - Unable to save '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum' -> '$first_index_enum_record' to map\n"); |
|
978
|
|
|
|
|
|
|
} |
|
979
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum", -value => $index_enum })) { |
|
980
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - Unable to save '$GROUP_ENUM_DATA${group_enum}_first_index_enum' -> '$index_enum' map entry.\n"); |
|
981
|
|
|
|
|
|
|
} |
|
982
|
|
|
|
|
|
|
} |
|
983
|
|
|
|
|
|
|
} |
|
984
|
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
# Flush any dangling sort data to a record |
|
986
|
0
|
0
|
|
|
|
|
if ($block_element_counter) { |
|
987
|
0
|
|
|
|
|
|
my $update_sort_key = "$PRELOAD_GROUP_ENUM_DATA$group_enum$UPDATE_SORTBLOCK_A$block_counter"; |
|
988
|
0
|
|
|
|
|
|
my $update_sort_value = join (' ',reverse sort @$block_data); |
|
989
|
0
|
|
|
|
|
|
$block_data = []; |
|
990
|
0
|
|
|
|
|
|
$block_element_counter = 0; |
|
991
|
0
|
|
|
|
|
|
$block_counter++; |
|
992
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => $update_sort_key, -value => $update_sort_value })) { |
|
993
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::update_group() - Failed to save UPDATE_SORTBLOCK_A record '$update_sort_key'\n"); |
|
994
|
|
|
|
|
|
|
} |
|
995
|
|
|
|
|
|
|
} |
|
996
|
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
# Merge sort the record blocks |
|
998
|
0
|
|
|
|
|
|
my $block_chunk = 1; |
|
999
|
0
|
|
|
|
|
|
my $source_blocks = $UPDATE_SORTBLOCK_B; |
|
1000
|
0
|
|
|
|
|
|
my $target_blocks = $UPDATE_SORTBLOCK_A; |
|
1001
|
0
|
|
|
|
|
|
my $high_block = $block_counter; |
|
1002
|
|
|
|
|
|
|
# Keep making passes until the number of blocks |
|
1003
|
|
|
|
|
|
|
# in a chunk is larger than the number of blocks. |
|
1004
|
0
|
|
|
|
|
|
my $n_passes = 0; |
|
1005
|
0
|
|
|
|
|
|
my $max_block_bytes = $block_size * ($record_size + 1) - 1; |
|
1006
|
0
|
|
|
|
|
|
while ($high_block > $block_chunk) { |
|
1007
|
|
|
|
|
|
|
# Swap the source and target areas |
|
1008
|
0
|
|
|
|
|
|
my $temp_source = $source_blocks; |
|
1009
|
0
|
|
|
|
|
|
$source_blocks = $target_blocks; |
|
1010
|
0
|
|
|
|
|
|
$target_blocks = $temp_source; |
|
1011
|
0
|
|
|
|
|
|
$n_passes++; |
|
1012
|
0
|
|
|
|
|
|
my @block_pointer = (0,$block_chunk); |
|
1013
|
0
|
|
|
|
|
|
my $target_block_counter = 0; |
|
1014
|
|
|
|
|
|
|
# Pairwise walk through the blocks in a pass |
|
1015
|
0
|
|
|
|
|
|
while ($block_pointer[0] < $block_counter) { # Merge block pairings |
|
1016
|
0
|
|
|
|
|
|
my @block_offset = (-1,-1); |
|
1017
|
0
|
|
|
|
|
|
my @running_block_pointer = ($block_pointer[0] - 1,$block_pointer[1] - 1); |
|
1018
|
0
|
|
|
|
|
|
my @block_data = (undef,undef); |
|
1019
|
0
|
|
|
|
|
|
my @block_data_length = (0,0); |
|
1020
|
0
|
|
|
|
|
|
my @running_record_pointer = (1,1); |
|
1021
|
0
|
|
|
|
|
|
my $target_record_offset = 0; |
|
1022
|
0
|
|
|
|
|
|
my $target_data = ''; |
|
1023
|
0
|
|
|
|
|
|
my $target_size = 0; |
|
1024
|
0
|
|
|
|
|
|
my @match_data = (undef,undef); |
|
1025
|
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
# Keep merging blocks until we exhaust the chunk we are looking at |
|
1027
|
0
|
|
|
|
|
|
my $chunk_done = 0; |
|
1028
|
0
|
|
|
|
|
|
until ($chunk_done) { |
|
1029
|
|
|
|
|
|
|
# Load blocks as needed to keep the merge lists filled with records |
|
1030
|
0
|
|
|
|
|
|
foreach my $half (0..1) { |
|
1031
|
0
|
0
|
|
|
|
|
if ($running_record_pointer[$half] >= $block_data_length[$half]) { |
|
1032
|
0
|
|
|
|
|
|
$block_offset[$half]++; |
|
1033
|
0
|
|
|
|
|
|
$running_block_pointer[$half]++; |
|
1034
|
0
|
0
|
0
|
|
|
|
if (($block_offset[$half] < $block_chunk) and ($running_block_pointer[$half] < $block_counter)) { |
|
1035
|
0
|
|
|
|
|
|
$block_data[$half] = $db->get({ -key => "$PRELOAD_GROUP_ENUM_DATA$group_enum$source_blocks$running_block_pointer[$half]" }); |
|
1036
|
0
|
|
|
|
|
|
$block_data_length[$half] = length ($block_data[$half]); |
|
1037
|
0
|
|
|
|
|
|
$running_record_pointer[$half] = 0; |
|
1038
|
|
|
|
|
|
|
} else { # out of data for this half |
|
1039
|
0
|
|
|
|
|
|
$block_data[$half] = undef; |
|
1040
|
0
|
|
|
|
|
|
$block_data_length[$half] = 0; |
|
1041
|
0
|
|
|
|
|
|
$running_record_pointer[$half] = -1; |
|
1042
|
|
|
|
|
|
|
} |
|
1043
|
|
|
|
|
|
|
} |
|
1044
|
|
|
|
|
|
|
} |
|
1045
|
|
|
|
|
|
|
# If there is no data pending for either side, we have finished the chunk. |
|
1046
|
0
|
0
|
0
|
|
|
|
if (not (defined ($block_data[0]) or defined ($block_data[1]))) { |
|
1047
|
0
|
|
|
|
|
|
$chunk_done = 1; |
|
1048
|
0
|
|
|
|
|
|
last; |
|
1049
|
|
|
|
|
|
|
} |
|
1050
|
|
|
|
|
|
|
|
|
1051
|
0
|
0
|
|
|
|
|
if ($target_record_offset == 0) { |
|
1052
|
0
|
|
|
|
|
|
$target_size = ($block_data_length[0] - $running_record_pointer[0]) + |
|
1053
|
|
|
|
|
|
|
($block_data_length[1] - $running_record_pointer[1]); |
|
1054
|
0
|
0
|
|
|
|
|
$target_size = $max_block_bytes if ($target_size > $max_block_bytes); |
|
1055
|
0
|
|
|
|
|
|
$target_data = ' ' x $target_size; |
|
1056
|
|
|
|
|
|
|
} |
|
1057
|
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
# Do the actual merging of the two data blocks |
|
1059
|
|
|
|
|
|
|
# Question: At typical block sizes, would it be faster |
|
1060
|
|
|
|
|
|
|
# to use the built in sort over the item by item merge? |
|
1061
|
|
|
|
|
|
|
# It it worth the substantial memory trade-off? |
|
1062
|
0
|
|
0
|
|
|
|
while (($running_record_pointer[0] < $block_data_length[0]) and |
|
1063
|
|
|
|
|
|
|
($running_record_pointer[1] < $block_data_length[1])) { |
|
1064
|
0
|
0
|
0
|
|
|
|
$match_data[0] = ($block_data_length[0] and ($block_data_length[0] > $running_record_pointer[0])) ? substr($block_data[0],$running_record_pointer[0],$record_size) : ''; |
|
1065
|
0
|
0
|
0
|
|
|
|
$match_data[1] = ($block_data_length[1] and ($block_data_length[1] > $running_record_pointer[1])) ? substr($block_data[1],$running_record_pointer[1],$record_size) : ''; |
|
1066
|
0
|
0
|
|
|
|
|
if ($match_data[0] ge $match_data[1]) { |
|
1067
|
0
|
|
|
|
|
|
substr($target_data,$target_record_offset,$record_size) = $match_data[0]; |
|
1068
|
0
|
|
|
|
|
|
$running_record_pointer[0] += $record_size + 1; |
|
1069
|
|
|
|
|
|
|
} else { |
|
1070
|
0
|
|
|
|
|
|
substr($target_data,$target_record_offset,$record_size) = $match_data[1]; |
|
1071
|
0
|
|
|
|
|
|
$running_record_pointer[1] += $record_size + 1; |
|
1072
|
|
|
|
|
|
|
} |
|
1073
|
0
|
|
|
|
|
|
$target_record_offset += $record_size + 1; |
|
1074
|
0
|
0
|
|
|
|
|
if ($target_record_offset >= $target_size) { # We've filled the target block. Save it and start a new one. |
|
1075
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$PRELOAD_GROUP_ENUM_DATA$group_enum$target_blocks$target_block_counter", |
|
1076
|
|
|
|
|
|
|
-value => $target_data })) { |
|
1077
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - Unable to save sort record to '$PRELOAD_GROUP_ENUM_DATA$group_enum$target_blocks$target_block_counter'\n"); |
|
1078
|
|
|
|
|
|
|
} |
|
1079
|
0
|
|
|
|
|
|
$target_block_counter++; |
|
1080
|
0
|
|
|
|
|
|
$target_size = ($block_data_length[0] - $running_record_pointer[0]) + |
|
1081
|
|
|
|
|
|
|
($block_data_length[1] - $running_record_pointer[1]); |
|
1082
|
0
|
0
|
|
|
|
|
$target_size = $max_block_bytes if ($target_size > $max_block_bytes); |
|
1083
|
0
|
0
|
|
|
|
|
$target_size = 0 if ($target_size < 0); |
|
1084
|
0
|
|
|
|
|
|
$target_data = ' ' x $target_size; |
|
1085
|
0
|
|
|
|
|
|
$target_record_offset = 0; |
|
1086
|
|
|
|
|
|
|
} |
|
1087
|
|
|
|
|
|
|
} |
|
1088
|
|
|
|
|
|
|
} |
|
1089
|
0
|
0
|
|
|
|
|
if ($target_record_offset) { # We have an unsaved target block. Save it. |
|
1090
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$PRELOAD_GROUP_ENUM_DATA$group_enum$target_blocks$target_block_counter", |
|
1091
|
|
|
|
|
|
|
-value => $target_data })) { |
|
1092
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - Unable to save sort record to '$PRELOAD_GROUP_ENUM_DATA$group_enum$target_blocks$target_block_counter'\n"); |
|
1093
|
|
|
|
|
|
|
} |
|
1094
|
|
|
|
|
|
|
} |
|
1095
|
0
|
|
|
|
|
|
$block_pointer[0] += 2 * $block_chunk; |
|
1096
|
0
|
|
|
|
|
|
$block_pointer[1] += 2 * $block_chunk; |
|
1097
|
|
|
|
|
|
|
} |
|
1098
|
|
|
|
|
|
|
# Double the block chunk size |
|
1099
|
0
|
|
|
|
|
|
$block_chunk *= 2; |
|
1100
|
|
|
|
|
|
|
} |
|
1101
|
|
|
|
|
|
|
# The current 'target_blocks' holds the fully sorted records |
|
1102
|
|
|
|
|
|
|
# Extract the 'sets' of KEYED_INDEX_DATA and save them. |
|
1103
|
0
|
|
|
|
|
|
my $current_key_enum = $NULL_ENUM; |
|
1104
|
0
|
|
|
|
|
|
my $current_block_number = 0; |
|
1105
|
0
|
|
|
|
|
|
my $current_key_data = {}; |
|
1106
|
0
|
|
|
|
|
|
my $dirty_counter = 0; |
|
1107
|
0
|
|
|
|
|
|
while ($current_block_number < $block_counter) { |
|
1108
|
0
|
|
|
|
|
|
my $block_data = $db->get({ -key => "$PRELOAD_GROUP_ENUM_DATA$group_enum$target_blocks$current_block_number"}); |
|
1109
|
0
|
0
|
|
|
|
|
if (not defined $block_data) { |
|
1110
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::update_group() - Unable to load block '$PRELOAD_GROUP_ENUM_DATA$group_enum$target_blocks$current_block_number'\n"); |
|
1111
|
|
|
|
|
|
|
|
|
1112
|
|
|
|
|
|
|
} |
|
1113
|
|
|
|
|
|
|
|
|
1114
|
0
|
|
|
|
|
|
my (@key_records) = split (/ /,$block_data); |
|
1115
|
0
|
|
|
|
|
|
for (my $count=0; $count<= $#key_records; $count++) { |
|
1116
|
0
|
|
|
|
|
|
my ($key_enum,$index_enum,$ranking) = split(/:/,$key_records[$count],3); |
|
1117
|
0
|
0
|
|
|
|
|
if ($key_enum ne $current_key_enum) { |
|
1118
|
0
|
0
|
|
|
|
|
if ($current_key_enum ne $NULL_ENUM) { |
|
1119
|
0
|
|
|
|
|
|
my $keyed_index_record = _pack_list($current_key_data); |
|
1120
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$current_key_enum" , |
|
1121
|
|
|
|
|
|
|
-value => $keyed_index_record })) { |
|
1122
|
0
|
|
|
|
|
|
croak (__PACKAGE__ .. "::update_group() - Unable to save KEYED_INDEX_LIST record ''\n"); |
|
1123
|
|
|
|
|
|
|
} |
|
1124
|
|
|
|
|
|
|
} |
|
1125
|
0
|
|
|
|
|
|
$current_key_data = {}; |
|
1126
|
0
|
|
|
|
|
|
$current_key_enum = $key_enum; |
|
1127
|
0
|
|
|
|
|
|
$dirty_counter = 0; |
|
1128
|
|
|
|
|
|
|
} |
|
1129
|
0
|
|
|
|
|
|
$current_key_data->{$index_enum} = $ranking; |
|
1130
|
0
|
|
|
|
|
|
$dirty_counter++; |
|
1131
|
|
|
|
|
|
|
} |
|
1132
|
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
# delete the sorted blocks from the database as we go |
|
1135
|
0
|
|
|
|
|
|
$db->delete({ -key => "$PRELOAD_GROUP_ENUM_DATA$group_enum$target_blocks$current_block_number"} ); |
|
1136
|
0
|
0
|
|
|
|
|
if ($n_passes) { |
|
1137
|
0
|
|
|
|
|
|
$db->delete({ -key => "$PRELOAD_GROUP_ENUM_DATA$group_enum$source_blocks$current_block_number"} ); |
|
1138
|
|
|
|
|
|
|
} |
|
1139
|
0
|
|
|
|
|
|
$current_block_number++; |
|
1140
|
|
|
|
|
|
|
} |
|
1141
|
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
# Save the final key_enum set, if needed |
|
1143
|
0
|
0
|
0
|
|
|
|
if ($dirty_counter and ($current_key_enum ne $NULL_ENUM)) { |
|
1144
|
0
|
|
|
|
|
|
my $keyed_index_record = _pack_list($current_key_data); |
|
1145
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$current_key_enum", |
|
1146
|
|
|
|
|
|
|
-value => $keyed_index_record })) { |
|
1147
|
0
|
|
|
|
|
|
croak (__PACKAGE__ .. "::update_group() - Unable to save KEYED_INDEX_LIST record ''\n"); |
|
1148
|
|
|
|
|
|
|
} |
|
1149
|
|
|
|
|
|
|
} |
|
1150
|
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
# clear the preload_update for the group |
|
1152
|
0
|
|
|
|
|
|
$self->clear_preload_update_for_group({ -group => $original_group }); |
|
1153
|
|
|
|
|
|
|
|
|
1154
|
|
|
|
|
|
|
# Fast swap the newly created database with the original database via pointer magic |
|
1155
|
0
|
|
|
|
|
|
my $original_group_enum_record = $db->get({ -key => "$GROUP_ENUM$original_group_enum" }); |
|
1156
|
0
|
|
|
|
|
|
$original_group_enum_record =~ s/^(.{12}) (.{12}) (.*)$/$1 $2 $group/s; |
|
1157
|
0
|
|
|
|
|
|
my $new_group_enum_record = $db->get({ -key => "$GROUP_ENUM$group_enum" }); |
|
1158
|
0
|
|
|
|
|
|
$new_group_enum_record =~ s/^(.{12}) (.{12}) (.*)$/$1 $2 $original_group/s; |
|
1159
|
0
|
|
|
|
|
|
$db->put({ -key => "$GROUP$original_group", -value => $group_enum }); |
|
1160
|
0
|
|
|
|
|
|
$db->put({ -key => "$GROUP_ENUM$group_enum", -value => $new_group_enum_record }); |
|
1161
|
0
|
|
|
|
|
|
$db->put({ -key => "$GROUP$group", -value => $original_group_enum }); |
|
1162
|
0
|
|
|
|
|
|
$db->put({ -key => "$GROUP_ENUM$original_group_enum", -value => $original_group_enum_record }); |
|
1163
|
|
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
|
# remove the original database |
|
1165
|
0
|
|
|
|
|
|
$self->remove_group({ -group => $group }); |
|
1166
|
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
1168
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
1169
|
|
|
|
|
|
|
} |
|
1170
|
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
#################################################################### |
|
1172
|
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
=over 4 |
|
1174
|
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
=item C $query [,-cache =E 1] });> |
|
1176
|
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
Performs a query on the map and returns the results as a |
|
1178
|
|
|
|
|
|
|
Search::InvertedIndex::Result object containing the keys and rankings. |
|
1179
|
|
|
|
|
|
|
|
|
1180
|
|
|
|
|
|
|
Example: |
|
1181
|
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
my $query = Search::InvertedIndex::Query->new(...); |
|
1183
|
|
|
|
|
|
|
my $result = $inv_map->search({ -query => $query }); |
|
1184
|
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
Performs a complex multi-key match search with boolean logic and |
|
1186
|
|
|
|
|
|
|
optional search term weighting. |
|
1187
|
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
The search request is formatted as follows: |
|
1189
|
|
|
|
|
|
|
|
|
1190
|
|
|
|
|
|
|
my $result = $inv_map->search({ -query => $query }); |
|
1191
|
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
where '$query' is a Search::InvertedIndex::Query object. |
|
1193
|
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
Each node can either be a specific search term with an optional weighting |
|
1195
|
|
|
|
|
|
|
term (a Search::InvertedIndex::Query::Leaf object) or a logic term with |
|
1196
|
|
|
|
|
|
|
its own sub-branches (a Search::Inverted::Query object). |
|
1197
|
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
The weightings are applied to the returned matches for each search term by |
|
1199
|
|
|
|
|
|
|
multiplication of their base ranking before combination with the other logic terms. |
|
1200
|
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
This allows recursive use of search to resolve arbitrarily |
|
1202
|
|
|
|
|
|
|
complex boolean searches and weight different search terms. |
|
1203
|
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
The optional -cache parameter instructs the database to cache ( |
|
1205
|
|
|
|
|
|
|
if the -search_cache_dir and -search_cache_size initialization |
|
1206
|
|
|
|
|
|
|
parameters are configured for use) the search and results for |
|
1207
|
|
|
|
|
|
|
performance on repeat searches. '1' means use the cache, '0' means do not. |
|
1208
|
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
=back |
|
1210
|
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
=cut |
|
1212
|
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
sub search { |
|
1214
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
1215
|
|
|
|
|
|
|
|
|
1216
|
0
|
|
|
|
|
|
my $parms = parse_parms({ -parms => \@_, |
|
1217
|
|
|
|
|
|
|
-legal => ['-cache'], |
|
1218
|
|
|
|
|
|
|
-required => ['-query'], |
|
1219
|
|
|
|
|
|
|
-defaults => {-cache => 1}, |
|
1220
|
|
|
|
|
|
|
}); |
|
1221
|
0
|
0
|
|
|
|
|
if (not defined $parms) { |
|
1222
|
0
|
|
|
|
|
|
my $error_message = Class::ParmList->error; |
|
1223
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::search() - $error_message\n"); |
|
1224
|
|
|
|
|
|
|
} |
|
1225
|
0
|
|
|
|
|
|
my ($query,$use_cache) = $parms->get(qw(-query -cache)); |
|
1226
|
0
|
|
|
|
|
|
my $db = $self->get(-database); |
|
1227
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1228
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::search() - No database opened for use\n"); |
|
1229
|
|
|
|
|
|
|
} |
|
1230
|
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
# Check the cache first |
|
1232
|
0
|
|
|
|
|
|
my ($cache,$cache_key); |
|
1233
|
0
|
0
|
|
|
|
|
if ($use_cache) { |
|
1234
|
0
|
|
|
|
|
|
my $cache_dir = $self->search_cache_dir; |
|
1235
|
0
|
|
|
|
|
|
my $cache_size = $self->search_cache_size; |
|
1236
|
0
|
0
|
0
|
|
|
|
if (defined ($cache_dir) and ($cache_size > 0)) { |
|
1237
|
0
|
|
|
|
|
|
$cache = Tie::FileLRUCache->new({ -cache_dir => $cache_dir, |
|
1238
|
|
|
|
|
|
|
-keep_last => $cache_size, |
|
1239
|
|
|
|
|
|
|
}); |
|
1240
|
0
|
|
|
|
|
|
$cache_key = $cache->make_cache_key({ -key => $query }); |
|
1241
|
0
|
|
|
|
|
|
$cache_key = $self->_untaint($cache_key); |
|
1242
|
0
|
|
|
|
|
|
my ($hit,$result_from_cache) = $cache->check({ -cache_key => $cache_key, }); |
|
1243
|
0
|
0
|
|
|
|
|
return $result_from_cache if ($hit); |
|
1244
|
|
|
|
|
|
|
} |
|
1245
|
|
|
|
|
|
|
} |
|
1246
|
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
# It wasn't in the cache, so do the search. |
|
1248
|
0
|
|
|
|
|
|
my $indexes = $self->_bare_search({ -query => $query }); |
|
1249
|
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
# Sort the results into an array |
|
1251
|
0
|
|
|
|
|
|
my $sorted_indexes = []; |
|
1252
|
0
|
|
|
|
|
|
@$sorted_indexes = map { { -index_enum => $_, -ranking => $indexes->{$_}} } |
|
|
0
|
|
|
|
|
|
|
|
1253
|
0
|
|
|
|
|
|
sort { $indexes->{$b} <=> $indexes->{$a} } |
|
1254
|
|
|
|
|
|
|
keys %$indexes; |
|
1255
|
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
# Make the Result object and load the search results into it |
|
1257
|
0
|
|
|
|
|
|
my $result = Search::InvertedIndex::Result->new({ -inv_map => $self, |
|
1258
|
|
|
|
|
|
|
-query => $query, |
|
1259
|
|
|
|
|
|
|
-indexes => $sorted_indexes, |
|
1260
|
|
|
|
|
|
|
-use_cache => $use_cache, |
|
1261
|
|
|
|
|
|
|
}); |
|
1262
|
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
# If we are caching, cache the result of the search |
|
1264
|
0
|
0
|
|
|
|
|
if ($cache) { |
|
1265
|
0
|
|
|
|
|
|
$cache->update({ -cache_key => $cache_key, |
|
1266
|
|
|
|
|
|
|
-value => $result, |
|
1267
|
|
|
|
|
|
|
}); |
|
1268
|
|
|
|
|
|
|
} |
|
1269
|
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
# All done. Return the results of the search. |
|
1271
|
0
|
|
|
|
|
|
$result; |
|
1272
|
|
|
|
|
|
|
} |
|
1273
|
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
#################################################################### |
|
1275
|
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
=over 4 |
|
1277
|
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
=item C $index });> |
|
1279
|
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
Returns the data record for the passed -index. Returns undef |
|
1281
|
|
|
|
|
|
|
if no matching -index is in the system. |
|
1282
|
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
Example: |
|
1284
|
|
|
|
|
|
|
my $data = $self->data_for_index({ -index => $index }); |
|
1285
|
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
=back |
|
1287
|
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
=cut |
|
1289
|
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
sub data_for_index { |
|
1291
|
0
|
|
|
0
|
1
|
|
my ($self) = shift; |
|
1292
|
|
|
|
|
|
|
|
|
1293
|
0
|
|
|
|
|
|
my ($index) = simple_parms(['-index'],@_); |
|
1294
|
0
|
|
|
|
|
|
my ($db,$thaw) = $self->get('-database','-thaw'); |
|
1295
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1296
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::data_for_index() - No database opened for use\n"); |
|
1297
|
|
|
|
|
|
|
} |
|
1298
|
0
|
|
|
|
|
|
my ($index_enum) = $db->get({ -key => "$INDEX$index" }); |
|
1299
|
0
|
0
|
|
|
|
|
return if (not defined $index_enum); |
|
1300
|
0
|
|
|
|
|
|
my ($data_record) = $db->get({ -key => "$INDEX_ENUM_DATA${index_enum}_data" }); |
|
1301
|
0
|
0
|
|
|
|
|
if (not defined $data_record) { |
|
1302
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::data_for_index() - Corrupt database. Record '$INDEX_ENUM_DATA${index_enum}_data' not found in system unexpectedly.\n"); |
|
1303
|
|
|
|
|
|
|
} |
|
1304
|
0
|
|
|
|
|
|
my ($data_ref) = &$thaw($data_record); |
|
1305
|
0
|
|
|
|
|
|
return $data_ref->{-data}; |
|
1306
|
|
|
|
|
|
|
} |
|
1307
|
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
#################################################################### |
|
1309
|
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
=over 4 |
|
1311
|
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
=item C |
|
1313
|
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
Completely clears the contents of the database and the search cache. |
|
1315
|
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
=back |
|
1317
|
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
=cut |
|
1319
|
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
sub clear_all { |
|
1321
|
0
|
|
|
0
|
1
|
|
my ($self) = shift; |
|
1322
|
|
|
|
|
|
|
|
|
1323
|
0
|
|
|
|
|
|
my $database = $self->get(-database); |
|
1324
|
0
|
|
|
|
|
|
$database->clear; |
|
1325
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
1326
|
|
|
|
|
|
|
} |
|
1327
|
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
#################################################################### |
|
1329
|
|
|
|
|
|
|
# Special accessor to improve performance |
|
1330
|
|
|
|
|
|
|
sub search_cache_dir { |
|
1331
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
1332
|
0
|
|
|
|
|
|
my $package = __PACKAGE__; |
|
1333
|
0
|
0
|
|
|
|
|
if (@_ == 1) { |
|
1334
|
0
|
|
|
|
|
|
$self->{$package}->{-search_cache_dir} = shift; |
|
1335
|
0
|
|
|
|
|
|
return; |
|
1336
|
|
|
|
|
|
|
} else { |
|
1337
|
0
|
|
|
|
|
|
return $self->{$package}->{-search_cache_dir}; |
|
1338
|
|
|
|
|
|
|
} |
|
1339
|
|
|
|
|
|
|
} |
|
1340
|
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
#################################################################### |
|
1342
|
|
|
|
|
|
|
# Special accessor to improve performance |
|
1343
|
|
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
sub search_cache_size { |
|
1345
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
1346
|
0
|
|
|
|
|
|
my $package = __PACKAGE__; |
|
1347
|
0
|
0
|
|
|
|
|
if (@_ == 1) { |
|
1348
|
0
|
|
|
|
|
|
$self->{$package}->{-search_cache_size} = shift; |
|
1349
|
0
|
|
|
|
|
|
return; |
|
1350
|
|
|
|
|
|
|
} else { |
|
1351
|
0
|
|
|
|
|
|
return $self->{$package}->{-search_cache_size}; |
|
1352
|
|
|
|
|
|
|
} |
|
1353
|
|
|
|
|
|
|
} |
|
1354
|
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
#################################################################### |
|
1356
|
|
|
|
|
|
|
|
|
1357
|
|
|
|
|
|
|
=over 4 |
|
1358
|
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
=item C |
|
1360
|
|
|
|
|
|
|
|
|
1361
|
|
|
|
|
|
|
Completely clears the contents of the search cache. |
|
1362
|
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
=back |
|
1364
|
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
=cut |
|
1366
|
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
sub clear_cache { |
|
1368
|
0
|
|
|
0
|
1
|
|
my ($self) = shift; |
|
1369
|
|
|
|
|
|
|
|
|
1370
|
0
|
|
|
|
|
|
my $cache_dir = $self->search_cache_dir; |
|
1371
|
0
|
|
|
|
|
|
my $cache_size = $self->search_cache_size; |
|
1372
|
|
|
|
|
|
|
|
|
1373
|
0
|
0
|
0
|
|
|
|
if (defined ($cache_dir) and ($cache_size > 0)) { |
|
1374
|
0
|
|
|
|
|
|
my $cache = Tie::FileLRUCache->new({ -cache_dir => $cache_dir, |
|
1375
|
|
|
|
|
|
|
-keep_last => $cache_size, |
|
1376
|
|
|
|
|
|
|
}); |
|
1377
|
0
|
|
|
|
|
|
$cache->clear; |
|
1378
|
|
|
|
|
|
|
} |
|
1379
|
|
|
|
|
|
|
} |
|
1380
|
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
#################################################################### |
|
1382
|
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
=over 4 |
|
1384
|
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
=item C |
|
1386
|
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
Closes the currently open -map and flushes all associated buffers. |
|
1388
|
|
|
|
|
|
|
|
|
1389
|
|
|
|
|
|
|
=back |
|
1390
|
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
=cut |
|
1392
|
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
sub close { |
|
1394
|
0
|
|
|
0
|
1
|
|
my ($self) = shift; |
|
1395
|
|
|
|
|
|
|
|
|
1396
|
0
|
|
|
|
|
|
my $database = $self->get(-database); |
|
1397
|
0
|
0
|
|
|
|
|
return if (not defined $database); |
|
1398
|
0
|
|
|
|
|
|
$self->clear(-database); |
|
1399
|
0
|
|
|
|
|
|
$database->close; |
|
1400
|
0
|
|
|
|
|
|
$database = $self->get(-database); |
|
1401
|
0
|
0
|
|
|
|
|
if (defined $database) { |
|
1402
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::close - failed to clear -database\n"); |
|
1403
|
|
|
|
|
|
|
} |
|
1404
|
|
|
|
|
|
|
} |
|
1405
|
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
#################################################################### |
|
1407
|
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
=over 4 |
|
1409
|
|
|
|
|
|
|
|
|
1410
|
|
|
|
|
|
|
=item C |
|
1411
|
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
Returns the raw number of groups in the system. |
|
1413
|
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
Example: my $n = $inv_map->number_of_groups; |
|
1415
|
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
=back |
|
1417
|
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
=cut |
|
1419
|
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
sub number_of_groups { |
|
1421
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
1422
|
|
|
|
|
|
|
|
|
1423
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
1424
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1425
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::number_of_groups() - No database opened for use\n"); |
|
1426
|
|
|
|
|
|
|
} |
|
1427
|
0
|
|
|
|
|
|
my ($number_of_groups) = $db->get({ -key => 'number_of_groups' }); |
|
1428
|
0
|
0
|
|
|
|
|
if (defined $number_of_groups) { |
|
1429
|
0
|
|
|
|
|
|
return $number_of_groups; |
|
1430
|
|
|
|
|
|
|
} |
|
1431
|
0
|
|
|
|
|
|
0; |
|
1432
|
|
|
|
|
|
|
} |
|
1433
|
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
#################################################################### |
|
1435
|
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
=over 4 |
|
1437
|
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
=item C |
|
1439
|
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
Returns the raw number of indexes in the system. |
|
1441
|
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
Example: my $n = $inv_map->number_of_indexes; |
|
1443
|
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
=back |
|
1445
|
|
|
|
|
|
|
|
|
1446
|
|
|
|
|
|
|
=cut |
|
1447
|
|
|
|
|
|
|
|
|
1448
|
|
|
|
|
|
|
sub number_of_indexes { |
|
1449
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
1450
|
|
|
|
|
|
|
|
|
1451
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
1452
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1453
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::number_of_indexes() - No database opened for use\n"); |
|
1454
|
|
|
|
|
|
|
} |
|
1455
|
0
|
|
|
|
|
|
my ($number_of_indexes) = $db->get({ -key => 'number_of_indexes' }); |
|
1456
|
0
|
0
|
|
|
|
|
if (defined $number_of_indexes) { |
|
1457
|
0
|
|
|
|
|
|
return $number_of_indexes; |
|
1458
|
|
|
|
|
|
|
} |
|
1459
|
0
|
|
|
|
|
|
0; |
|
1460
|
|
|
|
|
|
|
} |
|
1461
|
|
|
|
|
|
|
|
|
1462
|
|
|
|
|
|
|
#################################################################### |
|
1463
|
|
|
|
|
|
|
|
|
1464
|
|
|
|
|
|
|
=over 4 |
|
1465
|
|
|
|
|
|
|
|
|
1466
|
|
|
|
|
|
|
=item C |
|
1467
|
|
|
|
|
|
|
|
|
1468
|
|
|
|
|
|
|
Returns the raw number of keys in the system. |
|
1469
|
|
|
|
|
|
|
|
|
1470
|
|
|
|
|
|
|
Example: my $n = $inv_map->number_of_keys; |
|
1471
|
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
=back |
|
1473
|
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
=cut |
|
1475
|
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
sub number_of_keys { |
|
1477
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
1478
|
|
|
|
|
|
|
|
|
1479
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
1480
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1481
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::number_of_keys() - No database opened for use\n"); |
|
1482
|
|
|
|
|
|
|
} |
|
1483
|
0
|
|
|
|
|
|
my ($number_of_keys) = $db->get({ -key => 'number_of_keys' }); |
|
1484
|
0
|
0
|
|
|
|
|
if (defined $number_of_keys) { |
|
1485
|
0
|
|
|
|
|
|
return $number_of_keys; |
|
1486
|
|
|
|
|
|
|
} |
|
1487
|
0
|
|
|
|
|
|
0; |
|
1488
|
|
|
|
|
|
|
} |
|
1489
|
|
|
|
|
|
|
|
|
1490
|
|
|
|
|
|
|
#################################################################### |
|
1491
|
|
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
|
=over 4 |
|
1493
|
|
|
|
|
|
|
|
|
1494
|
|
|
|
|
|
|
=item C $group });> |
|
1495
|
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
Returns the raw number of indexes in a specific group. |
|
1497
|
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
Example: my $n = $inv_map->number_of_indexes_in_group({ -group => $group }); |
|
1499
|
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
=back |
|
1501
|
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
=cut |
|
1503
|
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
sub number_of_indexes_in_group { |
|
1505
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
1506
|
|
|
|
|
|
|
|
|
1507
|
0
|
|
|
|
|
|
my ($group) = simple_parms(['-group'],@_); |
|
1508
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
1509
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1510
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::number_of_indexes_in_group() - No database opened for use\n"); |
|
1511
|
|
|
|
|
|
|
} |
|
1512
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get({ -key => "$GROUP$group" }); |
|
1513
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
1514
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::number_of_indexes_in_group() - Group '$group' not in database\n"); |
|
1515
|
|
|
|
|
|
|
} |
|
1516
|
0
|
|
|
|
|
|
my ($number_of_indexes) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_indexes" }); |
|
1517
|
0
|
0
|
|
|
|
|
if (defined $number_of_indexes) { |
|
1518
|
0
|
|
|
|
|
|
return $number_of_indexes; |
|
1519
|
|
|
|
|
|
|
} |
|
1520
|
0
|
|
|
|
|
|
0; |
|
1521
|
|
|
|
|
|
|
} |
|
1522
|
|
|
|
|
|
|
|
|
1523
|
|
|
|
|
|
|
#################################################################### |
|
1524
|
|
|
|
|
|
|
|
|
1525
|
|
|
|
|
|
|
=over 4 |
|
1526
|
|
|
|
|
|
|
|
|
1527
|
|
|
|
|
|
|
=item C $group });> |
|
1528
|
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
Returns the raw number of keys in a specific group. |
|
1530
|
|
|
|
|
|
|
|
|
1531
|
|
|
|
|
|
|
Example: my $n = $inv_map->number_of_keys_in_group({ -group => $group }); |
|
1532
|
|
|
|
|
|
|
|
|
1533
|
|
|
|
|
|
|
=back |
|
1534
|
|
|
|
|
|
|
|
|
1535
|
|
|
|
|
|
|
=cut |
|
1536
|
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
sub number_of_keys_in_group { |
|
1538
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
1539
|
|
|
|
|
|
|
|
|
1540
|
0
|
|
|
|
|
|
my ($group) = simple_parms(['-group'],@_); |
|
1541
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
1542
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1543
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::number_of_keys_in_group() - No database opened for use\n"); |
|
1544
|
|
|
|
|
|
|
} |
|
1545
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get ({ -key => "$GROUP$group" }); |
|
1546
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
1547
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::number_of_indexes_in_group() - Group '$group' not in database\n"); |
|
1548
|
|
|
|
|
|
|
} |
|
1549
|
0
|
|
|
|
|
|
my ($number_of_keys) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_keys" }); |
|
1550
|
0
|
0
|
|
|
|
|
if (defined $number_of_keys) { |
|
1551
|
0
|
|
|
|
|
|
return $number_of_keys; |
|
1552
|
|
|
|
|
|
|
} |
|
1553
|
0
|
|
|
|
|
|
0; |
|
1554
|
|
|
|
|
|
|
} |
|
1555
|
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
#################################################################### |
|
1557
|
|
|
|
|
|
|
|
|
1558
|
|
|
|
|
|
|
=over 4 |
|
1559
|
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
=item C $group });> |
|
1561
|
|
|
|
|
|
|
|
|
1562
|
|
|
|
|
|
|
Adds a new '-group' to the map. There is normally no need to |
|
1563
|
|
|
|
|
|
|
call this method from outside the module. The addition of |
|
1564
|
|
|
|
|
|
|
new -groups is done automatically when adding new entries. |
|
1565
|
|
|
|
|
|
|
|
|
1566
|
|
|
|
|
|
|
Example: $inv_map->add_group({ -group => $group }); |
|
1567
|
|
|
|
|
|
|
|
|
1568
|
|
|
|
|
|
|
croaks if unable to successfuly create the group for some reason. |
|
1569
|
|
|
|
|
|
|
|
|
1570
|
|
|
|
|
|
|
It silently eats attempts to create an existing group. |
|
1571
|
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
=back |
|
1573
|
|
|
|
|
|
|
|
|
1574
|
|
|
|
|
|
|
=cut |
|
1575
|
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
sub add_group { |
|
1577
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
1578
|
|
|
|
|
|
|
|
|
1579
|
0
|
|
|
|
|
|
my ($group) = simple_parms(['-group'],@_); |
|
1580
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
1581
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1582
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - No database opened for use\n"); |
|
1583
|
|
|
|
|
|
|
} |
|
1584
|
|
|
|
|
|
|
|
|
1585
|
|
|
|
|
|
|
# Check if the group already exists in the system |
|
1586
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get({ -key => "$GROUP$group" }); |
|
1587
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
1588
|
|
|
|
|
|
|
# Add the new group |
|
1589
|
0
|
|
|
|
|
|
my ($group_enum_counter) = $db->get({ -key => 'group_enum_counter' }); |
|
1590
|
0
|
|
|
|
|
|
my ($old_first_group_enum); |
|
1591
|
0
|
0
|
|
|
|
|
if (not defined $group_enum_counter) { # First group |
|
1592
|
0
|
|
|
|
|
|
$group_enum_counter = $ZERO_ENUM; |
|
1593
|
|
|
|
|
|
|
} else { |
|
1594
|
0
|
|
|
|
|
|
$group_enum_counter = $self->_increment_enum($group_enum_counter); |
|
1595
|
0
|
|
|
|
|
|
$old_first_group_enum = $db->get({ -key => "${GROUP_ENUM}first_group_enum" }); |
|
1596
|
0
|
0
|
|
|
|
|
if (not defined $old_first_group_enum) { |
|
1597
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to locate the existing '${GROUP_ENUM}first_group_enum' value. Database may be corrupt.\n"); |
|
1598
|
|
|
|
|
|
|
} |
|
1599
|
|
|
|
|
|
|
} |
|
1600
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum_counter}_number_of_keys", -value => 0 })) { |
|
1601
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to save '$GROUP_ENUM_DATA${group_enum_counter}_number_of_keys' -> '0'\n"); |
|
1602
|
|
|
|
|
|
|
} |
|
1603
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum_counter}_number_of_indexes", -value => 0 })) { |
|
1604
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to save '$GROUP_ENUM_DATA${group_enum_counter}_number_of_indexes' -> '0'\n"); |
|
1605
|
|
|
|
|
|
|
} |
|
1606
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum_counter}_key_enum_counter", -value => $ZERO_ENUM })) { |
|
1607
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to save '$GROUP_ENUM_DATA${group_enum_counter}_group_key_enum_counter' -> '000000000000'\n"); |
|
1608
|
|
|
|
|
|
|
} |
|
1609
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum_counter}_first_key_enum", -value => $NULL_ENUM })) { |
|
1610
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to save '$GROUP_ENUM_DATA${group_enum_counter}_first_key_enum' -> '$NULL_ENUM'\n"); |
|
1611
|
|
|
|
|
|
|
} |
|
1612
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum_counter}_first_index_enum", -value => $NULL_ENUM })) { |
|
1613
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to save '$GROUP_ENUM_DATA${group_enum_counter}_first_index_enum' -> '$NULL_ENUM'\n"); |
|
1614
|
|
|
|
|
|
|
} |
|
1615
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP$group", -value => $group_enum_counter })) { |
|
1616
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to save '$GROUP$group' -> '$group_enum_counter' map entry\n"); |
|
1617
|
|
|
|
|
|
|
} |
|
1618
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => 'group_enum_counter', -value => $group_enum_counter })) { |
|
1619
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to save updated group_enum_counter '$group_enum_counter' to map."); |
|
1620
|
|
|
|
|
|
|
} |
|
1621
|
0
|
|
|
|
|
|
my $first_group_enum_record = "$NULL_ENUM $NULL_ENUM $group"; |
|
1622
|
|
|
|
|
|
|
# Rethread the head of an existing group link list to the new group |
|
1623
|
0
|
0
|
|
|
|
|
if (defined $old_first_group_enum) { # Record formated as: prev next group |
|
1624
|
0
|
|
|
|
|
|
my $old_first_group_enum_record = $db->get({ -key => "$GROUP_ENUM$old_first_group_enum" }); |
|
1625
|
0
|
0
|
|
|
|
|
if (not defined $old_first_group_enum_record) { |
|
1626
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to read '$GROUP_ENUM$old_first_group_enum' record. Database may be corrupt.\n"); |
|
1627
|
|
|
|
|
|
|
} |
|
1628
|
0
|
|
|
|
|
|
$old_first_group_enum_record =~ s/^$NULL_ENUM/$group_enum_counter/; |
|
1629
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM$old_first_group_enum", -value => $old_first_group_enum_record })) { |
|
1630
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to update 'prev' enum reference for '$GROUP_ENUM$old_first_group_enum'\n"); |
|
1631
|
|
|
|
|
|
|
} |
|
1632
|
0
|
|
|
|
|
|
$first_group_enum_record = "$NULL_ENUM $old_first_group_enum $group"; |
|
1633
|
|
|
|
|
|
|
} |
|
1634
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM$group_enum_counter", -value => $first_group_enum_record })) { |
|
1635
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to save '$GROUP_ENUM$group_enum_counter' -> '$first_group_enum_record' to map\n"); |
|
1636
|
|
|
|
|
|
|
} |
|
1637
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "${GROUP_ENUM}first_group_enum", -value => $group_enum_counter })) { |
|
1638
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to save '${GROUP_ENUM}first_group_enum' -> '$group_enum_counter' map entry.\n"); |
|
1639
|
|
|
|
|
|
|
} |
|
1640
|
0
|
|
|
|
|
|
my $number_of_groups = $db->get({ -key => 'number_of_groups' }); |
|
1641
|
0
|
0
|
|
|
|
|
if (not defined $number_of_groups) { |
|
1642
|
0
|
|
|
|
|
|
$number_of_groups = 1; |
|
1643
|
|
|
|
|
|
|
} else { |
|
1644
|
0
|
|
|
|
|
|
$number_of_groups++; |
|
1645
|
|
|
|
|
|
|
} |
|
1646
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => 'number_of_groups', -value => $number_of_groups })) { |
|
1647
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_group() - Unable to update 'number_of_groups. Database may be corrupt.\n"); |
|
1648
|
|
|
|
|
|
|
} |
|
1649
|
0
|
|
|
|
|
|
$group_enum = $group_enum_counter; |
|
1650
|
|
|
|
|
|
|
} |
|
1651
|
0
|
|
|
|
|
|
$group_enum; |
|
1652
|
|
|
|
|
|
|
} |
|
1653
|
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
#################################################################### |
|
1655
|
|
|
|
|
|
|
|
|
1656
|
|
|
|
|
|
|
=over 4 |
|
1657
|
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
=item C $index, -data =E $data });> |
|
1659
|
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
Adds a index entry to the system. |
|
1661
|
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
Example: $inv_map->add_index({ -index => $index, -data => $data }); |
|
1663
|
|
|
|
|
|
|
|
|
1664
|
|
|
|
|
|
|
If the 'index' is the same as an existing index, the '-data' for that |
|
1665
|
|
|
|
|
|
|
index will be updated. |
|
1666
|
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
-data can be pretty much any scalar. strings/object/hash/array references are ok. |
|
1668
|
|
|
|
|
|
|
They will be transparently serialized using Storable (preferred) or Data::Dumper. |
|
1669
|
|
|
|
|
|
|
|
|
1670
|
|
|
|
|
|
|
This method should be called to set the '-data' record returned by searches |
|
1671
|
|
|
|
|
|
|
to something useful. If you do not, you will have to maintain the |
|
1672
|
|
|
|
|
|
|
information you want to show to users seperately from the main search |
|
1673
|
|
|
|
|
|
|
engine core. |
|
1674
|
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
The method returns the index_enum of the index. |
|
1676
|
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
=back |
|
1678
|
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
=cut |
|
1680
|
|
|
|
|
|
|
|
|
1681
|
|
|
|
|
|
|
sub add_index { |
|
1682
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
1683
|
|
|
|
|
|
|
|
|
1684
|
0
|
|
|
|
|
|
my ($index,$data) = simple_parms(['-index','-data'],@_); |
|
1685
|
|
|
|
|
|
|
|
|
1686
|
0
|
0
|
|
|
|
|
if (not defined $data) { |
|
1687
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - -data for index may not be 'undef' value."); |
|
1688
|
|
|
|
|
|
|
} |
|
1689
|
|
|
|
|
|
|
|
|
1690
|
0
|
|
|
|
|
|
my ($db,$freeze) = $self->get('-database','-freeze'); |
|
1691
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1692
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - No database opened for use\n"); |
|
1693
|
|
|
|
|
|
|
} |
|
1694
|
|
|
|
|
|
|
# Check if the index already exists in the system |
|
1695
|
0
|
|
|
|
|
|
my ($index_enum) = $db->get({ -key => "$INDEX$index" }); |
|
1696
|
0
|
0
|
|
|
|
|
if (not defined $index_enum) { |
|
1697
|
|
|
|
|
|
|
# Add the new index |
|
1698
|
0
|
|
|
|
|
|
my ($index_enum_counter) = $db->get({ -key => 'index_enum_counter' }); |
|
1699
|
0
|
|
|
|
|
|
my ($old_first_index_enum); |
|
1700
|
0
|
0
|
|
|
|
|
if (not defined $index_enum_counter) { |
|
1701
|
0
|
|
|
|
|
|
$index_enum_counter = $ZERO_ENUM; |
|
1702
|
|
|
|
|
|
|
} else { |
|
1703
|
0
|
|
|
|
|
|
$index_enum_counter = $self->_increment_enum($index_enum_counter); |
|
1704
|
0
|
|
|
|
|
|
$old_first_index_enum = $db->get({ -key => "${INDEX_ENUM}first_index_enum" }); |
|
1705
|
0
|
0
|
|
|
|
|
if (not defined $old_first_index_enum) { |
|
1706
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - Unable to locate the existing '${INDEX_ENUM}first_index_enum' value. Database may be corrupt.\n"); |
|
1707
|
|
|
|
|
|
|
} |
|
1708
|
|
|
|
|
|
|
} |
|
1709
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$INDEX$index", -value => $index_enum_counter })) { |
|
1710
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - Unable to save '$INDEX$index' -> '$index_enum_counter' map entry\n"); |
|
1711
|
|
|
|
|
|
|
} |
|
1712
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => 'index_enum_counter', -value => $index_enum_counter })) { |
|
1713
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - Unable to save updated index_enum_counter '$index_enum_counter' to map."); |
|
1714
|
|
|
|
|
|
|
} |
|
1715
|
0
|
|
|
|
|
|
my $first_index_enum_record = "$NULL_ENUM $NULL_ENUM $index"; |
|
1716
|
0
|
0
|
|
|
|
|
if (defined $old_first_index_enum) { # Record formated as: prev next index |
|
1717
|
0
|
|
|
|
|
|
my $old_first_index_enum_record = $db->get({ -key => "$INDEX_ENUM$old_first_index_enum" }); |
|
1718
|
0
|
0
|
|
|
|
|
if (not defined $old_first_index_enum_record) { |
|
1719
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - Unable to read '$INDEX_ENUM$old_first_index_enum' record. Database may be corrupt.\n"); |
|
1720
|
|
|
|
|
|
|
} |
|
1721
|
0
|
|
|
|
|
|
$old_first_index_enum_record =~ s/^$NULL_ENUM/$index_enum_counter/; |
|
1722
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$INDEX_ENUM$old_first_index_enum", |
|
1723
|
|
|
|
|
|
|
-value => $old_first_index_enum_record, })) { |
|
1724
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - Unable to update 'prev' enum reference for '$INDEX_ENUM$old_first_index_enum'\n"); |
|
1725
|
|
|
|
|
|
|
} |
|
1726
|
0
|
|
|
|
|
|
$first_index_enum_record = "$NULL_ENUM $old_first_index_enum $index"; |
|
1727
|
|
|
|
|
|
|
} |
|
1728
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$INDEX_ENUM$index_enum_counter", -value => $first_index_enum_record })) { |
|
1729
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - Unable to save '$INDEX_ENUM$index_enum_counter' -> '$first_index_enum_record' to map\n"); |
|
1730
|
|
|
|
|
|
|
} |
|
1731
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "${INDEX_ENUM}first_index_enum", -value => $index_enum_counter })) { |
|
1732
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - Unable to save '${INDEX_ENUM}first_index_enum' -> '$index_enum_counter' map entry.\n"); |
|
1733
|
|
|
|
|
|
|
} |
|
1734
|
0
|
|
|
|
|
|
my $number_of_indexes = $db->get({ -key => 'number_of_indexes' }); |
|
1735
|
0
|
0
|
|
|
|
|
if (not defined $number_of_indexes) { |
|
1736
|
0
|
|
|
|
|
|
$number_of_indexes = 1; |
|
1737
|
|
|
|
|
|
|
} else { |
|
1738
|
0
|
|
|
|
|
|
$number_of_indexes++; |
|
1739
|
|
|
|
|
|
|
} |
|
1740
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => 'number_of_indexes', -value => $number_of_indexes })) { |
|
1741
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - Unable to update 'number_of_indexs. Database may be corrupt.\n"); |
|
1742
|
|
|
|
|
|
|
} |
|
1743
|
0
|
|
|
|
|
|
$index_enum = $index_enum_counter; |
|
1744
|
|
|
|
|
|
|
} |
|
1745
|
|
|
|
|
|
|
|
|
1746
|
|
|
|
|
|
|
# Store the -data record. The merged record saves an I/O for reading. |
|
1747
|
0
|
|
|
|
|
|
my ($raw_index_record) = { '-index' => $index, -data => $data }; |
|
1748
|
0
|
|
|
|
|
|
my $index_record = &$freeze($raw_index_record); |
|
1749
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$INDEX_ENUM_DATA${index_enum}_data", -value => $index_record })) { |
|
1750
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index() - Unable to store '$INDEX_ENUM_DATA${index_enum}_data' -data value\n"); |
|
1751
|
|
|
|
|
|
|
} |
|
1752
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
1753
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
1754
|
|
|
|
|
|
|
|
|
1755
|
0
|
|
|
|
|
|
$index_enum; |
|
1756
|
|
|
|
|
|
|
} |
|
1757
|
|
|
|
|
|
|
|
|
1758
|
|
|
|
|
|
|
#################################################################### |
|
1759
|
|
|
|
|
|
|
|
|
1760
|
|
|
|
|
|
|
=over 4 |
|
1761
|
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
=item C $group, -index =E $index[, -data =E $data] });> |
|
1763
|
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
Adds an index entry to a group. If the index does not already |
|
1765
|
|
|
|
|
|
|
exist in the system, adds it to the system as well. |
|
1766
|
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
Examples: |
|
1768
|
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
$inv_map->add_index_to_group({ -group => $group, '-index' => $index}); |
|
1770
|
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
$inv_map->add_index_to_group({ -group => $group, '-index' => $index, -data => $data}); |
|
1772
|
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
Returns the 'index_enum' for the index record. |
|
1774
|
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
If the 'index' is the same as an existing key, the 'index_enum' of the |
|
1776
|
|
|
|
|
|
|
existing index will be returned. |
|
1777
|
|
|
|
|
|
|
|
|
1778
|
|
|
|
|
|
|
There is normally no need to call this method directly. Addition |
|
1779
|
|
|
|
|
|
|
of index to groups is handled automatically during addition of |
|
1780
|
|
|
|
|
|
|
new entries. |
|
1781
|
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
It cannot be used to add index to non-existant groups. This is |
|
1783
|
|
|
|
|
|
|
a feature not a bug. |
|
1784
|
|
|
|
|
|
|
|
|
1785
|
|
|
|
|
|
|
The -data parameter is optional |
|
1786
|
|
|
|
|
|
|
|
|
1787
|
|
|
|
|
|
|
=back |
|
1788
|
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
=cut |
|
1790
|
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
sub add_index_to_group { |
|
1792
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
1793
|
|
|
|
|
|
|
|
|
1794
|
0
|
|
|
|
|
|
my $parms = parse_parms ({ -parms => \@_, |
|
1795
|
|
|
|
|
|
|
-legal => ['-data'], |
|
1796
|
|
|
|
|
|
|
-required => ['-group', '-index'], |
|
1797
|
|
|
|
|
|
|
-defaults => { -data => undef }, |
|
1798
|
|
|
|
|
|
|
}); |
|
1799
|
|
|
|
|
|
|
|
|
1800
|
0
|
0
|
|
|
|
|
if (not defined $parms) { |
|
1801
|
0
|
|
|
|
|
|
my $error_message = Class::ParmList->error; |
|
1802
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index_to_group() - $error_message\n"); |
|
1803
|
|
|
|
|
|
|
} |
|
1804
|
|
|
|
|
|
|
|
|
1805
|
0
|
|
|
|
|
|
my ($group,$index,$data) = $parms->get(qw(-group -index -data)); |
|
1806
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
1807
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1808
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index_to_group() - No database opened for use\n"); |
|
1809
|
|
|
|
|
|
|
} |
|
1810
|
0
|
|
|
|
|
|
my $group_enum = $db->get({ -key => "$GROUP$group" }); |
|
1811
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
1812
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index_to_group() - Attempted to add -index '$index' to non-existant -group '$group'\n"); |
|
1813
|
|
|
|
|
|
|
} |
|
1814
|
0
|
|
|
|
|
|
my $index_enum = $db->get({ -key => "$INDEX$index" }); |
|
1815
|
0
|
0
|
|
|
|
|
if (not defined $index_enum) { |
|
1816
|
0
|
0
|
|
|
|
|
if (not defined $data) { |
|
1817
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index_to_group() - Attempted to add completely new -index '$index with no defined -data' \n"); |
|
1818
|
|
|
|
|
|
|
} |
|
1819
|
0
|
|
|
|
|
|
$index_enum = $self->add_index({ '-index' => $index, -data => $data }); |
|
1820
|
|
|
|
|
|
|
} |
|
1821
|
|
|
|
|
|
|
|
|
1822
|
|
|
|
|
|
|
# Update the INDEX_ENUM_GROUP_CHAIN and number of indexes for the group as necessary |
|
1823
|
|
|
|
|
|
|
# Check if the index already exists in the group (if it doesn't, there isn't much to do) |
|
1824
|
0
|
|
|
|
|
|
my ($chain) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum" }); |
|
1825
|
0
|
0
|
|
|
|
|
if (not defined $chain) { |
|
1826
|
|
|
|
|
|
|
# Add the index_enum to the index chain for the group |
|
1827
|
0
|
|
|
|
|
|
my $old_first_index_enum = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum" }); |
|
1828
|
0
|
|
|
|
|
|
my $first_index_enum_record = "$NULL_ENUM $NULL_ENUM"; |
|
1829
|
0
|
0
|
0
|
|
|
|
if (defined ($old_first_index_enum) and ($old_first_index_enum ne $NULL_ENUM)) { # Record formated as: prev next index |
|
1830
|
0
|
|
|
|
|
|
my $old_first_index_enum_record = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum" }); |
|
1831
|
0
|
0
|
|
|
|
|
if (not defined $old_first_index_enum_record) { |
|
1832
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index_to_group() - Unable to read '$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum' record. Database may be corrupt.\n"); |
|
1833
|
|
|
|
|
|
|
} |
|
1834
|
0
|
|
|
|
|
|
$old_first_index_enum_record =~ s/^$NULL_ENUM/$index_enum/; |
|
1835
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum", |
|
1836
|
|
|
|
|
|
|
-value => $old_first_index_enum_record, })) { |
|
1837
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - Unable to update 'prev' enum reference for '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum'\n"); |
|
1838
|
|
|
|
|
|
|
} |
|
1839
|
0
|
|
|
|
|
|
$first_index_enum_record = "$NULL_ENUM $old_first_index_enum"; |
|
1840
|
|
|
|
|
|
|
} |
|
1841
|
|
|
|
|
|
|
|
|
1842
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum", -value => $first_index_enum_record })) { |
|
1843
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index_to_group() - Unable to save '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum' -> '$first_index_enum_record' to map\n"); |
|
1844
|
|
|
|
|
|
|
} |
|
1845
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum", -value => $index_enum })) { |
|
1846
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index_to_group() - Unable to save '$GROUP_ENUM_DATA${group_enum}_first_index_enum' -> '$index_enum' map entry.\n"); |
|
1847
|
|
|
|
|
|
|
} |
|
1848
|
|
|
|
|
|
|
|
|
1849
|
|
|
|
|
|
|
# Increment the number of indexes for the group |
|
1850
|
0
|
|
|
|
|
|
my $number_of_group_indexes = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_indexes" }); |
|
1851
|
0
|
0
|
|
|
|
|
if (not defined $number_of_group_indexes) { |
|
1852
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index_to_group () - Database may be corrupt. Failed to locate '$GROUP_ENUM_DATA${group_enum}_number_of_indexes' record for group '$group'\n"); |
|
1853
|
|
|
|
|
|
|
} |
|
1854
|
0
|
|
|
|
|
|
$number_of_group_indexes++; |
|
1855
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_indexes", -value => $number_of_group_indexes })) { |
|
1856
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_index_to_group () - Database may be corrupt. Unable to update '$GROUP_ENUM_DATA${group_enum}_number_of_indexes' record to '$number_of_group_indexes' for group '$group'\n"); |
|
1857
|
|
|
|
|
|
|
} |
|
1858
|
|
|
|
|
|
|
} |
|
1859
|
|
|
|
|
|
|
|
|
1860
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
1861
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
1862
|
|
|
|
|
|
|
|
|
1863
|
0
|
|
|
|
|
|
return $index_enum; |
|
1864
|
|
|
|
|
|
|
} |
|
1865
|
|
|
|
|
|
|
|
|
1866
|
|
|
|
|
|
|
#################################################################### |
|
1867
|
|
|
|
|
|
|
|
|
1868
|
|
|
|
|
|
|
=over 4 |
|
1869
|
|
|
|
|
|
|
|
|
1870
|
|
|
|
|
|
|
=item C $group, -key =E $key });> |
|
1871
|
|
|
|
|
|
|
|
|
1872
|
|
|
|
|
|
|
Adds a key entry to a group. |
|
1873
|
|
|
|
|
|
|
|
|
1874
|
|
|
|
|
|
|
Example: $inv_map->_add_key({ -group => $group, -key => $key }); |
|
1875
|
|
|
|
|
|
|
|
|
1876
|
|
|
|
|
|
|
Returns the 'key_enum' for the key record. |
|
1877
|
|
|
|
|
|
|
|
|
1878
|
|
|
|
|
|
|
If the 'key' is the same as an existing key, the 'key_enum' of the |
|
1879
|
|
|
|
|
|
|
existing key will be returned. |
|
1880
|
|
|
|
|
|
|
|
|
1881
|
|
|
|
|
|
|
There is normally no need to call this method directly. Addition |
|
1882
|
|
|
|
|
|
|
of keys to groups is handled automatically during addition of |
|
1883
|
|
|
|
|
|
|
new entries. |
|
1884
|
|
|
|
|
|
|
|
|
1885
|
|
|
|
|
|
|
It cannot be used to add keys to non-existant groups. This is |
|
1886
|
|
|
|
|
|
|
a feature not a bug. |
|
1887
|
|
|
|
|
|
|
|
|
1888
|
|
|
|
|
|
|
=back |
|
1889
|
|
|
|
|
|
|
|
|
1890
|
|
|
|
|
|
|
=cut |
|
1891
|
|
|
|
|
|
|
|
|
1892
|
|
|
|
|
|
|
sub add_key_to_group { |
|
1893
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
1894
|
|
|
|
|
|
|
|
|
1895
|
0
|
|
|
|
|
|
my $parm_ref = {}; |
|
1896
|
0
|
0
|
|
|
|
|
if (@_ == 1) { |
|
1897
|
0
|
|
|
|
|
|
$parm_ref = shift; |
|
1898
|
|
|
|
|
|
|
} else { |
|
1899
|
0
|
|
|
|
|
|
%$parm_ref = @_; |
|
1900
|
|
|
|
|
|
|
} |
|
1901
|
0
|
|
|
|
|
|
my $group = $parm_ref->{'-group'}; |
|
1902
|
0
|
0
|
|
|
|
|
if (not defined $group) { |
|
1903
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - '-group' parameter not passed.\n"); |
|
1904
|
|
|
|
|
|
|
} |
|
1905
|
0
|
|
|
|
|
|
my $key = $parm_ref->{'-key'}; |
|
1906
|
0
|
0
|
|
|
|
|
if (not defined $key) { |
|
1907
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - '-key' parameter not passed.\n"); |
|
1908
|
|
|
|
|
|
|
} |
|
1909
|
|
|
|
|
|
|
# Hidden performance hack. We can optionally pass the database ref in via the calling parms |
|
1910
|
0
|
|
|
|
|
|
my $db = $parm_ref->{'-database'}; |
|
1911
|
0
|
0
|
|
|
|
|
if (not defined $db) { |
|
1912
|
0
|
|
|
|
|
|
($db) = $self->get(-database); |
|
1913
|
|
|
|
|
|
|
} |
|
1914
|
|
|
|
|
|
|
|
|
1915
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
1916
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - No database opened for use\n"); |
|
1917
|
|
|
|
|
|
|
} |
|
1918
|
0
|
|
|
|
|
|
my $group_enum = $db->get({ -key => "$GROUP$group" }); |
|
1919
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
1920
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Attempted to add -key '$key' to non-existant -group '$group'\n"); |
|
1921
|
|
|
|
|
|
|
} |
|
1922
|
0
|
|
|
|
|
|
my $key_enum = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$KEY_TO_KEY_ENUM$key" }); |
|
1923
|
0
|
0
|
|
|
|
|
if (not defined $key_enum) { |
|
1924
|
|
|
|
|
|
|
|
|
1925
|
|
|
|
|
|
|
# Add the new key |
|
1926
|
0
|
|
|
|
|
|
my ($key_enum_counter) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_key_enum_counter" }); |
|
1927
|
0
|
|
|
|
|
|
my ($old_first_key_enum); |
|
1928
|
0
|
0
|
|
|
|
|
if (not defined $key_enum_counter) { |
|
1929
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Corrupt database. No '$GROUP_ENUM_DATA${group_enum}_key_enum_counter' value found for group '$group'.\n"); |
|
1930
|
|
|
|
|
|
|
} |
|
1931
|
0
|
|
|
|
|
|
$key_enum_counter = $self->_increment_enum($key_enum_counter); |
|
1932
|
0
|
|
|
|
|
|
$old_first_key_enum = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_key_enum" }); |
|
1933
|
0
|
0
|
|
|
|
|
if (not defined $old_first_key_enum) { |
|
1934
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Unable to locate the existing '$GROUP_ENUM_DATA${group_enum}_first_key_enum' value. Database may be corrupt.\n"); |
|
1935
|
|
|
|
|
|
|
} |
|
1936
|
|
|
|
|
|
|
|
|
1937
|
|
|
|
|
|
|
# Rethread the end of the next/prev links to place the new key as the 'first' key for the group |
|
1938
|
0
|
0
|
|
|
|
|
if ($old_first_key_enum ne $NULL_ENUM) { |
|
1939
|
|
|
|
|
|
|
# If the existing 'first_key_enum' is not the null enum value, update its 'prev' field to the new 'key_enum' |
|
1940
|
0
|
|
|
|
|
|
my $old_first_key_enum_record = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$KEY_ENUM_TO_KEY_AND_CHAIN$old_first_key_enum" }); |
|
1941
|
0
|
0
|
|
|
|
|
if (not defined $old_first_key_enum_record) { |
|
1942
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Unable to read '$GROUP_ENUM_DATA${group_enum}$KEY_ENUM_TO_KEY_AND_CHAIN$old_first_key_enum' record. Database may be corrupt.\n"); |
|
1943
|
|
|
|
|
|
|
} |
|
1944
|
0
|
|
|
|
|
|
$old_first_key_enum_record =~ s/^.{12}/$key_enum_counter/; |
|
1945
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}$KEY_ENUM_TO_KEY_AND_CHAIN$old_first_key_enum", -value => $old_first_key_enum_record })) { |
|
1946
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Unable to update 'prev' enum reference for '$GROUP_ENUM_DATA${group_enum}$KEY_ENUM_TO_KEY_AND_CHAIN$old_first_key_enum' -> '$old_first_key_enum_record'\n"); |
|
1947
|
|
|
|
|
|
|
} |
|
1948
|
|
|
|
|
|
|
} |
|
1949
|
|
|
|
|
|
|
# Prev Next Key |
|
1950
|
0
|
|
|
|
|
|
my $first_key_enum_record = "$NULL_ENUM $old_first_key_enum $key"; |
|
1951
|
|
|
|
|
|
|
|
|
1952
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum_counter", |
|
1953
|
|
|
|
|
|
|
-value => $first_key_enum_record })) { |
|
1954
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Unable to save '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum_counter' -> '$first_key_enum_record' to map\n"); |
|
1955
|
|
|
|
|
|
|
} |
|
1956
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_first_key_enum", |
|
1957
|
|
|
|
|
|
|
-value => $key_enum_counter })) { |
|
1958
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Unable to save '$GROUP_ENUM_DATA${group_enum}_first_key_enum' -> '$key_enum_counter' map entry.\n"); |
|
1959
|
|
|
|
|
|
|
} |
|
1960
|
|
|
|
|
|
|
|
|
1961
|
|
|
|
|
|
|
# Add to KEY_TO_KEY_ENUM |
|
1962
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum${KEY_TO_KEY_ENUM}$key", |
|
1963
|
|
|
|
|
|
|
-value => $key_enum_counter })) { |
|
1964
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Unable to save '$GROUP_ENUM_DATA$group_enum${KEY_TO_KEY_ENUM}$key' -> '$key_enum_counter' to map\n"); |
|
1965
|
|
|
|
|
|
|
} |
|
1966
|
|
|
|
|
|
|
|
|
1967
|
|
|
|
|
|
|
# Update number of keys for the group |
|
1968
|
0
|
|
|
|
|
|
my $number_of_keys_in_group = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_keys" }); |
|
1969
|
0
|
0
|
|
|
|
|
$number_of_keys_in_group = 0 if (not defined $number_of_keys_in_group); |
|
1970
|
0
|
|
|
|
|
|
$number_of_keys_in_group++; |
|
1971
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_keys", -value => $number_of_keys_in_group })) { |
|
1972
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Unable to save '$GROUP_ENUM_DATA${group_enum}_number_of_keys' -> '$number_of_keys_in_group'\n"); |
|
1973
|
|
|
|
|
|
|
} |
|
1974
|
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
# Update number of keys for the system |
|
1976
|
0
|
|
|
|
|
|
my $number_of_keys = $db->get({ -key => 'number_of_keys' }); |
|
1977
|
0
|
0
|
|
|
|
|
if (not defined $number_of_keys) { |
|
1978
|
0
|
|
|
|
|
|
$number_of_keys = 1; |
|
1979
|
|
|
|
|
|
|
} else { |
|
1980
|
0
|
|
|
|
|
|
$number_of_keys++; |
|
1981
|
|
|
|
|
|
|
} |
|
1982
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => 'number_of_keys', -value => $number_of_keys })) { |
|
1983
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Unable to update 'number_of_keys' -> '$number_of_keys'. Database may be corrupt.\n"); |
|
1984
|
|
|
|
|
|
|
} |
|
1985
|
|
|
|
|
|
|
|
|
1986
|
|
|
|
|
|
|
# Update the key_enum_counter |
|
1987
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_key_enum_counter", -value => $key_enum_counter })) { |
|
1988
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_key_to_group() - Unable to update '${GROUP_ENUM_DATA}${$group_enum}_key_enum_counter' -> '$key_enum_counter'. Database may be corrupt.\n"); |
|
|
0
|
|
|
|
|
|
|
|
1989
|
|
|
|
|
|
|
} |
|
1990
|
|
|
|
|
|
|
|
|
1991
|
|
|
|
|
|
|
|
|
1992
|
0
|
|
|
|
|
|
$key_enum = $key_enum_counter; |
|
1993
|
|
|
|
|
|
|
} |
|
1994
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
1995
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
1996
|
|
|
|
|
|
|
|
|
1997
|
0
|
|
|
|
|
|
$key_enum; |
|
1998
|
|
|
|
|
|
|
} |
|
1999
|
|
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
|
#################################################################### |
|
2001
|
|
|
|
|
|
|
|
|
2002
|
|
|
|
|
|
|
=over 4 |
|
2003
|
|
|
|
|
|
|
|
|
2004
|
|
|
|
|
|
|
=item C $group, -key =E $key, -index =E $index, -ranking =E $ranking });> |
|
2005
|
|
|
|
|
|
|
|
|
2006
|
|
|
|
|
|
|
Adds a reference to a particular index for a key with a ranking |
|
2007
|
|
|
|
|
|
|
to a specific group. |
|
2008
|
|
|
|
|
|
|
|
|
2009
|
|
|
|
|
|
|
Example: $inv_map->add_entry_to_group({ -group => $group, -key => $key, -index => $index, -ranking => $ranking }); |
|
2010
|
|
|
|
|
|
|
|
|
2011
|
|
|
|
|
|
|
This method cannot be used to create new -indexes or -groups. This is a feature, not a bug. |
|
2012
|
|
|
|
|
|
|
It *will* create new -keys as needed. |
|
2013
|
|
|
|
|
|
|
|
|
2014
|
|
|
|
|
|
|
=back |
|
2015
|
|
|
|
|
|
|
|
|
2016
|
|
|
|
|
|
|
=cut |
|
2017
|
|
|
|
|
|
|
|
|
2018
|
|
|
|
|
|
|
sub add_entry_to_group { |
|
2019
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
2020
|
|
|
|
|
|
|
|
|
2021
|
0
|
|
|
|
|
|
my ($group,$key,$index,$ranking) = simple_parms(['-group', '-key', '-index', '-ranking'],@_); |
|
2022
|
|
|
|
|
|
|
|
|
2023
|
0
|
|
|
|
|
|
$ranking = int($ranking+0.5); |
|
2024
|
0
|
0
|
0
|
|
|
|
if (($ranking > 32767) or ($ranking < -32768)) { |
|
2025
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - Legal ranking values must be between -32768 and 32768 inclusive\n"); |
|
2026
|
|
|
|
|
|
|
} |
|
2027
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
2028
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
2029
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - No database opened for use\n"); |
|
2030
|
|
|
|
|
|
|
} |
|
2031
|
|
|
|
|
|
|
|
|
2032
|
|
|
|
|
|
|
# Get the group_enum for this group |
|
2033
|
0
|
|
|
|
|
|
my $group_enum = $db->get({ -key => "$GROUP$group" }); |
|
2034
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
2035
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::add_entry_to_group() - Attempted to add an entry to the undeclared -group '$group'\n"); |
|
2036
|
|
|
|
|
|
|
} |
|
2037
|
|
|
|
|
|
|
|
|
2038
|
|
|
|
|
|
|
# Get the index_enum for this index |
|
2039
|
0
|
|
|
|
|
|
my $index_enum = $db->get({ -key => "$INDEX$index" }); |
|
2040
|
0
|
0
|
|
|
|
|
if (not defined $index_enum) { |
|
2041
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::add_entry_to_group() - Attempted to add an entry to -group '$group' with an undeclared -index of '$index'\n"); |
|
2042
|
|
|
|
|
|
|
} |
|
2043
|
|
|
|
|
|
|
|
|
2044
|
|
|
|
|
|
|
# Add the key to the group, if necessary. |
|
2045
|
0
|
|
|
|
|
|
my $key_enum = $self->add_key_to_group ({ -group => $group, -key => $key }); |
|
2046
|
|
|
|
|
|
|
|
|
2047
|
|
|
|
|
|
|
# Add the index_enum to the list of index_enums for this key_enum |
|
2048
|
0
|
|
|
|
|
|
my $keyed_record = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$key_enum" }); |
|
2049
|
0
|
0
|
|
|
|
|
if (not defined $keyed_record) { |
|
2050
|
0
|
|
|
|
|
|
$keyed_record = ''; |
|
2051
|
|
|
|
|
|
|
} |
|
2052
|
0
|
|
|
|
|
|
my $keyed_indexes = _unpack_list($keyed_record); |
|
2053
|
0
|
|
|
|
|
|
$keyed_indexes->{$index_enum} = $ranking; |
|
2054
|
0
|
|
|
|
|
|
$keyed_record = _pack_list($keyed_indexes); |
|
2055
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}$KEYED_INDEX_LIST$key_enum", -value => $keyed_record })) { |
|
2056
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - Failed to save updated '$GROUP_ENUM_DATA${group_enum}$KEYED_INDEX_LIST$key_enum' -> (list of ranked indexes)\n"); |
|
2057
|
|
|
|
|
|
|
} |
|
2058
|
0
|
|
|
|
|
|
my $test = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$KEYED_INDEX_LIST$key_enum" }); |
|
2059
|
0
|
0
|
|
|
|
|
if ($test ne $keyed_record) { |
|
2060
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - Database is failing to correctly store and retreive binary data\n"); |
|
2061
|
|
|
|
|
|
|
} |
|
2062
|
|
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
|
# Add the key_enum to the list of key_enums for this index_enum |
|
2064
|
0
|
|
|
|
|
|
my $indexed_record = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$index_enum" }); |
|
2065
|
|
|
|
|
|
|
# If this index is not currently used in this group, |
|
2066
|
|
|
|
|
|
|
# make a new INDEXED_KEY_LIST for this index_enum |
|
2067
|
|
|
|
|
|
|
# and increment the number of indexes for the group |
|
2068
|
0
|
|
|
|
|
|
my $indexed_keys = {}; |
|
2069
|
0
|
0
|
|
|
|
|
if (not defined $indexed_record) { |
|
2070
|
0
|
|
|
|
|
|
my $number_of_group_indexes = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_indexes" }); |
|
2071
|
0
|
0
|
|
|
|
|
if (not defined $number_of_group_indexes) { |
|
2072
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group () - Database may be corrupt. Failed to locate '$GROUP_ENUM_DATA${group_enum}_number_of_indexes' record for group '$group'\n"); |
|
2073
|
|
|
|
|
|
|
} |
|
2074
|
0
|
|
|
|
|
|
$number_of_group_indexes++; |
|
2075
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_indexes", -value => $number_of_group_indexes })) { |
|
2076
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group () - Database may be corrupt. Unable to update '$GROUP_ENUM_DATA${group_enum}_number_of_indexes' record to '$number_of_group_indexes' for group '$group'\n"); |
|
2077
|
|
|
|
|
|
|
} |
|
2078
|
|
|
|
|
|
|
} else { |
|
2079
|
0
|
|
|
|
|
|
$indexed_keys = _unpack_list($indexed_record); |
|
2080
|
|
|
|
|
|
|
} |
|
2081
|
0
|
|
|
|
|
|
$indexed_keys->{$key_enum} = $ranking; |
|
2082
|
0
|
|
|
|
|
|
my @displ_list = %$indexed_keys; |
|
2083
|
0
|
|
|
|
|
|
$indexed_record = _pack_list($indexed_keys); |
|
2084
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$index_enum", -value => $indexed_record })) { |
|
2085
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - Failed to save updated '$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$key_enum' -> (list of ranked keys)\n"); |
|
2086
|
|
|
|
|
|
|
} |
|
2087
|
|
|
|
|
|
|
|
|
2088
|
0
|
|
|
|
|
|
$test = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$index_enum" }); |
|
2089
|
0
|
0
|
|
|
|
|
if ($test ne $indexed_record) { |
|
2090
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - Database is failing to correctly store and retreive binary data\n"); |
|
2091
|
|
|
|
|
|
|
} |
|
2092
|
|
|
|
|
|
|
# Update the INDEX_ENUM_GROUP_CHAIN as necessary |
|
2093
|
|
|
|
|
|
|
# Check if the index already exists in the group |
|
2094
|
0
|
|
|
|
|
|
my ($chain) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum" }); |
|
2095
|
0
|
0
|
|
|
|
|
if (not defined $chain) { |
|
2096
|
|
|
|
|
|
|
# Add the index_enum to the index chain for the group |
|
2097
|
0
|
|
|
|
|
|
my $old_first_index_enum = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum" }); |
|
2098
|
0
|
|
|
|
|
|
my $first_index_enum_record = "$NULL_ENUM $NULL_ENUM"; |
|
2099
|
0
|
0
|
0
|
|
|
|
if (defined ($old_first_index_enum) and ($old_first_index_enum ne $NULL_ENUM)) { # Record formated as: prev next index |
|
2100
|
0
|
|
|
|
|
|
my $old_first_index_enum_record = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum" }); |
|
2101
|
0
|
0
|
|
|
|
|
if (not defined $old_first_index_enum_record) { |
|
2102
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - Unable to read '$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum' record. Database may be corrupt.\n"); |
|
2103
|
|
|
|
|
|
|
} |
|
2104
|
0
|
|
|
|
|
|
$old_first_index_enum_record =~ s/^$NULL_ENUM/$index_enum/; |
|
2105
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum", |
|
2106
|
|
|
|
|
|
|
-value => $old_first_index_enum_record, })) { |
|
2107
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - Unable to update 'prev' enum reference for '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$old_first_index_enum'\n"); |
|
2108
|
|
|
|
|
|
|
} |
|
2109
|
0
|
|
|
|
|
|
$first_index_enum_record = "$NULL_ENUM $old_first_index_enum"; |
|
2110
|
|
|
|
|
|
|
} |
|
2111
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum", -value => $first_index_enum_record })) { |
|
2112
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - Unable to save '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum' -> '$first_index_enum_record' to map\n"); |
|
2113
|
|
|
|
|
|
|
} |
|
2114
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum", -value => $index_enum })) { |
|
2115
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::add_entry_to_group() - Unable to save '$GROUP_ENUM_DATA${group_enum}_first_index_enum' -> '$index_enum' map entry.\n"); |
|
2116
|
|
|
|
|
|
|
} |
|
2117
|
|
|
|
|
|
|
} |
|
2118
|
|
|
|
|
|
|
|
|
2119
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
2120
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
2121
|
|
|
|
|
|
|
|
|
2122
|
0
|
|
|
|
|
|
1; |
|
2123
|
|
|
|
|
|
|
} |
|
2124
|
|
|
|
|
|
|
|
|
2125
|
|
|
|
|
|
|
#################################################################### |
|
2126
|
|
|
|
|
|
|
|
|
2127
|
|
|
|
|
|
|
=over 4 |
|
2128
|
|
|
|
|
|
|
|
|
2129
|
|
|
|
|
|
|
=item C $group });> |
|
2130
|
|
|
|
|
|
|
|
|
2131
|
|
|
|
|
|
|
Remove all entries for a group from the map. |
|
2132
|
|
|
|
|
|
|
|
|
2133
|
|
|
|
|
|
|
Example: $inv_map->remove_group({ -group => $group }); |
|
2134
|
|
|
|
|
|
|
|
|
2135
|
|
|
|
|
|
|
This removes all key and key/index entries for the group and |
|
2136
|
|
|
|
|
|
|
all other group specific data from the map. |
|
2137
|
|
|
|
|
|
|
|
|
2138
|
|
|
|
|
|
|
Use this method when you wish to completely delete a searchable |
|
2139
|
|
|
|
|
|
|
'group' from the map without disturbing other existing groups. |
|
2140
|
|
|
|
|
|
|
|
|
2141
|
|
|
|
|
|
|
=back |
|
2142
|
|
|
|
|
|
|
|
|
2143
|
|
|
|
|
|
|
=cut |
|
2144
|
|
|
|
|
|
|
|
|
2145
|
|
|
|
|
|
|
sub remove_group { |
|
2146
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
2147
|
|
|
|
|
|
|
|
|
2148
|
0
|
|
|
|
|
|
my ($group) = simple_parms(['-group'],@_); |
|
2149
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
2150
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
2151
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - No database opened for use\n"); |
|
2152
|
|
|
|
|
|
|
} |
|
2153
|
|
|
|
|
|
|
|
|
2154
|
|
|
|
|
|
|
# Check if the group exists in the system |
|
2155
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get({ -key => "$GROUP$group" }); |
|
2156
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
2157
|
0
|
|
|
|
|
|
croak (__PACKAGE__ ."::remove_group() - Attempted to remove a non-existant group '$group'\n"); |
|
2158
|
|
|
|
|
|
|
} |
|
2159
|
|
|
|
|
|
|
|
|
2160
|
|
|
|
|
|
|
# Remove the 'key' related records |
|
2161
|
0
|
|
|
|
|
|
my ($first_key_enum) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_key_enum" }); |
|
2162
|
0
|
0
|
|
|
|
|
if (not defined $first_key_enum) { |
|
2163
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Corrupt database. No '$GROUP_ENUM_DATA${group_enum}_first_key_enum' record found for group '$group'\n"); |
|
2164
|
|
|
|
|
|
|
} |
|
2165
|
|
|
|
|
|
|
|
|
2166
|
|
|
|
|
|
|
# Chase the linked list of 'key_enum's and delete them |
|
2167
|
0
|
|
|
|
|
|
my $key_enum = $first_key_enum; |
|
2168
|
0
|
|
|
|
|
|
while ($key_enum ne $NULL_ENUM) { |
|
2169
|
0
|
|
|
|
|
|
my ($key_enum_record) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum" }); |
|
2170
|
0
|
0
|
|
|
|
|
if (not defined $key_enum_record) { |
|
2171
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Corrupt database. No '$GROUP_ENUM_DATA${group_enum}$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record found for group '$group'\n"); |
|
2172
|
|
|
|
|
|
|
} |
|
2173
|
0
|
|
|
|
|
|
my ($prev_key_enum,$next_key_enum,$key) = $key_enum_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
2174
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA${group_enum}$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum" })) { |
|
2175
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '$GROUP_ENUM_DATA${group_enum}$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record found for group '$group'\n"); |
|
2176
|
|
|
|
|
|
|
} |
|
2177
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA${group_enum}$KEY_TO_KEY_ENUM$key" })) { |
|
2178
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '$GROUP_ENUM_DATA${group_enum}$KEY_TO_KEY_ENUM$key' record found for group '$group'\n"); |
|
2179
|
|
|
|
|
|
|
} |
|
2180
|
0
|
|
|
|
|
|
$db->delete({ -key => "$GROUP_ENUM_DATA${group_enum}$KEYED_INDEX_LIST$key_enum" }); |
|
2181
|
0
|
|
|
|
|
|
$key_enum = $next_key_enum; |
|
2182
|
|
|
|
|
|
|
} |
|
2183
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA${group_enum}_first_key_enum" })) { |
|
2184
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '$GROUP_ENUM_DATA${group_enum}_first_key_enum' record found for group '$group'\n"); |
|
2185
|
|
|
|
|
|
|
} |
|
2186
|
|
|
|
|
|
|
|
|
2187
|
|
|
|
|
|
|
# Remove the 'index' related records |
|
2188
|
0
|
|
|
|
|
|
my ($first_index_enum) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum" }); |
|
2189
|
0
|
0
|
|
|
|
|
if (not defined $first_index_enum) { |
|
2190
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Corrupt database. No '$GROUP_ENUM_DATA${group_enum}_first_index_enum' record found for group '$group'\n"); |
|
2191
|
|
|
|
|
|
|
} |
|
2192
|
|
|
|
|
|
|
|
|
2193
|
|
|
|
|
|
|
# Chase the linked list of 'index_enum's and delete them |
|
2194
|
0
|
|
|
|
|
|
my $index_enum = $first_index_enum; |
|
2195
|
0
|
|
|
|
|
|
while ($index_enum ne $NULL_ENUM) { |
|
2196
|
0
|
|
|
|
|
|
my ($index_enum_record) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$index_enum" }); |
|
2197
|
0
|
0
|
|
|
|
|
if (not defined $index_enum_record) { |
|
2198
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Corrupt database. No '$GROUP_ENUM_DATA${group_enum}$KEY_ENUM_TO_KEY_AND_CHAIN$index_enum' record found for group '$group'\n"); |
|
2199
|
|
|
|
|
|
|
} |
|
2200
|
0
|
|
|
|
|
|
my ($prev_index_enum,$next_index_enum,$index) = $index_enum_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
2201
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$index_enum" })) { |
|
2202
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '$GROUP_ENUM_DATA${group_enum}$INDEX_ENUM_GROUP_CHAIN$index_enum' record found for group '$group'\n"); |
|
2203
|
|
|
|
|
|
|
} |
|
2204
|
0
|
|
|
|
|
|
$db->delete({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$index_enum" }); |
|
2205
|
0
|
|
|
|
|
|
$index_enum = $next_index_enum; |
|
2206
|
|
|
|
|
|
|
} |
|
2207
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum" })) { |
|
2208
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '$GROUP_ENUM_DATA${group_enum}_first_index_enum' record found for group '$group'\n"); |
|
2209
|
|
|
|
|
|
|
} |
|
2210
|
|
|
|
|
|
|
|
|
2211
|
|
|
|
|
|
|
# Adjust the system wide 'number_of_keys' counter |
|
2212
|
0
|
|
|
|
|
|
my ($number_of_group_keys) = $db->get({ -key=> "$GROUP_ENUM_DATA${group_enum}_number_of_keys" }); |
|
2213
|
0
|
0
|
|
|
|
|
if (not defined $number_of_group_keys) { |
|
2214
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to retrieve '$GROUP_ENUM_DATA${group_enum}_number_of_keys' for group '$group'\n"); |
|
2215
|
|
|
|
|
|
|
} |
|
2216
|
0
|
|
|
|
|
|
my ($number_of_keys) = $db->get({ -key=> "number_of_keys" }); |
|
2217
|
0
|
0
|
|
|
|
|
$number_of_keys = 0 if (not defined $number_of_keys); |
|
2218
|
0
|
|
|
|
|
|
$number_of_keys -= $number_of_group_keys; |
|
2219
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => 'number_of_keys', -value => $number_of_keys })) { |
|
2220
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to store updated 'number_of_keys' ($number_of_keys) for system\n"); |
|
2221
|
|
|
|
|
|
|
} |
|
2222
|
|
|
|
|
|
|
|
|
2223
|
|
|
|
|
|
|
# remove the group key and index counters |
|
2224
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_keys" })) { |
|
2225
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '$GROUP_ENUM_DATA${group_enum}_number_of_keys' record\n"); |
|
2226
|
|
|
|
|
|
|
} |
|
2227
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA${group_enum}_key_enum_counter" })) { |
|
2228
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '$GROUP_ENUM_DATA${group_enum}_key_enum_counter' record\n"); |
|
2229
|
|
|
|
|
|
|
} |
|
2230
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_indexes" })) { |
|
2231
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '$GROUP_ENUM_DATA${group_enum}_number_of_indexes' record\n"); |
|
2232
|
|
|
|
|
|
|
} |
|
2233
|
|
|
|
|
|
|
|
|
2234
|
|
|
|
|
|
|
# Get the 'next' and 'prev' pointers for the group. |
|
2235
|
0
|
|
|
|
|
|
my ($group_record) = $db->get({ -key => "$GROUP_ENUM$group_enum" }); |
|
2236
|
0
|
0
|
|
|
|
|
if (not defined $group_record) { |
|
2237
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Inconsistent database. Unable to find '$GROUP_ENUM$group_enum' record for group '$group'\n"); |
|
2238
|
|
|
|
|
|
|
} |
|
2239
|
|
|
|
|
|
|
|
|
2240
|
|
|
|
|
|
|
# Rethread the doubly linked list of groups to omit this group |
|
2241
|
0
|
|
|
|
|
|
my ($prev_group_enum,$next_group_enum) = $group_record =~ m/^(.{12}) (.{12})/; |
|
2242
|
0
|
0
|
0
|
|
|
|
if (not (defined ($prev_group_enum) and defined ($next_group_enum))) { |
|
2243
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Corrupt data record '$GROUP_ENUM$group_enum' for group '$group'\n"); |
|
2244
|
|
|
|
|
|
|
} |
|
2245
|
|
|
|
|
|
|
|
|
2246
|
|
|
|
|
|
|
# Point the 'next' for the previous group to the next group_enum |
|
2247
|
0
|
0
|
|
|
|
|
if ($prev_group_enum ne $NULL_ENUM) { |
|
2248
|
0
|
|
|
|
|
|
my $prev_group_record = $db->get({ -key => "$GROUP_ENUM$prev_group_enum" }); |
|
2249
|
0
|
0
|
|
|
|
|
if (not defined $prev_group_record) { |
|
2250
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Inconsistent database. Unable to find '$GROUP_ENUM$prev_group_enum' record for group '$group'\n"); |
|
2251
|
|
|
|
|
|
|
} |
|
2252
|
0
|
|
|
|
|
|
$prev_group_record =~ s/^(.{12}) (.{12})/$1 $next_group_enum/; |
|
2253
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM$prev_group_enum", -value => $prev_group_record })) { |
|
2254
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to update '$GROUP_ENUM$prev_group_enum' record to '$prev_group_record'\n"); |
|
2255
|
|
|
|
|
|
|
} |
|
2256
|
|
|
|
|
|
|
} |
|
2257
|
|
|
|
|
|
|
|
|
2258
|
|
|
|
|
|
|
# Point the 'prev' for the next group to the previous group_enum |
|
2259
|
0
|
0
|
|
|
|
|
if ($next_group_enum ne $NULL_ENUM) { |
|
2260
|
0
|
|
|
|
|
|
my $next_group_record = $db->get({ -key => "$GROUP_ENUM$next_group_enum" }); |
|
2261
|
0
|
0
|
|
|
|
|
if (not defined $next_group_record) { |
|
2262
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Inconsistent database. Unable to find '$GROUP_ENUM$next_group_enum' record for group '$group'\n"); |
|
2263
|
|
|
|
|
|
|
} |
|
2264
|
0
|
|
|
|
|
|
$next_group_record =~ s/^(.{12})/$prev_group_enum/; |
|
2265
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM$next_group_enum", -value => $next_group_record })) { |
|
2266
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to update '$GROUP_ENUM$next_group_enum' record to '$next_group_record'\n"); |
|
2267
|
|
|
|
|
|
|
} |
|
2268
|
|
|
|
|
|
|
} |
|
2269
|
|
|
|
|
|
|
|
|
2270
|
|
|
|
|
|
|
# Fix the ${GROUP_ENUM}first_group_enum if we used to be it. |
|
2271
|
0
|
|
|
|
|
|
my $first_group_enum = $db->get({ -key => "${GROUP_ENUM}first_group_enum" }); |
|
2272
|
0
|
0
|
|
|
|
|
if (not defined $first_group_enum) { |
|
2273
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Corrupt database. Unable to locate '${GROUP_ENUM}first_group_enum' record\n"); |
|
2274
|
|
|
|
|
|
|
} |
|
2275
|
0
|
0
|
|
|
|
|
if ($first_group_enum eq $group_enum) { |
|
2276
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "${GROUP_ENUM}first_group_enum", -value => $next_group_enum })) { |
|
2277
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to update '${GROUP_ENUM}first_group_enum' record to '$next_group_enum'\n") |
|
2278
|
|
|
|
|
|
|
} |
|
2279
|
|
|
|
|
|
|
} |
|
2280
|
|
|
|
|
|
|
|
|
2281
|
|
|
|
|
|
|
# Delete this group listing |
|
2282
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP$group" })) { |
|
2283
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '$GROUP$group' record\n"); |
|
2284
|
|
|
|
|
|
|
} |
|
2285
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM$group_enum" })) { |
|
2286
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '$GROUP_ENUM$group_enum' record\n"); |
|
2287
|
|
|
|
|
|
|
} |
|
2288
|
|
|
|
|
|
|
|
|
2289
|
|
|
|
|
|
|
# Decrement the number of groups |
|
2290
|
0
|
|
|
|
|
|
my $number_of_groups = $db->get({ -key => 'number_of_groups' }); |
|
2291
|
0
|
0
|
|
|
|
|
if (not defined $number_of_groups) { |
|
2292
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Inconsistent database. No 'number_of_groups' record found.\n"); |
|
2293
|
|
|
|
|
|
|
} else { |
|
2294
|
0
|
|
|
|
|
|
$number_of_groups--; |
|
2295
|
|
|
|
|
|
|
} |
|
2296
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => 'number_of_groups', -value => $number_of_groups })) { |
|
2297
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to update 'number_of_groups. Database may be corrupt.\n"); |
|
2298
|
|
|
|
|
|
|
} |
|
2299
|
|
|
|
|
|
|
|
|
2300
|
|
|
|
|
|
|
|
|
2301
|
|
|
|
|
|
|
# delete the 'group_enum_counter' and the ${GROUP_ENUM}first_group_enum if no groups are left. |
|
2302
|
|
|
|
|
|
|
# The 'group_enum_counter' record is used as a flag for the 'add_group()' method |
|
2303
|
|
|
|
|
|
|
# to determine when to initialize for the first group. |
|
2304
|
0
|
0
|
|
|
|
|
if ($number_of_groups == 0) { |
|
2305
|
0
|
0
|
|
|
|
|
if (not $db->delete({-key => 'group_enum_counter'})) { |
|
2306
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete 'group_enum_counter' record from database.\n"); |
|
2307
|
|
|
|
|
|
|
} |
|
2308
|
0
|
0
|
|
|
|
|
if (not $db->delete({-key => "${GROUP_ENUM}first_group_enum"})) { |
|
2309
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_group() - Unable to delete '${GROUP_ENUM}first_group_enum' record from database.\n"); |
|
2310
|
|
|
|
|
|
|
} |
|
2311
|
|
|
|
|
|
|
} |
|
2312
|
|
|
|
|
|
|
|
|
2313
|
|
|
|
|
|
|
|
|
2314
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
2315
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
2316
|
|
|
|
|
|
|
|
|
2317
|
0
|
|
|
|
|
|
1; |
|
2318
|
|
|
|
|
|
|
} |
|
2319
|
|
|
|
|
|
|
|
|
2320
|
|
|
|
|
|
|
#################################################################### |
|
2321
|
|
|
|
|
|
|
|
|
2322
|
|
|
|
|
|
|
=over 4 |
|
2323
|
|
|
|
|
|
|
|
|
2324
|
|
|
|
|
|
|
=item C $group, -key =E $key, -index =E $index });> |
|
2325
|
|
|
|
|
|
|
|
|
2326
|
|
|
|
|
|
|
Remove a specific key<->index entry from the map for a group. |
|
2327
|
|
|
|
|
|
|
|
|
2328
|
|
|
|
|
|
|
Example: $inv_map->remove_entry_from_group({ -group => $group, -key => $key, -index => $index }); |
|
2329
|
|
|
|
|
|
|
|
|
2330
|
|
|
|
|
|
|
Does not remove the -key or -index from the database or the group - |
|
2331
|
|
|
|
|
|
|
only the entries mapping the two to each other. |
|
2332
|
|
|
|
|
|
|
|
|
2333
|
|
|
|
|
|
|
=back |
|
2334
|
|
|
|
|
|
|
|
|
2335
|
|
|
|
|
|
|
=cut |
|
2336
|
|
|
|
|
|
|
|
|
2337
|
|
|
|
|
|
|
sub remove_entry_from_group { |
|
2338
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
2339
|
|
|
|
|
|
|
|
|
2340
|
0
|
|
|
|
|
|
my ($group,$key,$index) = simple_parms(['-group','-key','-index'],@_); |
|
2341
|
|
|
|
|
|
|
|
|
2342
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
2343
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
2344
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_entry_from_group() - No database opened for use\n"); |
|
2345
|
|
|
|
|
|
|
} |
|
2346
|
|
|
|
|
|
|
|
|
2347
|
|
|
|
|
|
|
# Get the group_enum for this group |
|
2348
|
0
|
|
|
|
|
|
my $group_enum = $db->get({ -key => "$GROUP$group" }); |
|
2349
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
2350
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::remove_entry_from_group() - Attempted to remove an entry from the undeclared -group '$group'\n"); |
|
2351
|
|
|
|
|
|
|
} |
|
2352
|
|
|
|
|
|
|
|
|
2353
|
|
|
|
|
|
|
# Get the index_enum for this index |
|
2354
|
0
|
|
|
|
|
|
my $index_enum = $db->get({ -key => "$INDEX$index" }); |
|
2355
|
0
|
0
|
|
|
|
|
if (not defined $index_enum) { |
|
2356
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::remove_entry_from_group() - Attempted to remove an entry from the -group '$group' with an undeclared -index of '$index'\n"); |
|
2357
|
|
|
|
|
|
|
} |
|
2358
|
|
|
|
|
|
|
|
|
2359
|
|
|
|
|
|
|
# Get the key_enum for this key |
|
2360
|
0
|
|
|
|
|
|
my $key_enum = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$KEY_TO_KEY_ENUM$key" }); |
|
2361
|
0
|
0
|
|
|
|
|
if (not defined $key_enum) { |
|
2362
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::remove_entry_from_group() - Attempted to remove an entry from the -group '$group' with an undeclared -key of '$key'\n"); |
|
2363
|
|
|
|
|
|
|
} |
|
2364
|
|
|
|
|
|
|
|
|
2365
|
|
|
|
|
|
|
# Delete the index_enum from the list of index_enums for this key_enum |
|
2366
|
0
|
|
|
|
|
|
my $keyed_record = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$KEYED_INDEX_LIST$key_enum" }); |
|
2367
|
0
|
|
|
|
|
|
my $keyed_indexes = _unpack_list($keyed_record); |
|
2368
|
0
|
|
|
|
|
|
delete $keyed_indexes->{$index_enum}; |
|
2369
|
0
|
|
|
|
|
|
$keyed_record = _pack_list($keyed_indexes); |
|
2370
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}$KEYED_INDEX_LIST$key_enum", -value => $keyed_record })) { |
|
2371
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_entry_from_group() - Failed to save updated '$GROUP_ENUM_DATA${group_enum}$KEYED_INDEX_LIST$key_enum' -> (list of ranked indexes)\n"); |
|
2372
|
|
|
|
|
|
|
} |
|
2373
|
|
|
|
|
|
|
|
|
2374
|
|
|
|
|
|
|
# Delete the key_enum from the list of key_enums for this index_enum |
|
2375
|
0
|
|
|
|
|
|
my $indexed_record = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$index_enum" }); |
|
2376
|
0
|
|
|
|
|
|
my $indexed_keys = _unpack_list($indexed_record); |
|
2377
|
0
|
|
|
|
|
|
delete $indexed_keys->{$key_enum}; |
|
2378
|
0
|
|
|
|
|
|
$indexed_record = _pack_list($indexed_keys); |
|
2379
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$index_enum", -value => $keyed_record })) { |
|
2380
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_entry_from_group() - Failed to save updated '$GROUP_ENUM_DATA${group_enum}$INDEXED_KEY_LIST$key_enum' -> (list of ranked keys)\n"); |
|
2381
|
|
|
|
|
|
|
} |
|
2382
|
|
|
|
|
|
|
|
|
2383
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
2384
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
2385
|
|
|
|
|
|
|
|
|
2386
|
0
|
|
|
|
|
|
1; |
|
2387
|
|
|
|
|
|
|
} |
|
2388
|
|
|
|
|
|
|
|
|
2389
|
|
|
|
|
|
|
#################################################################### |
|
2390
|
|
|
|
|
|
|
|
|
2391
|
|
|
|
|
|
|
=over 4 |
|
2392
|
|
|
|
|
|
|
|
|
2393
|
|
|
|
|
|
|
=item C $group, -index =E $index });> |
|
2394
|
|
|
|
|
|
|
|
|
2395
|
|
|
|
|
|
|
Remove all references to a specific index for all keys for a group. |
|
2396
|
|
|
|
|
|
|
|
|
2397
|
|
|
|
|
|
|
Example: $inv_map->_remove_index_from_group({ -group => $group, -index => $index }); |
|
2398
|
|
|
|
|
|
|
|
|
2399
|
|
|
|
|
|
|
Note: This *does not* remove the index from the _system_ - just a specific |
|
2400
|
|
|
|
|
|
|
group. |
|
2401
|
|
|
|
|
|
|
|
|
2402
|
|
|
|
|
|
|
It is a null operation to remove an undeclared index or to remove a |
|
2403
|
|
|
|
|
|
|
declared index from a group where it is not used. |
|
2404
|
|
|
|
|
|
|
|
|
2405
|
|
|
|
|
|
|
=back |
|
2406
|
|
|
|
|
|
|
|
|
2407
|
|
|
|
|
|
|
=cut |
|
2408
|
|
|
|
|
|
|
|
|
2409
|
|
|
|
|
|
|
sub remove_index_from_group { |
|
2410
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
2411
|
|
|
|
|
|
|
|
|
2412
|
0
|
|
|
|
|
|
my ($group,$index) = simple_parms(['-group','-index'],@_); |
|
2413
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
2414
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
2415
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - No database opened for use\n"); |
|
2416
|
|
|
|
|
|
|
} |
|
2417
|
|
|
|
|
|
|
|
|
2418
|
|
|
|
|
|
|
# Get the group_enum for this group |
|
2419
|
0
|
|
|
|
|
|
my $group_enum = $db->get({ -key => "$GROUP$group" }); |
|
2420
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
2421
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::remove_index_from_group() - Attempted to remove an index from an undeclared -group '$group'\n"); |
|
2422
|
|
|
|
|
|
|
} |
|
2423
|
|
|
|
|
|
|
|
|
2424
|
|
|
|
|
|
|
# Get the index_enum for this index |
|
2425
|
0
|
|
|
|
|
|
my $index_enum = $db->get({ -key => "$INDEX$index" }); |
|
2426
|
0
|
0
|
|
|
|
|
return unless (defined $index_enum); |
|
2427
|
|
|
|
|
|
|
|
|
2428
|
|
|
|
|
|
|
# Get the group chain entry for this index |
|
2429
|
0
|
|
|
|
|
|
my ($index_chain_entry) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum" }); |
|
2430
|
|
|
|
|
|
|
|
|
2431
|
|
|
|
|
|
|
# If we did not find a matching index entry for removal - bail: There is nothing we need to do. |
|
2432
|
0
|
0
|
|
|
|
|
return unless (defined $index_chain_entry); |
|
2433
|
|
|
|
|
|
|
|
|
2434
|
|
|
|
|
|
|
# Remove the index from the INDEXED_KEY_LIST |
|
2435
|
0
|
|
|
|
|
|
my ($indexed_key_list_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEXED_KEY_LIST$index_enum" }); |
|
2436
|
|
|
|
|
|
|
|
|
2437
|
|
|
|
|
|
|
# If there was no match for the index, bail - there is nothing to do. |
|
2438
|
0
|
0
|
|
|
|
|
return unless (defined $indexed_key_list_record); |
|
2439
|
|
|
|
|
|
|
|
|
2440
|
0
|
|
|
|
|
|
my ($key_enum_data) = _unpack_list($indexed_key_list_record); |
|
2441
|
0
|
|
|
|
|
|
my @key_enums = keys %$key_enum_data; |
|
2442
|
0
|
|
|
|
|
|
my @zeroed_key_enums = (); |
|
2443
|
|
|
|
|
|
|
# Remove the index from the appropriate KEYED_INDEX_LISTs |
|
2444
|
0
|
|
|
|
|
|
foreach my $key_enum (@key_enums) { |
|
2445
|
0
|
|
|
|
|
|
my ($keyed_index_list_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$key_enum" }); |
|
2446
|
0
|
0
|
|
|
|
|
if (not defined $keyed_index_list_record) { |
|
2447
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Corrupted database. Unable to find '$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$key_enum' record\n"); |
|
2448
|
|
|
|
|
|
|
} |
|
2449
|
0
|
|
|
|
|
|
my ($index_enum_data) = _unpack_list($keyed_index_list_record); |
|
2450
|
0
|
|
|
|
|
|
delete $index_enum_data->{$index_enum}; |
|
2451
|
0
|
|
|
|
|
|
$keyed_index_list_record = _pack_list($index_enum_data); |
|
2452
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$key_enum", |
|
2453
|
|
|
|
|
|
|
-value => $keyed_index_list_record})) { |
|
2454
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Unable to save updated '$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$key_enum' record\n"); |
|
2455
|
|
|
|
|
|
|
} |
|
2456
|
0
|
0
|
|
|
|
|
push (@zeroed_key_enums,$key_enum) if (length($keyed_index_list_record) == 0); |
|
2457
|
|
|
|
|
|
|
} |
|
2458
|
0
|
|
|
|
|
|
$db->delete({ -key => "$GROUP_ENUM_DATA$group_enum$INDEXED_KEY_LIST$index_enum" }); |
|
2459
|
|
|
|
|
|
|
|
|
2460
|
|
|
|
|
|
|
# Re-thread the INDEX_ENUM_GROUP_CHAIN to omit this index_enum |
|
2461
|
0
|
|
|
|
|
|
my ($prev_index_enum,$next_index_enum) = $index_chain_entry =~ m/^(.{12}) (.{12})$/; |
|
2462
|
0
|
0
|
0
|
|
|
|
if (not (defined ($prev_index_enum) and defined ($next_index_enum))) { |
|
2463
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Corrupted database. Unable to parse 'GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum' record for group '$group'\n"); |
|
2464
|
|
|
|
|
|
|
} |
|
2465
|
|
|
|
|
|
|
|
|
2466
|
|
|
|
|
|
|
# Point the 'next' for the previous index_eum to the next index_enum in the chain |
|
2467
|
0
|
0
|
|
|
|
|
if ($prev_index_enum ne $NULL_ENUM) { |
|
2468
|
0
|
|
|
|
|
|
my ($prev_index_chain_entry) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$prev_index_enum" }); |
|
2469
|
0
|
0
|
|
|
|
|
if (not defined $index_chain_entry) { |
|
2470
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Corrupted database. Unable to locate 'GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$prev_index_enum' record for group '$group'\n"); |
|
2471
|
|
|
|
|
|
|
} |
|
2472
|
0
|
|
|
|
|
|
$prev_index_chain_entry =~ s/^(.{12}) (.{12})/$1 $next_index_enum/; |
|
2473
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$prev_index_enum", |
|
2474
|
|
|
|
|
|
|
-value => $prev_index_chain_entry })) { |
|
2475
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Unable to save updated '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$prev_index_enum' record ($prev_index_chain_entry) for group '$group'\n"); |
|
2476
|
|
|
|
|
|
|
} |
|
2477
|
|
|
|
|
|
|
} |
|
2478
|
|
|
|
|
|
|
|
|
2479
|
|
|
|
|
|
|
# Point the 'prev' for the next index_eum to the previous index_enum in the chain |
|
2480
|
0
|
0
|
|
|
|
|
if ($next_index_enum ne $NULL_ENUM) { |
|
2481
|
0
|
|
|
|
|
|
my ($next_index_chain_entry) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$next_index_enum" }); |
|
2482
|
0
|
0
|
|
|
|
|
if (not defined $index_chain_entry) { |
|
2483
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Corrupted database. Unable to locate 'GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$next_index_enum' record for group '$group'\n"); |
|
2484
|
|
|
|
|
|
|
} |
|
2485
|
0
|
|
|
|
|
|
$next_index_chain_entry =~ s/^(.{12})/$prev_index_enum/; |
|
2486
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$next_index_enum", |
|
2487
|
|
|
|
|
|
|
-value => $next_index_chain_entry })) { |
|
2488
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Unable to save updated '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$next_index_enum' record ($next_index_chain_entry) for group '$group'\n"); |
|
2489
|
|
|
|
|
|
|
} |
|
2490
|
|
|
|
|
|
|
} |
|
2491
|
|
|
|
|
|
|
|
|
2492
|
|
|
|
|
|
|
# Fix the $GROUP_ENUM_DATA${group_enum}first_index_enum if we used to be it. |
|
2493
|
0
|
|
|
|
|
|
my $first_index_enum = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum" }); |
|
2494
|
0
|
0
|
|
|
|
|
if (not defined $first_index_enum) { |
|
2495
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Corrupt database. Unable to locate '$GROUP_ENUM_DATA${group_enum}_first_index_enum' record\n"); |
|
2496
|
|
|
|
|
|
|
} |
|
2497
|
0
|
0
|
|
|
|
|
if ($first_index_enum eq $index_enum) { |
|
2498
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum", |
|
2499
|
|
|
|
|
|
|
-value => $next_index_enum })) { |
|
2500
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Unable to update '$GROUP_ENUM_DATA${group_enum}_first_index_enum' record to '$next_index_enum'\n") |
|
2501
|
|
|
|
|
|
|
} |
|
2502
|
|
|
|
|
|
|
} |
|
2503
|
|
|
|
|
|
|
|
|
2504
|
|
|
|
|
|
|
# Delete this index_enum from the INDEX_ENUM_GROUP_CHAIN |
|
2505
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum" })) { |
|
2506
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Unable to delete '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum' record from group '$group'\n"); |
|
2507
|
|
|
|
|
|
|
} |
|
2508
|
|
|
|
|
|
|
|
|
2509
|
|
|
|
|
|
|
# Decrement the number_of_indexes for this group |
|
2510
|
0
|
|
|
|
|
|
my ($number_of_indexes) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_indexes" }); |
|
2511
|
0
|
0
|
|
|
|
|
if (not defined $number_of_indexes) { |
|
2512
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Unable to locate '$GROUP_ENUM_DATA${group_enum}_number_of_indexes' record for group '$group'\n"); |
|
2513
|
|
|
|
|
|
|
} |
|
2514
|
0
|
|
|
|
|
|
$number_of_indexes--; |
|
2515
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_indexes", -value => $number_of_indexes })) { |
|
2516
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Unable to update '$GROUP_ENUM_DATA${group_enum}_number_of_indexes' record to '$number_of_indexes' for group '$group'\n"); |
|
2517
|
|
|
|
|
|
|
} |
|
2518
|
|
|
|
|
|
|
|
|
2519
|
|
|
|
|
|
|
# Remove zeroed out keys. |
|
2520
|
0
|
|
|
|
|
|
for my $key_enum (@zeroed_key_enums) { |
|
2521
|
0
|
|
|
|
|
|
my $key_record = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum" }); |
|
2522
|
0
|
0
|
|
|
|
|
if (not defined $key_record) { |
|
2523
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_group() - Unable to locate '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record.\n") |
|
2524
|
|
|
|
|
|
|
} |
|
2525
|
0
|
|
|
|
|
|
my ($prev_key_enum,$next_key_enum,$key) = $key_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
2526
|
0
|
|
|
|
|
|
$self->remove_key_from_group({ -group => $group, -key => $key }); |
|
2527
|
|
|
|
|
|
|
|
|
2528
|
|
|
|
|
|
|
} |
|
2529
|
|
|
|
|
|
|
|
|
2530
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
2531
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
2532
|
|
|
|
|
|
|
|
|
2533
|
0
|
|
|
|
|
|
return 1; |
|
2534
|
|
|
|
|
|
|
} |
|
2535
|
|
|
|
|
|
|
|
|
2536
|
|
|
|
|
|
|
#################################################################### |
|
2537
|
|
|
|
|
|
|
|
|
2538
|
|
|
|
|
|
|
=over 4 |
|
2539
|
|
|
|
|
|
|
|
|
2540
|
|
|
|
|
|
|
=item C $index });> |
|
2541
|
|
|
|
|
|
|
|
|
2542
|
|
|
|
|
|
|
Remove all references to a specific index from the system. |
|
2543
|
|
|
|
|
|
|
|
|
2544
|
|
|
|
|
|
|
Example: $inv_map->_remove_index_from_all({ -index => $index }); |
|
2545
|
|
|
|
|
|
|
|
|
2546
|
|
|
|
|
|
|
This *completely* removes it from all groups and the master |
|
2547
|
|
|
|
|
|
|
system entries. |
|
2548
|
|
|
|
|
|
|
|
|
2549
|
|
|
|
|
|
|
It is a null operation to remove an undefined index. |
|
2550
|
|
|
|
|
|
|
|
|
2551
|
|
|
|
|
|
|
=back |
|
2552
|
|
|
|
|
|
|
|
|
2553
|
|
|
|
|
|
|
=cut |
|
2554
|
|
|
|
|
|
|
|
|
2555
|
|
|
|
|
|
|
sub remove_index_from_all { |
|
2556
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
2557
|
|
|
|
|
|
|
|
|
2558
|
0
|
|
|
|
|
|
my ($index) = simple_parms(['-index'],@_); |
|
2559
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
2560
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
2561
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - No database opened for use\n"); |
|
2562
|
|
|
|
|
|
|
} |
|
2563
|
0
|
|
|
|
|
|
my ($index_enum) = $db->get({ -key => "$INDEX$index" }); |
|
2564
|
0
|
0
|
|
|
|
|
return if (not defined $index_enum); |
|
2565
|
|
|
|
|
|
|
|
|
2566
|
|
|
|
|
|
|
# Remove index entries from all groups |
|
2567
|
0
|
|
|
|
|
|
my ($first_group_enum) = $db->get({ -key => "${GROUP_ENUM}first_group_enum" }); |
|
2568
|
|
|
|
|
|
|
|
|
2569
|
0
|
0
|
|
|
|
|
if (defined $first_group_enum) { |
|
2570
|
0
|
|
|
|
|
|
my $group_enum = $first_group_enum; |
|
2571
|
0
|
|
|
|
|
|
while ($group_enum ne $NULL_ENUM) { |
|
2572
|
0
|
|
|
|
|
|
my ($group_record) = $db->get({ -key => "${GROUP_ENUM}$group_enum" }); |
|
2573
|
0
|
0
|
|
|
|
|
if (not defined $group_record) { |
|
2574
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Database corrupt. Unable to locate '${GROUP_ENUM}$group_enum' record for system.\n"); |
|
2575
|
|
|
|
|
|
|
} |
|
2576
|
0
|
|
|
|
|
|
my ($prev_group_enum,$next_group_enum,$group) = $group_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
2577
|
0
|
|
|
|
|
|
$self->remove_index_from_group({ -group => $group, '-index' => $index }); |
|
2578
|
0
|
|
|
|
|
|
$group_enum = $next_group_enum; |
|
2579
|
|
|
|
|
|
|
} |
|
2580
|
|
|
|
|
|
|
} |
|
2581
|
|
|
|
|
|
|
|
|
2582
|
|
|
|
|
|
|
# Re-thread the INDEX_ENUM to omit this index_enum |
|
2583
|
0
|
|
|
|
|
|
my ($index_chain_entry) = $db->get({ -key => "$INDEX_ENUM$index_enum" }); |
|
2584
|
0
|
0
|
|
|
|
|
if (not defined $index_chain_entry) { |
|
2585
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Corrupt database. Unable to locate '$INDEX_ENUM$index_enum' record\n"); |
|
2586
|
|
|
|
|
|
|
} |
|
2587
|
0
|
|
|
|
|
|
my ($prev_index_enum,$next_index_enum) = $index_chain_entry =~ m/^(.{12}) (.{12})/; |
|
2588
|
0
|
0
|
0
|
|
|
|
if (not (defined ($prev_index_enum) and defined ($next_index_enum))) { |
|
2589
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Corrupt database. Unable to parse '$INDEX_ENUM$index_enum' record\n"); |
|
2590
|
|
|
|
|
|
|
} |
|
2591
|
|
|
|
|
|
|
|
|
2592
|
0
|
0
|
|
|
|
|
if ($prev_index_enum ne $NULL_ENUM) { |
|
2593
|
0
|
|
|
|
|
|
my ($prev_index_chain_entry) = $db->get({ -key => "$INDEX_ENUM$prev_index_enum" }); |
|
2594
|
0
|
0
|
|
|
|
|
if (not defined $prev_index_chain_entry) { |
|
2595
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Corrupt database. Unable to locate '$INDEX_ENUM$prev_index_enum' record\n"); |
|
2596
|
|
|
|
|
|
|
} |
|
2597
|
0
|
|
|
|
|
|
$prev_index_chain_entry =~ s/^(.{12}) (.{12})/$1 $next_index_enum/; |
|
2598
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$INDEX_ENUM$prev_index_enum", |
|
2599
|
|
|
|
|
|
|
-value => $prev_index_chain_entry })) { |
|
2600
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Unable to save updated '$INDEX_ENUM$prev_index_enum' record ($prev_index_chain_entry)\n"); |
|
2601
|
|
|
|
|
|
|
} |
|
2602
|
|
|
|
|
|
|
} |
|
2603
|
|
|
|
|
|
|
|
|
2604
|
0
|
0
|
|
|
|
|
if ($next_index_enum ne $NULL_ENUM) { |
|
2605
|
0
|
|
|
|
|
|
my ($next_index_chain_entry) = $db->get({ -key => "$INDEX_ENUM$next_index_enum" }); |
|
2606
|
0
|
0
|
|
|
|
|
if (not defined $next_index_chain_entry) { |
|
2607
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Corrupt database. Unable to locate '$INDEX_ENUM$next_index_enum' record\n"); |
|
2608
|
|
|
|
|
|
|
} |
|
2609
|
0
|
|
|
|
|
|
$next_index_chain_entry =~ s/^(.{12})/$prev_index_enum/; |
|
2610
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$INDEX_ENUM$next_index_enum", |
|
2611
|
|
|
|
|
|
|
-value => $next_index_chain_entry })) { |
|
2612
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Unable to save updated '$INDEX_ENUM$next_index_enum' record ($next_index_chain_entry)\n"); |
|
2613
|
|
|
|
|
|
|
} |
|
2614
|
|
|
|
|
|
|
} |
|
2615
|
|
|
|
|
|
|
|
|
2616
|
|
|
|
|
|
|
# Fix the ${INDEX_ENUM}first_index_enum if we used to be it. |
|
2617
|
0
|
|
|
|
|
|
my $first_index_enum = $db->get({ -key => "${INDEX_ENUM}first_index_enum" }); |
|
2618
|
0
|
0
|
|
|
|
|
if (not defined $first_index_enum) { |
|
2619
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Corrupt database. Unable to locate '${INDEX_ENUM}first_index_enum' record\n"); |
|
2620
|
|
|
|
|
|
|
} |
|
2621
|
0
|
0
|
|
|
|
|
if ($first_index_enum eq $index_enum) { |
|
2622
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "${INDEX_ENUM}first_index_enum", |
|
2623
|
|
|
|
|
|
|
-value => $next_index_enum })) { |
|
2624
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Unable to update '${INDEX_ENUM}first_index_enum' record to '$next_index_enum'\n") |
|
2625
|
|
|
|
|
|
|
} |
|
2626
|
|
|
|
|
|
|
} |
|
2627
|
|
|
|
|
|
|
|
|
2628
|
|
|
|
|
|
|
# Delete this index_enum from the INDEX_ENUM |
|
2629
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$INDEX_ENUM$index_enum" })) { |
|
2630
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Unable to delete '$INDEX_ENUM$index_enum' record\n"); |
|
2631
|
|
|
|
|
|
|
} |
|
2632
|
|
|
|
|
|
|
|
|
2633
|
|
|
|
|
|
|
# Delete this index from the INDEX |
|
2634
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$INDEX$index" })) { |
|
2635
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Unable to delete '$INDEX$index' record\n"); |
|
2636
|
|
|
|
|
|
|
} |
|
2637
|
|
|
|
|
|
|
|
|
2638
|
|
|
|
|
|
|
# Delete this index -data from the INDEX_ENUM_DATA |
|
2639
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$INDEX_ENUM_DATA${index_enum}_data" })) { |
|
2640
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Unable to delete '$INDEX_ENUM_DATA${index_enum}_data' record\n"); |
|
2641
|
|
|
|
|
|
|
} |
|
2642
|
|
|
|
|
|
|
|
|
2643
|
|
|
|
|
|
|
# Decrement the number_of_indexes for the system |
|
2644
|
0
|
|
|
|
|
|
my ($number_of_indexes) = $db->get({ -key => "number_of_indexes" }); |
|
2645
|
0
|
0
|
|
|
|
|
if (not defined $number_of_indexes) { |
|
2646
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Unable to locate 'number_of_indexes' record for system\n"); |
|
2647
|
|
|
|
|
|
|
} |
|
2648
|
0
|
|
|
|
|
|
$number_of_indexes--; |
|
2649
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "number_of_indexes", -value => $number_of_indexes })) { |
|
2650
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to update 'number_of_indexes' record to '$number_of_indexes' for system\n"); |
|
2651
|
|
|
|
|
|
|
} |
|
2652
|
|
|
|
|
|
|
|
|
2653
|
|
|
|
|
|
|
# If there are no more indexes, clear out the |
|
2654
|
|
|
|
|
|
|
# ${INDEX_ENUM}_first_index_enum |
|
2655
|
|
|
|
|
|
|
# index_enum_counter and number_of_indexes |
|
2656
|
0
|
0
|
|
|
|
|
if ($number_of_indexes == 0) { |
|
2657
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "${INDEX_ENUM}first_index_enum" })) { |
|
2658
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Unable to delete '${INDEX_ENUM}first_index_enum' record\n"); |
|
2659
|
|
|
|
|
|
|
} |
|
2660
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "index_enum_counter" })) { |
|
2661
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Unable to delete 'index_enum_counter' record\n"); |
|
2662
|
|
|
|
|
|
|
} |
|
2663
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "number_of_indexes" })) { |
|
2664
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_index_from_all() - Unable to delete 'number_of_indexes' record\n"); |
|
2665
|
|
|
|
|
|
|
} |
|
2666
|
|
|
|
|
|
|
} |
|
2667
|
|
|
|
|
|
|
|
|
2668
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
2669
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
2670
|
|
|
|
|
|
|
|
|
2671
|
0
|
|
|
|
|
|
1; |
|
2672
|
|
|
|
|
|
|
} |
|
2673
|
|
|
|
|
|
|
|
|
2674
|
|
|
|
|
|
|
#################################################################### |
|
2675
|
|
|
|
|
|
|
|
|
2676
|
|
|
|
|
|
|
=over 4 |
|
2677
|
|
|
|
|
|
|
|
|
2678
|
|
|
|
|
|
|
=item C $group, -key =E $key });> |
|
2679
|
|
|
|
|
|
|
|
|
2680
|
|
|
|
|
|
|
Remove all references to a specific key for all indexes for a group. |
|
2681
|
|
|
|
|
|
|
|
|
2682
|
|
|
|
|
|
|
Example: $inv_map->remove({ -group => $group, -key => $key }); |
|
2683
|
|
|
|
|
|
|
|
|
2684
|
|
|
|
|
|
|
Returns undef if the key speced was not even in database. |
|
2685
|
|
|
|
|
|
|
Returns '1' if the key speced was in the database, and has |
|
2686
|
|
|
|
|
|
|
been successfully deleted. |
|
2687
|
|
|
|
|
|
|
|
|
2688
|
|
|
|
|
|
|
croaks on errors. |
|
2689
|
|
|
|
|
|
|
|
|
2690
|
|
|
|
|
|
|
=back |
|
2691
|
|
|
|
|
|
|
|
|
2692
|
|
|
|
|
|
|
=cut |
|
2693
|
|
|
|
|
|
|
|
|
2694
|
|
|
|
|
|
|
sub remove_key_from_group { |
|
2695
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
2696
|
|
|
|
|
|
|
|
|
2697
|
0
|
|
|
|
|
|
my ($group,$key) = simple_parms(['-group','-key'],@_); |
|
2698
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
2699
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
2700
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - No database opened for use\n"); |
|
2701
|
|
|
|
|
|
|
} |
|
2702
|
|
|
|
|
|
|
|
|
2703
|
|
|
|
|
|
|
# Get the group_enum for this group |
|
2704
|
0
|
|
|
|
|
|
my $group_enum = $db->get({ -key => "$GROUP$group" }); |
|
2705
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
2706
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::remove_key_from_group() - Attempted to remove an key from an undeclared -group '$group'\n"); |
|
2707
|
|
|
|
|
|
|
} |
|
2708
|
|
|
|
|
|
|
|
|
2709
|
|
|
|
|
|
|
# Get the key_enum for this key |
|
2710
|
0
|
|
|
|
|
|
my $key_enum = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_TO_KEY_ENUM$key" }); |
|
2711
|
0
|
0
|
|
|
|
|
return if (not defined $key_enum); |
|
2712
|
|
|
|
|
|
|
|
|
2713
|
|
|
|
|
|
|
# Remove the key from the KEYED_INDEX_LIST |
|
2714
|
0
|
|
|
|
|
|
my ($keyed_index_list_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$key_enum" }); |
|
2715
|
0
|
|
|
|
|
|
my $index_enum_data = {}; |
|
2716
|
0
|
0
|
|
|
|
|
if (defined $keyed_index_list_record) { |
|
2717
|
0
|
|
|
|
|
|
$index_enum_data = _unpack_list($keyed_index_list_record); |
|
2718
|
|
|
|
|
|
|
} |
|
2719
|
0
|
|
|
|
|
|
my @index_enums = keys %$index_enum_data; |
|
2720
|
0
|
|
|
|
|
|
my @zeroed_index_enums = (); |
|
2721
|
|
|
|
|
|
|
# Remove the key from the appropriate INDEXED_KEY_LISTs |
|
2722
|
0
|
|
|
|
|
|
foreach my $index_enum (@index_enums) { |
|
2723
|
0
|
|
|
|
|
|
my ($indexed_key_list_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEXED_KEY_LIST$index_enum" }); |
|
2724
|
0
|
0
|
|
|
|
|
if (not defined $indexed_key_list_record) { |
|
2725
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Corrupted database. Unable to find '$GROUP_ENUM_DATA$group_enum$INDEXED_KEY_LIST' record\n"); |
|
2726
|
|
|
|
|
|
|
} |
|
2727
|
0
|
|
|
|
|
|
my ($key_enum_data) = _unpack_list($indexed_key_list_record); |
|
2728
|
0
|
|
|
|
|
|
delete $key_enum_data->{$key_enum}; |
|
2729
|
0
|
|
|
|
|
|
$indexed_key_list_record = _pack_list($key_enum_data); |
|
2730
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$INDEXED_KEY_LIST$index_enum", |
|
2731
|
|
|
|
|
|
|
-value => $indexed_key_list_record })) { |
|
2732
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to save updated '$GROUP_ENUM_DATA$group_enum$INDEXED_KEY_LIST' record\n"); |
|
2733
|
|
|
|
|
|
|
} |
|
2734
|
0
|
0
|
|
|
|
|
push(@zeroed_index_enums,$index_enum) if (length ($indexed_key_list_record) == 0); |
|
2735
|
|
|
|
|
|
|
} |
|
2736
|
0
|
0
|
|
|
|
|
if (defined $keyed_index_list_record) { |
|
2737
|
0
|
|
|
|
|
|
$db->delete({ -key => "$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$key_enum" }); |
|
2738
|
|
|
|
|
|
|
} |
|
2739
|
|
|
|
|
|
|
|
|
2740
|
|
|
|
|
|
|
# Re-thread the KEY_ENUM_TO_KEY_AND_CHAIN to omit this key_enum |
|
2741
|
0
|
|
|
|
|
|
my ($key_chain_entry) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum" }); |
|
2742
|
0
|
0
|
|
|
|
|
if (not defined $key_chain_entry) { |
|
2743
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Corrupt database. Unable to locate 'GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record for group '$group'\n"); |
|
2744
|
|
|
|
|
|
|
} |
|
2745
|
0
|
|
|
|
|
|
my ($prev_key_enum,$next_key_enum) = $key_chain_entry =~ m/^(.{12}) (.{12})/; |
|
2746
|
0
|
0
|
0
|
|
|
|
if (not (defined ($prev_key_enum) and defined ($next_key_enum))) { |
|
2747
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Corrupt database. Unable to parse 'GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record ($key_chain_entry) for group '$group'\n"); |
|
2748
|
|
|
|
|
|
|
} |
|
2749
|
|
|
|
|
|
|
|
|
2750
|
0
|
0
|
|
|
|
|
if ($prev_key_enum ne $NULL_ENUM) { |
|
2751
|
0
|
|
|
|
|
|
my ($prev_key_chain_entry) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$prev_key_enum" }); |
|
2752
|
0
|
0
|
|
|
|
|
if (not defined $key_chain_entry) { |
|
2753
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Corrupt database. Unable to locate 'GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$prev_key_enum' record for group '$group'\n"); |
|
2754
|
|
|
|
|
|
|
} |
|
2755
|
0
|
|
|
|
|
|
$prev_key_chain_entry =~ s/^(.{12}) (.{12})/$1 $next_key_enum/; |
|
2756
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$prev_key_enum", |
|
2757
|
|
|
|
|
|
|
-value => $prev_key_chain_entry })) { |
|
2758
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to save updated '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$prev_key_enum' record ($prev_key_chain_entry) for group '$group'\n"); |
|
2759
|
|
|
|
|
|
|
} |
|
2760
|
|
|
|
|
|
|
} |
|
2761
|
|
|
|
|
|
|
|
|
2762
|
0
|
0
|
|
|
|
|
if ($next_key_enum ne $NULL_ENUM) { |
|
2763
|
0
|
|
|
|
|
|
my ($next_key_chain_entry) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$next_key_enum" }); |
|
2764
|
0
|
0
|
|
|
|
|
if (not defined $key_chain_entry) { |
|
2765
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Corrupt database. Unable to locate 'GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$next_key_enum' record for group '$group'\n"); |
|
2766
|
|
|
|
|
|
|
} |
|
2767
|
0
|
|
|
|
|
|
$next_key_chain_entry =~ s/^(.{12})/$prev_key_enum/; |
|
2768
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$next_key_enum", |
|
2769
|
|
|
|
|
|
|
-value => $next_key_chain_entry })) { |
|
2770
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to save updated '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$next_key_enum' record ($next_key_chain_entry) for group '$group'\n"); |
|
2771
|
|
|
|
|
|
|
} |
|
2772
|
|
|
|
|
|
|
} |
|
2773
|
|
|
|
|
|
|
|
|
2774
|
|
|
|
|
|
|
# Fix the $GROUP_ENUM_DATA${group_enum}first_key_enum if we used to be it. |
|
2775
|
0
|
|
|
|
|
|
my $first_key_enum = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_key_enum" }); |
|
2776
|
0
|
0
|
|
|
|
|
if (not defined $first_key_enum) { |
|
2777
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Corrupt database. Unable to locate '$GROUP_ENUM_DATA${group_enum}_first_key_enum' record\n"); |
|
2778
|
|
|
|
|
|
|
} |
|
2779
|
0
|
0
|
|
|
|
|
if ($first_key_enum eq $key_enum) { |
|
2780
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_first_key_enum", |
|
2781
|
|
|
|
|
|
|
-value => $next_key_enum })) { |
|
2782
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to update '$GROUP_ENUM_DATA${group_enum}_first_key_enum' record to '$next_key_enum'\n") |
|
2783
|
|
|
|
|
|
|
} |
|
2784
|
|
|
|
|
|
|
} |
|
2785
|
|
|
|
|
|
|
|
|
2786
|
|
|
|
|
|
|
# Delete this key_enum from the KEY_ENUM_TO_KEY_AND_CHAIN |
|
2787
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum" })) { |
|
2788
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to delete '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record from group '$group'\n"); |
|
2789
|
|
|
|
|
|
|
} |
|
2790
|
|
|
|
|
|
|
|
|
2791
|
|
|
|
|
|
|
# Delete the KEY_TO_KEY_ENUM entry for this key |
|
2792
|
0
|
0
|
|
|
|
|
if (not $db->delete({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_TO_KEY_ENUM$key" })) { |
|
2793
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to delete '$GROUP_ENUM_DATA$group_enum$KEY_TO_KEY_ENUM$key' record from group '$group'\n"); |
|
2794
|
|
|
|
|
|
|
} |
|
2795
|
|
|
|
|
|
|
|
|
2796
|
|
|
|
|
|
|
# Decrement the number_of_keys for this group |
|
2797
|
0
|
|
|
|
|
|
my ($group_number_of_keys) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_keys" }); |
|
2798
|
0
|
0
|
|
|
|
|
if (not defined $group_number_of_keys) { |
|
2799
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to locate '$GROUP_ENUM_DATA${group_enum}_number_of_keys' record for group '$group'\n"); |
|
2800
|
|
|
|
|
|
|
} |
|
2801
|
0
|
|
|
|
|
|
$group_number_of_keys--; |
|
2802
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "$GROUP_ENUM_DATA${group_enum}_number_of_keys", -value => $group_number_of_keys })) { |
|
2803
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to update '$GROUP_ENUM_DATA${group_enum}_number_of_keys' record to '$group_number_of_keys' for group '$group'\n"); |
|
2804
|
|
|
|
|
|
|
} |
|
2805
|
|
|
|
|
|
|
|
|
2806
|
|
|
|
|
|
|
# Decrement the number_of_keys for the system |
|
2807
|
0
|
|
|
|
|
|
my ($number_of_keys) = $db->get({ -key => "number_of_keys" }); |
|
2808
|
0
|
0
|
|
|
|
|
if (not defined $number_of_keys) { |
|
2809
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to locate 'number_of_keys' record for system\n"); |
|
2810
|
|
|
|
|
|
|
} |
|
2811
|
0
|
|
|
|
|
|
$number_of_keys--; |
|
2812
|
0
|
0
|
|
|
|
|
if (not $db->put({ -key => "number_of_keys", -value => $number_of_keys })) { |
|
2813
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to update 'number_of_keys' record to '$number_of_keys' for system\n"); |
|
2814
|
|
|
|
|
|
|
} |
|
2815
|
|
|
|
|
|
|
|
|
2816
|
|
|
|
|
|
|
# Remove zeroed out indexes. |
|
2817
|
0
|
|
|
|
|
|
for my $index_enum (@zeroed_index_enums) { |
|
2818
|
0
|
|
|
|
|
|
my $index_record = $db->get({ -key => "$INDEX_ENUM$index_enum" }); |
|
2819
|
0
|
0
|
|
|
|
|
if (not defined $index_record) { |
|
2820
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::remove_key_from_group() - Unable to locate '$INDEX_ENUM$index_enum' record.\n") |
|
2821
|
|
|
|
|
|
|
} |
|
2822
|
0
|
|
|
|
|
|
my ($prev_index_enum,$next_index_enum,$index) = $index_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
2823
|
0
|
|
|
|
|
|
$self->remove_index_from_group({ -group => $group, '-index' => $index }); |
|
2824
|
|
|
|
|
|
|
|
|
2825
|
|
|
|
|
|
|
} |
|
2826
|
|
|
|
|
|
|
|
|
2827
|
|
|
|
|
|
|
# We don't want the cache returning old info after an update |
|
2828
|
0
|
|
|
|
|
|
$self->clear_cache; |
|
2829
|
|
|
|
|
|
|
|
|
2830
|
0
|
|
|
|
|
|
1; |
|
2831
|
|
|
|
|
|
|
} |
|
2832
|
|
|
|
|
|
|
|
|
2833
|
|
|
|
|
|
|
#################################################################### |
|
2834
|
|
|
|
|
|
|
|
|
2835
|
|
|
|
|
|
|
=over 4 |
|
2836
|
|
|
|
|
|
|
|
|
2837
|
|
|
|
|
|
|
=item C $group });> |
|
2838
|
|
|
|
|
|
|
|
|
2839
|
|
|
|
|
|
|
Returns an anonymous array containing a list of all |
|
2840
|
|
|
|
|
|
|
defined keys in the specified group. |
|
2841
|
|
|
|
|
|
|
|
|
2842
|
|
|
|
|
|
|
Example: |
|
2843
|
|
|
|
|
|
|
$keys = $inv_map->list_all_keys_in_group({ -group => $group }); |
|
2844
|
|
|
|
|
|
|
|
|
2845
|
|
|
|
|
|
|
Note: This can result in *HUGE* returned lists. If you have a |
|
2846
|
|
|
|
|
|
|
lot of records in the group, you are better off using the |
|
2847
|
|
|
|
|
|
|
iteration support ('first_key_in_group', 'next_key_in_group'). |
|
2848
|
|
|
|
|
|
|
|
|
2849
|
|
|
|
|
|
|
=back |
|
2850
|
|
|
|
|
|
|
|
|
2851
|
|
|
|
|
|
|
=cut |
|
2852
|
|
|
|
|
|
|
|
|
2853
|
|
|
|
|
|
|
sub list_all_keys_in_group { |
|
2854
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
2855
|
|
|
|
|
|
|
|
|
2856
|
0
|
|
|
|
|
|
my ($group) = simple_parms(['-group'],@_); |
|
2857
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
2858
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
2859
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_keys_in_group() - No database opened for use\n"); |
|
2860
|
|
|
|
|
|
|
} |
|
2861
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get({ -key => "$GROUP$group" }); |
|
2862
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
2863
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_keys_in_group() - Attempted to list keys for an undeclared -group: '$group'\n"); |
|
2864
|
|
|
|
|
|
|
} |
|
2865
|
0
|
|
|
|
|
|
my ($first_key_enum) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_key_enum" }); |
|
2866
|
0
|
|
|
|
|
|
my ($keys) = []; |
|
2867
|
0
|
|
|
|
|
|
my $key_enum = $first_key_enum; |
|
2868
|
0
|
|
|
|
|
|
while ($key_enum ne $NULL_ENUM) { |
|
2869
|
0
|
|
|
|
|
|
my ($key_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum" }); |
|
2870
|
0
|
0
|
|
|
|
|
if (not defined $key_record) { |
|
2871
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_keys_in_group() - Corrupt database. Unable to locate '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record in group '$group'\n"); |
|
2872
|
|
|
|
|
|
|
} |
|
2873
|
0
|
|
|
|
|
|
my ($prev_key_enum, $next_key_enum, $key) = $key_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
2874
|
0
|
0
|
|
|
|
|
if (not defined $key) { |
|
2875
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_keys_in_group() - Corrupt database. Unable to parse '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record in group '$group'\n"); |
|
2876
|
|
|
|
|
|
|
} |
|
2877
|
0
|
|
|
|
|
|
push (@$keys,$key); |
|
2878
|
0
|
|
|
|
|
|
$key_enum = $next_key_enum; |
|
2879
|
|
|
|
|
|
|
} |
|
2880
|
0
|
|
|
|
|
|
return $keys; |
|
2881
|
|
|
|
|
|
|
} |
|
2882
|
|
|
|
|
|
|
|
|
2883
|
|
|
|
|
|
|
#################################################################### |
|
2884
|
|
|
|
|
|
|
|
|
2885
|
|
|
|
|
|
|
=over 4 |
|
2886
|
|
|
|
|
|
|
|
|
2887
|
|
|
|
|
|
|
=item C $group_name });> |
|
2888
|
|
|
|
|
|
|
|
|
2889
|
|
|
|
|
|
|
Returns the 'first' key in the -group based on hash ordering. |
|
2890
|
|
|
|
|
|
|
|
|
2891
|
|
|
|
|
|
|
Returns 'undef' if there are no keys in the group. |
|
2892
|
|
|
|
|
|
|
|
|
2893
|
|
|
|
|
|
|
Example: my $first_key = $inv_map->first_key_in_group({-group => $group}); |
|
2894
|
|
|
|
|
|
|
|
|
2895
|
|
|
|
|
|
|
=back |
|
2896
|
|
|
|
|
|
|
|
|
2897
|
|
|
|
|
|
|
=cut |
|
2898
|
|
|
|
|
|
|
|
|
2899
|
|
|
|
|
|
|
sub first_key_in_group { |
|
2900
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
2901
|
|
|
|
|
|
|
|
|
2902
|
0
|
|
|
|
|
|
my ($group) = simple_parms(['-group'],@_); |
|
2903
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
2904
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
2905
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_key_in_group() - No database opened for use\n"); |
|
2906
|
|
|
|
|
|
|
} |
|
2907
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get({ -key => "$GROUP$group" }); |
|
2908
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
2909
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_key_in_group() - Attempted to list keys for an undeclared -group: '$group'\n"); |
|
2910
|
|
|
|
|
|
|
} |
|
2911
|
|
|
|
|
|
|
|
|
2912
|
0
|
|
|
|
|
|
my ($first_key_enum) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_key_enum" }); |
|
2913
|
0
|
0
|
|
|
|
|
return if ($first_key_enum eq $NULL_ENUM); |
|
2914
|
|
|
|
|
|
|
|
|
2915
|
0
|
|
|
|
|
|
my ($key_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$first_key_enum" }); |
|
2916
|
0
|
0
|
|
|
|
|
if (not defined $key_record) { |
|
2917
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_key_in_group() - Corrupt database. Unable to locate '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$first_key_enum' record in group '$group'\n"); |
|
2918
|
|
|
|
|
|
|
} |
|
2919
|
0
|
|
|
|
|
|
my ($prev_key_enum, $next_key_enum, $key) = $key_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
2920
|
0
|
0
|
|
|
|
|
if (not defined $key) { |
|
2921
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_key_in_group() - Corrupt database. Unable to parse '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$first_key_enum' record in group '$group'\n"); |
|
2922
|
|
|
|
|
|
|
} |
|
2923
|
0
|
|
|
|
|
|
return $key; |
|
2924
|
|
|
|
|
|
|
} |
|
2925
|
|
|
|
|
|
|
|
|
2926
|
|
|
|
|
|
|
#################################################################### |
|
2927
|
|
|
|
|
|
|
|
|
2928
|
|
|
|
|
|
|
=over 4 |
|
2929
|
|
|
|
|
|
|
|
|
2930
|
|
|
|
|
|
|
=item C $group, -key =E $key });> |
|
2931
|
|
|
|
|
|
|
|
|
2932
|
|
|
|
|
|
|
Returns the 'next' key in the group based on hash ordering. |
|
2933
|
|
|
|
|
|
|
|
|
2934
|
|
|
|
|
|
|
Returns 'undef' when there are no more keys in the group or if |
|
2935
|
|
|
|
|
|
|
the passed -key is not in the group map. |
|
2936
|
|
|
|
|
|
|
|
|
2937
|
|
|
|
|
|
|
Example: my $next_key = $inv_map->next_key_in_group({ -group => $group, -key => $key }); |
|
2938
|
|
|
|
|
|
|
|
|
2939
|
|
|
|
|
|
|
=back |
|
2940
|
|
|
|
|
|
|
|
|
2941
|
|
|
|
|
|
|
=cut |
|
2942
|
|
|
|
|
|
|
|
|
2943
|
|
|
|
|
|
|
sub next_key_in_group { |
|
2944
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
2945
|
|
|
|
|
|
|
|
|
2946
|
0
|
|
|
|
|
|
my ($group,$key) = simple_parms(['-group','-key'],@_); |
|
2947
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
2948
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
2949
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_key_in_group() - No database opened for use\n"); |
|
2950
|
|
|
|
|
|
|
} |
|
2951
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get({ -key => "$GROUP$group" }); |
|
2952
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
2953
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_key_in_group() - Attempted to list keys for an undeclared -group: '$group'\n"); |
|
2954
|
|
|
|
|
|
|
} |
|
2955
|
0
|
|
|
|
|
|
my ($key_enum) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}$KEY_TO_KEY_ENUM$key" }); |
|
2956
|
0
|
0
|
|
|
|
|
return if (not defined $key_enum); # The passed key is not in the database |
|
2957
|
0
|
|
|
|
|
|
my ($key_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum" }); |
|
2958
|
0
|
0
|
|
|
|
|
if (not defined $key_record) { |
|
2959
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_key_in_group() - Corrupt database. Unable to locate '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record in group '$group'\n"); |
|
2960
|
|
|
|
|
|
|
} |
|
2961
|
0
|
|
|
|
|
|
my ($prev_key_enum, $next_key_enum, $this_key) = $key_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
2962
|
0
|
0
|
|
|
|
|
if (not defined $this_key) { |
|
2963
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_key_in_group() - Corrupt database. Unable to parse '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record in group '$group'\n"); |
|
2964
|
|
|
|
|
|
|
} |
|
2965
|
0
|
0
|
|
|
|
|
return if ($next_key_enum eq $NULL_ENUM); # No next key |
|
2966
|
0
|
|
|
|
|
|
my ($next_key_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$next_key_enum" }); |
|
2967
|
0
|
0
|
|
|
|
|
if (not defined $next_key_record) { |
|
2968
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_key_in_group() - Corrupt database. Unable to locate '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$next_key_enum' record in group '$group'\n"); |
|
2969
|
|
|
|
|
|
|
} |
|
2970
|
0
|
|
|
|
|
|
my ($next_prev_key_enum, $next_next_key_enum, $next_key) = $next_key_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
2971
|
0
|
0
|
|
|
|
|
if (not defined $next_key) { |
|
2972
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_key_in_group() - Corrupt database. Unable to parse '$GROUP_ENUM_DATA$group_enum$KEY_ENUM_TO_KEY_AND_CHAIN$key_enum' record in group '$group'\n"); |
|
2973
|
|
|
|
|
|
|
} |
|
2974
|
0
|
|
|
|
|
|
$next_key; |
|
2975
|
|
|
|
|
|
|
} |
|
2976
|
|
|
|
|
|
|
|
|
2977
|
|
|
|
|
|
|
#################################################################### |
|
2978
|
|
|
|
|
|
|
|
|
2979
|
|
|
|
|
|
|
=over 4 |
|
2980
|
|
|
|
|
|
|
|
|
2981
|
|
|
|
|
|
|
=item C $group });> |
|
2982
|
|
|
|
|
|
|
|
|
2983
|
|
|
|
|
|
|
Returns an anonymous array containing a list of all |
|
2984
|
|
|
|
|
|
|
defined indexes in the group |
|
2985
|
|
|
|
|
|
|
|
|
2986
|
|
|
|
|
|
|
Example: $indexes = $inv_map->list_all_indexes_in_group({ -group => $group }); |
|
2987
|
|
|
|
|
|
|
|
|
2988
|
|
|
|
|
|
|
Note: This can result in *HUGE* returned lists. If you have a |
|
2989
|
|
|
|
|
|
|
lot of records in the group, you are better off using the |
|
2990
|
|
|
|
|
|
|
iteration support (first_index_in_group(), next_index_in_group()) |
|
2991
|
|
|
|
|
|
|
|
|
2992
|
|
|
|
|
|
|
=back |
|
2993
|
|
|
|
|
|
|
|
|
2994
|
|
|
|
|
|
|
=cut |
|
2995
|
|
|
|
|
|
|
|
|
2996
|
|
|
|
|
|
|
sub list_all_indexes_in_group { |
|
2997
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
2998
|
|
|
|
|
|
|
|
|
2999
|
0
|
|
|
|
|
|
my ($group) = simple_parms(['-group'],@_); |
|
3000
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
3001
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3002
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_indexes_in_group() - No database opened for use\n"); |
|
3003
|
|
|
|
|
|
|
} |
|
3004
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get({ -key => "$GROUP$group" }); |
|
3005
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
3006
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_indexes_in_group() - Attempted to list indexes for an undeclared -group: '$group'\n"); |
|
3007
|
|
|
|
|
|
|
} |
|
3008
|
0
|
|
|
|
|
|
my ($first_index_enum) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum" }); |
|
3009
|
0
|
|
|
|
|
|
my ($indexes) = []; |
|
3010
|
0
|
0
|
0
|
|
|
|
return $indexes if ((not defined $first_index_enum) or ($first_index_enum eq $NULL_ENUM)); |
|
3011
|
0
|
|
|
|
|
|
my $index_enum = $first_index_enum; |
|
3012
|
0
|
|
|
|
|
|
while ($index_enum ne $NULL_ENUM) { |
|
3013
|
0
|
|
|
|
|
|
my ($group_index_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum" }); |
|
3014
|
0
|
0
|
|
|
|
|
if (not defined $group_index_record) { |
|
3015
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_indexes_in_group() - Corrupt database. Unable to locate '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum' record in group '$group'\n"); |
|
3016
|
|
|
|
|
|
|
} |
|
3017
|
0
|
|
|
|
|
|
my ($prev_group_index_enum, $next_group_index_enum) = $group_index_record =~ m/^(.{12}) (.{12})$/; |
|
3018
|
0
|
0
|
|
|
|
|
if (not defined $prev_group_index_enum) { |
|
3019
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_indexes_in_group() - Corrupt database. Unable to parse '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum' record in group '$group'\n"); |
|
3020
|
|
|
|
|
|
|
} |
|
3021
|
0
|
|
|
|
|
|
my ($system_index_record) = $db->get({ -key => "$INDEX_ENUM$index_enum" }); |
|
3022
|
0
|
0
|
|
|
|
|
if (not defined $system_index_record) { |
|
3023
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_indexes_in_group() - Corrupt database. Unable to locate '$INDEX_ENUM$index_enum' record\n"); |
|
3024
|
|
|
|
|
|
|
} |
|
3025
|
0
|
|
|
|
|
|
my ($prev_system_index_enum, $next_system_index_enum, $index) = $system_index_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3026
|
0
|
|
|
|
|
|
push (@$indexes,$index); |
|
3027
|
0
|
|
|
|
|
|
$index_enum = $next_group_index_enum; |
|
3028
|
|
|
|
|
|
|
} |
|
3029
|
0
|
|
|
|
|
|
return $indexes; |
|
3030
|
|
|
|
|
|
|
} |
|
3031
|
|
|
|
|
|
|
|
|
3032
|
|
|
|
|
|
|
#################################################################### |
|
3033
|
|
|
|
|
|
|
|
|
3034
|
|
|
|
|
|
|
=over 4 |
|
3035
|
|
|
|
|
|
|
|
|
3036
|
|
|
|
|
|
|
=item C |
|
3037
|
|
|
|
|
|
|
|
|
3038
|
|
|
|
|
|
|
Returns the 'first' index in the -group based on hash ordering. |
|
3039
|
|
|
|
|
|
|
Returns 'undef' if there are no indexes in the group. |
|
3040
|
|
|
|
|
|
|
|
|
3041
|
|
|
|
|
|
|
Example: my $first_index = $inv_map->first_index_in_group({ -group => $group }); |
|
3042
|
|
|
|
|
|
|
|
|
3043
|
|
|
|
|
|
|
=back |
|
3044
|
|
|
|
|
|
|
|
|
3045
|
|
|
|
|
|
|
=cut |
|
3046
|
|
|
|
|
|
|
|
|
3047
|
|
|
|
|
|
|
sub first_index_in_group { |
|
3048
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
3049
|
|
|
|
|
|
|
|
|
3050
|
0
|
|
|
|
|
|
my ($group) = simple_parms(['-group'],@_); |
|
3051
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
3052
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3053
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_index_in_group() - No database opened for use\n"); |
|
3054
|
|
|
|
|
|
|
} |
|
3055
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get({ -key => "$GROUP$group" }); |
|
3056
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
3057
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_indexes_in_group() - Attempted to list indexes for an undeclared -group: '$group'\n"); |
|
3058
|
|
|
|
|
|
|
} |
|
3059
|
0
|
|
|
|
|
|
my ($first_index_enum) = $db->get({ -key => "$GROUP_ENUM_DATA${group_enum}_first_index_enum" }); |
|
3060
|
0
|
0
|
|
|
|
|
return if ($first_index_enum eq $NULL_ENUM); |
|
3061
|
|
|
|
|
|
|
|
|
3062
|
0
|
|
|
|
|
|
my ($indexes) = []; |
|
3063
|
0
|
|
|
|
|
|
my $index_enum = $first_index_enum; |
|
3064
|
0
|
|
|
|
|
|
my ($system_index_record) = $db->get({ -key => "$INDEX_ENUM$index_enum" }); |
|
3065
|
0
|
0
|
|
|
|
|
if (not defined $system_index_record) { |
|
3066
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_indexes_in_group() - Corrupt database. Unable to locate '$INDEX_ENUM$index_enum' record\n"); |
|
3067
|
|
|
|
|
|
|
} |
|
3068
|
0
|
|
|
|
|
|
my ($prev_system_index_enum, $next_system_index_enum, $index) = $system_index_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3069
|
0
|
0
|
|
|
|
|
return if (not defined $index); |
|
3070
|
0
|
|
|
|
|
|
return $index; |
|
3071
|
|
|
|
|
|
|
} |
|
3072
|
|
|
|
|
|
|
|
|
3073
|
|
|
|
|
|
|
#################################################################### |
|
3074
|
|
|
|
|
|
|
|
|
3075
|
|
|
|
|
|
|
=over 4 |
|
3076
|
|
|
|
|
|
|
|
|
3077
|
|
|
|
|
|
|
=item C $group, -index => $index});> |
|
3078
|
|
|
|
|
|
|
|
|
3079
|
|
|
|
|
|
|
Returns the 'next' index in the -group based on hash ordering. |
|
3080
|
|
|
|
|
|
|
Returns 'undef' if there are no more indexes. |
|
3081
|
|
|
|
|
|
|
|
|
3082
|
|
|
|
|
|
|
Example: my $next_index = $inv_map->next_index_in_group({-group => group, -index => $index}); |
|
3083
|
|
|
|
|
|
|
|
|
3084
|
|
|
|
|
|
|
=back |
|
3085
|
|
|
|
|
|
|
|
|
3086
|
|
|
|
|
|
|
=cut |
|
3087
|
|
|
|
|
|
|
|
|
3088
|
|
|
|
|
|
|
sub next_index_in_group { |
|
3089
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
3090
|
|
|
|
|
|
|
|
|
3091
|
0
|
|
|
|
|
|
my ($group,$index) = simple_parms(['-group','-index'],@_); |
|
3092
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
3093
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3094
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_index_in_group() - No database opened for use\n"); |
|
3095
|
|
|
|
|
|
|
} |
|
3096
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get({ -key => "$GROUP$group" }); |
|
3097
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
3098
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_index_in_group() - Attempted to list indexes for an undeclared -group: '$group'\n"); |
|
3099
|
|
|
|
|
|
|
} |
|
3100
|
0
|
|
|
|
|
|
my ($index_enum) = $db->get({ -key => "$INDEX$index" }); |
|
3101
|
0
|
0
|
|
|
|
|
return if (not defined $index_enum); # The passed index is not in the database |
|
3102
|
0
|
|
|
|
|
|
my ($index_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum" }); |
|
3103
|
0
|
0
|
|
|
|
|
return if (not defined $index_record); # The passed index is not in the group |
|
3104
|
0
|
|
|
|
|
|
my ($prev_index_enum, $next_index_enum) = $index_record =~ m/^(.{12}) (.{12})$/; |
|
3105
|
0
|
0
|
|
|
|
|
if (not defined $prev_index_enum) { |
|
3106
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_index_in_group() - Corrupt database. Unable to parse '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$index_enum' record in group '$group'\n"); |
|
3107
|
|
|
|
|
|
|
} |
|
3108
|
0
|
0
|
|
|
|
|
return if ($next_index_enum eq $NULL_ENUM); # No next index |
|
3109
|
0
|
|
|
|
|
|
my ($next_index_record) = $db->get({ -key => "$INDEX_ENUM$next_index_enum" }); |
|
3110
|
0
|
0
|
|
|
|
|
if (not defined $next_index_record) { |
|
3111
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_index_in_group() - Corrupt database. Unable to locate '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$next_index_enum' record in group '$group'\n"); |
|
3112
|
|
|
|
|
|
|
} |
|
3113
|
0
|
|
|
|
|
|
my ($system_prev_index_enum, $system_next_index_enum, $next_index) = $next_index_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3114
|
0
|
0
|
|
|
|
|
if (not defined $next_index) { |
|
3115
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_index_in_group() - Corrupt database. Unable to parse '$GROUP_ENUM_DATA$group_enum$INDEX_ENUM_GROUP_CHAIN$next_index_enum' record in group '$group'\n"); |
|
3116
|
|
|
|
|
|
|
} |
|
3117
|
0
|
|
|
|
|
|
$next_index; |
|
3118
|
|
|
|
|
|
|
} |
|
3119
|
|
|
|
|
|
|
|
|
3120
|
|
|
|
|
|
|
#################################################################### |
|
3121
|
|
|
|
|
|
|
|
|
3122
|
|
|
|
|
|
|
=over 4 |
|
3123
|
|
|
|
|
|
|
|
|
3124
|
|
|
|
|
|
|
=item C |
|
3125
|
|
|
|
|
|
|
|
|
3126
|
|
|
|
|
|
|
Returns an anonymous array containing a list of all |
|
3127
|
|
|
|
|
|
|
defined indexes in the map. |
|
3128
|
|
|
|
|
|
|
|
|
3129
|
|
|
|
|
|
|
Example: $indexes = $inv_map->list_all_indexes; |
|
3130
|
|
|
|
|
|
|
|
|
3131
|
|
|
|
|
|
|
Note: This can result in *HUGE* returned lists. If you have a |
|
3132
|
|
|
|
|
|
|
lot of records in the map or do not have a lot memory, |
|
3133
|
|
|
|
|
|
|
you are better off using the iteration support |
|
3134
|
|
|
|
|
|
|
('first_index', 'next_index') |
|
3135
|
|
|
|
|
|
|
|
|
3136
|
|
|
|
|
|
|
=back |
|
3137
|
|
|
|
|
|
|
|
|
3138
|
|
|
|
|
|
|
=cut |
|
3139
|
|
|
|
|
|
|
|
|
3140
|
|
|
|
|
|
|
sub list_all_indexes { |
|
3141
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
3142
|
|
|
|
|
|
|
|
|
3143
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
3144
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3145
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_indexes() - No database opened for use\n"); |
|
3146
|
|
|
|
|
|
|
} |
|
3147
|
0
|
|
|
|
|
|
my ($first_index_enum) = $db->get({ -key => "${INDEX_ENUM}first_index_enum" }); |
|
3148
|
0
|
|
|
|
|
|
my ($indexes) = []; |
|
3149
|
0
|
0
|
0
|
|
|
|
return $indexes if ((not defined $first_index_enum) or ($first_index_enum eq $NULL_ENUM)); |
|
3150
|
0
|
|
|
|
|
|
my $index_enum = $first_index_enum; |
|
3151
|
0
|
|
|
|
|
|
while ($index_enum ne $NULL_ENUM) { |
|
3152
|
0
|
|
|
|
|
|
my ($index_record) = $db->get({ -key => "$INDEX_ENUM$index_enum" }); |
|
3153
|
0
|
0
|
|
|
|
|
if (not defined $index_record) { |
|
3154
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_indexes - Corrupt database. Unable to locate '$INDEX_ENUM$index_enum' record\n"); |
|
3155
|
|
|
|
|
|
|
} |
|
3156
|
0
|
|
|
|
|
|
my ($prev_index_enum, $next_index_enum, $index) = $index_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3157
|
0
|
|
|
|
|
|
push (@$indexes,$index); |
|
3158
|
0
|
|
|
|
|
|
$index_enum = $next_index_enum; |
|
3159
|
|
|
|
|
|
|
} |
|
3160
|
0
|
|
|
|
|
|
$indexes; |
|
3161
|
|
|
|
|
|
|
} |
|
3162
|
|
|
|
|
|
|
|
|
3163
|
|
|
|
|
|
|
#################################################################### |
|
3164
|
|
|
|
|
|
|
|
|
3165
|
|
|
|
|
|
|
=over 4 |
|
3166
|
|
|
|
|
|
|
|
|
3167
|
|
|
|
|
|
|
=item C |
|
3168
|
|
|
|
|
|
|
|
|
3169
|
|
|
|
|
|
|
Returns the 'first' index in the system based on hash ordering. |
|
3170
|
|
|
|
|
|
|
Returns 'undef' if there are no indexes. |
|
3171
|
|
|
|
|
|
|
|
|
3172
|
|
|
|
|
|
|
Example: my $first_index = $inv_map->first_index; |
|
3173
|
|
|
|
|
|
|
|
|
3174
|
|
|
|
|
|
|
=back |
|
3175
|
|
|
|
|
|
|
|
|
3176
|
|
|
|
|
|
|
=cut |
|
3177
|
|
|
|
|
|
|
|
|
3178
|
|
|
|
|
|
|
sub first_index { |
|
3179
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
3180
|
|
|
|
|
|
|
|
|
3181
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
3182
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3183
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_index() - No database opened for use\n"); |
|
3184
|
|
|
|
|
|
|
} |
|
3185
|
|
|
|
|
|
|
|
|
3186
|
0
|
|
|
|
|
|
my ($first_index_enum) = $db->get({ -key => "${INDEX_ENUM}first_index_enum" }); |
|
3187
|
0
|
0
|
|
|
|
|
return if ($first_index_enum eq $NULL_ENUM); |
|
3188
|
|
|
|
|
|
|
|
|
3189
|
0
|
|
|
|
|
|
my ($index_record) = $db->get({ -key => "$INDEX_ENUM$first_index_enum" }); |
|
3190
|
0
|
0
|
|
|
|
|
if (not defined $index_record) { |
|
3191
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_index - Corrupt database. Unable to locate '$INDEX_ENUM$first_index_enum' record\n"); |
|
3192
|
|
|
|
|
|
|
} |
|
3193
|
0
|
|
|
|
|
|
my ($prev_index_enum, $next_index_enum, $index) = $index_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3194
|
0
|
0
|
|
|
|
|
if (not defined $index) { |
|
3195
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_index - Corrupt database. Unable to parse '$INDEX_ENUM$first_index_enum' record\n"); |
|
3196
|
|
|
|
|
|
|
} |
|
3197
|
0
|
|
|
|
|
|
$index; |
|
3198
|
|
|
|
|
|
|
} |
|
3199
|
|
|
|
|
|
|
|
|
3200
|
|
|
|
|
|
|
#################################################################### |
|
3201
|
|
|
|
|
|
|
|
|
3202
|
|
|
|
|
|
|
=over 4 |
|
3203
|
|
|
|
|
|
|
|
|
3204
|
|
|
|
|
|
|
=item C $index});> |
|
3205
|
|
|
|
|
|
|
|
|
3206
|
|
|
|
|
|
|
Returns the 'next' index in the system based on hash ordering. |
|
3207
|
|
|
|
|
|
|
Returns 'undef' if there are no more indexes. |
|
3208
|
|
|
|
|
|
|
|
|
3209
|
|
|
|
|
|
|
Example: my $next_index = $inv_map->next_index({-index => $index}); |
|
3210
|
|
|
|
|
|
|
|
|
3211
|
|
|
|
|
|
|
=back |
|
3212
|
|
|
|
|
|
|
|
|
3213
|
|
|
|
|
|
|
=cut |
|
3214
|
|
|
|
|
|
|
|
|
3215
|
|
|
|
|
|
|
sub next_index { |
|
3216
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
3217
|
|
|
|
|
|
|
|
|
3218
|
0
|
|
|
|
|
|
my ($index) = simple_parms(['-index'],@_); |
|
3219
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
3220
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3221
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_index() - No database opened for use\n"); |
|
3222
|
|
|
|
|
|
|
} |
|
3223
|
0
|
|
|
|
|
|
my ($index_enum) = $db->get({ -key => "$INDEX$index" }); |
|
3224
|
0
|
0
|
|
|
|
|
return if (not defined $index_enum); # The passed index is not in the database |
|
3225
|
0
|
|
|
|
|
|
my ($index_record) = $db->get({ -key => "$INDEX_ENUM$index_enum" }); |
|
3226
|
0
|
0
|
|
|
|
|
if (not defined $index_record) { |
|
3227
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::next_index() - Corrupt database. Unable to locate '$INDEX_ENUM$index_enum'\n"); |
|
3228
|
|
|
|
|
|
|
} |
|
3229
|
0
|
|
|
|
|
|
my ($prev_index_enum, $next_index_enum,$this_index) = $index_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3230
|
0
|
0
|
|
|
|
|
if (not defined $this_index) { |
|
3231
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_index() - Corrupt database. Unable to parse '$INDEX_ENUM$index_enum' record\n"); |
|
3232
|
|
|
|
|
|
|
} |
|
3233
|
0
|
0
|
|
|
|
|
return if ($next_index_enum eq $NULL_ENUM); # No next index |
|
3234
|
0
|
|
|
|
|
|
my ($next_index_record) = $db->get({ -key => "$INDEX_ENUM$next_index_enum" }); |
|
3235
|
0
|
0
|
|
|
|
|
if (not defined $next_index_record) { |
|
3236
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_index() - Corrupt database. Unable to locate '$INDEX_ENUM$next_index_enum' record\n"); |
|
3237
|
|
|
|
|
|
|
} |
|
3238
|
0
|
|
|
|
|
|
my ($prev_next_index_enum, $next_next_index_enum, $next_index) = $next_index_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3239
|
0
|
0
|
|
|
|
|
if (not defined $next_index) { |
|
3240
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_index() - Corrupt database. Unable to parse '$INDEX_ENUM$next_index_enum' record\n"); |
|
3241
|
|
|
|
|
|
|
} |
|
3242
|
0
|
|
|
|
|
|
$next_index; |
|
3243
|
|
|
|
|
|
|
} |
|
3244
|
|
|
|
|
|
|
|
|
3245
|
|
|
|
|
|
|
#################################################################### |
|
3246
|
|
|
|
|
|
|
|
|
3247
|
|
|
|
|
|
|
=over 4 |
|
3248
|
|
|
|
|
|
|
|
|
3249
|
|
|
|
|
|
|
=item C |
|
3250
|
|
|
|
|
|
|
|
|
3251
|
|
|
|
|
|
|
Returns an anonymous array containing a list of all |
|
3252
|
|
|
|
|
|
|
defined groups in the map. |
|
3253
|
|
|
|
|
|
|
|
|
3254
|
|
|
|
|
|
|
Example: $groups = $inv_map->list_all_groups; |
|
3255
|
|
|
|
|
|
|
|
|
3256
|
|
|
|
|
|
|
If you have a lot of groups in the map or do not have a lot of memory, |
|
3257
|
|
|
|
|
|
|
you are better off using the iteration support ('first_group', |
|
3258
|
|
|
|
|
|
|
'next_group') |
|
3259
|
|
|
|
|
|
|
|
|
3260
|
|
|
|
|
|
|
=back |
|
3261
|
|
|
|
|
|
|
|
|
3262
|
|
|
|
|
|
|
=cut |
|
3263
|
|
|
|
|
|
|
|
|
3264
|
|
|
|
|
|
|
sub list_all_groups { |
|
3265
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
3266
|
|
|
|
|
|
|
|
|
3267
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
3268
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3269
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_groups() - No database opened for use\n"); |
|
3270
|
|
|
|
|
|
|
} |
|
3271
|
0
|
|
|
|
|
|
my ($first_group_enum) = $db->get({ -key => "${GROUP_ENUM}first_group_enum" }); |
|
3272
|
0
|
|
|
|
|
|
my ($groups) = []; |
|
3273
|
0
|
0
|
0
|
|
|
|
return $groups if ((not defined $first_group_enum) or ($first_group_enum eq $NULL_ENUM)); |
|
3274
|
0
|
|
|
|
|
|
my $group_enum = $first_group_enum; |
|
3275
|
0
|
|
|
|
|
|
while ($group_enum ne $NULL_ENUM) { |
|
3276
|
0
|
|
|
|
|
|
my ($group_record) = $db->get({ -key => "$GROUP_ENUM$group_enum" }); |
|
3277
|
0
|
0
|
|
|
|
|
if (not defined $group_record) { |
|
3278
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::list_all_groups - Corrupt database. Unable to locate '$GROUP_ENUM$group_enum' record\n"); |
|
3279
|
|
|
|
|
|
|
} |
|
3280
|
0
|
|
|
|
|
|
my ($prev_group_enum, $next_group_enum, $group) = $group_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3281
|
0
|
|
|
|
|
|
push (@$groups,$group); |
|
3282
|
0
|
|
|
|
|
|
$group_enum = $next_group_enum; |
|
3283
|
|
|
|
|
|
|
} |
|
3284
|
0
|
|
|
|
|
|
$groups; |
|
3285
|
|
|
|
|
|
|
} |
|
3286
|
|
|
|
|
|
|
|
|
3287
|
|
|
|
|
|
|
#################################################################### |
|
3288
|
|
|
|
|
|
|
|
|
3289
|
|
|
|
|
|
|
=over 4 |
|
3290
|
|
|
|
|
|
|
|
|
3291
|
|
|
|
|
|
|
=item C |
|
3292
|
|
|
|
|
|
|
|
|
3293
|
|
|
|
|
|
|
Returns the 'first' group in the system based on hash ordering. |
|
3294
|
|
|
|
|
|
|
Returns 'undef' if there are no groups. |
|
3295
|
|
|
|
|
|
|
|
|
3296
|
|
|
|
|
|
|
Example: my $first_group = $inv_map->first_group; |
|
3297
|
|
|
|
|
|
|
|
|
3298
|
|
|
|
|
|
|
=back |
|
3299
|
|
|
|
|
|
|
|
|
3300
|
|
|
|
|
|
|
=cut |
|
3301
|
|
|
|
|
|
|
|
|
3302
|
|
|
|
|
|
|
sub first_group{ |
|
3303
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
3304
|
|
|
|
|
|
|
|
|
3305
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
3306
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3307
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_group() - No database opened for use\n"); |
|
3308
|
|
|
|
|
|
|
} |
|
3309
|
|
|
|
|
|
|
|
|
3310
|
0
|
|
|
|
|
|
my ($first_group_enum) = $db->get({ -key => "${GROUP_ENUM}first_group_enum" }); |
|
3311
|
0
|
0
|
|
|
|
|
return if ($first_group_enum eq $NULL_ENUM); |
|
3312
|
|
|
|
|
|
|
|
|
3313
|
0
|
|
|
|
|
|
my ($group_record) = $db->get({ -key => "$GROUP_ENUM$first_group_enum" }); |
|
3314
|
0
|
0
|
|
|
|
|
if (not defined $group_record) { |
|
3315
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_group - Corrupt database. Unable to locate '$GROUP_ENUM$first_group_enum' record\n"); |
|
3316
|
|
|
|
|
|
|
} |
|
3317
|
0
|
|
|
|
|
|
my ($prev_group_enum, $next_group_enum, $group) = $group_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3318
|
0
|
0
|
|
|
|
|
if (not defined $group) { |
|
3319
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::first_index - Corrupt database. Unable to parse '$GROUP_ENUM$first_group_enum' record\n"); |
|
3320
|
|
|
|
|
|
|
} |
|
3321
|
0
|
|
|
|
|
|
$group; |
|
3322
|
|
|
|
|
|
|
} |
|
3323
|
|
|
|
|
|
|
|
|
3324
|
|
|
|
|
|
|
#################################################################### |
|
3325
|
|
|
|
|
|
|
|
|
3326
|
|
|
|
|
|
|
=over 4 |
|
3327
|
|
|
|
|
|
|
|
|
3328
|
|
|
|
|
|
|
=item C $group });> |
|
3329
|
|
|
|
|
|
|
|
|
3330
|
|
|
|
|
|
|
Returns the 'next' group in the system based on hash ordering. |
|
3331
|
|
|
|
|
|
|
Returns 'undef' if there are no more groups. |
|
3332
|
|
|
|
|
|
|
|
|
3333
|
|
|
|
|
|
|
Example: my $next_group = $inv_map->next_group({-group => $group}); |
|
3334
|
|
|
|
|
|
|
|
|
3335
|
|
|
|
|
|
|
=back |
|
3336
|
|
|
|
|
|
|
|
|
3337
|
|
|
|
|
|
|
=cut |
|
3338
|
|
|
|
|
|
|
|
|
3339
|
|
|
|
|
|
|
sub next_group { |
|
3340
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
3341
|
|
|
|
|
|
|
|
|
3342
|
0
|
|
|
|
|
|
my ($group) = simple_parms(['-group'],@_); |
|
3343
|
0
|
|
|
|
|
|
my ($db) = $self->get(-database); |
|
3344
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3345
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_group() - No database opened for use\n"); |
|
3346
|
|
|
|
|
|
|
} |
|
3347
|
0
|
|
|
|
|
|
my ($group_enum) = $db->get({ -key => "$GROUP$group" }); |
|
3348
|
0
|
0
|
|
|
|
|
return if (not defined $group_enum); # The passed group is not in the database |
|
3349
|
0
|
|
|
|
|
|
my ($group_record) = $db->get({ -key => "$GROUP_ENUM$group_enum" }); |
|
3350
|
0
|
0
|
|
|
|
|
if (not defined $group_record) { |
|
3351
|
0
|
|
|
|
|
|
croak(__PACKAGE__ . "::next_group() - Corrupt database. Unable to locate '$GROUP_ENUM$group_enum'\n"); |
|
3352
|
|
|
|
|
|
|
} |
|
3353
|
0
|
|
|
|
|
|
my ($prev_group_enum, $next_group_enum,$this_group) = $group_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3354
|
0
|
0
|
|
|
|
|
if (not defined $this_group) { |
|
3355
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_group() - Corrupt database. Unable to parse '$GROUP_ENUM$group_enum' record\n"); |
|
3356
|
|
|
|
|
|
|
} |
|
3357
|
0
|
0
|
|
|
|
|
return if ($next_group_enum eq $NULL_ENUM); # No next group |
|
3358
|
0
|
|
|
|
|
|
my ($next_group_record) = $db->get({ -key => "$GROUP_ENUM$next_group_enum" }); |
|
3359
|
0
|
0
|
|
|
|
|
if (not defined $next_group_record) { |
|
3360
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_group() - Corrupt database. Unable to locate '$GROUP_ENUM$next_group_enum' record\n"); |
|
3361
|
|
|
|
|
|
|
} |
|
3362
|
0
|
|
|
|
|
|
my ($prev_next_group_enum, $next_next_group_enum, $next_group) = $next_group_record =~ m/^(.{12}) (.{12}) (.*)$/s; |
|
3363
|
0
|
0
|
|
|
|
|
if (not defined $next_group) { |
|
3364
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::next_group() - Corrupt database. Unable to parse '$GROUP_ENUM$next_group_enum' record\n"); |
|
3365
|
|
|
|
|
|
|
} |
|
3366
|
0
|
|
|
|
|
|
$next_group; |
|
3367
|
|
|
|
|
|
|
} |
|
3368
|
|
|
|
|
|
|
|
|
3369
|
|
|
|
|
|
|
#################################################################### |
|
3370
|
|
|
|
|
|
|
# |
|
3371
|
|
|
|
|
|
|
# Internals |
|
3372
|
|
|
|
|
|
|
# |
|
3373
|
|
|
|
|
|
|
#The routines after this point are _internal_ to the object. |
|
3374
|
|
|
|
|
|
|
#Do not access them from outside the object. |
|
3375
|
|
|
|
|
|
|
# |
|
3376
|
|
|
|
|
|
|
#They are documented for code maintainence reasons only. |
|
3377
|
|
|
|
|
|
|
# |
|
3378
|
|
|
|
|
|
|
#You Have Been Warned. ;) |
|
3379
|
|
|
|
|
|
|
# |
|
3380
|
|
|
|
|
|
|
|
|
3381
|
|
|
|
|
|
|
#################################################################### |
|
3382
|
|
|
|
|
|
|
# _bare_search($parm_ref); |
|
3383
|
|
|
|
|
|
|
# |
|
3384
|
|
|
|
|
|
|
#Performs a query on the map and returns the results as a |
|
3385
|
|
|
|
|
|
|
#an anonymous array containing the keys and rankings. |
|
3386
|
|
|
|
|
|
|
# |
|
3387
|
|
|
|
|
|
|
#Example: |
|
3388
|
|
|
|
|
|
|
# |
|
3389
|
|
|
|
|
|
|
# my $query = Search::InvertedIndex::Query->new(...); |
|
3390
|
|
|
|
|
|
|
# my $result = $inv_map->search({ -query => $query }); |
|
3391
|
|
|
|
|
|
|
# |
|
3392
|
|
|
|
|
|
|
#Performs a complex multi-key match search with boolean logic and |
|
3393
|
|
|
|
|
|
|
#optional search term weighting. |
|
3394
|
|
|
|
|
|
|
# |
|
3395
|
|
|
|
|
|
|
#The search request is formatted as follows: |
|
3396
|
|
|
|
|
|
|
# |
|
3397
|
|
|
|
|
|
|
#my $result = $inv_map->search({ -query => $query }); |
|
3398
|
|
|
|
|
|
|
# |
|
3399
|
|
|
|
|
|
|
#where '$query' is a Search::InvertedIndex::Query object. |
|
3400
|
|
|
|
|
|
|
# |
|
3401
|
|
|
|
|
|
|
# |
|
3402
|
|
|
|
|
|
|
#Each node can either be a specific search term with an optional weighting |
|
3403
|
|
|
|
|
|
|
#term (a Search::InvertedIndex::Query::Leaf object) or a logic term with |
|
3404
|
|
|
|
|
|
|
#its own sub-branches (a Search::Inverted::Query object). |
|
3405
|
|
|
|
|
|
|
# |
|
3406
|
|
|
|
|
|
|
#The weightings are applied to the returned matches for each search term by |
|
3407
|
|
|
|
|
|
|
#multiplication of their base ranking before combination with the other logic terms. |
|
3408
|
|
|
|
|
|
|
# |
|
3409
|
|
|
|
|
|
|
#This allows recursive use of search to resolve arbitrarily |
|
3410
|
|
|
|
|
|
|
#complex boolean searches and weight different search terms. |
|
3411
|
|
|
|
|
|
|
# |
|
3412
|
|
|
|
|
|
|
#Returns a reference to a hash of indexes and their rankings. |
|
3413
|
|
|
|
|
|
|
# |
|
3414
|
|
|
|
|
|
|
|
|
3415
|
|
|
|
|
|
|
sub _bare_search { |
|
3416
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
3417
|
|
|
|
|
|
|
|
|
3418
|
0
|
|
|
|
|
|
my $parms = parse_parms ({ -parms => \@_, |
|
3419
|
|
|
|
|
|
|
-legal => ['-use_cache'], |
|
3420
|
|
|
|
|
|
|
-required => ['-query'], |
|
3421
|
|
|
|
|
|
|
-defaults => { -cache => 0}, |
|
3422
|
|
|
|
|
|
|
}); |
|
3423
|
|
|
|
|
|
|
|
|
3424
|
0
|
0
|
|
|
|
|
if (not defined $parms) { |
|
3425
|
0
|
|
|
|
|
|
my $error_message = Class::ParmList->error; |
|
3426
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::search() - $error_message\n"); |
|
3427
|
|
|
|
|
|
|
} |
|
3428
|
0
|
|
|
|
|
|
my ($query,$use_cache) = $parms->get('-query','-use_cache'); |
|
3429
|
0
|
|
|
|
|
|
my $db = $self->get(-database); |
|
3430
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3431
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::search() - No database opened for use\n"); |
|
3432
|
|
|
|
|
|
|
} |
|
3433
|
|
|
|
|
|
|
|
|
3434
|
0
|
|
|
|
|
|
my $group_enum_cache = {}; |
|
3435
|
0
|
|
|
|
|
|
my $terms = []; |
|
3436
|
|
|
|
|
|
|
|
|
3437
|
|
|
|
|
|
|
# Load the leaf term data |
|
3438
|
0
|
|
|
|
|
|
my ($logic,$weight,$leafs,$nodes) = $query->get(-logic,-weight,-leafs,-nodes); |
|
3439
|
0
|
|
|
|
|
|
$logic = lc ($logic); |
|
3440
|
0
|
0
|
|
|
|
|
if ($logic !~ m/^(and|or|nand)$/) { |
|
3441
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::search() - Illegal -logic value of '$logic'. Must be one of 'and','or','nand'\n"); |
|
3442
|
|
|
|
|
|
|
} |
|
3443
|
0
|
|
|
|
|
|
foreach my $leaf (@$leafs) { |
|
3444
|
0
|
|
|
|
|
|
my ($weight,$group,$key) = $leaf->get(-weight,-group,-key); |
|
3445
|
0
|
|
|
|
|
|
my $group_enum; |
|
3446
|
0
|
0
|
|
|
|
|
if (not exists $group_enum_cache->{$group}) { |
|
3447
|
0
|
|
|
|
|
|
$group_enum = $db->get({ -key => "$GROUP$group" }); |
|
3448
|
|
|
|
|
|
|
} else { |
|
3449
|
0
|
|
|
|
|
|
$group_enum = $group_enum_cache->{$group}; |
|
3450
|
|
|
|
|
|
|
} |
|
3451
|
0
|
0
|
|
|
|
|
if (not defined $group_enum) { |
|
3452
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::search() - No group '$group' defined in map\n"); |
|
3453
|
|
|
|
|
|
|
} |
|
3454
|
0
|
|
|
|
|
|
my $key_enum = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEY_TO_KEY_ENUM$key" }); |
|
3455
|
0
|
0
|
|
|
|
|
if (not defined $key_enum) { |
|
3456
|
0
|
|
|
|
|
|
push (@$terms,{}); |
|
3457
|
0
|
|
|
|
|
|
next; |
|
3458
|
|
|
|
|
|
|
} |
|
3459
|
0
|
|
|
|
|
|
my ($keyed_index_list_record) = $db->get({ -key => "$GROUP_ENUM_DATA$group_enum$KEYED_INDEX_LIST$key_enum" }); |
|
3460
|
0
|
0
|
|
|
|
|
$keyed_index_list_record = '' if (not defined $keyed_index_list_record); |
|
3461
|
0
|
|
|
|
|
|
my $index_data = _unpack_list($keyed_index_list_record); |
|
3462
|
0
|
0
|
|
|
|
|
if ($weight != 1) { |
|
3463
|
0
|
|
|
|
|
|
my (@index_enums) = keys (%$index_data); |
|
3464
|
0
|
|
|
|
|
|
foreach my $index_enum (@index_enums) { |
|
3465
|
0
|
|
|
|
|
|
$index_data->{$index_enum} *= $weight; |
|
3466
|
|
|
|
|
|
|
} |
|
3467
|
|
|
|
|
|
|
} |
|
3468
|
0
|
|
|
|
|
|
push (@$terms,$index_data); |
|
3469
|
|
|
|
|
|
|
} |
|
3470
|
|
|
|
|
|
|
|
|
3471
|
|
|
|
|
|
|
# Load the node term data via recursion |
|
3472
|
0
|
|
|
|
|
|
foreach my $node (@$nodes) { |
|
3473
|
0
|
|
|
|
|
|
my $index_data = $self->_bare_search({ -query => $node, -use_cache => 0 }); |
|
3474
|
0
|
|
|
|
|
|
push (@$terms,$index_data); |
|
3475
|
|
|
|
|
|
|
} |
|
3476
|
|
|
|
|
|
|
|
|
3477
|
|
|
|
|
|
|
# Now merge the results with the applied logic condition |
|
3478
|
0
|
|
|
|
|
|
my $merge; |
|
3479
|
0
|
0
|
|
|
|
|
if ($logic eq 'and') { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3480
|
0
|
|
|
|
|
|
$merge = $self->_and($terms); |
|
3481
|
|
|
|
|
|
|
} elsif ($logic eq 'or') { |
|
3482
|
0
|
|
|
|
|
|
$merge = $self->_or($terms); |
|
3483
|
|
|
|
|
|
|
} elsif ($logic eq 'nand') { |
|
3484
|
0
|
|
|
|
|
|
$merge = $self->_nand($terms); |
|
3485
|
|
|
|
|
|
|
} |
|
3486
|
|
|
|
|
|
|
|
|
3487
|
|
|
|
|
|
|
# Apply the weighting |
|
3488
|
0
|
0
|
|
|
|
|
if ($weight != 1) { |
|
3489
|
0
|
|
|
|
|
|
while (my ($key,$value) = each %$merge) { $merge->{$key} *= $weight; } |
|
|
0
|
|
|
|
|
|
|
|
3490
|
|
|
|
|
|
|
} |
|
3491
|
|
|
|
|
|
|
|
|
3492
|
0
|
|
|
|
|
|
$merge; |
|
3493
|
|
|
|
|
|
|
} |
|
3494
|
|
|
|
|
|
|
|
|
3495
|
|
|
|
|
|
|
#################################################################### |
|
3496
|
|
|
|
|
|
|
#_get_data_for_index_enum($parm_ref); |
|
3497
|
|
|
|
|
|
|
# |
|
3498
|
|
|
|
|
|
|
#Returns the data record for the passed -index_enum. |
|
3499
|
|
|
|
|
|
|
# |
|
3500
|
|
|
|
|
|
|
#Returns undef if no data record exists for the requested -index_enum. |
|
3501
|
|
|
|
|
|
|
# |
|
3502
|
|
|
|
|
|
|
#Example: |
|
3503
|
|
|
|
|
|
|
# my $data = $self->_get_data_for_index_enum({ -index_enum => $index_enum }); |
|
3504
|
|
|
|
|
|
|
# |
|
3505
|
|
|
|
|
|
|
|
|
3506
|
|
|
|
|
|
|
sub _get_data_for_index_enum { |
|
3507
|
0
|
|
|
0
|
|
|
my ($self) = shift; |
|
3508
|
|
|
|
|
|
|
|
|
3509
|
0
|
|
|
|
|
|
my ($index_enum) = simple_parms(['-index_enum'],@_); |
|
3510
|
0
|
|
|
|
|
|
my ($db,$thaw) = $self->get('-database','-thaw'); |
|
3511
|
0
|
0
|
|
|
|
|
if (not $db) { |
|
3512
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::search() - No database opened for use\n"); |
|
3513
|
|
|
|
|
|
|
} |
|
3514
|
0
|
|
|
|
|
|
my ($data_record) = $db->get({ -key => "$INDEX_ENUM_DATA${index_enum}_data" }); |
|
3515
|
0
|
0
|
|
|
|
|
return if (not defined $data_record); |
|
3516
|
0
|
|
|
|
|
|
my ($data) = &$thaw($data_record); |
|
3517
|
0
|
|
|
|
|
|
$data; |
|
3518
|
|
|
|
|
|
|
} |
|
3519
|
|
|
|
|
|
|
|
|
3520
|
|
|
|
|
|
|
#################################################################### |
|
3521
|
|
|
|
|
|
|
# _and($terms); |
|
3522
|
|
|
|
|
|
|
# |
|
3523
|
|
|
|
|
|
|
# Takes the passed list of search data results and merges them |
|
3524
|
|
|
|
|
|
|
# via logical _and. Merged ranking is the sum of the individual rankings. |
|
3525
|
|
|
|
|
|
|
# |
|
3526
|
|
|
|
|
|
|
|
|
3527
|
|
|
|
|
|
|
sub _and { |
|
3528
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
3529
|
|
|
|
|
|
|
|
|
3530
|
0
|
|
|
|
|
|
my ($terms) = @_; |
|
3531
|
|
|
|
|
|
|
|
|
3532
|
0
|
|
|
|
|
|
my $n_terms = $#$terms + 1; |
|
3533
|
0
|
0
|
|
|
|
|
return {} if ($n_terms == 0); |
|
3534
|
0
|
0
|
|
|
|
|
return $terms->[0] if ($n_terms == 1); |
|
3535
|
0
|
|
|
|
|
|
my $first = shift @$terms; |
|
3536
|
0
|
|
|
|
|
|
my %merged = (); |
|
3537
|
0
|
|
|
|
|
|
%merged = %$first; |
|
3538
|
0
|
|
|
|
|
|
my ($key); |
|
3539
|
0
|
|
|
|
|
|
foreach my $term (@$terms) { |
|
3540
|
0
|
|
|
|
|
|
my @merge_keys = keys %merged; |
|
3541
|
0
|
|
|
|
|
|
foreach $key (@merge_keys) { |
|
3542
|
0
|
0
|
|
|
|
|
if (exists ($term->{$key})) { |
|
3543
|
0
|
|
|
|
|
|
$merged{$key} += $term->{$key}; |
|
3544
|
|
|
|
|
|
|
} else { |
|
3545
|
0
|
|
|
|
|
|
delete $merged{$key}; |
|
3546
|
|
|
|
|
|
|
} |
|
3547
|
|
|
|
|
|
|
} |
|
3548
|
|
|
|
|
|
|
} |
|
3549
|
|
|
|
|
|
|
# foreach $key (keys %merged) { # arithmetical average each term |
|
3550
|
|
|
|
|
|
|
# $merged{$key} /= $n_terms; |
|
3551
|
|
|
|
|
|
|
# } |
|
3552
|
|
|
|
|
|
|
|
|
3553
|
0
|
|
|
|
|
|
return \%merged; |
|
3554
|
|
|
|
|
|
|
} |
|
3555
|
|
|
|
|
|
|
|
|
3556
|
|
|
|
|
|
|
#################################################################### |
|
3557
|
|
|
|
|
|
|
# _nand($terms); |
|
3558
|
|
|
|
|
|
|
# |
|
3559
|
|
|
|
|
|
|
#Takes the passed list of search data results and merges them |
|
3560
|
|
|
|
|
|
|
#via logical NAND (Not And). Merged ranking is the sum |
|
3561
|
|
|
|
|
|
|
#of the individual rankings. |
|
3562
|
|
|
|
|
|
|
# |
|
3563
|
|
|
|
|
|
|
|
|
3564
|
|
|
|
|
|
|
sub _nand { |
|
3565
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
3566
|
|
|
|
|
|
|
|
|
3567
|
0
|
|
|
|
|
|
my ($terms) = @_; |
|
3568
|
|
|
|
|
|
|
|
|
3569
|
0
|
|
|
|
|
|
my $n_terms = $#$terms + 1; |
|
3570
|
0
|
0
|
|
|
|
|
return {} if ($n_terms == 0); |
|
3571
|
0
|
0
|
|
|
|
|
return {} if ($n_terms == 1); |
|
3572
|
0
|
|
|
|
|
|
my $first = shift @$terms; |
|
3573
|
0
|
|
|
|
|
|
my %merged = (); |
|
3574
|
0
|
|
|
|
|
|
%merged = %$first; |
|
3575
|
0
|
|
|
|
|
|
my %count = (); |
|
3576
|
0
|
|
|
|
|
|
foreach my $key (keys %merged) { |
|
3577
|
0
|
|
|
|
|
|
$count{$key} = 1; |
|
3578
|
|
|
|
|
|
|
} |
|
3579
|
0
|
|
|
|
|
|
my ($key); |
|
3580
|
0
|
|
|
|
|
|
foreach my $term (@$terms) { |
|
3581
|
0
|
|
|
|
|
|
my @term_keys = keys %$term; |
|
3582
|
0
|
|
|
|
|
|
foreach $key (@term_keys) { |
|
3583
|
0
|
|
|
|
|
|
$merged{$key} += $term->{$key}; |
|
3584
|
0
|
|
|
|
|
|
$count{$key}++; |
|
3585
|
|
|
|
|
|
|
} |
|
3586
|
|
|
|
|
|
|
} |
|
3587
|
|
|
|
|
|
|
|
|
3588
|
|
|
|
|
|
|
# Discard things that appear in ALL terms |
|
3589
|
0
|
|
|
|
|
|
my @merge_keys = keys %merged; |
|
3590
|
0
|
|
|
|
|
|
foreach $key (@merge_keys) { |
|
3591
|
0
|
0
|
|
|
|
|
if ($count{$key} == $n_terms) { |
|
3592
|
0
|
|
|
|
|
|
delete $merged{$key}; |
|
3593
|
|
|
|
|
|
|
} |
|
3594
|
|
|
|
|
|
|
} |
|
3595
|
0
|
|
|
|
|
|
return \%merged; |
|
3596
|
|
|
|
|
|
|
} |
|
3597
|
|
|
|
|
|
|
|
|
3598
|
|
|
|
|
|
|
#################################################################### |
|
3599
|
|
|
|
|
|
|
# _or($terms); |
|
3600
|
|
|
|
|
|
|
# |
|
3601
|
|
|
|
|
|
|
# Takes the passed list of search data results and merges them |
|
3602
|
|
|
|
|
|
|
# via logical OR. Merged ranking is the sum of the individual rankings. |
|
3603
|
|
|
|
|
|
|
# |
|
3604
|
|
|
|
|
|
|
|
|
3605
|
|
|
|
|
|
|
sub _or { |
|
3606
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
3607
|
|
|
|
|
|
|
|
|
3608
|
0
|
|
|
|
|
|
my ($terms) = @_; |
|
3609
|
|
|
|
|
|
|
|
|
3610
|
0
|
|
|
|
|
|
my $n_terms = $#$terms + 1; |
|
3611
|
0
|
0
|
|
|
|
|
return {} if ($n_terms == 0); |
|
3612
|
0
|
0
|
|
|
|
|
return $terms->[0] if ($n_terms == 1); |
|
3613
|
0
|
|
|
|
|
|
my $first = shift @$terms; |
|
3614
|
0
|
|
|
|
|
|
my %merged = (); |
|
3615
|
0
|
|
|
|
|
|
%merged = %$first; |
|
3616
|
0
|
|
|
|
|
|
my ($key); |
|
3617
|
0
|
|
|
|
|
|
my %count = (); |
|
3618
|
0
|
|
|
|
|
|
foreach my $key (keys %merged) { |
|
3619
|
0
|
|
|
|
|
|
$count{$key} = 1; |
|
3620
|
|
|
|
|
|
|
} |
|
3621
|
0
|
|
|
|
|
|
foreach my $term (@$terms) { |
|
3622
|
0
|
|
|
|
|
|
my @term_keys = keys %$term; |
|
3623
|
0
|
|
|
|
|
|
foreach $key (@term_keys) { |
|
3624
|
0
|
|
|
|
|
|
$merged{$key} += $term->{$key}; |
|
3625
|
0
|
|
|
|
|
|
$count{$key}++; |
|
3626
|
|
|
|
|
|
|
} |
|
3627
|
|
|
|
|
|
|
} |
|
3628
|
|
|
|
|
|
|
|
|
3629
|
|
|
|
|
|
|
# Compute arithmetical averages of the terms |
|
3630
|
|
|
|
|
|
|
# my @merge_keys = keys %merged; |
|
3631
|
|
|
|
|
|
|
# foreach $key (@merge_keys) { |
|
3632
|
|
|
|
|
|
|
# $merged{$key} /= $count{$key}; |
|
3633
|
|
|
|
|
|
|
# } |
|
3634
|
|
|
|
|
|
|
|
|
3635
|
0
|
|
|
|
|
|
return \%merged; |
|
3636
|
|
|
|
|
|
|
} |
|
3637
|
|
|
|
|
|
|
|
|
3638
|
|
|
|
|
|
|
|
|
3639
|
|
|
|
|
|
|
#################################################################### |
|
3640
|
|
|
|
|
|
|
# _increment_enum($enum_value); |
|
3641
|
|
|
|
|
|
|
# |
|
3642
|
|
|
|
|
|
|
# Internal method. Not for access outside of the module. |
|
3643
|
|
|
|
|
|
|
# |
|
3644
|
|
|
|
|
|
|
# Increments an 'enum' (internally a 12 digit hexadecimal number) by 1. |
|
3645
|
|
|
|
|
|
|
# |
|
3646
|
|
|
|
|
|
|
|
|
3647
|
|
|
|
|
|
|
sub _increment_enum { |
|
3648
|
0
|
|
|
0
|
|
|
my $self = shift; |
|
3649
|
|
|
|
|
|
|
|
|
3650
|
0
|
|
|
|
|
|
my ($enum) = @_; |
|
3651
|
0
|
0
|
|
|
|
|
if ($enum !~ m/^([0-9a-fA-F]{4})([0-9a-fA-F]{4})([0-9a-fA-F]{4})$/) { |
|
3652
|
0
|
|
|
|
|
|
croak (__PACKAGE__ . "::_increment_enum() - passed an invalid enum value of '$enum'\n"); |
|
3653
|
|
|
|
|
|
|
} |
|
3654
|
0
|
|
|
|
|
|
my (@hexwords) = ($1,$2,$3); |
|
3655
|
0
|
|
|
|
|
|
my $word2 = hex($hexwords[2]); |
|
3656
|
0
|
|
|
|
|
|
$word2++; |
|
3657
|
0
|
0
|
|
|
|
|
if ($word2 > 65535) { |
|
3658
|
0
|
|
|
|
|
|
my $word1 = hex($hexwords[1]); |
|
3659
|
0
|
|
|
|
|
|
$word2 = 0; |
|
3660
|
0
|
|
|
|
|
|
$word1++; |
|
3661
|
0
|
0
|
|
|
|
|
if ($word1 > 65535) { |
|
3662
|
0
|
|
|
|
|
|
my $word0 = hex($hexwords[0]); |
|
3663
|
0
|
|
|
|
|
|
$word1 = 0; |
|
3664
|
0
|
|
|
|
|
|
$word0++; |
|
3665
|
0
|
|
|
|
|
|
$hexwords[0] = sprintf('%0.4lx',$word0); |
|
3666
|
|
|
|
|
|
|
} |
|
3667
|
0
|
|
|
|
|
|
$hexwords[1] = sprintf('%0.4lx',$word1); |
|
3668
|
|
|
|
|
|
|
} |
|
3669
|
0
|
|
|
|
|
|
$hexwords[2] = sprintf('%0.4lx',$word2); |
|
3670
|
0
|
|
|
|
|
|
join('',@hexwords); |
|
3671
|
|
|
|
|
|
|
} |
|
3672
|
|
|
|
|
|
|
|
|
3673
|
|
|
|
|
|
|
################################################################ |
|
3674
|
|
|
|
|
|
|
#_untaint($string); |
|
3675
|
|
|
|
|
|
|
# |
|
3676
|
|
|
|
|
|
|
#Untaints the passed string. Use with care. |
|
3677
|
|
|
|
|
|
|
|
|
3678
|
|
|
|
|
|
|
sub _untaint { |
|
3679
|
0
|
|
|
0
|
|
|
my ($self) = shift; |
|
3680
|
0
|
|
|
|
|
|
my $string; |
|
3681
|
0
|
0
|
|
|
|
|
if (ref $self) { |
|
3682
|
0
|
|
|
|
|
|
$string = $self; |
|
3683
|
|
|
|
|
|
|
} else { |
|
3684
|
0
|
|
|
|
|
|
($string) = @_; |
|
3685
|
|
|
|
|
|
|
} |
|
3686
|
0
|
|
|
|
|
|
my ($untainted_string) = $string =~ m/^(.*)$/s; |
|
3687
|
0
|
|
|
|
|
|
$untainted_string; |
|
3688
|
|
|
|
|
|
|
} |
|
3689
|
|
|
|
|
|
|
|
|
3690
|
|
|
|
|
|
|
#################################################################### |
|
3691
|
|
|
|
|
|
|
# |
|
3692
|
|
|
|
|
|
|
# DESTROY; |
|
3693
|
|
|
|
|
|
|
# |
|
3694
|
|
|
|
|
|
|
# Closes the currently open -map and flushes all associated buffers. |
|
3695
|
|
|
|
|
|
|
# |
|
3696
|
|
|
|
|
|
|
|
|
3697
|
|
|
|
|
|
|
sub DESTROY { |
|
3698
|
0
|
|
|
0
|
|
|
my ($self) = shift; |
|
3699
|
0
|
|
|
|
|
|
$self->close; |
|
3700
|
|
|
|
|
|
|
} |
|
3701
|
|
|
|
|
|
|
|
|
3702
|
|
|
|
|
|
|
# ################################################################ |
|
3703
|
|
|
|
|
|
|
# |
|
3704
|
|
|
|
|
|
|
# DATABASE STRUCTURES |
|
3705
|
|
|
|
|
|
|
# |
|
3706
|
|
|
|
|
|
|
# The inverted database uses a complex overlay built on a generic |
|
3707
|
|
|
|
|
|
|
# key/value accessible database (it really is fairly 'database agnostic'). |
|
3708
|
|
|
|
|
|
|
# |
|
3709
|
|
|
|
|
|
|
# It is organized into sub-sets of information by database key name space: |
|
3710
|
|
|
|
|
|
|
# |
|
3711
|
|
|
|
|
|
|
# ; Stringifier. The serializer used for packing information for storage |
|
3712
|
|
|
|
|
|
|
# $STRINGIFIER -> 'Data::Dumper' or 'Storable' |
|
3713
|
|
|
|
|
|
|
# |
|
3714
|
|
|
|
|
|
|
# $VERSION -> The version number of Search::InvertedIndex |
|
3715
|
|
|
|
|
|
|
# matching this database. |
|
3716
|
|
|
|
|
|
|
# |
|
3717
|
|
|
|
|
|
|
# ; Counter. Incremented for new groups, decremented for deleted groups. |
|
3718
|
|
|
|
|
|
|
# number_of_groups -> # (decimal integer) |
|
3719
|
|
|
|
|
|
|
# |
|
3720
|
|
|
|
|
|
|
# ; Counter. Incremented for new indexes, decremented for deleted indexes. |
|
3721
|
|
|
|
|
|
|
# number_of_indexes -> # (decimal integer) |
|
3722
|
|
|
|
|
|
|
# |
|
3723
|
|
|
|
|
|
|
# ; Counter. Incremented for new keys, decremented for deleted keys. |
|
3724
|
|
|
|
|
|
|
# number_of_keys -> # (decimal integer) |
|
3725
|
|
|
|
|
|
|
# |
|
3726
|
|
|
|
|
|
|
# ; The 'high water' mark used in assigning new index_enum keys |
|
3727
|
|
|
|
|
|
|
# index_enum_counter -> # (12 digit hex number) |
|
3728
|
|
|
|
|
|
|
# |
|
3729
|
|
|
|
|
|
|
# ; Maps an index ("file") to its assigned index enumeration key |
|
3730
|
|
|
|
|
|
|
# $INDEX -> index_enum |
|
3731
|
|
|
|
|
|
|
# |
|
3732
|
|
|
|
|
|
|
# ; Maps the assigned index enumeration back to the index ("file") and |
|
3733
|
|
|
|
|
|
|
# ; provides pointers to the 'next' and 'prev' index_enums in the system |
|
3734
|
|
|
|
|
|
|
# $INDEX_ENUM -> _next_index_enum_ _prev_index_enum_ index |
|
3735
|
|
|
|
|
|
|
# |
|
3736
|
|
|
|
|
|
|
# ; Maps the 'first' 'index_enum' for the system |
|
3737
|
|
|
|
|
|
|
# ${INDEX_ENUM}first_index_enum -> index_enum of 'first' index_enum for the system |
|
3738
|
|
|
|
|
|
|
# |
|
3739
|
|
|
|
|
|
|
# ; Data record for the index ("File"). Wrapped using 'Storable' or 'Data::Dumper' |
|
3740
|
|
|
|
|
|
|
# $INDEX_ENUM_DATA_data -> data |
|
3741
|
|
|
|
|
|
|
# |
|
3742
|
|
|
|
|
|
|
# ; The 'high water' mark used in assigning new group_enum keys |
|
3743
|
|
|
|
|
|
|
# group_enum_counter -> # (12 digit hex number) |
|
3744
|
|
|
|
|
|
|
# |
|
3745
|
|
|
|
|
|
|
# ; Maps a group's name to its assigned group enumeration key |
|
3746
|
|
|
|
|
|
|
# $GROUP -> group_enum |
|
3747
|
|
|
|
|
|
|
# |
|
3748
|
|
|
|
|
|
|
# ; Maps the assigned group enumeration key to a group and provides |
|
3749
|
|
|
|
|
|
|
# ; pointers to the 'next' and 'previous' groups in the system. |
|
3750
|
|
|
|
|
|
|
# $GROUP_ENUM -> _prev_group_enum_ _next_group_enum_ $group |
|
3751
|
|
|
|
|
|
|
# |
|
3752
|
|
|
|
|
|
|
# ; Maps the 'first' 'group_enum' for the system |
|
3753
|
|
|
|
|
|
|
# ${GROUP_ENUM}first_group_enum -> group_enum of 'first' group_enum for the system |
|
3754
|
|
|
|
|
|
|
# |
|
3755
|
|
|
|
|
|
|
# ; Counter. Incremented for new keys, decremented for deleted keys. |
|
3756
|
|
|
|
|
|
|
# $GROUP_ENUM_DATA_number_of_keys -> # (decimal integer) |
|
3757
|
|
|
|
|
|
|
# |
|
3758
|
|
|
|
|
|
|
# ; Counter. Incremented for new indexes, decremented for deleted indexes. |
|
3759
|
|
|
|
|
|
|
# $GROUP_ENUM_DATA_number_of_indexes -> # (decimal integer) |
|
3760
|
|
|
|
|
|
|
# |
|
3761
|
|
|
|
|
|
|
# ; 'High water' mark used in assigning new key_enum values for keys |
|
3762
|
|
|
|
|
|
|
# $GROUP_ENUM_DATA_key_enum_counter -> # (12 digit hex number) |
|
3763
|
|
|
|
|
|
|
# |
|
3764
|
|
|
|
|
|
|
# ; Maps the 'first' 'key_enum' for the group |
|
3765
|
|
|
|
|
|
|
# $GROUP_ENUM_DATA_first_key_enum -> key_enum of 'first' key_enum |
|
3766
|
|
|
|
|
|
|
# |
|
3767
|
|
|
|
|
|
|
# ; Maps the 'first' 'index_enum' for the group |
|
3768
|
|
|
|
|
|
|
# $GROUP_ENUM_DATA_first_index_enum -> index_enum of 'first' index_enum for the group |
|
3769
|
|
|
|
|
|
|
# |
|
3770
|
|
|
|
|
|
|
# ; network order packed list of (6 byte) key_enums and |
|
3771
|
|
|
|
|
|
|
# ; (16 bit signed) relevance rankings for the specified group_enum |
|
3772
|
|
|
|
|
|
|
# ; and index_enum |
|
3773
|
|
|
|
|
|
|
# $GROUP_ENUM_DATA$INDEXED_KEY_LIST -> key_list |
|
3774
|
|
|
|
|
|
|
# |
|
3775
|
|
|
|
|
|
|
# ; Pointers to the 'next' and 'previous' index_enums for this group. |
|
3776
|
|
|
|
|
|
|
# $GROUP_ENUM_DATA$INDEX_ENUM_GROUP_CHAIN -> _prev_index_enum_ _next_index_enum_ |
|
3777
|
|
|
|
|
|
|
# |
|
3778
|
|
|
|
|
|
|
# ; network order packed list of (6 byte) index_enums |
|
3779
|
|
|
|
|
|
|
# ; and (16 bit signed) relevance rankings for the specified group_enum |
|
3780
|
|
|
|
|
|
|
# ; and key_enum |
|
3781
|
|
|
|
|
|
|
# $GROUP_ENUM_DATA$KEYED_INDEX_LIST -> index_list |
|
3782
|
|
|
|
|
|
|
# |
|
3783
|
|
|
|
|
|
|
# ; Maps 'key's to 'key_enum's |
|
3784
|
|
|
|
|
|
|
# $GROUP_ENUM_DATA$KEY_TO_KEY_ENUM -> key_enum |
|
3785
|
|
|
|
|
|
|
# |
|
3786
|
|
|
|
|
|
|
# ; Maps 'key_enum's to 'key's and provides pointers to the |
|
3787
|
|
|
|
|
|
|
# ; 'next' and 'previous' keys for the group |
|
3788
|
|
|
|
|
|
|
# $GROUP_ENUM_DATA$KEY_ENUM_TO_KEY_AND_CHAIN -> _prev_key_enum_ _next_key_enum_ key |
|
3789
|
|
|
|
|
|
|
# |
|
3790
|
|
|
|
|
|
|
|
|
3791
|
|
|
|
|
|
|
=head1 VERSION |
|
3792
|
|
|
|
|
|
|
|
|
3793
|
|
|
|
|
|
|
1.14 |
|
3794
|
|
|
|
|
|
|
|
|
3795
|
|
|
|
|
|
|
=head1 COPYRIGHT |
|
3796
|
|
|
|
|
|
|
|
|
3797
|
|
|
|
|
|
|
Copyright 1999-2002, Benjamin Franz () and |
|
3798
|
|
|
|
|
|
|
FreeRun Technologies, Inc. (). All Rights Reserved. |
|
3799
|
|
|
|
|
|
|
This software may be copied or redistributed under the same terms as Perl itelf. |
|
3800
|
|
|
|
|
|
|
|
|
3801
|
|
|
|
|
|
|
=head1 AUTHOR |
|
3802
|
|
|
|
|
|
|
|
|
3803
|
|
|
|
|
|
|
Benjamin Franz |
|
3804
|
|
|
|
|
|
|
|
|
3805
|
|
|
|
|
|
|
=head1 TODO |
|
3806
|
|
|
|
|
|
|
|
|
3807
|
|
|
|
|
|
|
Integrate code and documentation patches from Kate Pugh. Seperate POD into .pod files. |
|
3808
|
|
|
|
|
|
|
|
|
3809
|
|
|
|
|
|
|
Concept item for evaluation: By storing a dense list of all indexed keywords, |
|
3810
|
|
|
|
|
|
|
you would be able to use a regular expression or other fuzzy search matching |
|
3811
|
|
|
|
|
|
|
scheme comparatively efficiently, locate possible words via a grep and then |
|
3812
|
|
|
|
|
|
|
search on the possibilities. Seems to make sense to implement that as _another_ |
|
3813
|
|
|
|
|
|
|
module that uses this module as a backend. 'Search::InvertedIndex::Fuzzy' perhaps. |
|
3814
|
|
|
|
|
|
|
|
|
3815
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
3816
|
|
|
|
|
|
|
|
|
3817
|
|
|
|
|
|
|
Search::InvertedIndex::Query Search::InvertedIndex::Query::Leaf |
|
3818
|
|
|
|
|
|
|
Search::InvertedIndex::Result Search::InvertedIndex::Update |
|
3819
|
|
|
|
|
|
|
Search::InvertedIndex::DB::DB_File_SplitHash |
|
3820
|
|
|
|
|
|
|
Search::InvertedIndex::DB::Mysql |
|
3821
|
|
|
|
|
|
|
|
|
3822
|
|
|
|
|
|
|
=cut |
|
3823
|
|
|
|
|
|
|
|
|
3824
|
|
|
|
|
|
|
1; |