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