Removed debug flag from code and POD
[dbsrgits/DBM-Deep.git] / lib / DBM / Deep.pm
1 package DBM::Deep;
2
3 ##
4 # DBM::Deep
5 #
6 # Description:
7 #       Multi-level database module for storing hash trees, arrays and simple
8 #       key/value pairs into FTP-able, cross-platform binary database files.
9 #
10 #       Type `perldoc DBM::Deep` for complete documentation.
11 #
12 # Usage Examples:
13 #       my %db;
14 #       tie %db, 'DBM::Deep', 'my_database.db'; # standard tie() method
15 #       
16 #       my $db = new DBM::Deep( 'my_database.db' ); # preferred OO method
17 #
18 #       $db->{my_scalar} = 'hello world';
19 #       $db->{my_hash} = { larry => 'genius', hashes => 'fast' };
20 #       $db->{my_array} = [ 1, 2, 3, time() ];
21 #       $db->{my_complex} = [ 'hello', { perl => 'rules' }, 42, 99 ];
22 #       push @{$db->{my_array}}, 'another value';
23 #       my @key_list = keys %{$db->{my_hash}};
24 #       print "This module " . $db->{my_complex}->[1]->{perl} . "!\n";
25 #
26 # Copyright:
27 #       (c) 2002-2006 Joseph Huckaby.  All Rights Reserved.
28 #       This program is free software; you can redistribute it and/or 
29 #       modify it under the same terms as Perl itself.
30 ##
31
32 use strict;
33
34 use Fcntl qw( :DEFAULT :flock :seek );
35 use Digest::MD5 ();
36 use Scalar::Util ();
37
38 use DBM::Deep::Engine;
39
40 use vars qw( $VERSION );
41 $VERSION = q(0.99_01);
42
43
44 ##
45 # Setup file and tag signatures.  These should never change.
46 ##
47 sub SIG_FILE   () { 'DPDB' }
48 sub SIG_HASH   () { 'H' }
49 sub SIG_ARRAY  () { 'A' }
50 sub SIG_SCALAR () { 'S' }
51 sub SIG_NULL   () { 'N' }
52 sub SIG_DATA   () { 'D' }
53 sub SIG_INDEX  () { 'I' }
54 sub SIG_BLIST  () { 'B' }
55 sub SIG_SIZE   () {  1  }
56
57 ##
58 # Setup constants for users to pass to new()
59 ##
60 sub TYPE_HASH   () { SIG_HASH   }
61 sub TYPE_ARRAY  () { SIG_ARRAY  }
62 sub TYPE_SCALAR () { SIG_SCALAR }
63
64 sub _get_args {
65     my $proto = shift;
66
67     my $args;
68     if (scalar(@_) > 1) {
69         if ( @_ % 2 ) {
70             $proto->_throw_error( "Odd number of parameters to " . (caller(1))[2] );
71         }
72         $args = {@_};
73     }
74         elsif ( ref $_[0] ) {
75         unless ( eval { local $SIG{'__DIE__'}; %{$_[0]} || 1 } ) {
76             $proto->_throw_error( "Not a hashref in args to " . (caller(1))[2] );
77         }
78         $args = $_[0];
79     }
80         else {
81         $args = { file => shift };
82     }
83
84     return $args;
85 }
86
87 sub new {
88         ##
89         # Class constructor method for Perl OO interface.
90         # Calls tie() and returns blessed reference to tied hash or array,
91         # providing a hybrid OO/tie interface.
92         ##
93         my $class = shift;
94         my $args = $class->_get_args( @_ );
95         
96         ##
97         # Check if we want a tied hash or array.
98         ##
99         my $self;
100         if (defined($args->{type}) && $args->{type} eq TYPE_ARRAY) {
101         $class = 'DBM::Deep::Array';
102         require DBM::Deep::Array;
103                 tie @$self, $class, %$args;
104         }
105         else {
106         $class = 'DBM::Deep::Hash';
107         require DBM::Deep::Hash;
108                 tie %$self, $class, %$args;
109         }
110
111         return bless $self, $class;
112 }
113
114 sub _init {
115     ##
116     # Setup $self and bless into this class.
117     ##
118     my $class = shift;
119     my $args = shift;
120
121     # These are the defaults to be optionally overridden below
122     my $self = bless {
123         type        => TYPE_HASH,
124         base_offset => length(SIG_FILE),
125         engine      => 'DBM::Deep::Engine',
126     }, $class;
127
128     foreach my $param ( keys %$self ) {
129         next unless exists $args->{$param};
130         $self->{$param} = delete $args->{$param}
131     }
132     
133     # locking implicitly enables autoflush
134     if ($args->{locking}) { $args->{autoflush} = 1; }
135     
136     $self->{root} = exists $args->{root}
137         ? $args->{root}
138         : DBM::Deep::_::Root->new( $args );
139
140     if (!defined($self->_fh)) { $self->{engine}->open( $self ); }
141
142     return $self;
143 }
144
145 sub TIEHASH {
146     shift;
147     require DBM::Deep::Hash;
148     return DBM::Deep::Hash->TIEHASH( @_ );
149 }
150
151 sub TIEARRAY {
152     shift;
153     require DBM::Deep::Array;
154     return DBM::Deep::Array->TIEARRAY( @_ );
155 }
156
157 #XXX Unneeded now ...
158 #sub DESTROY {
159 #}
160
161 sub lock {
162         ##
163         # If db locking is set, flock() the db file.  If called multiple
164         # times before unlock(), then the same number of unlocks() must
165         # be called before the lock is released.
166         ##
167     my $self = $_[0]->_get_self;
168         my $type = $_[1];
169     $type = LOCK_EX unless defined $type;
170         
171         if (!defined($self->_fh)) { return; }
172
173         if ($self->_root->{locking}) {
174                 if (!$self->_root->{locked}) {
175                         flock($self->_fh, $type);
176                         
177                         # refresh end counter in case file has changed size
178                         my @stats = stat($self->_root->{file});
179                         $self->_root->{end} = $stats[7];
180                         
181                         # double-check file inode, in case another process
182                         # has optimize()d our file while we were waiting.
183                         if ($stats[1] != $self->_root->{inode}) {
184                                 $self->{engine}->open( $self ); # re-open
185                                 flock($self->_fh, $type); # re-lock
186                                 $self->_root->{end} = (stat($self->_fh))[7]; # re-end
187                         }
188                 }
189                 $self->_root->{locked}++;
190
191         return 1;
192         }
193
194     return;
195 }
196
197 sub unlock {
198         ##
199         # If db locking is set, unlock the db file.  See note in lock()
200         # regarding calling lock() multiple times.
201         ##
202     my $self = $_[0]->_get_self;
203
204         if (!defined($self->_fh)) { return; }
205         
206         if ($self->_root->{locking} && $self->_root->{locked} > 0) {
207                 $self->_root->{locked}--;
208                 if (!$self->_root->{locked}) { flock($self->_fh, LOCK_UN); }
209
210         return 1;
211         }
212
213     return;
214 }
215
216 sub _copy_value {
217     my $self = shift->_get_self;
218     my ($spot, $value) = @_;
219
220     if ( !ref $value ) {
221         ${$spot} = $value;
222     }
223     elsif ( eval { local $SIG{__DIE__}; $value->isa( 'DBM::Deep' ) } ) {
224         my $type = $value->_type;
225         ${$spot} = $type eq TYPE_HASH ? {} : [];
226         $value->_copy_node( ${$spot} );
227     }
228     else {
229         my $r = Scalar::Util::reftype( $value );
230         my $c = Scalar::Util::blessed( $value );
231         if ( $r eq 'ARRAY' ) {
232             ${$spot} = [ @{$value} ];
233         }
234         else {
235             ${$spot} = { %{$value} };
236         }
237         ${$spot} = bless ${$spot}, $c
238             if defined $c;
239     }
240
241     return 1;
242 }
243
244 sub _copy_node {
245         ##
246         # Copy single level of keys or elements to new DB handle.
247         # Recurse for nested structures
248         ##
249     my $self = shift->_get_self;
250         my ($db_temp) = @_;
251
252         if ($self->_type eq TYPE_HASH) {
253                 my $key = $self->first_key();
254                 while ($key) {
255                         my $value = $self->get($key);
256             $self->_copy_value( \$db_temp->{$key}, $value );
257                         $key = $self->next_key($key);
258                 }
259         }
260         else {
261                 my $length = $self->length();
262                 for (my $index = 0; $index < $length; $index++) {
263                         my $value = $self->get($index);
264             $self->_copy_value( \$db_temp->[$index], $value );
265                 }
266         }
267
268     return 1;
269 }
270
271 sub export {
272         ##
273         # Recursively export into standard Perl hashes and arrays.
274         ##
275     my $self = $_[0]->_get_self;
276         
277         my $temp;
278         if ($self->_type eq TYPE_HASH) { $temp = {}; }
279         elsif ($self->_type eq TYPE_ARRAY) { $temp = []; }
280         
281         $self->lock();
282         $self->_copy_node( $temp );
283         $self->unlock();
284         
285         return $temp;
286 }
287
288 sub import {
289         ##
290         # Recursively import Perl hash/array structure
291         ##
292     #XXX This use of ref() seems to be ok
293         if (!ref($_[0])) { return; } # Perl calls import() on use -- ignore
294         
295     my $self = $_[0]->_get_self;
296         my $struct = $_[1];
297         
298     #XXX This use of ref() seems to be ok
299         if (!ref($struct)) {
300                 ##
301                 # struct is not a reference, so just import based on our type
302                 ##
303                 shift @_;
304                 
305                 if ($self->_type eq TYPE_HASH) { $struct = {@_}; }
306                 elsif ($self->_type eq TYPE_ARRAY) { $struct = [@_]; }
307         }
308         
309     my $r = Scalar::Util::reftype($struct) || '';
310         if ($r eq "HASH" && $self->_type eq TYPE_HASH) {
311                 foreach my $key (keys %$struct) { $self->put($key, $struct->{$key}); }
312         }
313         elsif ($r eq "ARRAY" && $self->_type eq TYPE_ARRAY) {
314                 $self->push( @$struct );
315         }
316         else {
317                 return $self->_throw_error("Cannot import: type mismatch");
318         }
319         
320         return 1;
321 }
322
323 sub optimize {
324         ##
325         # Rebuild entire database into new file, then move
326         # it back on top of original.
327         ##
328     my $self = $_[0]->_get_self;
329
330 #XXX Need to create a new test for this
331 #       if ($self->_root->{links} > 1) {
332 #               return $self->_throw_error("Cannot optimize: reference count is greater than 1");
333 #       }
334         
335         my $db_temp = DBM::Deep->new(
336                 file => $self->_root->{file} . '.tmp',
337                 type => $self->_type
338         );
339         if (!$db_temp) {
340                 return $self->_throw_error("Cannot optimize: failed to open temp file: $!");
341         }
342         
343         $self->lock();
344         $self->_copy_node( $db_temp );
345         undef $db_temp;
346         
347         ##
348         # Attempt to copy user, group and permissions over to new file
349         ##
350         my @stats = stat($self->_fh);
351         my $perms = $stats[2] & 07777;
352         my $uid = $stats[4];
353         my $gid = $stats[5];
354         chown( $uid, $gid, $self->_root->{file} . '.tmp' );
355         chmod( $perms, $self->_root->{file} . '.tmp' );
356         
357     # q.v. perlport for more information on this variable
358     if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) {
359                 ##
360                 # Potential race condition when optmizing on Win32 with locking.
361                 # The Windows filesystem requires that the filehandle be closed 
362                 # before it is overwritten with rename().  This could be redone
363                 # with a soft copy.
364                 ##
365                 $self->unlock();
366                 $self->{engine}->close( $self );
367         }
368         
369         if (!rename $self->_root->{file} . '.tmp', $self->_root->{file}) {
370                 unlink $self->_root->{file} . '.tmp';
371                 $self->unlock();
372                 return $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!");
373         }
374         
375         $self->unlock();
376         $self->{engine}->close( $self );
377         $self->{engine}->open( $self );
378         
379         return 1;
380 }
381
382 sub clone {
383         ##
384         # Make copy of object and return
385         ##
386     my $self = $_[0]->_get_self;
387         
388         return DBM::Deep->new(
389                 type => $self->_type,
390                 base_offset => $self->_base_offset,
391                 root => $self->_root
392         );
393 }
394
395 {
396     my %is_legal_filter = map {
397         $_ => ~~1,
398     } qw(
399         store_key store_value
400         fetch_key fetch_value
401     );
402
403     sub set_filter {
404         ##
405         # Setup filter function for storing or fetching the key or value
406         ##
407         my $self = $_[0]->_get_self;
408         my $type = lc $_[1];
409         my $func = $_[2] ? $_[2] : undef;
410         
411         if ( $is_legal_filter{$type} ) {
412             $self->_root->{"filter_$type"} = $func;
413             return 1;
414         }
415
416         return;
417     }
418 }
419
420 ##
421 # Accessor methods
422 ##
423
424 sub _root {
425         ##
426         # Get access to the root structure
427         ##
428     my $self = $_[0]->_get_self;
429         return $self->{root};
430 }
431
432 sub _fh {
433         ##
434         # Get access to the raw fh
435         ##
436     #XXX It will be useful, though, when we split out HASH and ARRAY
437     my $self = $_[0]->_get_self;
438         return $self->_root->{fh};
439 }
440
441 sub _type {
442         ##
443         # Get type of current node (TYPE_HASH or TYPE_ARRAY)
444         ##
445     my $self = $_[0]->_get_self;
446         return $self->{type};
447 }
448
449 sub _base_offset {
450         ##
451         # Get base_offset of current node (TYPE_HASH or TYPE_ARRAY)
452         ##
453     my $self = $_[0]->_get_self;
454         return $self->{base_offset};
455 }
456
457 ##
458 # Utility methods
459 ##
460
461 sub _throw_error {
462     die "DBM::Deep: $_[1]\n";
463 }
464
465 sub _is_writable {
466     my $fh = shift;
467     (O_WRONLY | O_RDWR) & fcntl( $fh, F_GETFL, my $slush = 0);
468 }
469
470 #sub _is_readable {
471 #    my $fh = shift;
472 #    (O_RDONLY | O_RDWR) & fcntl( $fh, F_GETFL, my $slush = 0);
473 #}
474
475 ##
476 # tie() methods (hashes and arrays)
477 ##
478
479 sub STORE {
480         ##
481         # Store single hash key/value or array element in database.
482         ##
483     my $self = $_[0]->_get_self;
484         my $key = $_[1];
485
486     # User may be storing a hash, in which case we do not want it run 
487     # through the filtering system
488         my $value = ($self->_root->{filter_store_value} && !ref($_[2]))
489         ? $self->_root->{filter_store_value}->($_[2])
490         : $_[2];
491         
492         my $md5 = $DBM::Deep::Engine::DIGEST_FUNC->($key);
493         
494     unless ( _is_writable( $self->_fh ) ) {
495         $self->_throw_error( 'Cannot write to a readonly filehandle' );
496     }
497         
498         ##
499         # Request exclusive lock for writing
500         ##
501         $self->lock( LOCK_EX );
502         
503         my $fh = $self->_fh;
504         
505         ##
506         # Locate offset for bucket list using digest index system
507         ##
508         my $tag = $self->{engine}->load_tag($self, $self->_base_offset);
509         if (!$tag) {
510                 $tag = $self->{engine}->create_tag($self, $self->_base_offset, SIG_INDEX, chr(0) x $DBM::Deep::Engine::INDEX_SIZE);
511         }
512         
513         my $ch = 0;
514         while ($tag->{signature} ne SIG_BLIST) {
515                 my $num = ord(substr($md5, $ch, 1));
516
517         my $ref_loc = $tag->{offset} + ($num * $DBM::Deep::Engine::LONG_SIZE);
518                 my $new_tag = $self->{engine}->index_lookup($self, $tag, $num);
519
520                 if (!$new_tag) {
521                         seek($fh, $ref_loc + $self->_root->{file_offset}, SEEK_SET);
522                         print( $fh pack($DBM::Deep::Engine::LONG_PACK, $self->_root->{end}) );
523                         
524                         $tag = $self->{engine}->create_tag($self, $self->_root->{end}, SIG_BLIST, chr(0) x $DBM::Deep::Engine::BUCKET_LIST_SIZE);
525
526                         $tag->{ref_loc} = $ref_loc;
527                         $tag->{ch} = $ch;
528
529                         last;
530                 }
531                 else {
532                         $tag = $new_tag;
533
534                         $tag->{ref_loc} = $ref_loc;
535                         $tag->{ch} = $ch;
536                 }
537                 $ch++;
538         }
539         
540         ##
541         # Add key/value to bucket list
542         ##
543         my $result = $self->{engine}->add_bucket( $self, $tag, $md5, $key, $value );
544         
545         $self->unlock();
546
547         return $result;
548 }
549
550 sub FETCH {
551         ##
552         # Fetch single value or element given plain key or array index
553         ##
554     my $self = shift->_get_self;
555     my $key = shift;
556
557         my $md5 = $DBM::Deep::Engine::DIGEST_FUNC->($key);
558
559         ##
560         # Request shared lock for reading
561         ##
562         $self->lock( LOCK_SH );
563         
564         my $tag = $self->{engine}->find_bucket_list( $self, $md5 );
565         if (!$tag) {
566                 $self->unlock();
567                 return;
568         }
569         
570         ##
571         # Get value from bucket list
572         ##
573         my $result = $self->{engine}->get_bucket_value( $self, $tag, $md5 );
574         
575         $self->unlock();
576         
577     #XXX What is ref() checking here?
578     #YYY Filters only apply on scalar values, so the ref check is making
579     #YYY sure the fetched bucket is a scalar, not a child hash or array.
580         return ($result && !ref($result) && $self->_root->{filter_fetch_value})
581         ? $self->_root->{filter_fetch_value}->($result)
582         : $result;
583 }
584
585 sub DELETE {
586         ##
587         # Delete single key/value pair or element given plain key or array index
588         ##
589     my $self = $_[0]->_get_self;
590         my $key = $_[1];
591         
592         my $md5 = $DBM::Deep::Engine::DIGEST_FUNC->($key);
593
594         ##
595         # Request exclusive lock for writing
596         ##
597         $self->lock( LOCK_EX );
598         
599         my $tag = $self->{engine}->find_bucket_list( $self, $md5 );
600         if (!$tag) {
601                 $self->unlock();
602                 return;
603         }
604         
605         ##
606         # Delete bucket
607         ##
608     my $value = $self->{engine}->get_bucket_value($self,  $tag, $md5 );
609         if ($value && !ref($value) && $self->_root->{filter_fetch_value}) {
610         $value = $self->_root->{filter_fetch_value}->($value);
611     }
612
613         my $result = $self->{engine}->delete_bucket( $self, $tag, $md5 );
614         
615         ##
616         # If this object is an array and the key deleted was on the end of the stack,
617         # decrement the length variable.
618         ##
619         
620         $self->unlock();
621         
622         return $value;
623 }
624
625 sub EXISTS {
626         ##
627         # Check if a single key or element exists given plain key or array index
628         ##
629     my $self = $_[0]->_get_self;
630         my $key = $_[1];
631         
632         my $md5 = $DBM::Deep::Engine::DIGEST_FUNC->($key);
633
634         ##
635         # Request shared lock for reading
636         ##
637         $self->lock( LOCK_SH );
638         
639         my $tag = $self->{engine}->find_bucket_list( $self, $md5 );
640         
641         ##
642         # For some reason, the built-in exists() function returns '' for false
643         ##
644         if (!$tag) {
645                 $self->unlock();
646                 return '';
647         }
648         
649         ##
650         # Check if bucket exists and return 1 or ''
651         ##
652         my $result = $self->{engine}->bucket_exists( $self, $tag, $md5 ) || '';
653         
654         $self->unlock();
655         
656         return $result;
657 }
658
659 sub CLEAR {
660         ##
661         # Clear all keys from hash, or all elements from array.
662         ##
663     my $self = $_[0]->_get_self;
664
665         ##
666         # Request exclusive lock for writing
667         ##
668         $self->lock( LOCK_EX );
669         
670     my $fh = $self->_fh;
671
672         seek($fh, $self->_base_offset + $self->_root->{file_offset}, SEEK_SET);
673         if (eof $fh) {
674                 $self->unlock();
675                 return;
676         }
677         
678         $self->{engine}->create_tag($self, $self->_base_offset, $self->_type, chr(0) x $DBM::Deep::Engine::INDEX_SIZE);
679         
680         $self->unlock();
681         
682         return 1;
683 }
684
685 ##
686 # Public method aliases
687 ##
688 sub put { (shift)->STORE( @_ ) }
689 sub store { (shift)->STORE( @_ ) }
690 sub get { (shift)->FETCH( @_ ) }
691 sub fetch { (shift)->FETCH( @_ ) }
692 sub delete { (shift)->DELETE( @_ ) }
693 sub exists { (shift)->EXISTS( @_ ) }
694 sub clear { (shift)->CLEAR( @_ ) }
695
696 package DBM::Deep::_::Root;
697
698 sub new {
699     my $class = shift;
700     my ($args) = @_;
701
702     my $self = bless {
703         file               => undef,
704         fh                 => undef,
705         file_offset        => 0,
706         end                => 0,
707         autoflush          => undef,
708         locking            => undef,
709         locked             => 0,
710         filter_store_key   => undef,
711         filter_store_value => undef,
712         filter_fetch_key   => undef,
713         filter_fetch_value => undef,
714         autobless          => undef,
715         %$args,
716     }, $class;
717
718     if ( $self->{fh} && !$self->{file_offset} ) {
719         $self->{file_offset} = tell( $self->{fh} );
720     }
721
722     return $self;
723 }
724
725 sub DESTROY {
726     my $self = shift;
727     return unless $self;
728
729     close $self->{fh} if $self->{fh};
730
731     return;
732 }
733
734 1;
735
736 __END__
737
738 =head1 NAME
739
740 DBM::Deep - A pure perl multi-level hash/array DBM
741
742 =head1 SYNOPSIS
743
744   use DBM::Deep;
745   my $db = DBM::Deep->new( "foo.db" );
746   
747   $db->{key} = 'value'; # tie() style
748   print $db->{key};
749   
750   $db->put('key' => 'value'); # OO style
751   print $db->get('key');
752   
753   # true multi-level support
754   $db->{my_complex} = [
755         'hello', { perl => 'rules' }, 
756         42, 99,
757   ];
758
759 =head1 DESCRIPTION
760
761 A unique flat-file database module, written in pure perl.  True 
762 multi-level hash/array support (unlike MLDBM, which is faked), hybrid 
763 OO / tie() interface, cross-platform FTPable files, and quite fast.  Can 
764 handle millions of keys and unlimited hash levels without significant 
765 slow-down.  Written from the ground-up in pure perl -- this is NOT a 
766 wrapper around a C-based DBM.  Out-of-the-box compatibility with Unix, 
767 Mac OS X and Windows.
768
769 =head1 INSTALLATION
770
771 Hopefully you are using Perl's excellent CPAN module, which will download
772 and install the module for you.  If not, get the tarball, and run these 
773 commands:
774
775         tar zxf DBM-Deep-*
776         cd DBM-Deep-*
777         perl Makefile.PL
778         make
779         make test
780         make install
781
782 =head1 SETUP
783
784 Construction can be done OO-style (which is the recommended way), or using 
785 Perl's tie() function.  Both are examined here.
786
787 =head2 OO CONSTRUCTION
788
789 The recommended way to construct a DBM::Deep object is to use the new()
790 method, which gets you a blessed, tied hash or array reference.
791
792         my $db = DBM::Deep->new( "foo.db" );
793
794 This opens a new database handle, mapped to the file "foo.db".  If this
795 file does not exist, it will automatically be created.  DB files are 
796 opened in "r+" (read/write) mode, and the type of object returned is a
797 hash, unless otherwise specified (see L<OPTIONS> below).
798
799 You can pass a number of options to the constructor to specify things like
800 locking, autoflush, etc.  This is done by passing an inline hash:
801
802         my $db = DBM::Deep->new(
803                 file => "foo.db",
804                 locking => 1,
805                 autoflush => 1
806         );
807
808 Notice that the filename is now specified I<inside> the hash with
809 the "file" parameter, as opposed to being the sole argument to the 
810 constructor.  This is required if any options are specified.
811 See L<OPTIONS> below for the complete list.
812
813
814
815 You can also start with an array instead of a hash.  For this, you must
816 specify the C<type> parameter:
817
818         my $db = DBM::Deep->new(
819                 file => "foo.db",
820                 type => DBM::Deep->TYPE_ARRAY
821         );
822
823 B<Note:> Specifing the C<type> parameter only takes effect when beginning
824 a new DB file.  If you create a DBM::Deep object with an existing file, the
825 C<type> will be loaded from the file header, and an error will be thrown if
826 the wrong type is passed in.
827
828 =head2 TIE CONSTRUCTION
829
830 Alternately, you can create a DBM::Deep handle by using Perl's built-in
831 tie() function.  The object returned from tie() can be used to call methods,
832 such as lock() and unlock(), but cannot be used to assign to the DBM::Deep
833 file (as expected with most tie'd objects).
834
835         my %hash;
836         my $db = tie %hash, "DBM::Deep", "foo.db";
837         
838         my @array;
839         my $db = tie @array, "DBM::Deep", "bar.db";
840
841 As with the OO constructor, you can replace the DB filename parameter with
842 a hash containing one or more options (see L<OPTIONS> just below for the
843 complete list).
844
845         tie %hash, "DBM::Deep", {
846                 file => "foo.db",
847                 locking => 1,
848                 autoflush => 1
849         };
850
851 =head2 OPTIONS
852
853 There are a number of options that can be passed in when constructing your
854 DBM::Deep objects.  These apply to both the OO- and tie- based approaches.
855
856 =over
857
858 =item * file
859
860 Filename of the DB file to link the handle to.  You can pass a full absolute
861 filesystem path, partial path, or a plain filename if the file is in the 
862 current working directory.  This is a required parameter (though q.v. fh).
863
864 =item * fh
865
866 If you want, you can pass in the fh instead of the file. This is most useful for doing
867 something like:
868
869   my $db = DBM::Deep->new( { fh => \*DATA } );
870
871 You are responsible for making sure that the fh has been opened appropriately for your
872 needs. If you open it read-only and attempt to write, an exception will be thrown. If you
873 open it write-only or append-only, an exception will be thrown immediately as DBM::Deep
874 needs to read from the fh.
875
876 =item * file_offset
877
878 This is the offset within the file that the DBM::Deep db starts. Most of the time, you will
879 not need to set this. However, it's there if you want it.
880
881 If you pass in fh and do not set this, it will be set appropriately.
882
883 =item * type
884
885 This parameter specifies what type of object to create, a hash or array.  Use
886 one of these two constants: C<DBM::Deep-E<gt>TYPE_HASH> or C<DBM::Deep-E<gt>TYPE_ARRAY>.
887 This only takes effect when beginning a new file.  This is an optional 
888 parameter, and defaults to C<DBM::Deep-E<gt>TYPE_HASH>.
889
890 =item * locking
891
892 Specifies whether locking is to be enabled.  DBM::Deep uses Perl's Fnctl flock()
893 function to lock the database in exclusive mode for writes, and shared mode for
894 reads.  Pass any true value to enable.  This affects the base DB handle I<and 
895 any child hashes or arrays> that use the same DB file.  This is an optional 
896 parameter, and defaults to 0 (disabled).  See L<LOCKING> below for more.
897
898 =item * autoflush
899
900 Specifies whether autoflush is to be enabled on the underlying filehandle.  
901 This obviously slows down write operations, but is required if you may have 
902 multiple processes accessing the same DB file (also consider enable I<locking>).  
903 Pass any true value to enable.  This is an optional parameter, and defaults to 0 
904 (disabled).
905
906 =item * autobless
907
908 If I<autobless> mode is enabled, DBM::Deep will preserve blessed hashes, and
909 restore them when fetched.  This is an B<experimental> feature, and does have
910 side-effects.  Basically, when hashes are re-blessed into their original
911 classes, they are no longer blessed into the DBM::Deep class!  So you won't be
912 able to call any DBM::Deep methods on them.  You have been warned.
913 This is an optional parameter, and defaults to 0 (disabled).
914
915 =item * filter_*
916
917 See L<FILTERS> below.
918
919 =back
920
921 =head1 TIE INTERFACE
922
923 With DBM::Deep you can access your databases using Perl's standard hash/array
924 syntax.  Because all DBM::Deep objects are I<tied> to hashes or arrays, you can
925 treat them as such.  DBM::Deep will intercept all reads/writes and direct them
926 to the right place -- the DB file.  This has nothing to do with the
927 L<TIE CONSTRUCTION> section above.  This simply tells you how to use DBM::Deep
928 using regular hashes and arrays, rather than calling functions like C<get()>
929 and C<put()> (although those work too).  It is entirely up to you how to want
930 to access your databases.
931
932 =head2 HASHES
933
934 You can treat any DBM::Deep object like a normal Perl hash reference.  Add keys,
935 or even nested hashes (or arrays) using standard Perl syntax:
936
937         my $db = DBM::Deep->new( "foo.db" );
938         
939         $db->{mykey} = "myvalue";
940         $db->{myhash} = {};
941         $db->{myhash}->{subkey} = "subvalue";
942
943         print $db->{myhash}->{subkey} . "\n";
944
945 You can even step through hash keys using the normal Perl C<keys()> function:
946
947         foreach my $key (keys %$db) {
948                 print "$key: " . $db->{$key} . "\n";
949         }
950
951 Remember that Perl's C<keys()> function extracts I<every> key from the hash and
952 pushes them onto an array, all before the loop even begins.  If you have an 
953 extra large hash, this may exhaust Perl's memory.  Instead, consider using 
954 Perl's C<each()> function, which pulls keys/values one at a time, using very 
955 little memory:
956
957         while (my ($key, $value) = each %$db) {
958                 print "$key: $value\n";
959         }
960
961 Please note that when using C<each()>, you should always pass a direct
962 hash reference, not a lookup.  Meaning, you should B<never> do this:
963
964         # NEVER DO THIS
965         while (my ($key, $value) = each %{$db->{foo}}) { # BAD
966
967 This causes an infinite loop, because for each iteration, Perl is calling
968 FETCH() on the $db handle, resulting in a "new" hash for foo every time, so
969 it effectively keeps returning the first key over and over again. Instead, 
970 assign a temporary variable to C<$db->{foo}>, then pass that to each().
971
972 =head2 ARRAYS
973
974 As with hashes, you can treat any DBM::Deep object like a normal Perl array
975 reference.  This includes inserting, removing and manipulating elements, 
976 and the C<push()>, C<pop()>, C<shift()>, C<unshift()> and C<splice()> functions.
977 The object must have first been created using type C<DBM::Deep-E<gt>TYPE_ARRAY>, 
978 or simply be a nested array reference inside a hash.  Example:
979
980         my $db = DBM::Deep->new(
981                 file => "foo-array.db",
982                 type => DBM::Deep->TYPE_ARRAY
983         );
984         
985         $db->[0] = "foo";
986         push @$db, "bar", "baz";
987         unshift @$db, "bah";
988         
989         my $last_elem = pop @$db; # baz
990         my $first_elem = shift @$db; # bah
991         my $second_elem = $db->[1]; # bar
992         
993         my $num_elements = scalar @$db;
994
995 =head1 OO INTERFACE
996
997 In addition to the I<tie()> interface, you can also use a standard OO interface
998 to manipulate all aspects of DBM::Deep databases.  Each type of object (hash or
999 array) has its own methods, but both types share the following common methods: 
1000 C<put()>, C<get()>, C<exists()>, C<delete()> and C<clear()>.
1001
1002 =over
1003
1004 =item * new() / clone()
1005
1006 These are the constructor and copy-functions.
1007
1008 =item * put() / store()
1009
1010 Stores a new hash key/value pair, or sets an array element value.  Takes two
1011 arguments, the hash key or array index, and the new value.  The value can be
1012 a scalar, hash ref or array ref.  Returns true on success, false on failure.
1013
1014         $db->put("foo", "bar"); # for hashes
1015         $db->put(1, "bar"); # for arrays
1016
1017 =item * get() / fetch()
1018
1019 Fetches the value of a hash key or array element.  Takes one argument: the hash
1020 key or array index.  Returns a scalar, hash ref or array ref, depending on the 
1021 data type stored.
1022
1023         my $value = $db->get("foo"); # for hashes
1024         my $value = $db->get(1); # for arrays
1025
1026 =item * exists()
1027
1028 Checks if a hash key or array index exists.  Takes one argument: the hash key 
1029 or array index.  Returns true if it exists, false if not.
1030
1031         if ($db->exists("foo")) { print "yay!\n"; } # for hashes
1032         if ($db->exists(1)) { print "yay!\n"; } # for arrays
1033
1034 =item * delete()
1035
1036 Deletes one hash key/value pair or array element.  Takes one argument: the hash
1037 key or array index.  Returns true on success, false if not found.  For arrays,
1038 the remaining elements located after the deleted element are NOT moved over.
1039 The deleted element is essentially just undefined, which is exactly how Perl's
1040 internal arrays work.  Please note that the space occupied by the deleted 
1041 key/value or element is B<not> reused again -- see L<UNUSED SPACE RECOVERY> 
1042 below for details and workarounds.
1043
1044         $db->delete("foo"); # for hashes
1045         $db->delete(1); # for arrays
1046
1047 =item * clear()
1048
1049 Deletes B<all> hash keys or array elements.  Takes no arguments.  No return 
1050 value.  Please note that the space occupied by the deleted keys/values or 
1051 elements is B<not> reused again -- see L<UNUSED SPACE RECOVERY> below for 
1052 details and workarounds.
1053
1054         $db->clear(); # hashes or arrays
1055
1056 =item * lock() / unlock()
1057
1058 q.v. Locking.
1059
1060 =item * optimize()
1061
1062 Recover lost disk space.
1063
1064 =item * import() / export()
1065
1066 Data going in and out.
1067
1068 =item * set_digest() / set_pack() / set_filter()
1069
1070 q.v. adjusting the interal parameters.
1071
1072 =back
1073
1074 =head2 HASHES
1075
1076 For hashes, DBM::Deep supports all the common methods described above, and the 
1077 following additional methods: C<first_key()> and C<next_key()>.
1078
1079 =over
1080
1081 =item * first_key()
1082
1083 Returns the "first" key in the hash.  As with built-in Perl hashes, keys are 
1084 fetched in an undefined order (which appears random).  Takes no arguments, 
1085 returns the key as a scalar value.
1086
1087         my $key = $db->first_key();
1088
1089 =item * next_key()
1090
1091 Returns the "next" key in the hash, given the previous one as the sole argument.
1092 Returns undef if there are no more keys to be fetched.
1093
1094         $key = $db->next_key($key);
1095
1096 =back
1097
1098 Here are some examples of using hashes:
1099
1100         my $db = DBM::Deep->new( "foo.db" );
1101         
1102         $db->put("foo", "bar");
1103         print "foo: " . $db->get("foo") . "\n";
1104         
1105         $db->put("baz", {}); # new child hash ref
1106         $db->get("baz")->put("buz", "biz");
1107         print "buz: " . $db->get("baz")->get("buz") . "\n";
1108         
1109         my $key = $db->first_key();
1110         while ($key) {
1111                 print "$key: " . $db->get($key) . "\n";
1112                 $key = $db->next_key($key);     
1113         }
1114         
1115         if ($db->exists("foo")) { $db->delete("foo"); }
1116
1117 =head2 ARRAYS
1118
1119 For arrays, DBM::Deep supports all the common methods described above, and the 
1120 following additional methods: C<length()>, C<push()>, C<pop()>, C<shift()>, 
1121 C<unshift()> and C<splice()>.
1122
1123 =over
1124
1125 =item * length()
1126
1127 Returns the number of elements in the array.  Takes no arguments.
1128
1129         my $len = $db->length();
1130
1131 =item * push()
1132
1133 Adds one or more elements onto the end of the array.  Accepts scalars, hash 
1134 refs or array refs.  No return value.
1135
1136         $db->push("foo", "bar", {});
1137
1138 =item * pop()
1139
1140 Fetches the last element in the array, and deletes it.  Takes no arguments.
1141 Returns undef if array is empty.  Returns the element value.
1142
1143         my $elem = $db->pop();
1144
1145 =item * shift()
1146
1147 Fetches the first element in the array, deletes it, then shifts all the 
1148 remaining elements over to take up the space.  Returns the element value.  This 
1149 method is not recommended with large arrays -- see L<LARGE ARRAYS> below for 
1150 details.
1151
1152         my $elem = $db->shift();
1153
1154 =item * unshift()
1155
1156 Inserts one or more elements onto the beginning of the array, shifting all 
1157 existing elements over to make room.  Accepts scalars, hash refs or array refs.  
1158 No return value.  This method is not recommended with large arrays -- see 
1159 <LARGE ARRAYS> below for details.
1160
1161         $db->unshift("foo", "bar", {});
1162
1163 =item * splice()
1164
1165 Performs exactly like Perl's built-in function of the same name.  See L<perldoc 
1166 -f splice> for usage -- it is too complicated to document here.  This method is
1167 not recommended with large arrays -- see L<LARGE ARRAYS> below for details.
1168
1169 =back
1170
1171 Here are some examples of using arrays:
1172
1173         my $db = DBM::Deep->new(
1174                 file => "foo.db",
1175                 type => DBM::Deep->TYPE_ARRAY
1176         );
1177         
1178         $db->push("bar", "baz");
1179         $db->unshift("foo");
1180         $db->put(3, "buz");
1181         
1182         my $len = $db->length();
1183         print "length: $len\n"; # 4
1184         
1185         for (my $k=0; $k<$len; $k++) {
1186                 print "$k: " . $db->get($k) . "\n";
1187         }
1188         
1189         $db->splice(1, 2, "biz", "baf");
1190         
1191         while (my $elem = shift @$db) {
1192                 print "shifted: $elem\n";
1193         }
1194
1195 =head1 LOCKING
1196
1197 Enable automatic file locking by passing a true value to the C<locking> 
1198 parameter when constructing your DBM::Deep object (see L<SETUP> above).
1199
1200         my $db = DBM::Deep->new(
1201                 file => "foo.db",
1202                 locking => 1
1203         );
1204
1205 This causes DBM::Deep to C<flock()> the underlying filehandle with exclusive 
1206 mode for writes, and shared mode for reads.  This is required if you have 
1207 multiple processes accessing the same database file, to avoid file corruption.  
1208 Please note that C<flock()> does NOT work for files over NFS.  See L<DB OVER 
1209 NFS> below for more.
1210
1211 =head2 EXPLICIT LOCKING
1212
1213 You can explicitly lock a database, so it remains locked for multiple 
1214 transactions.  This is done by calling the C<lock()> method, and passing an 
1215 optional lock mode argument (defaults to exclusive mode).  This is particularly
1216 useful for things like counters, where the current value needs to be fetched, 
1217 then incremented, then stored again.
1218
1219         $db->lock();
1220         my $counter = $db->get("counter");
1221         $counter++;
1222         $db->put("counter", $counter);
1223         $db->unlock();
1224
1225         # or...
1226         
1227         $db->lock();
1228         $db->{counter}++;
1229         $db->unlock();
1230
1231 You can pass C<lock()> an optional argument, which specifies which mode to use
1232 (exclusive or shared).  Use one of these two constants: C<DBM::Deep-E<gt>LOCK_EX> 
1233 or C<DBM::Deep-E<gt>LOCK_SH>.  These are passed directly to C<flock()>, and are the 
1234 same as the constants defined in Perl's C<Fcntl> module.
1235
1236         $db->lock( DBM::Deep->LOCK_SH );
1237         # something here
1238         $db->unlock();
1239
1240 =head1 IMPORTING/EXPORTING
1241
1242 You can import existing complex structures by calling the C<import()> method,
1243 and export an entire database into an in-memory structure using the C<export()>
1244 method.  Both are examined here.
1245
1246 =head2 IMPORTING
1247
1248 Say you have an existing hash with nested hashes/arrays inside it.  Instead of
1249 walking the structure and adding keys/elements to the database as you go, 
1250 simply pass a reference to the C<import()> method.  This recursively adds 
1251 everything to an existing DBM::Deep object for you.  Here is an example:
1252
1253         my $struct = {
1254                 key1 => "value1",
1255                 key2 => "value2",
1256                 array1 => [ "elem0", "elem1", "elem2" ],
1257                 hash1 => {
1258                         subkey1 => "subvalue1",
1259                         subkey2 => "subvalue2"
1260                 }
1261         };
1262         
1263         my $db = DBM::Deep->new( "foo.db" );
1264         $db->import( $struct );
1265         
1266         print $db->{key1} . "\n"; # prints "value1"
1267
1268 This recursively imports the entire C<$struct> object into C<$db>, including 
1269 all nested hashes and arrays.  If the DBM::Deep object contains exsiting data,
1270 keys are merged with the existing ones, replacing if they already exist.  
1271 The C<import()> method can be called on any database level (not just the base 
1272 level), and works with both hash and array DB types.
1273
1274 B<Note:> Make sure your existing structure has no circular references in it.
1275 These will cause an infinite loop when importing.
1276
1277 =head2 EXPORTING
1278
1279 Calling the C<export()> method on an existing DBM::Deep object will return 
1280 a reference to a new in-memory copy of the database.  The export is done 
1281 recursively, so all nested hashes/arrays are all exported to standard Perl
1282 objects.  Here is an example:
1283
1284         my $db = DBM::Deep->new( "foo.db" );
1285         
1286         $db->{key1} = "value1";
1287         $db->{key2} = "value2";
1288         $db->{hash1} = {};
1289         $db->{hash1}->{subkey1} = "subvalue1";
1290         $db->{hash1}->{subkey2} = "subvalue2";
1291         
1292         my $struct = $db->export();
1293         
1294         print $struct->{key1} . "\n"; # prints "value1"
1295
1296 This makes a complete copy of the database in memory, and returns a reference
1297 to it.  The C<export()> method can be called on any database level (not just 
1298 the base level), and works with both hash and array DB types.  Be careful of 
1299 large databases -- you can store a lot more data in a DBM::Deep object than an 
1300 in-memory Perl structure.
1301
1302 B<Note:> Make sure your database has no circular references in it.
1303 These will cause an infinite loop when exporting.
1304
1305 =head1 FILTERS
1306
1307 DBM::Deep has a number of hooks where you can specify your own Perl function
1308 to perform filtering on incoming or outgoing data.  This is a perfect
1309 way to extend the engine, and implement things like real-time compression or
1310 encryption.  Filtering applies to the base DB level, and all child hashes / 
1311 arrays.  Filter hooks can be specified when your DBM::Deep object is first 
1312 constructed, or by calling the C<set_filter()> method at any time.  There are 
1313 four available filter hooks, described below:
1314
1315 =over
1316
1317 =item * filter_store_key
1318
1319 This filter is called whenever a hash key is stored.  It 
1320 is passed the incoming key, and expected to return a transformed key.
1321
1322 =item * filter_store_value
1323
1324 This filter is called whenever a hash key or array element is stored.  It 
1325 is passed the incoming value, and expected to return a transformed value.
1326
1327 =item * filter_fetch_key
1328
1329 This filter is called whenever a hash key is fetched (i.e. via 
1330 C<first_key()> or C<next_key()>).  It is passed the transformed key,
1331 and expected to return the plain key.
1332
1333 =item * filter_fetch_value
1334
1335 This filter is called whenever a hash key or array element is fetched.  
1336 It is passed the transformed value, and expected to return the plain value.
1337
1338 =back
1339
1340 Here are the two ways to setup a filter hook:
1341
1342         my $db = DBM::Deep->new(
1343                 file => "foo.db",
1344                 filter_store_value => \&my_filter_store,
1345                 filter_fetch_value => \&my_filter_fetch
1346         );
1347         
1348         # or...
1349         
1350         $db->set_filter( "filter_store_value", \&my_filter_store );
1351         $db->set_filter( "filter_fetch_value", \&my_filter_fetch );
1352
1353 Your filter function will be called only when dealing with SCALAR keys or
1354 values.  When nested hashes and arrays are being stored/fetched, filtering
1355 is bypassed.  Filters are called as static functions, passed a single SCALAR 
1356 argument, and expected to return a single SCALAR value.  If you want to
1357 remove a filter, set the function reference to C<undef>:
1358
1359         $db->set_filter( "filter_store_value", undef );
1360
1361 =head2 REAL-TIME ENCRYPTION EXAMPLE
1362
1363 Here is a working example that uses the I<Crypt::Blowfish> module to 
1364 do real-time encryption / decryption of keys & values with DBM::Deep Filters.
1365 Please visit L<http://search.cpan.org/search?module=Crypt::Blowfish> for more 
1366 on I<Crypt::Blowfish>.  You'll also need the I<Crypt::CBC> module.
1367
1368         use DBM::Deep;
1369         use Crypt::Blowfish;
1370         use Crypt::CBC;
1371         
1372         my $cipher = Crypt::CBC->new({
1373                 'key'             => 'my secret key',
1374                 'cipher'          => 'Blowfish',
1375                 'iv'              => '$KJh#(}q',
1376                 'regenerate_key'  => 0,
1377                 'padding'         => 'space',
1378                 'prepend_iv'      => 0
1379         });
1380         
1381         my $db = DBM::Deep->new(
1382                 file => "foo-encrypt.db",
1383                 filter_store_key => \&my_encrypt,
1384                 filter_store_value => \&my_encrypt,
1385                 filter_fetch_key => \&my_decrypt,
1386                 filter_fetch_value => \&my_decrypt,
1387         );
1388         
1389         $db->{key1} = "value1";
1390         $db->{key2} = "value2";
1391         print "key1: " . $db->{key1} . "\n";
1392         print "key2: " . $db->{key2} . "\n";
1393         
1394         undef $db;
1395         exit;
1396         
1397         sub my_encrypt {
1398                 return $cipher->encrypt( $_[0] );
1399         }
1400         sub my_decrypt {
1401                 return $cipher->decrypt( $_[0] );
1402         }
1403
1404 =head2 REAL-TIME COMPRESSION EXAMPLE
1405
1406 Here is a working example that uses the I<Compress::Zlib> module to do real-time
1407 compression / decompression of keys & values with DBM::Deep Filters.
1408 Please visit L<http://search.cpan.org/search?module=Compress::Zlib> for 
1409 more on I<Compress::Zlib>.
1410
1411         use DBM::Deep;
1412         use Compress::Zlib;
1413         
1414         my $db = DBM::Deep->new(
1415                 file => "foo-compress.db",
1416                 filter_store_key => \&my_compress,
1417                 filter_store_value => \&my_compress,
1418                 filter_fetch_key => \&my_decompress,
1419                 filter_fetch_value => \&my_decompress,
1420         );
1421         
1422         $db->{key1} = "value1";
1423         $db->{key2} = "value2";
1424         print "key1: " . $db->{key1} . "\n";
1425         print "key2: " . $db->{key2} . "\n";
1426         
1427         undef $db;
1428         exit;
1429         
1430         sub my_compress {
1431                 return Compress::Zlib::memGzip( $_[0] ) ;
1432         }
1433         sub my_decompress {
1434                 return Compress::Zlib::memGunzip( $_[0] ) ;
1435         }
1436
1437 B<Note:> Filtering of keys only applies to hashes.  Array "keys" are
1438 actually numerical index numbers, and are not filtered.
1439
1440 =head1 ERROR HANDLING
1441
1442 Most DBM::Deep methods return a true value for success, and call die() on
1443 failure.  You can wrap calls in an eval block to catch the die.
1444
1445         my $db = DBM::Deep->new( "foo.db" ); # create hash
1446         eval { $db->push("foo"); }; # ILLEGAL -- push is array-only call
1447         
1448     print $@;           # prints error message
1449
1450 =head1 LARGEFILE SUPPORT
1451
1452 If you have a 64-bit system, and your Perl is compiled with both LARGEFILE
1453 and 64-bit support, you I<may> be able to create databases larger than 2 GB.
1454 DBM::Deep by default uses 32-bit file offset tags, but these can be changed
1455 by calling the static C<set_pack()> method before you do anything else.
1456
1457         DBM::Deep::set_pack(8, 'Q');
1458
1459 This tells DBM::Deep to pack all file offsets with 8-byte (64-bit) quad words 
1460 instead of 32-bit longs.  After setting these values your DB files have a 
1461 theoretical maximum size of 16 XB (exabytes).
1462
1463 B<Note:> Changing these values will B<NOT> work for existing database files.
1464 Only change this for new files, and make sure it stays set consistently 
1465 throughout the file's life.  If you do set these values, you can no longer 
1466 access 32-bit DB files.  You can, however, call C<set_pack(4, 'N')> to change 
1467 back to 32-bit mode.
1468
1469 B<Note:> I have not personally tested files > 2 GB -- all my systems have 
1470 only a 32-bit Perl.  However, I have received user reports that this does 
1471 indeed work!
1472
1473 =head1 LOW-LEVEL ACCESS
1474
1475 If you require low-level access to the underlying filehandle that DBM::Deep uses,
1476 you can call the C<_fh()> method, which returns the handle:
1477
1478         my $fh = $db->_fh();
1479
1480 This method can be called on the root level of the datbase, or any child
1481 hashes or arrays.  All levels share a I<root> structure, which contains things
1482 like the filehandle, a reference counter, and all the options specified
1483 when you created the object.  You can get access to this root structure by 
1484 calling the C<root()> method.
1485
1486         my $root = $db->_root();
1487
1488 This is useful for changing options after the object has already been created,
1489 such as enabling/disabling locking.  You can also store your own temporary user
1490 data in this structure (be wary of name collision), which is then accessible from
1491 any child hash or array.
1492
1493 =head1 CUSTOM DIGEST ALGORITHM
1494
1495 DBM::Deep by default uses the I<Message Digest 5> (MD5) algorithm for hashing
1496 keys.  However you can override this, and use another algorithm (such as SHA-256)
1497 or even write your own.  But please note that DBM::Deep currently expects zero 
1498 collisions, so your algorithm has to be I<perfect>, so to speak.
1499 Collision detection may be introduced in a later version.
1500
1501
1502
1503 You can specify a custom digest algorithm by calling the static C<set_digest()> 
1504 function, passing a reference to a subroutine, and the length of the algorithm's 
1505 hashes (in bytes).  This is a global static function, which affects ALL DBM::Deep 
1506 objects.  Here is a working example that uses a 256-bit hash from the 
1507 I<Digest::SHA256> module.  Please see 
1508 L<http://search.cpan.org/search?module=Digest::SHA256> for more.
1509
1510         use DBM::Deep;
1511         use Digest::SHA256;
1512         
1513         my $context = Digest::SHA256::new(256);
1514         
1515         DBM::Deep::set_digest( \&my_digest, 32 );
1516         
1517         my $db = DBM::Deep->new( "foo-sha.db" );
1518         
1519         $db->{key1} = "value1";
1520         $db->{key2} = "value2";
1521         print "key1: " . $db->{key1} . "\n";
1522         print "key2: " . $db->{key2} . "\n";
1523         
1524         undef $db;
1525         exit;
1526         
1527         sub my_digest {
1528                 return substr( $context->hash($_[0]), 0, 32 );
1529         }
1530
1531 B<Note:> Your returned digest strings must be B<EXACTLY> the number
1532 of bytes you specify in the C<set_digest()> function (in this case 32).
1533
1534 =head1 CIRCULAR REFERENCES
1535
1536 DBM::Deep has B<experimental> support for circular references.  Meaning you
1537 can have a nested hash key or array element that points to a parent object.
1538 This relationship is stored in the DB file, and is preserved between sessions.
1539 Here is an example:
1540
1541         my $db = DBM::Deep->new( "foo.db" );
1542         
1543         $db->{foo} = "bar";
1544         $db->{circle} = $db; # ref to self
1545         
1546         print $db->{foo} . "\n"; # prints "foo"
1547         print $db->{circle}->{foo} . "\n"; # prints "foo" again
1548
1549 One catch is, passing the object to a function that recursively walks the
1550 object tree (such as I<Data::Dumper> or even the built-in C<optimize()> or
1551 C<export()> methods) will result in an infinite loop.  The other catch is, 
1552 if you fetch the I<key> of a circular reference (i.e. using the C<first_key()> 
1553 or C<next_key()> methods), you will get the I<target object's key>, not the 
1554 ref's key.  This gets even more interesting with the above example, where 
1555 the I<circle> key points to the base DB object, which technically doesn't 
1556 have a key.  So I made DBM::Deep return "[base]" as the key name in that 
1557 special case.
1558
1559 =head1 CAVEATS / ISSUES / BUGS
1560
1561 This section describes all the known issues with DBM::Deep.  It you have found
1562 something that is not listed here, please send e-mail to L<jhuckaby@cpan.org>.
1563
1564 =head2 UNUSED SPACE RECOVERY
1565
1566 One major caveat with DBM::Deep is that space occupied by existing keys and
1567 values is not recovered when they are deleted.  Meaning if you keep deleting
1568 and adding new keys, your file will continuously grow.  I am working on this,
1569 but in the meantime you can call the built-in C<optimize()> method from time to 
1570 time (perhaps in a crontab or something) to recover all your unused space.
1571
1572         $db->optimize(); # returns true on success
1573
1574 This rebuilds the ENTIRE database into a new file, then moves it on top of
1575 the original.  The new file will have no unused space, thus it will take up as
1576 little disk space as possible.  Please note that this operation can take 
1577 a long time for large files, and you need enough disk space to temporarily hold 
1578 2 copies of your DB file.  The temporary file is created in the same directory 
1579 as the original, named with a ".tmp" extension, and is deleted when the 
1580 operation completes.  Oh, and if locking is enabled, the DB is automatically 
1581 locked for the entire duration of the copy.
1582
1583 B<WARNING:> Only call optimize() on the top-level node of the database, and 
1584 make sure there are no child references lying around.  DBM::Deep keeps a reference 
1585 counter, and if it is greater than 1, optimize() will abort and return undef.
1586
1587 =head2 AUTOVIVIFICATION
1588
1589 Unfortunately, autovivification doesn't work with tied hashes.  This appears to 
1590 be a bug in Perl's tie() system, as I<Jakob Schmidt> encountered the very same 
1591 issue with his I<DWH_FIle> module (see L<http://search.cpan.org/search?module=DWH_File>),
1592 and it is also mentioned in the BUGS section for the I<MLDBM> module <see 
1593 L<http://search.cpan.org/search?module=MLDBM>).  Basically, on a new db file,
1594 this does not work:
1595
1596         $db->{foo}->{bar} = "hello";
1597
1598 Since "foo" doesn't exist, you cannot add "bar" to it.  You end up with "foo"
1599 being an empty hash.  Try this instead, which works fine:
1600
1601         $db->{foo} = { bar => "hello" };
1602
1603 As of Perl 5.8.7, this bug still exists.  I have walked very carefully through
1604 the execution path, and Perl indeed passes an empty hash to the STORE() method.
1605 Probably a bug in Perl.
1606
1607 =head2 FILE CORRUPTION
1608
1609 The current level of error handling in DBM::Deep is minimal.  Files I<are> checked
1610 for a 32-bit signature when opened, but other corruption in files can cause
1611 segmentation faults.  DBM::Deep may try to seek() past the end of a file, or get
1612 stuck in an infinite loop depending on the level of corruption.  File write
1613 operations are not checked for failure (for speed), so if you happen to run
1614 out of disk space, DBM::Deep will probably fail in a bad way.  These things will 
1615 be addressed in a later version of DBM::Deep.
1616
1617 =head2 DB OVER NFS
1618
1619 Beware of using DB files over NFS.  DBM::Deep uses flock(), which works well on local
1620 filesystems, but will NOT protect you from file corruption over NFS.  I've heard 
1621 about setting up your NFS server with a locking daemon, then using lockf() to 
1622 lock your files, but your mileage may vary there as well.  From what I 
1623 understand, there is no real way to do it.  However, if you need access to the 
1624 underlying filehandle in DBM::Deep for using some other kind of locking scheme like 
1625 lockf(), see the L<LOW-LEVEL ACCESS> section above.
1626
1627 =head2 COPYING OBJECTS
1628
1629 Beware of copying tied objects in Perl.  Very strange things can happen.  
1630 Instead, use DBM::Deep's C<clone()> method which safely copies the object and 
1631 returns a new, blessed, tied hash or array to the same level in the DB.
1632
1633         my $copy = $db->clone();
1634
1635 B<Note>: Since clone() here is cloning the object, not the database location, any
1636 modifications to either $db or $copy will be visible in both.
1637
1638 =head2 LARGE ARRAYS
1639
1640 Beware of using C<shift()>, C<unshift()> or C<splice()> with large arrays.
1641 These functions cause every element in the array to move, which can be murder
1642 on DBM::Deep, as every element has to be fetched from disk, then stored again in
1643 a different location.  This will be addressed in the forthcoming version 1.00.
1644
1645 =head2 WRITEONLY FILES
1646
1647 If you pass in a filehandle to new(), you may have opened it in either a readonly or
1648 writeonly mode. STORE will verify that the filehandle is writable. However, there
1649 doesn't seem to be a good way to determine if a filehandle is readable. And, if the
1650 filehandle isn't readable, it's not clear what will happen. So, don't do that.
1651
1652 =head1 PERFORMANCE
1653
1654 This section discusses DBM::Deep's speed and memory usage.
1655
1656 =head2 SPEED
1657
1658 Obviously, DBM::Deep isn't going to be as fast as some C-based DBMs, such as 
1659 the almighty I<BerkeleyDB>.  But it makes up for it in features like true
1660 multi-level hash/array support, and cross-platform FTPable files.  Even so,
1661 DBM::Deep is still pretty fast, and the speed stays fairly consistent, even
1662 with huge databases.  Here is some test data:
1663         
1664         Adding 1,000,000 keys to new DB file...
1665         
1666         At 100 keys, avg. speed is 2,703 keys/sec
1667         At 200 keys, avg. speed is 2,642 keys/sec
1668         At 300 keys, avg. speed is 2,598 keys/sec
1669         At 400 keys, avg. speed is 2,578 keys/sec
1670         At 500 keys, avg. speed is 2,722 keys/sec
1671         At 600 keys, avg. speed is 2,628 keys/sec
1672         At 700 keys, avg. speed is 2,700 keys/sec
1673         At 800 keys, avg. speed is 2,607 keys/sec
1674         At 900 keys, avg. speed is 2,190 keys/sec
1675         At 1,000 keys, avg. speed is 2,570 keys/sec
1676         At 2,000 keys, avg. speed is 2,417 keys/sec
1677         At 3,000 keys, avg. speed is 1,982 keys/sec
1678         At 4,000 keys, avg. speed is 1,568 keys/sec
1679         At 5,000 keys, avg. speed is 1,533 keys/sec
1680         At 6,000 keys, avg. speed is 1,787 keys/sec
1681         At 7,000 keys, avg. speed is 1,977 keys/sec
1682         At 8,000 keys, avg. speed is 2,028 keys/sec
1683         At 9,000 keys, avg. speed is 2,077 keys/sec
1684         At 10,000 keys, avg. speed is 2,031 keys/sec
1685         At 20,000 keys, avg. speed is 1,970 keys/sec
1686         At 30,000 keys, avg. speed is 2,050 keys/sec
1687         At 40,000 keys, avg. speed is 2,073 keys/sec
1688         At 50,000 keys, avg. speed is 1,973 keys/sec
1689         At 60,000 keys, avg. speed is 1,914 keys/sec
1690         At 70,000 keys, avg. speed is 2,091 keys/sec
1691         At 80,000 keys, avg. speed is 2,103 keys/sec
1692         At 90,000 keys, avg. speed is 1,886 keys/sec
1693         At 100,000 keys, avg. speed is 1,970 keys/sec
1694         At 200,000 keys, avg. speed is 2,053 keys/sec
1695         At 300,000 keys, avg. speed is 1,697 keys/sec
1696         At 400,000 keys, avg. speed is 1,838 keys/sec
1697         At 500,000 keys, avg. speed is 1,941 keys/sec
1698         At 600,000 keys, avg. speed is 1,930 keys/sec
1699         At 700,000 keys, avg. speed is 1,735 keys/sec
1700         At 800,000 keys, avg. speed is 1,795 keys/sec
1701         At 900,000 keys, avg. speed is 1,221 keys/sec
1702         At 1,000,000 keys, avg. speed is 1,077 keys/sec
1703
1704 This test was performed on a PowerMac G4 1gHz running Mac OS X 10.3.2 & Perl 
1705 5.8.1, with an 80GB Ultra ATA/100 HD spinning at 7200RPM.  The hash keys and 
1706 values were between 6 - 12 chars in length.  The DB file ended up at 210MB.  
1707 Run time was 12 min 3 sec.
1708
1709 =head2 MEMORY USAGE
1710
1711 One of the great things about DBM::Deep is that it uses very little memory.
1712 Even with huge databases (1,000,000+ keys) you will not see much increased
1713 memory on your process.  DBM::Deep relies solely on the filesystem for storing
1714 and fetching data.  Here is output from I</usr/bin/top> before even opening a
1715 database handle:
1716
1717           PID USER     PRI  NI  SIZE  RSS SHARE STAT %CPU %MEM   TIME COMMAND
1718         22831 root      11   0  2716 2716  1296 R     0.0  0.2   0:07 perl
1719
1720 Basically the process is taking 2,716K of memory.  And here is the same 
1721 process after storing and fetching 1,000,000 keys:
1722
1723           PID USER     PRI  NI  SIZE  RSS SHARE STAT %CPU %MEM   TIME COMMAND
1724         22831 root      14   0  2772 2772  1328 R     0.0  0.2  13:32 perl
1725
1726 Notice the memory usage increased by only 56K.  Test was performed on a 700mHz 
1727 x86 box running Linux RedHat 7.2 & Perl 5.6.1.
1728
1729 =head1 DB FILE FORMAT
1730
1731 In case you were interested in the underlying DB file format, it is documented
1732 here in this section.  You don't need to know this to use the module, it's just 
1733 included for reference.
1734
1735 =head2 SIGNATURE
1736
1737 DBM::Deep files always start with a 32-bit signature to identify the file type.
1738 This is at offset 0.  The signature is "DPDB" in network byte order.  This is
1739 checked for when the file is opened and an error will be thrown if it's not found.
1740
1741 =head2 TAG
1742
1743 The DBM::Deep file is in a I<tagged format>, meaning each section of the file
1744 has a standard header containing the type of data, the length of data, and then 
1745 the data itself.  The type is a single character (1 byte), the length is a 
1746 32-bit unsigned long in network byte order, and the data is, well, the data.
1747 Here is how it unfolds:
1748
1749 =head2 MASTER INDEX
1750
1751 Immediately after the 32-bit file signature is the I<Master Index> record.  
1752 This is a standard tag header followed by 1024 bytes (in 32-bit mode) or 2048 
1753 bytes (in 64-bit mode) of data.  The type is I<H> for hash or I<A> for array, 
1754 depending on how the DBM::Deep object was constructed.
1755
1756 The index works by looking at a I<MD5 Hash> of the hash key (or array index 
1757 number).  The first 8-bit char of the MD5 signature is the offset into the 
1758 index, multipled by 4 in 32-bit mode, or 8 in 64-bit mode.  The value of the 
1759 index element is a file offset of the next tag for the key/element in question,
1760 which is usually a I<Bucket List> tag (see below).
1761
1762 The next tag I<could> be another index, depending on how many keys/elements
1763 exist.  See L<RE-INDEXING> below for details.
1764
1765 =head2 BUCKET LIST
1766
1767 A I<Bucket List> is a collection of 16 MD5 hashes for keys/elements, plus 
1768 file offsets to where the actual data is stored.  It starts with a standard 
1769 tag header, with type I<B>, and a data size of 320 bytes in 32-bit mode, or 
1770 384 bytes in 64-bit mode.  Each MD5 hash is stored in full (16 bytes), plus
1771 the 32-bit or 64-bit file offset for the I<Bucket> containing the actual data.
1772 When the list fills up, a I<Re-Index> operation is performed (See 
1773 L<RE-INDEXING> below).
1774
1775 =head2 BUCKET
1776
1777 A I<Bucket> is a tag containing a key/value pair (in hash mode), or a
1778 index/value pair (in array mode).  It starts with a standard tag header with
1779 type I<D> for scalar data (string, binary, etc.), or it could be a nested
1780 hash (type I<H>) or array (type I<A>).  The value comes just after the tag
1781 header.  The size reported in the tag header is only for the value, but then,
1782 just after the value is another size (32-bit unsigned long) and then the plain 
1783 key itself.  Since the value is likely to be fetched more often than the plain 
1784 key, I figured it would be I<slightly> faster to store the value first.
1785
1786 If the type is I<H> (hash) or I<A> (array), the value is another I<Master Index>
1787 record for the nested structure, where the process begins all over again.
1788
1789 =head2 RE-INDEXING
1790
1791 After a I<Bucket List> grows to 16 records, its allocated space in the file is
1792 exhausted.  Then, when another key/element comes in, the list is converted to a 
1793 new index record.  However, this index will look at the next char in the MD5 
1794 hash, and arrange new Bucket List pointers accordingly.  This process is called 
1795 I<Re-Indexing>.  Basically, a new index tag is created at the file EOF, and all 
1796 17 (16 + new one) keys/elements are removed from the old Bucket List and 
1797 inserted into the new index.  Several new Bucket Lists are created in the 
1798 process, as a new MD5 char from the key is being examined (it is unlikely that 
1799 the keys will all share the same next char of their MD5s).
1800
1801 Because of the way the I<MD5> algorithm works, it is impossible to tell exactly
1802 when the Bucket Lists will turn into indexes, but the first round tends to 
1803 happen right around 4,000 keys.  You will see a I<slight> decrease in 
1804 performance here, but it picks back up pretty quick (see L<SPEED> above).  Then 
1805 it takes B<a lot> more keys to exhaust the next level of Bucket Lists.  It's 
1806 right around 900,000 keys.  This process can continue nearly indefinitely -- 
1807 right up until the point the I<MD5> signatures start colliding with each other, 
1808 and this is B<EXTREMELY> rare -- like winning the lottery 5 times in a row AND 
1809 getting struck by lightning while you are walking to cash in your tickets.  
1810 Theoretically, since I<MD5> hashes are 128-bit values, you I<could> have up to 
1811 340,282,366,921,000,000,000,000,000,000,000,000,000 keys/elements (I believe 
1812 this is 340 unodecillion, but don't quote me).
1813
1814 =head2 STORING
1815
1816 When a new key/element is stored, the key (or index number) is first run through 
1817 I<Digest::MD5> to get a 128-bit signature (example, in hex: 
1818 b05783b0773d894396d475ced9d2f4f6).  Then, the I<Master Index> record is checked
1819 for the first char of the signature (in this case I<b0>).  If it does not exist,
1820 a new I<Bucket List> is created for our key (and the next 15 future keys that 
1821 happen to also have I<b> as their first MD5 char).  The entire MD5 is written 
1822 to the I<Bucket List> along with the offset of the new I<Bucket> record (EOF at
1823 this point, unless we are replacing an existing I<Bucket>), where the actual 
1824 data will be stored.
1825
1826 =head2 FETCHING
1827
1828 Fetching an existing key/element involves getting a I<Digest::MD5> of the key 
1829 (or index number), then walking along the indexes.  If there are enough 
1830 keys/elements in this DB level, there might be nested indexes, each linked to 
1831 a particular char of the MD5.  Finally, a I<Bucket List> is pointed to, which 
1832 contains up to 16 full MD5 hashes.  Each is checked for equality to the key in 
1833 question.  If we found a match, the I<Bucket> tag is loaded, where the value and 
1834 plain key are stored.
1835
1836 Fetching the plain key occurs when calling the I<first_key()> and I<next_key()>
1837 methods.  In this process the indexes are walked systematically, and each key
1838 fetched in increasing MD5 order (which is why it appears random).   Once the
1839 I<Bucket> is found, the value is skipped and the plain key returned instead.  
1840 B<Note:> Do not count on keys being fetched as if the MD5 hashes were 
1841 alphabetically sorted.  This only happens on an index-level -- as soon as the 
1842 I<Bucket Lists> are hit, the keys will come out in the order they went in -- 
1843 so it's pretty much undefined how the keys will come out -- just like Perl's 
1844 built-in hashes.
1845
1846 =head1 CODE COVERAGE
1847
1848 We use B<Devel::Cover> to test the code coverage of our tests, below is the
1849 B<Devel::Cover> report on this module's test suite.
1850
1851   ---------------------------- ------ ------ ------ ------ ------ ------ ------
1852   File                           stmt   bran   cond    sub    pod   time  total
1853   ---------------------------- ------ ------ ------ ------ ------ ------ ------
1854   blib/lib/DBM/Deep.pm           95.2   83.8   70.0   98.2  100.0   58.0   91.0
1855   blib/lib/DBM/Deep/Array.pm    100.0   91.1  100.0  100.0    n/a   26.7   98.0
1856   blib/lib/DBM/Deep/Hash.pm      95.3   80.0  100.0  100.0    n/a   15.3   92.4
1857   Total                          96.2   84.8   74.4   98.8  100.0  100.0   92.4
1858   ---------------------------- ------ ------ ------ ------ ------ ------ ------
1859
1860 =head1 MORE INFORMATION
1861
1862 Check out the DBM::Deep Google Group at L<http://groups.google.com/group/DBM-Deep>
1863 or send email to L<DBM-Deep@googlegroups.com>.
1864
1865 =head1 AUTHORS
1866
1867 Joseph Huckaby, L<jhuckaby@cpan.org>
1868
1869 Rob Kinyon, L<rkinyon@cpan.org>
1870
1871 Special thanks to Adam Sah and Rich Gaushell!  You know why :-)
1872
1873 =head1 SEE ALSO
1874
1875 perltie(1), Tie::Hash(3), Digest::MD5(3), Fcntl(3), flock(2), lockf(3), nfs(5),
1876 Digest::SHA256(3), Crypt::Blowfish(3), Compress::Zlib(3)
1877
1878 =head1 LICENSE
1879
1880 Copyright (c) 2002-2006 Joseph Huckaby.  All Rights Reserved.
1881 This is free software, you may use it and distribute it under the
1882 same terms as Perl itself.
1883
1884 =cut