File Coverage

lib/Search/InvertedIndex.pm
Criterion Covered Total %
statement 21 1504 1.4
branch 0 814 0.0
condition 0 96 0.0
subroutine 7 62 11.2
pod 39 41 95.1
total 67 2517 2.6


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;