X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBM%2FDeep%2FArray.pm;h=74dad6ca8878789f6c6554aec83d22b91ecf0c61;hb=c3aafc1482fc010410a0dbe2b09b95307cf9f747;hp=687cb190adb637aad4262585422b602205f6b751;hpb=cfd97a7f63c295750c44d5a5be469cf57841b867;p=dbsrgits%2FDBM-Deep.git

diff --git a/lib/DBM/Deep/Array.pm b/lib/DBM/Deep/Array.pm
index 687cb19..74dad6c 100644
--- a/lib/DBM/Deep/Array.pm
+++ b/lib/DBM/Deep/Array.pm
@@ -5,6 +5,8 @@ use 5.6.0;
 use strict;
 use warnings;
 
+our $VERSION = '0.99_03';
+
 # This is to allow DBM::Deep::Array to handle negative indices on
 # its own. Otherwise, Perl would intercept the call to negative
 # indices for us. This was causing bugs for negative index handling.
@@ -36,19 +38,19 @@ sub _import {
 sub TIEARRAY {
     my $class = shift;
     my $args = $class->_get_args( @_ );
-	
-	$args->{type} = $class->TYPE_ARRAY;
-	
-	return $class->_init($args);
+
+    $args->{type} = $class->TYPE_ARRAY;
+
+    return $class->_init($args);
 }
 
 sub FETCH {
     my $self = shift->_get_self;
     my ($key) = @_;
 
-	$self->lock( $self->LOCK_SH );
+    $self->lock( $self->LOCK_SH );
 
-    my $orig_key = $key eq 'length' ? undef : $key;
+    my $orig_key;
     if ( $key =~ /^-?\d+$/ ) {
         if ( $key < 0 ) {
             $key += $self->FETCHSIZE;
@@ -57,8 +59,10 @@ sub FETCH {
                 return;
             }
         }
-
-        $key = pack($self->{engine}{long_pack}, $key);
+        $orig_key = $key;
+    }
+    else {
+        $orig_key = undef;
     }
 
     my $rv = $self->SUPER::FETCH( $key, $orig_key );
@@ -74,29 +78,25 @@ sub STORE {
 
     $self->lock( $self->LOCK_EX );
 
-    my $orig = $key eq 'length' ? undef : $key;
-
     my $size;
-    my $numeric_idx;
+    my $idx_is_numeric;
     if ( $key =~ /^\-?\d+$/ ) {
-        $numeric_idx = 1;
+        $idx_is_numeric = 1;
         if ( $key < 0 ) {
             $size = $self->FETCHSIZE;
-            $key += $size;
-            if ( $key < 0 ) {
-                die( "Modification of non-creatable array value attempted, subscript $orig" );
+            if ( $key + $size < 0 ) {
+                die( "Modification of non-creatable array value attempted, subscript $key" );
             }
+            $key += $size
         }
-
-        $key = pack($self->{engine}{long_pack}, $key);
     }
 
-    my $rv = $self->SUPER::STORE( $key, $value, $orig );
+    my $rv = $self->SUPER::STORE( $key, $value, ($key eq 'length' ? undef : $key) );
 
-    if ( $numeric_idx && $rv == 2 ) {
+    if ( $idx_is_numeric ) {
         $size = $self->FETCHSIZE unless defined $size;
-        if ( $orig >= $size ) {
-            $self->STORESIZE( $orig + 1 );
+        if ( $key >= $size ) {
+            $self->STORESIZE( $key + 1 );
         }
     }
 
@@ -109,7 +109,7 @@ sub EXISTS {
     my $self = shift->_get_self;
     my ($key) = @_;
 
-	$self->lock( $self->LOCK_SH );
+    $self->lock( $self->LOCK_SH );
 
     if ( $key =~ /^\-?\d+$/ ) {
         if ( $key < 0 ) {
@@ -119,8 +119,6 @@ sub EXISTS {
                 return;
             }
         }
-
-        $key = pack($self->{engine}{long_pack}, $key);
     }
 
     my $rv = $self->SUPER::EXISTS( $key );
@@ -134,9 +132,6 @@ sub DELETE {
     my $self = shift->_get_self;
     my ($key) = @_;
 
-    my $unpacked_key = $key;
-    my $orig = $key eq 'length' ? undef : $key;
-
     $self->lock( $self->LOCK_EX );
 
     my $size = $self->FETCHSIZE;
@@ -148,15 +143,13 @@ sub DELETE {
                 return;
             }
         }
-
-        $key = pack($self->{engine}{long_pack}, $key);
     }
 
-    my $rv = $self->SUPER::DELETE( $key, $orig );
+    my $rv = $self->SUPER::DELETE( $key );
 
-	if ($rv && $unpacked_key == $size - 1) {
-		$self->STORESIZE( $unpacked_key );
-	}
+    if ($rv && $key == $size - 1) {
+        $self->STORESIZE( $key, ($key eq 'length' ? undef : $key) );
+    }
 
     $self->unlock;
 
@@ -168,38 +161,38 @@ sub FETCHSIZE {
 
     $self->lock( $self->LOCK_SH );
 
-	my $SAVE_FILTER = $self->_fileobj->{filter_fetch_value};
-	$self->_fileobj->{filter_fetch_value} = undef;
-	
-	my $packed_size = $self->FETCH('length');
-	
-	$self->_fileobj->{filter_fetch_value} = $SAVE_FILTER;
-	
+    my $SAVE_FILTER = $self->_fileobj->{filter_fetch_value};
+    $self->_fileobj->{filter_fetch_value} = undef;
+
+    my $packed_size = $self->FETCH('length');
+
+    $self->_fileobj->{filter_fetch_value} = $SAVE_FILTER;
+
     $self->unlock;
 
-	if ($packed_size) {
-        return int(unpack($self->{engine}{long_pack}, $packed_size));
+    if ($packed_size) {
+        return int(unpack($self->_engine->{long_pack}, $packed_size));
     }
 
-	return 0;
+    return 0;
 }
 
 sub STORESIZE {
     my $self = shift->_get_self;
-	my ($new_length) = @_;
-	
+    my ($new_length) = @_;
+
     $self->lock( $self->LOCK_EX );
 
-	my $SAVE_FILTER = $self->_fileobj->{filter_store_value};
-	$self->_fileobj->{filter_store_value} = undef;
-	
-	my $result = $self->STORE('length', pack($self->{engine}{long_pack}, $new_length));
-	
-	$self->_fileobj->{filter_store_value} = $SAVE_FILTER;
-	
+    my $SAVE_FILTER = $self->_fileobj->{filter_store_value};
+    $self->_fileobj->{filter_store_value} = undef;
+
+    my $result = $self->STORE('length', pack($self->_engine->{long_pack}, $new_length), 'length');
+
+    $self->_fileobj->{filter_store_value} = $SAVE_FILTER;
+
     $self->unlock;
 
-	return $result;
+    return $result;
 }
 
 sub POP {
@@ -207,33 +200,33 @@ sub POP {
 
     $self->lock( $self->LOCK_EX );
 
-	my $length = $self->FETCHSIZE();
-	
-	if ($length) {
-		my $content = $self->FETCH( $length - 1 );
-		$self->DELETE( $length - 1 );
+    my $length = $self->FETCHSIZE();
+
+    if ($length) {
+        my $content = $self->FETCH( $length - 1 );
+        $self->DELETE( $length - 1 );
 
         $self->unlock;
 
-		return $content;
-	}
-	else {
+        return $content;
+    }
+    else {
         $self->unlock;
-		return;
-	}
+        return;
+    }
 }
 
 sub PUSH {
     my $self = shift->_get_self;
-	
+
     $self->lock( $self->LOCK_EX );
 
-	my $length = $self->FETCHSIZE();
+    my $length = $self->FETCHSIZE();
 
-	while (my $content = shift @_) {
-		$self->STORE( $length, $content );
-		$length++;
-	}
+    while (my $content = shift @_) {
+        $self->STORE( $length, $content );
+        $length++;
+    }
 
     $self->unlock;
 
@@ -245,44 +238,44 @@ sub SHIFT {
 
     $self->lock( $self->LOCK_EX );
 
-	my $length = $self->FETCHSIZE();
-	
-	if ($length) {
-		my $content = $self->FETCH( 0 );
-		
-		for (my $i = 0; $i < $length - 1; $i++) {
-			$self->STORE( $i, $self->FETCH($i + 1) );
-		}
-		$self->DELETE( $length - 1 );
+    my $length = $self->FETCHSIZE();
+
+    if ($length) {
+        my $content = $self->FETCH( 0 );
+
+        for (my $i = 0; $i < $length - 1; $i++) {
+            $self->STORE( $i, $self->FETCH($i + 1) );
+        }
+        $self->DELETE( $length - 1 );
 
         $self->unlock;
-		
-		return $content;
-	}
-	else {
+
+        return $content;
+    }
+    else {
         $self->unlock;
-		return;
-	}
+        return;
+    }
 }
 
 sub UNSHIFT {
     my $self = shift->_get_self;
-	my @new_elements = @_;
+    my @new_elements = @_;
 
     $self->lock( $self->LOCK_EX );
 
-	my $length = $self->FETCHSIZE();
-	my $new_size = scalar @new_elements;
-	
-	if ($length) {
-		for (my $i = $length - 1; $i >= 0; $i--) {
-			$self->STORE( $i + $new_size, $self->FETCH($i) );
-		}
-	}
-	
-	for (my $i = 0; $i < $new_size; $i++) {
-		$self->STORE( $i, $new_elements[$i] );
-	}
+    my $length = $self->FETCHSIZE();
+    my $new_size = scalar @new_elements;
+
+    if ($length) {
+        for (my $i = $length - 1; $i >= 0; $i--) {
+            $self->STORE( $i + $new_size, $self->FETCH($i) );
+        }
+    }
+
+    for (my $i = 0; $i < $new_size; $i++) {
+        $self->STORE( $i, $new_elements[$i] );
+    }
 
     $self->unlock;
 
@@ -294,33 +287,33 @@ sub SPLICE {
 
     $self->lock( $self->LOCK_EX );
 
-	my $length = $self->FETCHSIZE();
-	
-	##
-	# Calculate offset and length of splice
-	##
-	my $offset = shift;
+    my $length = $self->FETCHSIZE();
+
+    ##
+    # Calculate offset and length of splice
+    ##
+    my $offset = shift;
     $offset = 0 unless defined $offset;
-	if ($offset < 0) { $offset += $length; }
-	
-	my $splice_length;
-	if (scalar @_) { $splice_length = shift; }
-	else { $splice_length = $length - $offset; }
-	if ($splice_length < 0) { $splice_length += ($length - $offset); }
-	
-	##
-	# Setup array with new elements, and copy out old elements for return
-	##
-	my @new_elements = @_;
-	my $new_size = scalar @new_elements;
-	
+    if ($offset < 0) { $offset += $length; }
+
+    my $splice_length;
+    if (scalar @_) { $splice_length = shift; }
+    else { $splice_length = $length - $offset; }
+    if ($splice_length < 0) { $splice_length += ($length - $offset); }
+
+    ##
+    # Setup array with new elements, and copy out old elements for return
+    ##
+    my @new_elements = @_;
+    my $new_size = scalar @new_elements;
+
     my @old_elements = map {
         $self->FETCH( $_ )
     } $offset .. ($offset + $splice_length - 1);
-	
-	##
-	# Adjust array length, and shift elements to accomodate new section.
-	##
+
+    ##
+    # Adjust array length, and shift elements to accomodate new section.
+    ##
     if ( $new_size != $splice_length ) {
         if ($new_size > $splice_length) {
             for (my $i = $length - 1; $i >= $offset + $splice_length; $i--) {
@@ -336,30 +329,30 @@ sub SPLICE {
                 $length--;
             }
         }
-	}
-	
-	##
-	# Insert new elements into array
-	##
-	for (my $i = $offset; $i < $offset + $new_size; $i++) {
-		$self->STORE( $i, shift @new_elements );
-	}
-	
+    }
+
+    ##
+    # Insert new elements into array
+    ##
+    for (my $i = $offset; $i < $offset + $new_size; $i++) {
+        $self->STORE( $i, shift @new_elements );
+    }
+
     $self->unlock;
 
-	##
-	# Return deleted section, or last element in scalar context.
-	##
-	return wantarray ? @old_elements : $old_elements[-1];
+    ##
+    # Return deleted section, or last element in scalar context.
+    ##
+    return wantarray ? @old_elements : $old_elements[-1];
 }
 
 # We don't need to define it, yet.
 # It will be useful, though, when we split out HASH and ARRAY
 sub EXTEND {
-	##
-	# Perl will call EXTEND() when the array is likely to grow.
-	# We don't care, but include it because it gets called at times.
-	##
+    ##
+    # Perl will call EXTEND() when the array is likely to grow.
+    # We don't care, but include it because it gets called at times.
+    ##
 }
 
 sub _copy_node {