package Bits;
#
# See the end of this file for the documentation in POD format.
#

our $VERSION = "0.1"; # April 25 2005

use strict;
use warnings;

# Only for debugging.
use Data::Dumper;

use overload
  '^'  => \&xor,
  '""' => \&as_text,
  '<<' => \&left_shift,
  '>>' => \&right_shift,
  '.'  => \&append,
  '0+' => \&as_number,
  '+'  => \&plus,
  ;

# Usage :
# $bits = new Bits binary => '0110_0001_0110_0010'
#       = new Bits hex    => '61_62'
#       = new Bits raw    => 'ab'
# The underbars are optional.

sub new {
  my $class = shift;
  my %args = @_;
  $class = ref($class) || $class;
  my $self = bless {%args}, $class;
  $self->_sync;
  #print Dumper( $self );
  return $self;
}

sub clone {
  my $self = shift;
  return Bits->new( array => [ @{$self->{array}} ] );
}

# Usage:  set error  : $self->error('Oops...');
#         test error : ... if $self->error;
#         get error  : print $self->error
sub error {
  my ($self, $message) = @_;
  $self->{error} = $message if $message;
  return $self->{error};
}

sub as_text {
  my $self = shift;
  if ($self->{error}){ return $self->{error} }
  $self->_expand;
  return $self->_prettify_binary;
}

sub as_number {
  my $self = shift;
  my $result = 0;
  my $base = 1;
  for (my $i=scalar(@{$self->{array}})-1; $i>=0; $i--){
    $result += $base * $self->{array}[$i];
    $base *= 2;
  }
  return $result;
}

sub plus {
  my ($self,$other) = @_;
  return $self->as_number() + $other;
}

sub as_binary {
  my $self = shift;
  $self->_expand;
  return $self->{binary};
}

sub size {
  my $self = shift;
  return scalar @{$self->{array}};
}

sub append {
  my ($self, $other, $reverse) = @_;
  if (ref($other) and $other->isa(__PACKAGE__)){
    return new Bits array => [ @{$self->{array}}, @{$other->{array}} ];
  }
  else {
    return $reverse ? $other . $self->as_text() : $self->as_text() . $other;
  }
}

sub xor {
  my ($self, $other) = @_;
  if ( $self->size != $other->size ){
    $self->error('Oops: attempted Bits XOR on differing sizes');
    return $self;
  }
  my $sum;
  for (my $i=0; $i<@{$self->{array}}; $i++){
    push @$sum, ($self->{array}[$i] + $other->{array}[$i]) % 2;
  }
  return Bits->new( array => $sum );
}

sub left_shift {
  my ($self, $number) = @_;
  if ($number < 0){
    return $self->right_shift($number);
  }
  my $other = $self->clone;
  while ($number--){
    # print " left: other array is '" , @{$other->{array}}, "'\n";
    push @{$other->{array}}, shift(@{$other->{array}});
  }
  return $other;
}

sub right_shift {
  my ($self, $number) = @_;
  if ($number < 0){
    return $self->left_shift($number);
  }
  my $other = $self->clone;
  while ($number--){
    # print " right: other array is '" , @{$other->{array}}, "'\n";
    unshift @{$other->{array}}, pop(@{$other->{array}});
  }
  return $other;
}

# Usage: return a new Bits object from a list of indeces.
# Example: 
#   $x = new Bits binary=>'1001';
#   $y = $x->permute(1,0,3,2);          # gives 0110
#   $z = $x->permute(0,0,1,1,2,2,3,3);  # gives 11000011
sub permute {
  my $self = shift;
  my @permutation = @_;
  my $other = new Bits;
  $other->{array} = [ @{$self->{array}}[@permutation] ];
  return $other;
}

sub as_hex {
  my $self = shift;
  if ($self->size % 4 != 0){
    $self->error('Oops - can only convert to hex if size is a multiple of 4');
    return $self;
  }
  $self->_expand;
  if ($self->size % 8 != 0){  # if not even number of bytes, 
    $self->{hex} =~ s/0$//;   # then a trailing 0 was appended.  Remove it.
  }
  #print Dumper($self);
  return $self->{hex};
}

sub as_raw {
  my $self = shift;
  $self->_expand;
  return $self->{raw};
}

sub get {
  my ($self, $index) = @_;
  return $self->{array}[$index];
}

sub set {
  my ($self, $index, $value) = @_;
  if (not ($value == 0 or $value == 1)){
    $self->error('Oops: tried to set a value to something other than 0 or 1');
  }
  elsif ( $index < 0 or $index > $self->size-1){
    $self->error('Oops: tried to set an index outside defined range');
  }
  else {
    $self->{array}[$index] = $value;
  }
}

# - - private methods - -

# Internals
#   raw    => "ab"                                    = raw bytes of data
#   hex    => "6162"                                  = unpack("H*", raw)
#   binary => "0110000101100010"                      = unpack("B*", raw)
#   array  => [0,0,1,1,0, 0,0,0,1, 0,1,1,0, 0,0,1,0]  = array of 0,1 integers
# 

# Convert to array form.
# The first available form 
# (number ->hex -> raw -> binary -> array) determines the result;
# only the array form is kept.
sub _sync {
  my $self = shift;
  for my $key (qw( binary hex)){     # remove optional underbar chars
    $self->{$key} =~ s/_//g if exists $self->{$key};
  }
  $self->_number2hex, delete $self->{number}   if exists $self->{number};
  # print " sync 1 : " . Dumper($self);
  $self->_hex2raw,      delete $self->{hex}    if exists $self->{hex};
  # print " sync 2 : " . Dumper($self);
  $self->_raw2binary,   delete $self->{raw}    if exists $self->{raw};
  # print " sync 3 : " . Dumper($self);
  $self->_binary2array, delete $self->{binary} if exists $self->{binary};
  # print " sync 4 : " . Dumper($self);
  $self->{array} = [] unless exists $self->{array};
}

# Starting from array form, generate the others.
sub _expand {
  my $self = shift;
  $self->_array2binary;
  $self->_binary2raw;
  $self->_raw2hex;
}

sub _prettify_binary {
  my $self = shift;
  my $result;
  for (my $i=0; $i<length($self->{binary}); $i++){
    $result .= substr($self->{binary},$i,1);
    $result .= '_' if $i % 4 == 3;
  }
  $result =~ s/_$//;  # remove trailing _
  return $result;
}

sub _number2hex {
  my $self = shift;
  $self->{hex} = sprintf("%x", $self->{number});
}

sub _raw2binary {
  my $self = shift;
  $self->{binary} = unpack("B*", $self->{raw});
}

sub _binary2raw {
  my $self = shift;
  $self->{raw} = pack("B*", $self->{binary});
}

sub _raw2hex {
  my $self = shift;
  $self->{hex} = unpack("H*", $self->{raw});
}

sub _hex2raw {
  my $self = shift;
  $self->{raw} = pack("H*", $self->{hex});
}

sub _array2binary {
  my $self = shift;
  local $" = "";   # put nothing between stringified array values
  $self->{binary} = "@{$self->{array}}";
}

sub _binary2array {
  my $self = shift;
  $self->{array} = [ map {0+$_} split //,$self->{binary} ];
}

1;

##########################################################################

=head1 NAME

Bits implements an array of 0's and 1's with a few binary math operations
and input/output formats.

=head1 SYNOPSIS

  use Bits;

  $m = new Bits binary => '0011_0101_0001_1000';   # underbars optional
  $p = new Bits hex    => '61_62_6d_6e';           # ditto
  $n = new Bits number => 97;       
  $q = new Bits raw    => 'hello';
  
  print $q->as_hex;    # "68656c6c6f"; error if size isn't a multiple of 4
  print $n->as_text;   # "0110_0001";  same as "$n"
  print $p->as_raw;    #  "abmn"
  print $m->as_number; #  13592 ; same as 0+$m

  print $m->size;      # 16
  $m << 3;             # left shift 3 bits; wraps around
  $m >> 6;

  $r = $n ^ $m;
  print $r;            # "Oops: attempted Bits XOR on differing sizes"
  print $r->error;     # same; can be tested for error conditions.
  
  $m = new Bits binary => '1111';
  $n = new Bits binary => '0101';
  $p = $m . $n;        # concatenation = Bits->new( binary => '1111_0101')
  $q = $m ^ $n;        # binary xor

  my $z = $m->clone;   # deep copy
  print $z->get(0);    # 0'th bit of $z (indeces are like arrays: 0,1,2,...)
  $z->set(3,0);        # set 3rd bit of $z to 0.

  $x = new Bits binary => '1001';
  $y = $x->permute(1,0,3,2);          # "0110"
  $z = $x->permute(0,0,1,1,2,2,3,3);  # "1100_0011"


=head1 DESCRIPTION

This package implements a few operations on arrays of bits;
I wrote it to help me look at the DES encryption algorithm.

The $bit->set($index,$value) function gives an error 
(by setting $b->error) if either 
(a) $index is smaller than 0 or larger than $bit->size()-1, or
(b) $value is anything other than a 0 or 1.

Not yet implemented :

 * $bits->reverse();

 * $bits->not() = ~ $bits;         # bitwise "not"

 * $bits->and($z) = $bits & $z;    # bitwise "and"

 * $bits->or($z) = $bits | $z;     # bitwise "or"

 * $bits->as_number for numbers bigger than perl's standard ints

Run "./test_Bits.pl" to see the tests.

=head1 AUTHOR & COPYRIGHT

Copyright 2005 Jim Mahoney, Marlboro College (mahoney@marlboro.edu)

This program is free software;
you may redistribute it and/or modify it
under the same terms as Perl itself.

=cut