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