File Coverage

blib/lib/Bit/Vector/Array.pm

Criterion	Covered	Total	%
statement	44	53	83.0
branch	2	2	100.0
condition			n/a
subroutine	13	15	86.6
pod	0	1	0.0
total	59	71	83.1

package Bit::Vector::Array::Tie;

use strict;
use warnings;
use Data::Dumper;

use Tie::Array;
use base 'Tie::Array';

sub TIEARRAY
{
	return bless {}, $_[0];
}

sub CLEAR
{
	$_[0]->{Value}=0;
}

sub STORESIZE
{
	my ($obj,$value)=@_;
	$value=int($value);

	#warn "STORESIZE, $value";

	$obj->{Value}=$value-1;
}

sub FETCHSIZE
{
	my ($obj)=@_;
	my $value = $obj->{Value};
	#warn "FETCHSIZE, $value";
	return $value+1;
}

sub STORE
{
	my($obj,$bit_index,$bit_value)=@_;
	#warn "STORE, $bit_index,$bit_value";

	#################################################
	# if user says
	#	$arr[1]=1;
	# then set bit 1 (lsb) to a '1'
	# if user says
	#	$arr[4]=0;
	# then set bit 4 to a '0'
	#################################################
		{
		$bit_index--;
		$bit_value = $bit_value ? '1' : '0';
		my $bin_str = sprintf("%lb",$obj->{Value});
		my $padding='0'x($bit_index-length($bin_str));
		$bin_str = '00'.$padding.$bin_str;
		my $substr_offset = -1 * ($bit_index+2);
#warn $bin_str;
		substr($bin_str,$substr_offset,1)=$bit_value;
#warn $bin_str;
		my $dec_val = oct('0b'.$bin_str);
		$obj->{Value}=$dec_val;
		}
}


sub FETCH
{
	my($obj,$bit_index)=@_;

	#################################################
	# if user says
	#	my $bit = $arr[1];
	# then return the bit at index 1 (lsb)
	#################################################
		{
		my $bin_str = sprintf("%lb",$obj->{Value});
		my $padding='0'x($bit_index-length($bin_str));
		$bin_str = '00'.$padding.$bin_str;
		my $substr_offset = -1 * ($bit_index+1);
		my $bit_val=substr($bin_str,$substr_offset,1);
		return $bit_val;
		}
}


##############################################################
package Bit::Vector::Array;

use 5.008002;
use strict;
use warnings;

require Exporter;


our @ISA = qw(Exporter);

# Items to export into callers namespace by default.
our @EXPORT = qw(
	bva
);

our $VERSION = '0.02';

sub bva(\@)
{
	tie @{$_[0]},'Bit::Vector::Array::Tie';
}


1;
__END__