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