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; |