Class::Bits - Class wrappers around bit vectors

  package MyClass;
  use Class::Bits;

  make_bits( a => 4,  # 0..15
             b => 1,  # 0..1
             c => 1,  # 0..1
             d => 2,  # 0..3
             e => s4  # -8..7
             f => s1  # -1..0
   );

   package;

   $o=MyClass->new(a=>12, d=>2);
   print "o->b is ", $o->b, "\n";

   print "bit vector is ", unpack("h*", $$o), "\n";

   $o2=$o->new();
   $o3=MyClass->new($string);

package Class::Bits;

use 5.006;

our $VERSION = '0.05';

# use strict;
use warnings::register;
use warnings ();

use integer;

require Exporter;

our @ISA = qw(Exporter);
our @EXPORT = qw(make_bits);

use Carp;
use Config;

use constant nvsize => $Config{nvsize}*8;

my %umax = ( 1  => 1,
	     2  => 3,
	     4  => 15,
	     8  => 255,
	     16 => 65535,
	     32 => 4294967295 );

my %smax = ( 1  => 0,
	     2  => 1,
	     4  => 7,
	     8  => 127,
	     16 => 32767,
	     32 => 2147483647 );

my %smin = ( 1  => -1,
	     2  => -2,
	     4  => -8,
	     8  => -128,
	     16 => -32768,
	     32 => -2147483648 );

my %sext = map { $_ => (~$smax{$_}) } keys(%smax);

my %signed = ( 's' => 1,
               'u' => 0,
               ''  => 0 );

sub make_bits {
    @_ & 1 and
	croak 'Class::Bits::bits called with an even number of arguments';

    my %names;
    my $offset=0;
    my $pkg=caller();

    while(@_) {
	my $name=shift;
	exists $names{$name} and
	    croak "repeated name '$name'";
	$names{$name}=1;

	my $spec=shift;
	$spec=~/^\s*([us]?)\s*(\d+)\s*$/ or
	    croak "invalid Class::Bits specification '$spec' for '$name'";
	my $sig=$signed{$1};
	my $size=$2;

	exists $smax{$size} or
	    croak "invalid Class::Bits size '$size' for '$name'";

	my $index=int(($offset+$size-1)/$size);
	$offset=($index+1)*$size;

	$pkg->{INDEX}{$name}=$index;
	$pkg->{SIZE}{$name}=$size;
	$pkg->{SIGNED}{$name}=$sig;

	# warn "$name: index=>$index, size=>$size, sig=>$sig";

	if ($sig) {
	    my $max=$smax{$size};
	    my $min=$smin{$size};
	    my $ext=$sext{$size};

	    *{"${pkg}::$name"}=sub {
		my $this=shift;
		if (@_) {
		    my $value=shift;
		    if ($value > $max or $value < $min) {
			warnings::warn "value $value for "
			    .ref($this)
				."::$name out of range [$min, $max]"
				    if warnings::enabled();
		    }
		    vec ($$this, $index, $size) = $value;
		}
		my $value=vec ($$this, $index, $size);
		if ($value & $ext) {
		    return $ext|$value;
		}
		return $value;
	    }
	}
	else {

	    my $max=$umax{$size};

	    *{"${pkg}::$name"}=sub {
		my $this=shift;
		if (@_) {
		    my $value=shift;
		    if (!defined($value)) {
			warnings::warnif('uninitialized',
					 "Uninitialized value passed to $name accessor");
			$value=0;
		    }
		    warnings::warnif("value $value for ".ref($this)."::$name out of range [0, $max]")
			    if ($value > $max or $value < 0);
		    vec ($$this, $index, $size) = $value;
		}
		else {
		    vec ($$this, $index, $size);
		}
	    };
	}
    }

    *{"${pkg}::new"}=sub {
	my $ref=shift;
	my ($class, $string);
	if (ref($ref)) {
	    $class=ref($ref);
	    $string=$$ref;
	}
	else {
	    $class=$ref;
	    $string="\0" x ((7+ $offset) >> 3)
	}
	
	$string=shift if @_ & 1;

	my $this=\$string;
	bless $this, $class;

	my %opts=@_;
	for my $k (keys %opts) {
	    $this->$k($opts{$k});
	}
	
	return $this;
    };

    *{"${pkg}::length"}=sub { $offset }
	unless exists $names{lenght};

    *{"${pkg}::keys"}=sub { keys %names }
	unless exists $names{keys};

    *{"${pkg}::as_hash"}=sub {
	my $this=shift;
	map { ($_, $this->$_ ) } keys %names
    }
	unless exists $names{as_hash};
}



1;
__END__