Had to turn off caching, but I've merged everything from SPROUT's fixes
[dbsrgits/DBM-Deep.git] / lib / DBM / Deep / Hash.pm
index cc84b64..40f0bf6 100644 (file)
@@ -4,6 +4,7 @@ use 5.006_000;
 
 use strict;
 use warnings FATAL => 'all';
+no warnings 'recursion';
 
 use base 'DBM::Deep';
 
@@ -14,9 +15,6 @@ sub _get_self {
 sub _repr { return {} }
 
 sub TIEHASH {
-    ##
-    # Tied hash constructor method, called by Perl's tie() function.
-    ##
     my $class = shift;
     my $args = $class->_get_args( @_ );
     
@@ -66,27 +64,23 @@ sub DELETE {
     return $self->SUPER::DELETE( $key, $_[0] );
 }
 
+# Locate and return first key (in no particular order)
 sub FIRSTKEY {
-    ##
-    # Locate and return first key (in no particular order)
-    ##
     my $self = shift->_get_self;
 
     $self->lock_shared;
     
     my $result = $self->_engine->get_next_key( $self );
     
-    $self->unlock();
+    $self->unlock;
     
     return ($result && $self->_engine->storage->{filter_fetch_key})
         ? $self->_engine->storage->{filter_fetch_key}->($result)
         : $result;
 }
 
+# Return next key (in no particular order), given previous one
 sub NEXTKEY {
-    ##
-    # Return next key (in no particular order), given previous one
-    ##
     my $self = shift->_get_self;
 
     my $prev_key = ($self->_engine->storage->{filter_store_key})
@@ -97,18 +91,27 @@ sub NEXTKEY {
     
     my $result = $self->_engine->get_next_key( $self, $prev_key );
     
-    $self->unlock();
+    $self->unlock;
     
     return ($result && $self->_engine->storage->{filter_fetch_key})
         ? $self->_engine->storage->{filter_fetch_key}->($result)
         : $result;
 }
 
-##
-# Public method aliases
-##
 sub first_key { (shift)->FIRSTKEY(@_) }
-sub next_key { (shift)->NEXTKEY(@_) }
+sub next_key  { (shift)->NEXTKEY(@_)  }
+
+sub _clear {
+    my $self = shift->_get_self;
+
+    while ( defined(my $key = $self->first_key) ) {
+      do {
+        $self->_engine->delete_key( $self, $key, $key );
+      } while defined($key = $self->next_key($key));
+    }
+
+    return;
+}
 
 sub _copy_node {
     my $self = shift;