r11725@rob-kinyons-powerbook58: rob | 2006-05-01 15:53:46 -0400
[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 5.6.0;
33
34 use strict;
35 use warnings;
36
37 our $VERSION = q(0.99_03);
38
39 use Fcntl qw( :DEFAULT :flock :seek );
40
41 use Clone::Any '_clone_data';
42 use Digest::MD5 ();
43 use FileHandle::Fmode ();
44 use Scalar::Util ();
45
46 use DBM::Deep::Engine;
47 use DBM::Deep::File;
48
49 ##
50 # Setup constants for users to pass to new()
51 ##
52 sub TYPE_HASH   () { DBM::Deep::Engine->SIG_HASH  }
53 sub TYPE_ARRAY  () { DBM::Deep::Engine->SIG_ARRAY }
54
55 sub _get_args {
56     my $proto = shift;
57
58     my $args;
59     if (scalar(@_) > 1) {
60         if ( @_ % 2 ) {
61             $proto->_throw_error( "Odd number of parameters to " . (caller(1))[2] );
62         }
63         $args = {@_};
64     }
65     elsif ( ref $_[0] ) {
66         unless ( eval { local $SIG{'__DIE__'}; %{$_[0]} || 1 } ) {
67             $proto->_throw_error( "Not a hashref in args to " . (caller(1))[2] );
68         }
69         $args = $_[0];
70     }
71     else {
72         $args = { file => shift };
73     }
74
75     return $args;
76 }
77
78 sub new {
79     ##
80     # Class constructor method for Perl OO interface.
81     # Calls tie() and returns blessed reference to tied hash or array,
82     # providing a hybrid OO/tie interface.
83     ##
84     my $class = shift;
85     my $args = $class->_get_args( @_ );
86
87     ##
88     # Check if we want a tied hash or array.
89     ##
90     my $self;
91     if (defined($args->{type}) && $args->{type} eq TYPE_ARRAY) {
92         $class = 'DBM::Deep::Array';
93         require DBM::Deep::Array;
94         tie @$self, $class, %$args;
95     }
96     else {
97         $class = 'DBM::Deep::Hash';
98         require DBM::Deep::Hash;
99         tie %$self, $class, %$args;
100     }
101
102     return bless $self, $class;
103 }
104
105 # This initializer is called from the various TIE* methods. new() calls tie(),
106 # which allows for a single point of entry.
107 sub _init {
108     my $class = shift;
109     my ($args) = @_;
110
111     $args->{fileobj} = DBM::Deep::File->new( $args )
112         unless exists $args->{fileobj};
113
114     # locking implicitly enables autoflush
115     if ($args->{locking}) { $args->{autoflush} = 1; }
116
117     # These are the defaults to be optionally overridden below
118     my $self = bless {
119         type        => TYPE_HASH,
120         base_offset => undef,
121
122         parent      => undef,
123         parent_key  => undef,
124
125         fileobj     => undef,
126     }, $class;
127     $self->{engine} = DBM::Deep::Engine->new( { %{$args}, obj => $self } );
128
129     # Grab the parameters we want to use
130     foreach my $param ( keys %$self ) {
131         next unless exists $args->{$param};
132         $self->{$param} = $args->{$param};
133     }
134
135     $self->_engine->setup_fh( $self );
136
137     $self->{fileobj}->set_db( $self );
138
139     return $self;
140 }
141
142 sub TIEHASH {
143     shift;
144     require DBM::Deep::Hash;
145     return DBM::Deep::Hash->TIEHASH( @_ );
146 }
147
148 sub TIEARRAY {
149     shift;
150     require DBM::Deep::Array;
151     return DBM::Deep::Array->TIEARRAY( @_ );
152 }
153
154 sub lock {
155     my $self = shift->_get_self;
156     return $self->_fileobj->lock( $self, @_ );
157 }
158
159 sub unlock {
160     my $self = shift->_get_self;
161     return $self->_fileobj->unlock( $self, @_ );
162 }
163
164 sub _copy_value {
165     my $self = shift->_get_self;
166     my ($spot, $value) = @_;
167
168     if ( !ref $value ) {
169         ${$spot} = $value;
170     }
171     elsif ( eval { local $SIG{__DIE__}; $value->isa( 'DBM::Deep' ) } ) {
172         ${$spot} = $value->_repr;
173         $value->_copy_node( ${$spot} );
174     }
175     else {
176         my $r = Scalar::Util::reftype( $value );
177         my $c = Scalar::Util::blessed( $value );
178         if ( $r eq 'ARRAY' ) {
179             ${$spot} = [ @{$value} ];
180         }
181         else {
182             ${$spot} = { %{$value} };
183         }
184         ${$spot} = bless ${$spot}, $c
185             if defined $c;
186     }
187
188     return 1;
189 }
190
191 sub _copy_node {
192     die "Must be implemented in a child class\n";
193 }
194
195 sub _repr {
196     die "Must be implemented in a child class\n";
197 }
198
199 sub export {
200     ##
201     # Recursively export into standard Perl hashes and arrays.
202     ##
203     my $self = shift->_get_self;
204
205     my $temp = $self->_repr;
206
207     $self->lock();
208     $self->_copy_node( $temp );
209     $self->unlock();
210
211     # This will always work because $self, after _get_self() is a HASH
212     if ( $self->{parent} ) {
213         my $c = Scalar::Util::blessed(
214             $self->{parent}->get($self->{parent_key})
215         );
216         if ( $c && !$c->isa( 'DBM::Deep' ) ) {
217             bless $temp, $c;
218         }
219     }
220
221     return $temp;
222 }
223
224 sub import {
225     ##
226     # Recursively import Perl hash/array structure
227     ##
228     if (!ref($_[0])) { return; } # Perl calls import() on use -- ignore
229
230     my $self = shift->_get_self;
231     my ($struct) = @_;
232
233     # struct is not a reference, so just import based on our type
234     if (!ref($struct)) {
235         $struct = $self->_repr( @_ );
236     }
237
238     #XXX This isn't the best solution. Better would be to use Data::Walker,
239     #XXX but that's a lot more thinking than I want to do right now.
240     eval {
241         $self->begin_work;
242         $self->_import( _clone_data( $struct ) );
243         $self->commit;
244     }; if ( $@ ) {
245         $self->rollback;
246         die $@;
247     }
248
249     return 1;
250 }
251
252 #XXX Need to keep track of who has a fh to this file in order to
253 #XXX close them all prior to optimize on Win32/cygwin
254 sub optimize {
255     ##
256     # Rebuild entire database into new file, then move
257     # it back on top of original.
258     ##
259     my $self = shift->_get_self;
260
261 #XXX Need to create a new test for this
262 #    if ($self->_fileobj->{links} > 1) {
263 #        $self->_throw_error("Cannot optimize: reference count is greater than 1");
264 #    }
265
266     #XXX Do we have to lock the tempfile?
267
268     my $db_temp = DBM::Deep->new(
269         file => $self->_fileobj->{file} . '.tmp',
270         type => $self->_type
271     );
272
273     $self->lock();
274     $self->_copy_node( $db_temp );
275     undef $db_temp;
276
277     ##
278     # Attempt to copy user, group and permissions over to new file
279     ##
280     my @stats = stat($self->_fh);
281     my $perms = $stats[2] & 07777;
282     my $uid = $stats[4];
283     my $gid = $stats[5];
284     chown( $uid, $gid, $self->_fileobj->{file} . '.tmp' );
285     chmod( $perms, $self->_fileobj->{file} . '.tmp' );
286
287     # q.v. perlport for more information on this variable
288     if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) {
289         ##
290         # Potential race condition when optmizing on Win32 with locking.
291         # The Windows filesystem requires that the filehandle be closed
292         # before it is overwritten with rename().  This could be redone
293         # with a soft copy.
294         ##
295         $self->unlock();
296         $self->_fileobj->close;
297     }
298
299     if (!rename $self->_fileobj->{file} . '.tmp', $self->_fileobj->{file}) {
300         unlink $self->_fileobj->{file} . '.tmp';
301         $self->unlock();
302         $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!");
303     }
304
305     $self->unlock();
306     $self->_fileobj->close;
307     $self->_fileobj->open;
308     $self->_engine->setup_fh( $self );
309
310     return 1;
311 }
312
313 sub clone {
314     ##
315     # Make copy of object and return
316     ##
317     my $self = shift->_get_self;
318
319     return DBM::Deep->new(
320         type => $self->_type,
321         base_offset => $self->_base_offset,
322         fileobj => $self->_fileobj,
323     );
324 }
325
326 {
327     my %is_legal_filter = map {
328         $_ => ~~1,
329     } qw(
330         store_key store_value
331         fetch_key fetch_value
332     );
333
334     sub set_filter {
335         ##
336         # Setup filter function for storing or fetching the key or value
337         ##
338         my $self = shift->_get_self;
339         my $type = lc shift;
340         my $func = shift;
341
342         if ( $is_legal_filter{$type} ) {
343             $self->_fileobj->{"filter_$type"} = $func;
344             return 1;
345         }
346
347         return;
348     }
349 }
350
351 sub begin_work {
352     my $self = shift->_get_self;
353     $self->_fileobj->begin_transaction;
354     return 1;
355 }
356
357 sub rollback {
358     my $self = shift->_get_self;
359     $self->_fileobj->end_transaction;
360     return 1;
361 }
362
363 sub commit {
364     my $self = shift->_get_self;
365     $self->_fileobj->commit_transaction;
366     return 1;
367 }
368
369 ##
370 # Accessor methods
371 ##
372
373 sub _engine {
374     my $self = $_[0]->_get_self;
375     return $self->{engine};
376 }
377
378 sub _fileobj {
379     my $self = $_[0]->_get_self;
380     return $self->{fileobj};
381 }
382
383 sub _type {
384     my $self = $_[0]->_get_self;
385     return $self->{type};
386 }
387
388 sub _base_offset {
389     my $self = $_[0]->_get_self;
390     return $self->{base_offset};
391 }
392
393 sub _fh {
394     my $self = $_[0]->_get_self;
395     return $self->_fileobj->{fh};
396 }
397
398 ##
399 # Utility methods
400 ##
401
402 sub _throw_error {
403     die "DBM::Deep: $_[1]\n";
404 }
405
406 sub _find_parent {
407     my $self = shift;
408
409     my $base = '';
410     #XXX This if() is redundant
411     if ( my $parent = $self->{parent} ) {
412         my $child = $self;
413         while ( $parent->{parent} ) {
414             $base = (
415                 $parent->_type eq TYPE_HASH
416                     ? "\{q{$child->{parent_key}}\}"
417                     : "\[$child->{parent_key}\]"
418             ) . $base;
419
420             $child = $parent;
421             $parent = $parent->{parent};
422         }
423         if ( $base ) {
424             $base = "\$db->get( q{$child->{parent_key}} )->" . $base;
425         }
426         else {
427             $base = "\$db->get( q{$child->{parent_key}} )";
428         }
429     }
430     return $base;
431 }
432
433 sub STORE {
434     ##
435     # Store single hash key/value or array element in database.
436     ##
437     my $self = shift->_get_self;
438     my ($key, $value, $orig_key) = @_;
439
440
441     if ( !FileHandle::Fmode::is_W( $self->_fh ) ) {
442         $self->_throw_error( 'Cannot write to a readonly filehandle' );
443     }
444
445     #XXX The second condition needs to disappear
446     if ( defined $orig_key && !( $self->_type eq TYPE_ARRAY && $orig_key eq 'length') ) {
447         my $rhs;
448
449         my $r = Scalar::Util::reftype( $value ) || '';
450         if ( $r eq 'HASH' ) {
451             $rhs = '{}';
452         }
453         elsif ( $r eq 'ARRAY' ) {
454             $rhs = '[]';
455         }
456         elsif ( defined $value ) {
457             $rhs = "'$value'";
458         }
459         else {
460             $rhs = "undef";
461         }
462
463         if ( my $c = Scalar::Util::blessed( $value ) ) {
464             $rhs = "bless $rhs, '$c'";
465         }
466
467         my $lhs = $self->_find_parent;
468         if ( $lhs ) {
469             if ( $self->_type eq TYPE_HASH ) {
470                 $lhs .= "->\{q{$orig_key}\}";
471             }
472             else {
473                 $lhs .= "->\[$orig_key\]";
474             }
475
476             $lhs .= "=$rhs;";
477         }
478         else {
479             $lhs = "\$db->put(q{$orig_key},$rhs);";
480         }
481
482         $self->_fileobj->audit($lhs);
483     }
484
485     ##
486     # Request exclusive lock for writing
487     ##
488     $self->lock( LOCK_EX );
489
490     my $md5 = $self->_engine->{digest}->($key);
491
492     my $tag = $self->_engine->find_blist( $self->_base_offset, $md5, { create => 1 } );
493
494     # User may be storing a hash, in which case we do not want it run
495     # through the filtering system
496     if ( !ref($value) && $self->_fileobj->{filter_store_value} ) {
497         $value = $self->_fileobj->{filter_store_value}->( $value );
498     }
499
500     ##
501     # Add key/value to bucket list
502     ##
503     $self->_engine->add_bucket( $tag, $md5, $key, $value, undef, $orig_key ); 
504
505     $self->unlock();
506
507     return 1;
508 }
509
510 sub FETCH {
511     ##
512     # Fetch single value or element given plain key or array index
513     ##
514     my $self = shift->_get_self;
515     my ($key, $orig_key) = @_;
516
517     my $md5 = $self->_engine->{digest}->($key);
518
519     ##
520     # Request shared lock for reading
521     ##
522     $self->lock( LOCK_SH );
523
524     my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );#, { create => 1 } );
525     #XXX This needs to autovivify
526     if (!$tag) {
527         $self->unlock();
528         return;
529     }
530
531     ##
532     # Get value from bucket list
533     ##
534     my $result = $self->_engine->get_bucket_value( $tag, $md5, $orig_key );
535
536     $self->unlock();
537
538     # Filters only apply to scalar values, so the ref check is making
539     # sure the fetched bucket is a scalar, not a child hash or array.
540     return ($result && !ref($result) && $self->_fileobj->{filter_fetch_value})
541         ? $self->_fileobj->{filter_fetch_value}->($result)
542         : $result;
543 }
544
545 sub DELETE {
546     ##
547     # Delete single key/value pair or element given plain key or array index
548     ##
549     my $self = shift->_get_self;
550     my ($key, $orig_key) = @_;
551
552     if ( !FileHandle::Fmode::is_W( $self->_fh ) ) {
553         $self->_throw_error( 'Cannot write to a readonly filehandle' );
554     }
555
556     if ( defined $orig_key ) {
557         my $lhs = $self->_find_parent;
558         if ( $lhs ) {
559             $self->_fileobj->audit( "delete $lhs;" );
560         }
561         else {
562             $self->_fileobj->audit( "\$db->delete('$orig_key');" );
563         }
564     }
565
566     ##
567     # Request exclusive lock for writing
568     ##
569     $self->lock( LOCK_EX );
570
571     my $md5 = $self->_engine->{digest}->($key);
572
573     my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );
574     if (!$tag) {
575         $self->unlock();
576         return;
577     }
578
579     ##
580     # Delete bucket
581     ##
582     my $value = $self->_engine->get_bucket_value( $tag, $md5 );
583
584     if (defined $value && !ref($value) && $self->_fileobj->{filter_fetch_value}) {
585         $value = $self->_fileobj->{filter_fetch_value}->($value);
586     }
587
588     my $result = $self->_engine->delete_bucket( $tag, $md5, $orig_key );
589
590     ##
591     # If this object is an array and the key deleted was on the end of the stack,
592     # decrement the length variable.
593     ##
594
595     $self->unlock();
596
597     return $value;
598 }
599
600 sub EXISTS {
601     ##
602     # Check if a single key or element exists given plain key or array index
603     ##
604     my $self = shift->_get_self;
605     my ($key) = @_;
606
607     my $md5 = $self->_engine->{digest}->($key);
608
609     ##
610     # Request shared lock for reading
611     ##
612     $self->lock( LOCK_SH );
613
614     my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );
615     if (!$tag) {
616         $self->unlock();
617
618         ##
619         # For some reason, the built-in exists() function returns '' for false
620         ##
621         return '';
622     }
623
624     ##
625     # Check if bucket exists and return 1 or ''
626     ##
627     my $result = $self->_engine->bucket_exists( $tag, $md5 ) || '';
628
629     $self->unlock();
630
631     return $result;
632 }
633
634 sub CLEAR {
635     ##
636     # Clear all keys from hash, or all elements from array.
637     ##
638     my $self = shift->_get_self;
639
640     if ( !FileHandle::Fmode::is_W( $self->_fh ) ) {
641         $self->_throw_error( 'Cannot write to a readonly filehandle' );
642     }
643
644     {
645         my $lhs = $self->_find_parent;
646
647         if ( $self->_type eq TYPE_HASH ) {
648             $lhs = '%{' . $lhs . '}';
649         }
650         else {
651             $lhs = '@{' . $lhs . '}';
652         }
653
654         $self->_fileobj->audit( "$lhs = ();" );
655     }
656
657     ##
658     # Request exclusive lock for writing
659     ##
660     $self->lock( LOCK_EX );
661
662     if ( $self->_type eq TYPE_HASH ) {
663         my $key = $self->first_key;
664         while ( $key ) {
665             my $next_key = $self->next_key( $key );
666             my $md5 = $self->_engine->{digest}->($key);
667             my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );
668             $self->_engine->delete_bucket( $tag, $md5, $key );
669             $key = $next_key;
670         }
671     }
672     else {
673         my $size = $self->FETCHSIZE;
674         for my $key ( map { pack ( $self->_engine->{long_pack}, $_ ) } 0 .. $size - 1 ) {
675             my $md5 = $self->_engine->{digest}->($key);
676             my $tag = $self->_engine->find_blist( $self->_base_offset, $md5 );
677             $self->_engine->delete_bucket( $tag, $md5, $key );
678         }
679         $self->STORESIZE( 0 );
680     }
681 #XXX This needs updating to use _release_space
682 #    $self->_engine->write_tag(
683 #        $self->_base_offset, $self->_type,
684 #        chr(0)x$self->_engine->{index_size},
685 #    );
686
687     $self->unlock();
688
689     return 1;
690 }
691
692 ##
693 # Public method aliases
694 ##
695 sub put { (shift)->STORE( @_ ) }
696 sub store { (shift)->STORE( @_ ) }
697 sub get { (shift)->FETCH( @_ ) }
698 sub fetch { (shift)->FETCH( @_ ) }
699 sub delete { (shift)->DELETE( @_ ) }
700 sub exists { (shift)->EXISTS( @_ ) }
701 sub clear { (shift)->CLEAR( @_ ) }
702
703 1;
704 __END__
705
706 =head1 NAME
707
708 DBM::Deep - A pure perl multi-level hash/array DBM
709
710 =head1 SYNOPSIS
711
712   use DBM::Deep;
713   my $db = DBM::Deep->new( "foo.db" );
714
715   $db->{key} = 'value';
716   print $db->{key};
717
718   $db->put('key' => 'value');
719   print $db->get('key');
720
721   # true multi-level support
722   $db->{my_complex} = [
723       'hello', { perl => 'rules' },
724       42, 99,
725   ];
726
727   tie my %db, 'DBM::Deep', 'foo.db';
728   $db{key} = 'value';
729   print $db{key};
730
731   tied(%db)->put('key' => 'value');
732   print tied(%db)->get('key');
733
734 =head1 DESCRIPTION
735
736 A unique flat-file database module, written in pure perl.  True multi-level
737 hash/array support (unlike MLDBM, which is faked), hybrid OO / tie()
738 interface, cross-platform FTPable files, ACID transactions, and is quite fast.
739 Can handle millions of keys and unlimited levels without significant
740 slow-down.  Written from the ground-up in pure perl -- this is NOT a wrapper
741 around a C-based DBM.  Out-of-the-box compatibility with Unix, Mac OS X and
742 Windows.
743
744 =head1 VERSION DIFFERENCES
745
746 B<NOTE>: 0.99_01 and above have significant file format differences from 0.983 and
747 before. There will be a backwards-compatibility layer in 1.00, but that is
748 slated for a later 0.99_x release. This version is B<NOT> backwards compatible
749 with 0.983 and before.
750
751 =head1 SETUP
752
753 Construction can be done OO-style (which is the recommended way), or using
754 Perl's tie() function.  Both are examined here.
755
756 =head2 OO CONSTRUCTION
757
758 The recommended way to construct a DBM::Deep object is to use the new()
759 method, which gets you a blessed I<and> tied hash (or array) reference.
760
761   my $db = DBM::Deep->new( "foo.db" );
762
763 This opens a new database handle, mapped to the file "foo.db".  If this
764 file does not exist, it will automatically be created.  DB files are
765 opened in "r+" (read/write) mode, and the type of object returned is a
766 hash, unless otherwise specified (see L<OPTIONS> below).
767
768 You can pass a number of options to the constructor to specify things like
769 locking, autoflush, etc.  This is done by passing an inline hash (or hashref):
770
771   my $db = DBM::Deep->new(
772       file      => "foo.db",
773       locking   => 1,
774       autoflush => 1
775   );
776
777 Notice that the filename is now specified I<inside> the hash with
778 the "file" parameter, as opposed to being the sole argument to the
779 constructor.  This is required if any options are specified.
780 See L<OPTIONS> below for the complete list.
781
782 You can also start with an array instead of a hash.  For this, you must
783 specify the C<type> parameter:
784
785   my $db = DBM::Deep->new(
786       file => "foo.db",
787       type => DBM::Deep->TYPE_ARRAY
788   );
789
790 B<Note:> Specifing the C<type> parameter only takes effect when beginning
791 a new DB file.  If you create a DBM::Deep object with an existing file, the
792 C<type> will be loaded from the file header, and an error will be thrown if
793 the wrong type is passed in.
794
795 =head2 TIE CONSTRUCTION
796
797 Alternately, you can create a DBM::Deep handle by using Perl's built-in
798 tie() function.  The object returned from tie() can be used to call methods,
799 such as lock() and unlock(). (That object can be retrieved from the tied
800 variable at any time using tied() - please see L<perltie/> for more info.
801
802   my %hash;
803   my $db = tie %hash, "DBM::Deep", "foo.db";
804
805   my @array;
806   my $db = tie @array, "DBM::Deep", "bar.db";
807
808 As with the OO constructor, you can replace the DB filename parameter with
809 a hash containing one or more options (see L<OPTIONS> just below for the
810 complete list).
811
812   tie %hash, "DBM::Deep", {
813       file => "foo.db",
814       locking => 1,
815       autoflush => 1
816   };
817
818 =head2 OPTIONS
819
820 There are a number of options that can be passed in when constructing your
821 DBM::Deep objects.  These apply to both the OO- and tie- based approaches.
822
823 =over
824
825 =item * file
826
827 Filename of the DB file to link the handle to.  You can pass a full absolute
828 filesystem path, partial path, or a plain filename if the file is in the
829 current working directory.  This is a required parameter (though q.v. fh).
830
831 =item * fh
832
833 If you want, you can pass in the fh instead of the file. This is most useful for doing
834 something like:
835
836   my $db = DBM::Deep->new( { fh => \*DATA } );
837
838 You are responsible for making sure that the fh has been opened appropriately for your
839 needs. If you open it read-only and attempt to write, an exception will be thrown. If you
840 open it write-only or append-only, an exception will be thrown immediately as DBM::Deep
841 needs to read from the fh.
842
843 =item * audit_file / audit_fh
844
845 These are just like file/fh, except for auditing. Please see L</AUDITING> for
846 more information.
847
848 =item * file_offset
849
850 This is the offset within the file that the DBM::Deep db starts. Most of the time, you will
851 not need to set this. However, it's there if you want it.
852
853 If you pass in fh and do not set this, it will be set appropriately.
854
855 =item * type
856
857 This parameter specifies what type of object to create, a hash or array.  Use
858 one of these two constants:
859
860 =over 4
861
862 =item * C<DBM::Deep-E<gt>TYPE_HASH>
863
864 =item * C<DBM::Deep-E<gt>TYPE_ARRAY>.
865
866 =back
867
868 This only takes effect when beginning a new file.  This is an optional
869 parameter, and defaults to C<DBM::Deep-E<gt>TYPE_HASH>.
870
871 =item * locking
872
873 Specifies whether locking is to be enabled.  DBM::Deep uses Perl's flock()
874 function to lock the database in exclusive mode for writes, and shared mode
875 for reads.  Pass any true value to enable.  This affects the base DB handle
876 I<and any child hashes or arrays> that use the same DB file.  This is an
877 optional parameter, and defaults to 0 (disabled).  See L<LOCKING> below for
878 more.
879
880 =item * autoflush
881
882 Specifies whether autoflush is to be enabled on the underlying filehandle.
883 This obviously slows down write operations, but is required if you may have
884 multiple processes accessing the same DB file (also consider enable I<locking>).
885 Pass any true value to enable.  This is an optional parameter, and defaults to 0
886 (disabled).
887
888 =item * autobless
889
890 If I<autobless> mode is enabled, DBM::Deep will preserve the class something
891 is blessed into, and restores it when fetched.  This is an optional parameter, and defaults to 1 (enabled).
892
893 B<Note:> If you use the OO-interface, you will not be able to call any methods
894 of DBM::Deep on the blessed item. This is considered to be a feature.
895
896 =item * filter_*
897
898 See L</FILTERS> below.
899
900 =back
901
902 =head1 TIE INTERFACE
903
904 With DBM::Deep you can access your databases using Perl's standard hash/array
905 syntax.  Because all DBM::Deep objects are I<tied> to hashes or arrays, you can
906 treat them as such.  DBM::Deep will intercept all reads/writes and direct them
907 to the right place -- the DB file.  This has nothing to do with the
908 L<TIE CONSTRUCTION> section above.  This simply tells you how to use DBM::Deep
909 using regular hashes and arrays, rather than calling functions like C<get()>
910 and C<put()> (although those work too).  It is entirely up to you how to want
911 to access your databases.
912
913 =head2 HASHES
914
915 You can treat any DBM::Deep object like a normal Perl hash reference.  Add keys,
916 or even nested hashes (or arrays) using standard Perl syntax:
917
918   my $db = DBM::Deep->new( "foo.db" );
919
920   $db->{mykey} = "myvalue";
921   $db->{myhash} = {};
922   $db->{myhash}->{subkey} = "subvalue";
923
924   print $db->{myhash}->{subkey} . "\n";
925
926 You can even step through hash keys using the normal Perl C<keys()> function:
927
928   foreach my $key (keys %$db) {
929       print "$key: " . $db->{$key} . "\n";
930   }
931
932 Remember that Perl's C<keys()> function extracts I<every> key from the hash and
933 pushes them onto an array, all before the loop even begins.  If you have an
934 extremely large hash, this may exhaust Perl's memory.  Instead, consider using
935 Perl's C<each()> function, which pulls keys/values one at a time, using very
936 little memory:
937
938   while (my ($key, $value) = each %$db) {
939       print "$key: $value\n";
940   }
941
942 Please note that when using C<each()>, you should always pass a direct
943 hash reference, not a lookup.  Meaning, you should B<never> do this:
944
945   # NEVER DO THIS
946   while (my ($key, $value) = each %{$db->{foo}}) { # BAD
947
948 This causes an infinite loop, because for each iteration, Perl is calling
949 FETCH() on the $db handle, resulting in a "new" hash for foo every time, so
950 it effectively keeps returning the first key over and over again. Instead,
951 assign a temporary variable to C<$db->{foo}>, then pass that to each().
952
953 =head2 ARRAYS
954
955 As with hashes, you can treat any DBM::Deep object like a normal Perl array
956 reference.  This includes inserting, removing and manipulating elements,
957 and the C<push()>, C<pop()>, C<shift()>, C<unshift()> and C<splice()> functions.
958 The object must have first been created using type C<DBM::Deep-E<gt>TYPE_ARRAY>,
959 or simply be a nested array reference inside a hash.  Example:
960
961   my $db = DBM::Deep->new(
962       file => "foo-array.db",
963       type => DBM::Deep->TYPE_ARRAY
964   );
965
966   $db->[0] = "foo";
967   push @$db, "bar", "baz";
968   unshift @$db, "bah";
969
970   my $last_elem = pop @$db; # baz
971   my $first_elem = shift @$db; # bah
972   my $second_elem = $db->[1]; # bar
973
974   my $num_elements = scalar @$db;
975
976 =head1 OO INTERFACE
977
978 In addition to the I<tie()> interface, you can also use a standard OO interface
979 to manipulate all aspects of DBM::Deep databases.  Each type of object (hash or
980 array) has its own methods, but both types share the following common methods:
981 C<put()>, C<get()>, C<exists()>, C<delete()> and C<clear()>. C<fetch()> and
982 C<store(> are aliases to C<put()> and C<get()>, respectively.
983
984 =over
985
986 =item * new() / clone()
987
988 These are the constructor and copy-functions.
989
990 =item * put() / store()
991
992 Stores a new hash key/value pair, or sets an array element value.  Takes two
993 arguments, the hash key or array index, and the new value.  The value can be
994 a scalar, hash ref or array ref.  Returns true on success, false on failure.
995
996   $db->put("foo", "bar"); # for hashes
997   $db->put(1, "bar"); # for arrays
998
999 =item * get() / fetch()
1000
1001 Fetches the value of a hash key or array element.  Takes one argument: the hash
1002 key or array index.  Returns a scalar, hash ref or array ref, depending on the
1003 data type stored.
1004
1005   my $value = $db->get("foo"); # for hashes
1006   my $value = $db->get(1); # for arrays
1007
1008 =item * exists()
1009
1010 Checks if a hash key or array index exists.  Takes one argument: the hash key
1011 or array index.  Returns true if it exists, false if not.
1012
1013   if ($db->exists("foo")) { print "yay!\n"; } # for hashes
1014   if ($db->exists(1)) { print "yay!\n"; } # for arrays
1015
1016 =item * delete()
1017
1018 Deletes one hash key/value pair or array element.  Takes one argument: the hash
1019 key or array index.  Returns true on success, false if not found.  For arrays,
1020 the remaining elements located after the deleted element are NOT moved over.
1021 The deleted element is essentially just undefined, which is exactly how Perl's
1022 internal arrays work.  Please note that the space occupied by the deleted
1023 key/value or element is B<not> reused again -- see L<UNUSED SPACE RECOVERY>
1024 below for details and workarounds.
1025
1026   $db->delete("foo"); # for hashes
1027   $db->delete(1); # for arrays
1028
1029 =item * clear()
1030
1031 Deletes B<all> hash keys or array elements.  Takes no arguments.  No return
1032 value.  Please note that the space occupied by the deleted keys/values or
1033 elements is B<not> reused again -- see L<UNUSED SPACE RECOVERY> below for
1034 details and workarounds.
1035
1036   $db->clear(); # hashes or arrays
1037
1038 =item * lock() / unlock()
1039
1040 q.v. Locking.
1041
1042 =item * optimize()
1043
1044 Recover lost disk space. This is important to do, especially if you use
1045 transactions.
1046
1047 =item * import() / export()
1048
1049 Data going in and out.
1050
1051 =back
1052
1053 =head2 HASHES
1054
1055 For hashes, DBM::Deep supports all the common methods described above, and the
1056 following additional methods: C<first_key()> and C<next_key()>.
1057
1058 =over
1059
1060 =item * first_key()
1061
1062 Returns the "first" key in the hash.  As with built-in Perl hashes, keys are
1063 fetched in an undefined order (which appears random).  Takes no arguments,
1064 returns the key as a scalar value.
1065
1066   my $key = $db->first_key();
1067
1068 =item * next_key()
1069
1070 Returns the "next" key in the hash, given the previous one as the sole argument.
1071 Returns undef if there are no more keys to be fetched.
1072
1073   $key = $db->next_key($key);
1074
1075 =back
1076
1077 Here are some examples of using hashes:
1078
1079   my $db = DBM::Deep->new( "foo.db" );
1080
1081   $db->put("foo", "bar");
1082   print "foo: " . $db->get("foo") . "\n";
1083
1084   $db->put("baz", {}); # new child hash ref
1085   $db->get("baz")->put("buz", "biz");
1086   print "buz: " . $db->get("baz")->get("buz") . "\n";
1087
1088   my $key = $db->first_key();
1089   while ($key) {
1090       print "$key: " . $db->get($key) . "\n";
1091       $key = $db->next_key($key);
1092   }
1093
1094   if ($db->exists("foo")) { $db->delete("foo"); }
1095
1096 =head2 ARRAYS
1097
1098 For arrays, DBM::Deep supports all the common methods described above, and the
1099 following additional methods: C<length()>, C<push()>, C<pop()>, C<shift()>,
1100 C<unshift()> and C<splice()>.
1101
1102 =over
1103
1104 =item * length()
1105
1106 Returns the number of elements in the array.  Takes no arguments.
1107
1108   my $len = $db->length();
1109
1110 =item * push()
1111
1112 Adds one or more elements onto the end of the array.  Accepts scalars, hash
1113 refs or array refs.  No return value.
1114
1115   $db->push("foo", "bar", {});
1116
1117 =item * pop()
1118
1119 Fetches the last element in the array, and deletes it.  Takes no arguments.
1120 Returns undef if array is empty.  Returns the element value.
1121
1122   my $elem = $db->pop();
1123
1124 =item * shift()
1125
1126 Fetches the first element in the array, deletes it, then shifts all the
1127 remaining elements over to take up the space.  Returns the element value.  This
1128 method is not recommended with large arrays -- see L<LARGE ARRAYS> below for
1129 details.
1130
1131   my $elem = $db->shift();
1132
1133 =item * unshift()
1134
1135 Inserts one or more elements onto the beginning of the array, shifting all
1136 existing elements over to make room.  Accepts scalars, hash refs or array refs.
1137 No return value.  This method is not recommended with large arrays -- see
1138 <LARGE ARRAYS> below for details.
1139
1140   $db->unshift("foo", "bar", {});
1141
1142 =item * splice()
1143
1144 Performs exactly like Perl's built-in function of the same name.  See L<perldoc
1145 -f splice> for usage -- it is too complicated to document here.  This method is
1146 not recommended with large arrays -- see L<LARGE ARRAYS> below for details.
1147
1148 =back
1149
1150 Here are some examples of using arrays:
1151
1152   my $db = DBM::Deep->new(
1153       file => "foo.db",
1154       type => DBM::Deep->TYPE_ARRAY
1155   );
1156
1157   $db->push("bar", "baz");
1158   $db->unshift("foo");
1159   $db->put(3, "buz");
1160
1161   my $len = $db->length();
1162   print "length: $len\n"; # 4
1163
1164   for (my $k=0; $k<$len; $k++) {
1165       print "$k: " . $db->get($k) . "\n";
1166   }
1167
1168   $db->splice(1, 2, "biz", "baf");
1169
1170   while (my $elem = shift @$db) {
1171       print "shifted: $elem\n";
1172   }
1173
1174 =head1 LOCKING
1175
1176 Enable automatic file locking by passing a true value to the C<locking>
1177 parameter when constructing your DBM::Deep object (see L<SETUP> above).
1178
1179   my $db = DBM::Deep->new(
1180       file => "foo.db",
1181       locking => 1
1182   );
1183
1184 This causes DBM::Deep to C<flock()> the underlying filehandle with exclusive
1185 mode for writes, and shared mode for reads.  This is required if you have
1186 multiple processes accessing the same database file, to avoid file corruption.
1187 Please note that C<flock()> does NOT work for files over NFS.  See L<DB OVER
1188 NFS> below for more.
1189
1190 =head2 EXPLICIT LOCKING
1191
1192 You can explicitly lock a database, so it remains locked for multiple
1193 transactions.  This is done by calling the C<lock()> method, and passing an
1194 optional lock mode argument (defaults to exclusive mode).  This is particularly
1195 useful for things like counters, where the current value needs to be fetched,
1196 then incremented, then stored again.
1197
1198   $db->lock();
1199   my $counter = $db->get("counter");
1200   $counter++;
1201   $db->put("counter", $counter);
1202   $db->unlock();
1203
1204   # or...
1205
1206   $db->lock();
1207   $db->{counter}++;
1208   $db->unlock();
1209
1210 You can pass C<lock()> an optional argument, which specifies which mode to use
1211 (exclusive or shared).  Use one of these two constants:
1212 C<DBM::Deep-E<gt>LOCK_EX> or C<DBM::Deep-E<gt>LOCK_SH>.  These are passed
1213 directly to C<flock()>, and are the same as the constants defined in Perl's
1214 L<Fcntl/> module.
1215
1216   $db->lock( $db->LOCK_SH );
1217   # something here
1218   $db->unlock();
1219
1220 =head1 IMPORTING/EXPORTING
1221
1222 You can import existing complex structures by calling the C<import()> method,
1223 and export an entire database into an in-memory structure using the C<export()>
1224 method.  Both are examined here.
1225
1226 =head2 IMPORTING
1227
1228 Say you have an existing hash with nested hashes/arrays inside it.  Instead of
1229 walking the structure and adding keys/elements to the database as you go,
1230 simply pass a reference to the C<import()> method.  This recursively adds
1231 everything to an existing DBM::Deep object for you.  Here is an example:
1232
1233   my $struct = {
1234       key1 => "value1",
1235       key2 => "value2",
1236       array1 => [ "elem0", "elem1", "elem2" ],
1237       hash1 => {
1238           subkey1 => "subvalue1",
1239           subkey2 => "subvalue2"
1240       }
1241   };
1242
1243   my $db = DBM::Deep->new( "foo.db" );
1244   $db->import( $struct );
1245
1246   print $db->{key1} . "\n"; # prints "value1"
1247
1248 This recursively imports the entire C<$struct> object into C<$db>, including
1249 all nested hashes and arrays.  If the DBM::Deep object contains exsiting data,
1250 keys are merged with the existing ones, replacing if they already exist.
1251 The C<import()> method can be called on any database level (not just the base
1252 level), and works with both hash and array DB types.
1253
1254 B<Note:> Make sure your existing structure has no circular references in it.
1255 These will cause an infinite loop when importing. There are plans to fix this
1256 in a later release.
1257
1258 =head2 EXPORTING
1259
1260 Calling the C<export()> method on an existing DBM::Deep object will return
1261 a reference to a new in-memory copy of the database.  The export is done
1262 recursively, so all nested hashes/arrays are all exported to standard Perl
1263 objects.  Here is an example:
1264
1265   my $db = DBM::Deep->new( "foo.db" );
1266
1267   $db->{key1} = "value1";
1268   $db->{key2} = "value2";
1269   $db->{hash1} = {};
1270   $db->{hash1}->{subkey1} = "subvalue1";
1271   $db->{hash1}->{subkey2} = "subvalue2";
1272
1273   my $struct = $db->export();
1274
1275   print $struct->{key1} . "\n"; # prints "value1"
1276
1277 This makes a complete copy of the database in memory, and returns a reference
1278 to it.  The C<export()> method can be called on any database level (not just
1279 the base level), and works with both hash and array DB types.  Be careful of
1280 large databases -- you can store a lot more data in a DBM::Deep object than an
1281 in-memory Perl structure.
1282
1283 B<Note:> Make sure your database has no circular references in it.
1284 These will cause an infinite loop when exporting. There are plans to fix this
1285 in a later release.
1286
1287 =head1 FILTERS
1288
1289 DBM::Deep has a number of hooks where you can specify your own Perl function
1290 to perform filtering on incoming or outgoing data.  This is a perfect
1291 way to extend the engine, and implement things like real-time compression or
1292 encryption.  Filtering applies to the base DB level, and all child hashes /
1293 arrays.  Filter hooks can be specified when your DBM::Deep object is first
1294 constructed, or by calling the C<set_filter()> method at any time.  There are
1295 four available filter hooks, described below:
1296
1297 =over
1298
1299 =item * filter_store_key
1300
1301 This filter is called whenever a hash key is stored.  It
1302 is passed the incoming key, and expected to return a transformed key.
1303
1304 =item * filter_store_value
1305
1306 This filter is called whenever a hash key or array element is stored.  It
1307 is passed the incoming value, and expected to return a transformed value.
1308
1309 =item * filter_fetch_key
1310
1311 This filter is called whenever a hash key is fetched (i.e. via
1312 C<first_key()> or C<next_key()>).  It is passed the transformed key,
1313 and expected to return the plain key.
1314
1315 =item * filter_fetch_value
1316
1317 This filter is called whenever a hash key or array element is fetched.
1318 It is passed the transformed value, and expected to return the plain value.
1319
1320 =back
1321
1322 Here are the two ways to setup a filter hook:
1323
1324   my $db = DBM::Deep->new(
1325       file => "foo.db",
1326       filter_store_value => \&my_filter_store,
1327       filter_fetch_value => \&my_filter_fetch
1328   );
1329
1330   # or...
1331
1332   $db->set_filter( "filter_store_value", \&my_filter_store );
1333   $db->set_filter( "filter_fetch_value", \&my_filter_fetch );
1334
1335 Your filter function will be called only when dealing with SCALAR keys or
1336 values.  When nested hashes and arrays are being stored/fetched, filtering
1337 is bypassed.  Filters are called as static functions, passed a single SCALAR
1338 argument, and expected to return a single SCALAR value.  If you want to
1339 remove a filter, set the function reference to C<undef>:
1340
1341   $db->set_filter( "filter_store_value", undef );
1342
1343 =head2 REAL-TIME ENCRYPTION EXAMPLE
1344
1345 Here is a working example that uses the I<Crypt::Blowfish> module to
1346 do real-time encryption / decryption of keys & values with DBM::Deep Filters.
1347 Please visit L<http://search.cpan.org/search?module=Crypt::Blowfish> for more
1348 on I<Crypt::Blowfish>.  You'll also need the I<Crypt::CBC> module.
1349
1350   use DBM::Deep;
1351   use Crypt::Blowfish;
1352   use Crypt::CBC;
1353
1354   my $cipher = Crypt::CBC->new({
1355       'key'             => 'my secret key',
1356       'cipher'          => 'Blowfish',
1357       'iv'              => '$KJh#(}q',
1358       'regenerate_key'  => 0,
1359       'padding'         => 'space',
1360       'prepend_iv'      => 0
1361   });
1362
1363   my $db = DBM::Deep->new(
1364       file => "foo-encrypt.db",
1365       filter_store_key => \&my_encrypt,
1366       filter_store_value => \&my_encrypt,
1367       filter_fetch_key => \&my_decrypt,
1368       filter_fetch_value => \&my_decrypt,
1369   );
1370
1371   $db->{key1} = "value1";
1372   $db->{key2} = "value2";
1373   print "key1: " . $db->{key1} . "\n";
1374   print "key2: " . $db->{key2} . "\n";
1375
1376   undef $db;
1377   exit;
1378
1379   sub my_encrypt {
1380       return $cipher->encrypt( $_[0] );
1381   }
1382   sub my_decrypt {
1383       return $cipher->decrypt( $_[0] );
1384   }
1385
1386 =head2 REAL-TIME COMPRESSION EXAMPLE
1387
1388 Here is a working example that uses the I<Compress::Zlib> module to do real-time
1389 compression / decompression of keys & values with DBM::Deep Filters.
1390 Please visit L<http://search.cpan.org/search?module=Compress::Zlib> for
1391 more on I<Compress::Zlib>.
1392
1393   use DBM::Deep;
1394   use Compress::Zlib;
1395
1396   my $db = DBM::Deep->new(
1397       file => "foo-compress.db",
1398       filter_store_key => \&my_compress,
1399       filter_store_value => \&my_compress,
1400       filter_fetch_key => \&my_decompress,
1401       filter_fetch_value => \&my_decompress,
1402   );
1403
1404   $db->{key1} = "value1";
1405   $db->{key2} = "value2";
1406   print "key1: " . $db->{key1} . "\n";
1407   print "key2: " . $db->{key2} . "\n";
1408
1409   undef $db;
1410   exit;
1411
1412   sub my_compress {
1413       return Compress::Zlib::memGzip( $_[0] ) ;
1414   }
1415   sub my_decompress {
1416       return Compress::Zlib::memGunzip( $_[0] ) ;
1417   }
1418
1419 B<Note:> Filtering of keys only applies to hashes.  Array "keys" are
1420 actually numerical index numbers, and are not filtered.
1421
1422 =head1 ERROR HANDLING
1423
1424 Most DBM::Deep methods return a true value for success, and call die() on
1425 failure.  You can wrap calls in an eval block to catch the die.
1426
1427   my $db = DBM::Deep->new( "foo.db" ); # create hash
1428   eval { $db->push("foo"); }; # ILLEGAL -- push is array-only call
1429
1430   print $@;           # prints error message
1431
1432 =head1 LARGEFILE SUPPORT
1433
1434 If you have a 64-bit system, and your Perl is compiled with both LARGEFILE
1435 and 64-bit support, you I<may> be able to create databases larger than 2 GB.
1436 DBM::Deep by default uses 32-bit file offset tags, but these can be changed
1437 by specifying the 'pack_size' parameter when constructing the file.
1438
1439   DBM::Deep->new(
1440       filename  => $filename,
1441       pack_size => 'large',
1442   );
1443
1444 This tells DBM::Deep to pack all file offsets with 8-byte (64-bit) quad words
1445 instead of 32-bit longs.  After setting these values your DB files have a
1446 theoretical maximum size of 16 XB (exabytes).
1447
1448 You can also use C<pack_size =E<gt> 'small'> in order to use 16-bit file
1449 offsets.
1450
1451 B<Note:> Changing these values will B<NOT> work for existing database files.
1452 Only change this for new files. Once the value has been set, it is stored in
1453 the file's header and cannot be changed for the life of the file. These
1454 parameters are per-file, meaning you can access 32-bit and 64-bit files, as
1455 you chose.
1456
1457 B<Note:> We have not personally tested files larger than 2 GB -- all my
1458 systems have only a 32-bit Perl.  However, I have received user reports that
1459 this does indeed work!
1460
1461 =head1 LOW-LEVEL ACCESS
1462
1463 If you require low-level access to the underlying filehandle that DBM::Deep uses,
1464 you can call the C<_fh()> method, which returns the handle:
1465
1466   my $fh = $db->_fh();
1467
1468 This method can be called on the root level of the datbase, or any child
1469 hashes or arrays.  All levels share a I<root> structure, which contains things
1470 like the filehandle, a reference counter, and all the options specified
1471 when you created the object.  You can get access to this file object by
1472 calling the C<_fileobj()> method.
1473
1474   my $file_obj = $db->_fileobj();
1475
1476 This is useful for changing options after the object has already been created,
1477 such as enabling/disabling locking.  You can also store your own temporary user
1478 data in this structure (be wary of name collision), which is then accessible from
1479 any child hash or array.
1480
1481 =head1 CUSTOM DIGEST ALGORITHM
1482
1483 DBM::Deep by default uses the I<Message Digest 5> (MD5) algorithm for hashing
1484 keys.  However you can override this, and use another algorithm (such as SHA-256)
1485 or even write your own.  But please note that DBM::Deep currently expects zero
1486 collisions, so your algorithm has to be I<perfect>, so to speak. Collision
1487 detection may be introduced in a later version.
1488
1489 You can specify a custom digest algorithm by passing it into the parameter
1490 list for new(), passing a reference to a subroutine as the 'digest' parameter,
1491 and the length of the algorithm's hashes (in bytes) as the 'hash_size'
1492 parameter. Here is a working example that uses a 256-bit hash from the
1493 I<Digest::SHA256> module.  Please see
1494 L<http://search.cpan.org/search?module=Digest::SHA256> for more information.
1495
1496   use DBM::Deep;
1497   use Digest::SHA256;
1498
1499   my $context = Digest::SHA256::new(256);
1500
1501   my $db = DBM::Deep->new(
1502       filename => "foo-sha.db",
1503       digest => \&my_digest,
1504       hash_size => 32,
1505   );
1506
1507   $db->{key1} = "value1";
1508   $db->{key2} = "value2";
1509   print "key1: " . $db->{key1} . "\n";
1510   print "key2: " . $db->{key2} . "\n";
1511
1512   undef $db;
1513   exit;
1514
1515   sub my_digest {
1516       return substr( $context->hash($_[0]), 0, 32 );
1517   }
1518
1519 B<Note:> Your returned digest strings must be B<EXACTLY> the number
1520 of bytes you specify in the hash_size parameter (in this case 32).
1521
1522 B<Note:> If you do choose to use a custom digest algorithm, you must set it
1523 every time you access this file. Otherwise, the default (MD5) will be used.
1524
1525 =head1 CIRCULAR REFERENCES
1526
1527 DBM::Deep has B<experimental> support for circular references.  Meaning you
1528 can have a nested hash key or array element that points to a parent object.
1529 This relationship is stored in the DB file, and is preserved between sessions.
1530 Here is an example:
1531
1532   my $db = DBM::Deep->new( "foo.db" );
1533
1534   $db->{foo} = "bar";
1535   $db->{circle} = $db; # ref to self
1536
1537   print $db->{foo} . "\n"; # prints "bar"
1538   print $db->{circle}->{foo} . "\n"; # prints "bar" again
1539
1540 B<Note>: Passing the object to a function that recursively walks the
1541 object tree (such as I<Data::Dumper> or even the built-in C<optimize()> or
1542 C<export()> methods) will result in an infinite loop. This will be fixed in
1543 a future release.
1544
1545 =head1 AUDITING
1546
1547 New in 0.99_01 is the ability to audit your databases actions. By passing in
1548 audit_file (or audit_fh) to the constructor, all actions will be logged to
1549 that file. The format is one that is suitable for eval'ing against the
1550 database to replay the actions. Please see t/33_audit_trail.t for an example
1551 of how to do this.
1552
1553 =head1 TRANSACTIONS
1554
1555 New in 0.99_01 is ACID transactions. Every DBM::Deep object is completely
1556 transaction-ready - it is not an option you have to turn on. Three new methods
1557 have been added to support them. They are:
1558
1559 =over 4
1560
1561 =item * begin_work()
1562
1563 This starts a transaction.
1564
1565 =item * commit()
1566
1567 This applies the changes done within the transaction to the mainline and ends
1568 the transaction.
1569
1570 =item * rollback()
1571
1572 This discards the changes done within the transaction to the mainline and ends
1573 the transaction.
1574
1575 =back
1576
1577 Transactions in DBM::Deep are done using the MVCC method, the same method used
1578 by the InnoDB MySQL table type.
1579
1580 =head1 CAVEATS / ISSUES / BUGS
1581
1582 This section describes all the known issues with DBM::Deep.  It you have found
1583 something that is not listed here, please send e-mail to L<jhuckaby@cpan.org>.
1584
1585 =head2 UNUSED SPACE RECOVERY
1586
1587 One major caveat with DBM::Deep is that space occupied by existing keys and
1588 values is not recovered when they are deleted.  Meaning if you keep deleting
1589 and adding new keys, your file will continuously grow.  I am working on this,
1590 but in the meantime you can call the built-in C<optimize()> method from time to
1591 time (perhaps in a crontab or something) to recover all your unused space.
1592
1593   $db->optimize(); # returns true on success
1594
1595 This rebuilds the ENTIRE database into a new file, then moves it on top of
1596 the original.  The new file will have no unused space, thus it will take up as
1597 little disk space as possible.  Please note that this operation can take
1598 a long time for large files, and you need enough disk space to temporarily hold
1599 2 copies of your DB file.  The temporary file is created in the same directory
1600 as the original, named with a ".tmp" extension, and is deleted when the
1601 operation completes.  Oh, and if locking is enabled, the DB is automatically
1602 locked for the entire duration of the copy.
1603
1604 B<WARNING:> Only call optimize() on the top-level node of the database, and
1605 make sure there are no child references lying around.  DBM::Deep keeps a reference
1606 counter, and if it is greater than 1, optimize() will abort and return undef.
1607
1608 =head2 REFERENCES
1609
1610 (The reasons given assume a high level of Perl understanding, specifically of
1611 references. You can safely skip this section.)
1612
1613 Currently, the only references supported are HASH and ARRAY. The other reference
1614 types (SCALAR, CODE, GLOB, and REF) cannot be supported for various reasons.
1615
1616 =over 4
1617
1618 =item * GLOB
1619
1620 These are things like filehandles and other sockets. They can't be supported
1621 because it's completely unclear how DBM::Deep should serialize them.
1622
1623 =item * SCALAR / REF
1624
1625 The discussion here refers to the following type of example:
1626
1627   my $x = 25;
1628   $db->{key1} = \$x;
1629
1630   $x = 50;
1631
1632   # In some other process ...
1633
1634   my $val = ${ $db->{key1} };
1635
1636   is( $val, 50, "What actually gets stored in the DB file?" );
1637
1638 The problem is one of synchronization. When the variable being referred to
1639 changes value, the reference isn't notified. This means that the new value won't
1640 be stored in the datafile for other processes to read. There is no TIEREF.
1641
1642 It is theoretically possible to store references to values already within a
1643 DBM::Deep object because everything already is synchronized, but the change to
1644 the internals would be quite large. Specifically, DBM::Deep would have to tie
1645 every single value that is stored. This would bloat the RAM footprint of
1646 DBM::Deep at least twofold (if not more) and be a significant performance drain,
1647 all to support a feature that has never been requested.
1648
1649 =item * CODE
1650
1651 L<Data::Dump::Streamer/> provides a mechanism for serializing coderefs,
1652 including saving off all closure state.  However, just as for SCALAR and REF,
1653 that closure state may change without notifying the DBM::Deep object storing
1654 the reference.
1655
1656 =back
1657
1658 =head2 FILE CORRUPTION
1659
1660 The current level of error handling in DBM::Deep is minimal.  Files I<are> checked
1661 for a 32-bit signature when opened, but other corruption in files can cause
1662 segmentation faults.  DBM::Deep may try to seek() past the end of a file, or get
1663 stuck in an infinite loop depending on the level of corruption.  File write
1664 operations are not checked for failure (for speed), so if you happen to run
1665 out of disk space, DBM::Deep will probably fail in a bad way.  These things will
1666 be addressed in a later version of DBM::Deep.
1667
1668 =head2 DB OVER NFS
1669
1670 Beware of using DBM::Deep files over NFS.  DBM::Deep uses flock(), which works
1671 well on local filesystems, but will NOT protect you from file corruption over
1672 NFS.  I've heard about setting up your NFS server with a locking daemon, then
1673 using lockf() to lock your files, but your mileage may vary there as well.
1674 From what I understand, there is no real way to do it.  However, if you need
1675 access to the underlying filehandle in DBM::Deep for using some other kind of
1676 locking scheme like lockf(), see the L<LOW-LEVEL ACCESS> section above.
1677
1678 =head2 COPYING OBJECTS
1679
1680 Beware of copying tied objects in Perl.  Very strange things can happen.
1681 Instead, use DBM::Deep's C<clone()> method which safely copies the object and
1682 returns a new, blessed, tied hash or array to the same level in the DB.
1683
1684   my $copy = $db->clone();
1685
1686 B<Note>: Since clone() here is cloning the object, not the database location, any
1687 modifications to either $db or $copy will be visible to both.
1688
1689 =head2 LARGE ARRAYS
1690
1691 Beware of using C<shift()>, C<unshift()> or C<splice()> with large arrays.
1692 These functions cause every element in the array to move, which can be murder
1693 on DBM::Deep, as every element has to be fetched from disk, then stored again in
1694 a different location.  This will be addressed in the forthcoming version 1.00.
1695
1696 =head2 WRITEONLY FILES
1697
1698 If you pass in a filehandle to new(), you may have opened it in either a readonly or
1699 writeonly mode. STORE will verify that the filehandle is writable. However, there
1700 doesn't seem to be a good way to determine if a filehandle is readable. And, if the
1701 filehandle isn't readable, it's not clear what will happen. So, don't do that.
1702
1703 =head1 CODE COVERAGE
1704
1705 B<Devel::Cover> is used to test the code coverage of the tests. Below is the
1706 B<Devel::Cover> report on this distribution's test suite.
1707
1708   ---------------------------- ------ ------ ------ ------ ------ ------ ------
1709   File                           stmt   bran   cond    sub    pod   time  total
1710   ---------------------------- ------ ------ ------ ------ ------ ------ ------
1711   blib/lib/DBM/Deep.pm           96.2   89.0   75.0   95.8   89.5   36.0   92.9
1712   blib/lib/DBM/Deep/Array.pm     96.1   88.3  100.0   96.4  100.0   15.9   94.7
1713   blib/lib/DBM/Deep/Engine.pm    96.6   86.6   89.5  100.0    0.0   20.0   91.0
1714   blib/lib/DBM/Deep/File.pm      99.4   88.3   55.6  100.0    0.0   19.6   89.5
1715   blib/lib/DBM/Deep/Hash.pm      98.5   83.3  100.0  100.0  100.0    8.5   96.3
1716   Total                          96.9   87.4   81.2   98.0   38.5  100.0   92.1
1717   ---------------------------- ------ ------ ------ ------ ------ ------ ------
1718
1719 =head1 MORE INFORMATION
1720
1721 Check out the DBM::Deep Google Group at L<http://groups.google.com/group/DBM-Deep>
1722 or send email to L<DBM-Deep@googlegroups.com>. You can also visit #dbm-deep on
1723 irc.perl.org
1724
1725 The source code repository is at L<http://svn.perl.org/modules/DBM-Deep>
1726
1727 =head1 MAINTAINERS
1728
1729 Rob Kinyon, L<rkinyon@cpan.org>
1730
1731 Originally written by Joseph Huckaby, L<jhuckaby@cpan.org>
1732
1733 Special thanks to Adam Sah and Rich Gaushell!  You know why :-)
1734
1735 =head1 SEE ALSO
1736
1737 perltie(1), Tie::Hash(3), Digest::MD5(3), Fcntl(3), flock(2), lockf(3), nfs(5),
1738 Digest::SHA256(3), Crypt::Blowfish(3), Compress::Zlib(3)
1739
1740 =head1 LICENSE
1741
1742 Copyright (c) 2002-2006 Joseph Huckaby.  All Rights Reserved.
1743 This is free software, you may use it and distribute it under the
1744 same terms as Perl itself.
1745
1746 =cut