Commit | Line | Data |
ffed8b01 |
1 | package DBM::Deep; |
2 | |
b48ae6ec |
3 | use 5.006_000; |
460b1067 |
4 | |
ffed8b01 |
5 | use strict; |
460b1067 |
6 | use warnings; |
8b957036 |
7 | |
6e78585c |
8 | our $VERSION = q(1.0009); |
86867f3a |
9 | |
9a63e1f2 |
10 | use Fcntl qw( :flock ); |
12b96196 |
11 | |
ffed8b01 |
12 | use Digest::MD5 (); |
13 | use Scalar::Util (); |
ffed8b01 |
14 | |
9a63e1f2 |
15 | use DBM::Deep::Engine; |
460b1067 |
16 | use DBM::Deep::File; |
95967a5e |
17 | |
ef3cf62e |
18 | use overload |
19 | '""' => sub { overload::StrVal( $_[0] ) }, |
20 | fallback => 1; |
21 | |
ffed8b01 |
22 | ## |
23 | # Setup constants for users to pass to new() |
24 | ## |
9a63e1f2 |
25 | sub TYPE_HASH () { DBM::Deep::Engine->SIG_HASH } |
26 | sub TYPE_ARRAY () { DBM::Deep::Engine->SIG_ARRAY } |
ffed8b01 |
27 | |
9a63e1f2 |
28 | # This is used in all the children of this class in their TIE<type> methods. |
0ca7ea98 |
29 | sub _get_args { |
30 | my $proto = shift; |
31 | |
32 | my $args; |
33 | if (scalar(@_) > 1) { |
34 | if ( @_ % 2 ) { |
35 | $proto->_throw_error( "Odd number of parameters to " . (caller(1))[2] ); |
36 | } |
37 | $args = {@_}; |
38 | } |
d0b74c17 |
39 | elsif ( ref $_[0] ) { |
4d35d856 |
40 | unless ( eval { local $SIG{'__DIE__'}; %{$_[0]} || 1 } ) { |
0ca7ea98 |
41 | $proto->_throw_error( "Not a hashref in args to " . (caller(1))[2] ); |
42 | } |
43 | $args = $_[0]; |
44 | } |
d0b74c17 |
45 | else { |
0ca7ea98 |
46 | $args = { file => shift }; |
47 | } |
48 | |
49 | return $args; |
50 | } |
51 | |
ffed8b01 |
52 | sub new { |
d0b74c17 |
53 | ## |
54 | # Class constructor method for Perl OO interface. |
55 | # Calls tie() and returns blessed reference to tied hash or array, |
56 | # providing a hybrid OO/tie interface. |
57 | ## |
58 | my $class = shift; |
59 | my $args = $class->_get_args( @_ ); |
60 | |
61 | ## |
62 | # Check if we want a tied hash or array. |
63 | ## |
64 | my $self; |
65 | if (defined($args->{type}) && $args->{type} eq TYPE_ARRAY) { |
6fe26b29 |
66 | $class = 'DBM::Deep::Array'; |
67 | require DBM::Deep::Array; |
d0b74c17 |
68 | tie @$self, $class, %$args; |
69 | } |
70 | else { |
6fe26b29 |
71 | $class = 'DBM::Deep::Hash'; |
72 | require DBM::Deep::Hash; |
d0b74c17 |
73 | tie %$self, $class, %$args; |
74 | } |
ffed8b01 |
75 | |
d0b74c17 |
76 | return bless $self, $class; |
ffed8b01 |
77 | } |
78 | |
96041a25 |
79 | # This initializer is called from the various TIE* methods. new() calls tie(), |
80 | # which allows for a single point of entry. |
0795f290 |
81 | sub _init { |
0795f290 |
82 | my $class = shift; |
994ccd8e |
83 | my ($args) = @_; |
0795f290 |
84 | |
83371fe3 |
85 | $args->{storage} = DBM::Deep::File->new( $args ) |
86 | unless exists $args->{storage}; |
460b1067 |
87 | |
88 | # locking implicitly enables autoflush |
89 | if ($args->{locking}) { $args->{autoflush} = 1; } |
90 | |
0795f290 |
91 | # These are the defaults to be optionally overridden below |
92 | my $self = bless { |
95967a5e |
93 | type => TYPE_HASH, |
e06824f8 |
94 | base_offset => undef, |
9a63e1f2 |
95 | staleness => undef, |
359a01ac |
96 | |
83371fe3 |
97 | storage => undef, |
9a63e1f2 |
98 | engine => undef, |
0795f290 |
99 | }, $class; |
9a63e1f2 |
100 | |
101 | $args->{engine} = DBM::Deep::Engine->new( { %{$args}, obj => $self } ) |
102 | unless exists $args->{engine}; |
8db25060 |
103 | |
fde3db1a |
104 | # Grab the parameters we want to use |
0795f290 |
105 | foreach my $param ( keys %$self ) { |
106 | next unless exists $args->{$param}; |
3e9498a1 |
107 | $self->{$param} = $args->{$param}; |
ffed8b01 |
108 | } |
d0b74c17 |
109 | |
9a63e1f2 |
110 | eval { |
111 | local $SIG{'__DIE__'}; |
0795f290 |
112 | |
9a63e1f2 |
113 | $self->lock; |
114 | $self->_engine->setup_fh( $self ); |
115 | $self->_storage->set_inode; |
116 | $self->unlock; |
117 | }; if ( $@ ) { |
118 | my $e = $@; |
119 | eval { local $SIG{'__DIE__'}; $self->unlock; }; |
120 | die $e; |
121 | } |
359a01ac |
122 | |
0795f290 |
123 | return $self; |
ffed8b01 |
124 | } |
125 | |
ffed8b01 |
126 | sub TIEHASH { |
6fe26b29 |
127 | shift; |
128 | require DBM::Deep::Hash; |
129 | return DBM::Deep::Hash->TIEHASH( @_ ); |
ffed8b01 |
130 | } |
131 | |
132 | sub TIEARRAY { |
6fe26b29 |
133 | shift; |
134 | require DBM::Deep::Array; |
135 | return DBM::Deep::Array->TIEARRAY( @_ ); |
ffed8b01 |
136 | } |
137 | |
ffed8b01 |
138 | sub lock { |
994ccd8e |
139 | my $self = shift->_get_self; |
83371fe3 |
140 | return $self->_storage->lock( $self, @_ ); |
ffed8b01 |
141 | } |
142 | |
143 | sub unlock { |
994ccd8e |
144 | my $self = shift->_get_self; |
83371fe3 |
145 | return $self->_storage->unlock( $self, @_ ); |
ffed8b01 |
146 | } |
147 | |
906c8e01 |
148 | sub _copy_value { |
149 | my $self = shift->_get_self; |
150 | my ($spot, $value) = @_; |
151 | |
152 | if ( !ref $value ) { |
153 | ${$spot} = $value; |
154 | } |
155 | elsif ( eval { local $SIG{__DIE__}; $value->isa( 'DBM::Deep' ) } ) { |
f9c33187 |
156 | ${$spot} = $value->_repr; |
906c8e01 |
157 | $value->_copy_node( ${$spot} ); |
158 | } |
159 | else { |
160 | my $r = Scalar::Util::reftype( $value ); |
161 | my $c = Scalar::Util::blessed( $value ); |
162 | if ( $r eq 'ARRAY' ) { |
163 | ${$spot} = [ @{$value} ]; |
164 | } |
165 | else { |
166 | ${$spot} = { %{$value} }; |
167 | } |
95bbd935 |
168 | ${$spot} = bless ${$spot}, $c |
906c8e01 |
169 | if defined $c; |
170 | } |
171 | |
172 | return 1; |
173 | } |
174 | |
9a63e1f2 |
175 | #sub _copy_node { |
176 | # die "Must be implemented in a child class\n"; |
177 | #} |
178 | # |
179 | #sub _repr { |
180 | # die "Must be implemented in a child class\n"; |
181 | #} |
ffed8b01 |
182 | |
183 | sub export { |
d0b74c17 |
184 | ## |
185 | # Recursively export into standard Perl hashes and arrays. |
186 | ## |
994ccd8e |
187 | my $self = shift->_get_self; |
d0b74c17 |
188 | |
f9c33187 |
189 | my $temp = $self->_repr; |
d0b74c17 |
190 | |
191 | $self->lock(); |
192 | $self->_copy_node( $temp ); |
193 | $self->unlock(); |
194 | |
9a63e1f2 |
195 | my $classname = $self->_engine->get_classname( $self ); |
196 | if ( defined $classname ) { |
197 | bless $temp, $classname; |
68f943b3 |
198 | } |
199 | |
d0b74c17 |
200 | return $temp; |
ffed8b01 |
201 | } |
202 | |
4301e879 |
203 | sub _check_legality { |
204 | my $self = shift; |
205 | my ($val) = @_; |
206 | |
207 | my $r = Scalar::Util::reftype( $val ); |
208 | |
209 | return $r if !defined $r || '' eq $r; |
210 | return $r if 'HASH' eq $r; |
211 | return $r if 'ARRAY' eq $r; |
212 | |
213 | DBM::Deep->_throw_error( |
214 | "Storage of references of type '$r' is not supported." |
215 | ); |
216 | } |
217 | |
ffed8b01 |
218 | sub import { |
4301e879 |
219 | # Perl calls import() on use -- ignore |
220 | return if !ref $_[0]; |
d0b74c17 |
221 | |
994ccd8e |
222 | my $self = shift->_get_self; |
223 | my ($struct) = @_; |
d0b74c17 |
224 | |
4301e879 |
225 | my $type = $self->_check_legality( $struct ); |
226 | if ( !$type ) { |
227 | DBM::Deep->_throw_error( "Cannot import a scalar" ); |
d0b74c17 |
228 | } |
229 | |
4301e879 |
230 | if ( substr( $type, 0, 1 ) ne $self->_type ) { |
231 | DBM::Deep->_throw_error( |
232 | "Cannot import " . ('HASH' eq $type ? 'a hash' : 'an array') |
233 | . " into " . ('HASH' eq $type ? 'an array' : 'a hash') |
234 | ); |
7a960a12 |
235 | } |
236 | |
4301e879 |
237 | my %seen; |
238 | my $recurse; |
239 | $recurse = sub { |
240 | my ($db, $val) = @_; |
241 | |
242 | my $obj = 'HASH' eq Scalar::Util::reftype( $db ) ? tied(%$db) : tied(@$db); |
243 | $obj ||= $db; |
244 | |
245 | my $r = $self->_check_legality( $val ); |
246 | if ( 'HASH' eq $r ) { |
247 | while ( my ($k, $v) = each %$val ) { |
248 | my $r = $self->_check_legality( $v ); |
249 | if ( $r ) { |
250 | my $temp = 'HASH' eq $r ? {} : []; |
251 | if ( my $c = Scalar::Util::blessed( $v ) ) { |
252 | bless $temp, $c; |
253 | } |
254 | $obj->put( $k, $temp ); |
255 | $recurse->( $temp, $v ); |
256 | } |
257 | else { |
258 | $obj->put( $k, $v ); |
259 | } |
260 | } |
261 | } |
262 | elsif ( 'ARRAY' eq $r ) { |
263 | foreach my $k ( 0 .. $#$val ) { |
264 | my $v = $val->[$k]; |
265 | my $r = $self->_check_legality( $v ); |
266 | if ( $r ) { |
267 | my $temp = 'HASH' eq $r ? {} : []; |
268 | if ( my $c = Scalar::Util::blessed( $v ) ) { |
269 | bless $temp, $c; |
270 | } |
271 | $obj->put( $k, $temp ); |
272 | $recurse->( $temp, $v ); |
273 | } |
274 | else { |
275 | $obj->put( $k, $v ); |
276 | } |
277 | } |
278 | } |
279 | }; |
280 | $recurse->( $self, $struct ); |
281 | |
7a960a12 |
282 | return 1; |
ffed8b01 |
283 | } |
284 | |
13ff93d5 |
285 | #XXX Need to keep track of who has a fh to this file in order to |
286 | #XXX close them all prior to optimize on Win32/cygwin |
ffed8b01 |
287 | sub optimize { |
d0b74c17 |
288 | ## |
289 | # Rebuild entire database into new file, then move |
290 | # it back on top of original. |
291 | ## |
994ccd8e |
292 | my $self = shift->_get_self; |
cc4bef86 |
293 | |
294 | #XXX Need to create a new test for this |
83371fe3 |
295 | # if ($self->_storage->{links} > 1) { |
1400a48e |
296 | # $self->_throw_error("Cannot optimize: reference count is greater than 1"); |
d0b74c17 |
297 | # } |
298 | |
7a960a12 |
299 | #XXX Do we have to lock the tempfile? |
300 | |
4301e879 |
301 | #XXX Should we use tempfile() here instead of a hard-coded name? |
6e78585c |
302 | my $temp_filename = $self->_storage->{file} . '.tmp'; |
d0b74c17 |
303 | my $db_temp = DBM::Deep->new( |
6e78585c |
304 | file => $temp_filename, |
9a63e1f2 |
305 | type => $self->_type, |
306 | |
307 | # Bring over all the parameters that we need to bring over |
3300d0b3 |
308 | ( map { $_ => $self->_engine->$_ } qw( |
309 | byte_size max_buckets data_sector_size num_txns |
310 | )), |
d0b74c17 |
311 | ); |
d0b74c17 |
312 | |
313 | $self->lock(); |
90a80a23 |
314 | $self->_engine->clear_cache; |
d0b74c17 |
315 | $self->_copy_node( $db_temp ); |
316 | undef $db_temp; |
317 | |
318 | ## |
319 | # Attempt to copy user, group and permissions over to new file |
320 | ## |
6e78585c |
321 | $self->_storage->copy_stats( $temp_filename ); |
d0b74c17 |
322 | |
ffed8b01 |
323 | # q.v. perlport for more information on this variable |
90f93b43 |
324 | if ( $^O eq 'MSWin32' || $^O eq 'cygwin' ) { |
d0b74c17 |
325 | ## |
326 | # Potential race condition when optmizing on Win32 with locking. |
327 | # The Windows filesystem requires that the filehandle be closed |
328 | # before it is overwritten with rename(). This could be redone |
329 | # with a soft copy. |
330 | ## |
331 | $self->unlock(); |
83371fe3 |
332 | $self->_storage->close; |
d0b74c17 |
333 | } |
334 | |
6e78585c |
335 | if (!rename $temp_filename, $self->_storage->{file}) { |
336 | unlink $temp_filename; |
d0b74c17 |
337 | $self->unlock(); |
1400a48e |
338 | $self->_throw_error("Optimize failed: Cannot copy temp file over original: $!"); |
d0b74c17 |
339 | } |
340 | |
341 | $self->unlock(); |
83371fe3 |
342 | $self->_storage->close; |
9a63e1f2 |
343 | |
83371fe3 |
344 | $self->_storage->open; |
9a63e1f2 |
345 | $self->lock(); |
72e315ac |
346 | $self->_engine->setup_fh( $self ); |
9a63e1f2 |
347 | $self->unlock(); |
70b55428 |
348 | |
d0b74c17 |
349 | return 1; |
ffed8b01 |
350 | } |
351 | |
352 | sub clone { |
d0b74c17 |
353 | ## |
354 | # Make copy of object and return |
355 | ## |
994ccd8e |
356 | my $self = shift->_get_self; |
d0b74c17 |
357 | |
358 | return DBM::Deep->new( |
c3aafc14 |
359 | type => $self->_type, |
d0b74c17 |
360 | base_offset => $self->_base_offset, |
9a63e1f2 |
361 | staleness => $self->_staleness, |
83371fe3 |
362 | storage => $self->_storage, |
9a63e1f2 |
363 | engine => $self->_engine, |
d0b74c17 |
364 | ); |
ffed8b01 |
365 | } |
366 | |
9a63e1f2 |
367 | #XXX Migrate this to the engine, where it really belongs and go through some |
368 | # API - stop poking in the innards of someone else.. |
ffed8b01 |
369 | { |
370 | my %is_legal_filter = map { |
371 | $_ => ~~1, |
372 | } qw( |
373 | store_key store_value |
374 | fetch_key fetch_value |
375 | ); |
376 | |
377 | sub set_filter { |
994ccd8e |
378 | my $self = shift->_get_self; |
379 | my $type = lc shift; |
380 | my $func = shift; |
d0b74c17 |
381 | |
ffed8b01 |
382 | if ( $is_legal_filter{$type} ) { |
83371fe3 |
383 | $self->_storage->{"filter_$type"} = $func; |
ffed8b01 |
384 | return 1; |
385 | } |
386 | |
387 | return; |
388 | } |
9f83dc31 |
389 | |
390 | sub filter_store_key { $_[0]->set_filter( store_key => $_[1] ); } |
391 | sub filter_store_value { $_[0]->set_filter( store_value => $_[1] ); } |
392 | sub filter_fetch_key { $_[0]->set_filter( fetch_key => $_[1] ); } |
393 | sub filter_fetch_value { $_[0]->set_filter( fetch_value => $_[1] ); } |
ffed8b01 |
394 | } |
395 | |
fee0243f |
396 | sub begin_work { |
397 | my $self = shift->_get_self; |
9a63e1f2 |
398 | return $self->_engine->begin_work( $self, @_ ); |
fee0243f |
399 | } |
400 | |
401 | sub rollback { |
402 | my $self = shift->_get_self; |
9a63e1f2 |
403 | return $self->_engine->rollback( $self, @_ ); |
fee0243f |
404 | } |
405 | |
359a01ac |
406 | sub commit { |
407 | my $self = shift->_get_self; |
9a63e1f2 |
408 | return $self->_engine->commit( $self, @_ ); |
359a01ac |
409 | } |
fee0243f |
410 | |
ffed8b01 |
411 | ## |
412 | # Accessor methods |
413 | ## |
414 | |
72e315ac |
415 | sub _engine { |
416 | my $self = $_[0]->_get_self; |
417 | return $self->{engine}; |
418 | } |
419 | |
83371fe3 |
420 | sub _storage { |
2ac02042 |
421 | my $self = $_[0]->_get_self; |
83371fe3 |
422 | return $self->{storage}; |
ffed8b01 |
423 | } |
424 | |
4d35d856 |
425 | sub _type { |
2ac02042 |
426 | my $self = $_[0]->_get_self; |
d0b74c17 |
427 | return $self->{type}; |
ffed8b01 |
428 | } |
429 | |
4d35d856 |
430 | sub _base_offset { |
2ac02042 |
431 | my $self = $_[0]->_get_self; |
d0b74c17 |
432 | return $self->{base_offset}; |
ffed8b01 |
433 | } |
434 | |
9a63e1f2 |
435 | sub _staleness { |
436 | my $self = $_[0]->_get_self; |
437 | return $self->{staleness}; |
438 | } |
439 | |
ffed8b01 |
440 | ## |
441 | # Utility methods |
442 | ## |
443 | |
261d1296 |
444 | sub _throw_error { |
a34e9b3f |
445 | my $n = 0; |
446 | while( 1 ) { |
447 | my @caller = caller( ++$n ); |
448 | next if $caller[0] =~ m/^DBM::Deep/; |
449 | |
450 | die "DBM::Deep: $_[1] at $0 line $caller[2]\n"; |
a34e9b3f |
451 | } |
ffed8b01 |
452 | } |
453 | |
ffed8b01 |
454 | sub STORE { |
d0b74c17 |
455 | ## |
456 | # Store single hash key/value or array element in database. |
457 | ## |
458 | my $self = shift->_get_self; |
9a63e1f2 |
459 | my ($key, $value) = @_; |
81d3d316 |
460 | |
6e78585c |
461 | unless ( $self->_storage->is_writable ) { |
acd4faf2 |
462 | $self->_throw_error( 'Cannot write to a readonly filehandle' ); |
463 | } |
d0b74c17 |
464 | |
465 | ## |
466 | # Request exclusive lock for writing |
467 | ## |
468 | $self->lock( LOCK_EX ); |
469 | |
0cb639bd |
470 | # User may be storing a complex value, in which case we do not want it run |
471 | # through the filtering system. |
83371fe3 |
472 | if ( !ref($value) && $self->_storage->{filter_store_value} ) { |
473 | $value = $self->_storage->{filter_store_value}->( $value ); |
d0b74c17 |
474 | } |
475 | |
9a63e1f2 |
476 | $self->_engine->write_value( $self, $key, $value); |
d0b74c17 |
477 | |
478 | $self->unlock(); |
479 | |
86867f3a |
480 | return 1; |
ffed8b01 |
481 | } |
482 | |
483 | sub FETCH { |
d0b74c17 |
484 | ## |
485 | # Fetch single value or element given plain key or array index |
486 | ## |
cb79ec85 |
487 | my $self = shift->_get_self; |
9a63e1f2 |
488 | my ($key) = @_; |
ffed8b01 |
489 | |
d0b74c17 |
490 | ## |
491 | # Request shared lock for reading |
492 | ## |
493 | $self->lock( LOCK_SH ); |
494 | |
9a63e1f2 |
495 | my $result = $self->_engine->read_value( $self, $key); |
d0b74c17 |
496 | |
497 | $self->unlock(); |
498 | |
a86430bd |
499 | # Filters only apply to scalar values, so the ref check is making |
500 | # sure the fetched bucket is a scalar, not a child hash or array. |
83371fe3 |
501 | return ($result && !ref($result) && $self->_storage->{filter_fetch_value}) |
502 | ? $self->_storage->{filter_fetch_value}->($result) |
cb79ec85 |
503 | : $result; |
ffed8b01 |
504 | } |
505 | |
506 | sub DELETE { |
d0b74c17 |
507 | ## |
508 | # Delete single key/value pair or element given plain key or array index |
509 | ## |
a97c8f67 |
510 | my $self = shift->_get_self; |
9a63e1f2 |
511 | my ($key) = @_; |
d0b74c17 |
512 | |
6e78585c |
513 | unless ( $self->_storage->is_writable ) { |
a86430bd |
514 | $self->_throw_error( 'Cannot write to a readonly filehandle' ); |
515 | } |
d0b74c17 |
516 | |
517 | ## |
518 | # Request exclusive lock for writing |
519 | ## |
520 | $self->lock( LOCK_EX ); |
521 | |
d0b74c17 |
522 | ## |
523 | # Delete bucket |
524 | ## |
9a63e1f2 |
525 | my $value = $self->_engine->delete_key( $self, $key); |
a86430bd |
526 | |
83371fe3 |
527 | if (defined $value && !ref($value) && $self->_storage->{filter_fetch_value}) { |
528 | $value = $self->_storage->{filter_fetch_value}->($value); |
3b6a5056 |
529 | } |
530 | |
d0b74c17 |
531 | $self->unlock(); |
532 | |
533 | return $value; |
ffed8b01 |
534 | } |
535 | |
536 | sub EXISTS { |
d0b74c17 |
537 | ## |
538 | # Check if a single key or element exists given plain key or array index |
539 | ## |
a97c8f67 |
540 | my $self = shift->_get_self; |
541 | my ($key) = @_; |
d0b74c17 |
542 | |
d0b74c17 |
543 | ## |
544 | # Request shared lock for reading |
545 | ## |
546 | $self->lock( LOCK_SH ); |
547 | |
9a63e1f2 |
548 | my $result = $self->_engine->key_exists( $self, $key ); |
d0b74c17 |
549 | |
550 | $self->unlock(); |
551 | |
552 | return $result; |
ffed8b01 |
553 | } |
554 | |
555 | sub CLEAR { |
d0b74c17 |
556 | ## |
557 | # Clear all keys from hash, or all elements from array. |
558 | ## |
a97c8f67 |
559 | my $self = shift->_get_self; |
ffed8b01 |
560 | |
6e78585c |
561 | unless ( $self->_storage->is_writable ) { |
a86430bd |
562 | $self->_throw_error( 'Cannot write to a readonly filehandle' ); |
563 | } |
564 | |
d0b74c17 |
565 | ## |
566 | # Request exclusive lock for writing |
567 | ## |
568 | $self->lock( LOCK_EX ); |
569 | |
9a63e1f2 |
570 | #XXX Rewrite this dreck to do it in the engine as a tight loop vs. |
571 | # iterating over keys - such a WASTE - is this required for transactional |
572 | # clearning?! Surely that can be detected in the engine ... |
f9a320bb |
573 | if ( $self->_type eq TYPE_HASH ) { |
574 | my $key = $self->first_key; |
575 | while ( $key ) { |
83c43bb5 |
576 | # Retrieve the key before deleting because we depend on next_key |
f9a320bb |
577 | my $next_key = $self->next_key( $key ); |
9a63e1f2 |
578 | $self->_engine->delete_key( $self, $key, $key ); |
f9a320bb |
579 | $key = $next_key; |
580 | } |
581 | } |
582 | else { |
583 | my $size = $self->FETCHSIZE; |
c3aafc14 |
584 | for my $key ( 0 .. $size - 1 ) { |
9a63e1f2 |
585 | $self->_engine->delete_key( $self, $key, $key ); |
f9a320bb |
586 | } |
587 | $self->STORESIZE( 0 ); |
588 | } |
d0b74c17 |
589 | |
590 | $self->unlock(); |
591 | |
592 | return 1; |
ffed8b01 |
593 | } |
594 | |
ffed8b01 |
595 | ## |
596 | # Public method aliases |
597 | ## |
7f441181 |
598 | sub put { (shift)->STORE( @_ ) } |
599 | sub store { (shift)->STORE( @_ ) } |
600 | sub get { (shift)->FETCH( @_ ) } |
601 | sub fetch { (shift)->FETCH( @_ ) } |
baa27ab6 |
602 | sub delete { (shift)->DELETE( @_ ) } |
603 | sub exists { (shift)->EXISTS( @_ ) } |
604 | sub clear { (shift)->CLEAR( @_ ) } |
ffed8b01 |
605 | |
0700305e |
606 | sub _dump_file {shift->_get_self->_engine->_dump_file;} |
9f83dc31 |
607 | |
ffed8b01 |
608 | 1; |
ffed8b01 |
609 | __END__ |