       1 package BitVector;
       2 #
       3 # $RCSfile: BitVector.pm,v $
       4 # $Date: 2015/02/28 20:47:02 $
       5 # $Revision: 1.32 $
       6 #
       7 # Author: Manish Sud <msud@san.rr.com>
       8 #
       9 # Copyright (C) 2015 Manish Sud. All rights reserved.
      10 #
      11 # This file is part of MayaChemTools.
      12 #
      13 # MayaChemTools is free software; you can redistribute it and/or modify it under
      14 # the terms of the GNU Lesser General Public License as published by the Free
      15 # Software Foundation; either version 3 of the License, or (at your option) any
      16 # later version.
      17 #
      18 # MayaChemTools is distributed in the hope that it will be useful, but without
      19 # any warranty; without even the implied warranty of merchantability of fitness
      20 # for a particular purpose.  See the GNU Lesser General Public License for more
      21 # details.
      22 #
      23 # You should have received a copy of the GNU Lesser General Public License
      24 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or
      25 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330,
      26 # Boston, MA, 02111-1307, USA.
      27 #
      28
      29 use strict;
      30 use Carp;
      31 use Exporter;
      32 use Scalar::Util ();
      33 use TextUtil ();
      34 use ConversionsUtil ();
      35 use MathUtil;
      36
      37 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
      38
      39 @ISA = qw(Exporter);
      40 @EXPORT = qw(IsBitVector);
      41 @EXPORT_OK = qw(NewFromBinaryString NewFromDecimalString NewFromHexadecimalString NewFromOctalString NewFromRawBinaryString);
      42
      43 %EXPORT_TAGS = (all  => [@EXPORT, @EXPORT_OK]);
      44
      45 # Setup class variables...
      46 my($ClassName, $ValueFormat, $ValueBitOrder);
      47 _InitializeClass();
      48
      49 #
      50 # Overload bitwise and some logical operators...
      51 #
      52 # 'fallback' is set to 'false' to raise exception for all other operators.
      53 #
      54 use overload '""' => 'StringifyBitVector',
      55   '&' => '_BitVectorAndOperator',
      56   '|' => '_BitVectorOrOperator',
      57   '^' => '_BitVectorExclusiveOrOperator',
      58
      59   '~' => '_BitVectorNegationOperator',
      60
      61   '==' => '_BitVectorEqualOperator',
      62   '!=' => '_BitVectorNotEqualOperator',
      63
      64   'fallback' => undef;
      65
      66 # Class constructor...
      67 #
      68 sub new {
      69   my($Class, $Size) = @_;
      70
      71   # Initialize object...
      72   my $This = {};
      73   bless $This, ref($Class) || $Class;
      74   $This->_InitializeBitVector($Size);
      75
      76   return $This;
      77 }
      78
      79 # Initialize object data...
      80 #
      81 # Note:
      82 #  . Perl pack function used to initialize vector automatically sets its size to
      83 #    nearest power of 2 value.
      84 #
      85 sub _InitializeBitVector {
      86   my($This, $Size) = @_;
      87
      88   if (!defined $Size) {
      89     croak "Error: ${ClassName}->new: BitVector object instantiated without specifying its size ...";
      90   }
      91   if ($Size <=0) {
      92     croak "Error: ${ClassName}->new: Bit vector size, $Size, must be a positive integer...";
      93   }
      94
      95   # Initialize vector with zeros...
      96   $This->{BitValues} = pack("b*", "0" x $Size);
      97
      98   # Size to automatically set to nearest power of 2 by Perl pack function. So use the length
      99   # of packed vector to set size...
     100   $This->{Size} = length($This->GetBitsAsBinaryString());
     101
     102   return $This;
     103 }
     104
     105 # Initialize class ...
     106 sub _InitializeClass {
     107   #Class name...
     108   $ClassName = __PACKAGE__;
     109
     110   # Print format for bit vectore values...
     111   $ValueFormat = "Binary";
     112
     113   # Bit ordering for printing bit vector value strings. Default is to print lowest bit of each
     114   # byte on the left.
     115   #
     116   # Internally, bits are stored in ascending order using Perl vec function. Regardless
     117   # of machine order, big-endian or little-endian, vec function always considers first
     118   # string byte as the lowest byte and first bit within each byte as the lowest bit.
     119   #
     120   # Possible values: Ascending or Descending
     121   #
     122   $ValueBitOrder = 'Ascending';
     123 }
     124
     125 # Create a new bit vector using binary string. This functionality can be
     126 # either invoked as a class function or an object method.
     127 #
     128 # The size of bit vector is automatically set to reflect the string.
     129 #
     130 sub NewFromBinaryString ($;$) {
     131   my($FirstParameter, $SecondParameter, $ThirdParameter) = @_;
     132
     133   if (_IsBitVector($FirstParameter)) {
     134     return _NewBitVectorFromString('Binary', $SecondParameter, $ThirdParameter);
     135   }
     136   else {
     137     return _NewBitVectorFromString( 'Binary', $FirstParameter, $SecondParameter);
     138   }
     139 }
     140
     141 # Create a new bit vector using hexadecimal string. This functionality can be
     142 # either invoked as a class function or an object method.
     143 #
     144 # The size of bit vector is automatically set to reflect the string.
     145 #
     146 sub NewFromHexadecimalString ($;$) {
     147   my($FirstParameter, $SecondParameter, $ThirdParameter) = @_;
     148
     149   if (_IsBitVector($FirstParameter)) {
     150     return _NewBitVectorFromString('Hexadecimal', $SecondParameter, $ThirdParameter);
     151   }
     152   else {
     153     return _NewBitVectorFromString( 'Hexadecimal', $FirstParameter, $SecondParameter);
     154   }
     155 }
     156
     157 # Create a new bit vector using octal string. This functionality can be
     158 # either invoked as a class function or an object method.
     159 #
     160 # The size of bit vector is automatically set to reflect the string.
     161 #
     162 sub NewFromOctalString ($;$) {
     163   my($FirstParameter, $SecondParameter, $ThirdParameter) = @_;
     164
     165   if (_IsBitVector($FirstParameter)) {
     166     return _NewBitVectorFromString('Octal', $SecondParameter, $ThirdParameter);
     167   }
     168   else {
     169     return _NewBitVectorFromString( 'Octal', $FirstParameter, $SecondParameter);
     170   }
     171 }
     172
     173 # Create a new bit vector using decimal string. This functionality can be
     174 # either invoked as a class function or an object method.
     175 #
     176 # The size of bit vector is automatically set to reflect the string.
     177 #
     178 sub NewFromDecimalString ($;$) {
     179   my($FirstParameter, $SecondParameter, $ThirdParameter) = @_;
     180
     181   if (_IsBitVector($FirstParameter)) {
     182     return _NewBitVectorFromString('Decimal', $SecondParameter, $ThirdParameter);
     183   }
     184   else {
     185     return _NewBitVectorFromString( 'Decimal', $FirstParameter, $SecondParameter);
     186   }
     187 }
     188
     189 # Create a new bit vector using raw binary string. This functionality can be
     190 # either invoked as a class function or an object method.
     191 #
     192 # The size of bit vector is automatically set to reflect the string.
     193 #
     194 sub NewFromRawBinaryString ($;$) {
     195   my($FirstParameter, $SecondParameter, $ThirdParameter) = @_;
     196
     197   if (_IsBitVector($FirstParameter)) {
     198     return _NewBitVectorFromString('RawBinary', $SecondParameter, $ThirdParameter);
     199   }
     200   else {
     201     return _NewBitVectorFromString( 'RawBinary', $FirstParameter, $SecondParameter);
     202   }
     203 }
     204
     205 # Create a new bit vector from a string...
     206 #
     207 sub _NewBitVectorFromString ($$;$) {
     208   my($Format, $String, $BitOrder) = @_;
     209   my($Size, $BitVector);
     210
     211   $Size = _CalculateStringSizeInBits($Format, $String);
     212
     213   $BitVector = new BitVector($Size);
     214   $BitVector->_SetBitsAsString($Format, $String, $BitOrder);
     215
     216   return $BitVector;
     217 }
     218
     219 # Copy bit vector...
     220 sub Copy {
     221   my($This) = @_;
     222   my($BitVector);
     223
     224   # Make a new bit vector...
     225   $BitVector = (ref $This)->new($This->{Size});
     226
     227   # Copy bit values...
     228   $BitVector->{BitValues} = $This->{BitValues};
     229
     230   # Copy value format for stringification...
     231   if (exists $This->{ValueFormat}) {
     232     $BitVector->{ValueFormat} = $This->{ValueFormat};
     233   }
     234   # Copy value bit order for stringification...
     235   if (exists $This->{ValueBitOrder}) {
     236     $BitVector->{ValueBitOrder} = $This->{ValueBitOrder};
     237   }
     238   return $BitVector;
     239 }
     240
     241 # Reverse bit values in bit vector...
     242 sub Reverse {
     243   my($This) = @_;
     244   my($BitNum, $ReverseBitNum, $BitValue, $ReverseBitValue);
     245
     246   $BitNum = 0; $ReverseBitNum = $This->{Size} - 1;
     247
     248   while ($BitNum < $ReverseBitNum) {
     249     $BitValue = $This->_GetBitValue($BitNum);
     250     $ReverseBitValue = $This->_GetBitValue($ReverseBitNum);
     251
     252     $This->_SetBitValue($BitNum, $ReverseBitValue);
     253     $This->_SetBitValue($ReverseBitNum, $BitValue);
     254
     255     $BitNum++; $ReverseBitNum--;
     256   }
     257   return $This;
     258 }
     259
     260 # Is it a bit vector object?
     261 sub IsBitVector ($) {
     262   my($Object) = @_;
     263
     264   return _IsBitVector($Object);
     265 }
     266
     267 # Get size...
     268 sub GetSize {
     269   my($This) = @_;
     270
     271   return $This->{Size};
     272 }
     273
     274 # Set a bit...
     275 #
     276 sub SetBit {
     277   my($This, $BitNum, $SkipCheck) = @_;
     278
     279   # Just set it...
     280   if ($SkipCheck) {
     281     return $This->_SetBitValue($BitNum, 1);
     282   }
     283
     284   # Check and set...
     285   $This->_ValidateBitNumber("SetBit", $BitNum);
     286
     287   return $This->_SetBitValue($BitNum, 1);
     288 }
     289
     290 # Set arbitrary bits specified as a list of bit numbers...
     291 #
     292 sub SetBits {
     293   my($This, @BitNums) = @_;
     294   my($BitNum);
     295
     296   for $BitNum (@BitNums) {
     297     $This->SetBit($BitNum);
     298   }
     299   return $This;
     300 }
     301
     302 # Set bits in a specified range...
     303 #
     304 sub SetBitsRange {
     305   my($This, $MinBitNum, $MaxBitNum) = @_;
     306   my($BitNum);
     307
     308   $This->_ValidateBitNumber("SetBitsRange", $MinBitNum);
     309   $This->_ValidateBitNumber("SetBitsRange", $MaxBitNum);
     310
     311   for $BitNum ($MinBitNum .. $MaxBitNum) {
     312     $This->_SetBitValue($BitNum, 1);
     313   }
     314   return $This;
     315 }
     316
     317 # Set all bits...
     318 #
     319 sub SetAllBits {
     320   my($This) = @_;
     321
     322   $This->{BitValues} = pack("b*", "1" x $This->{Size});
     323 }
     324
     325 # Clear a bit...
     326 #
     327 sub ClearBit {
     328   my($This, $BitNum) = @_;
     329
     330   $This->_ValidateBitNumber("ClearBit", $BitNum);
     331
     332   return $This->_SetBitValue($BitNum, 0);
     333 }
     334
     335 # Clear arbitrary bits specified as a list of bit numbers...
     336 #
     337 sub ClearBits {
     338   my($This, @BitNums) = @_;
     339   my($BitNum);
     340
     341   for $BitNum (@BitNums) {
     342     $This->ClearBit($BitNum);
     343   }
     344   return $This;
     345 }
     346
     347 # Clear bits in a specified range...
     348 #
     349 sub ClearBitsRange {
     350   my($This, $MinBitNum, $MaxBitNum) = @_;
     351   my($BitNum);
     352
     353   $This->_ValidateBitNumber("ClearBitsRange", $MinBitNum);
     354   $This->_ValidateBitNumber("ClearBitsRange", $MaxBitNum);
     355
     356   for $BitNum ($MinBitNum .. $MaxBitNum) {
     357     $This->_SetBitValue($BitNum, 0);
     358   }
     359   return $This;
     360 }
     361
     362 # Clear all bits...
     363 #
     364 sub ClearAllBits {
     365   my($This) = @_;
     366
     367   $This->{BitValues} = pack("b*", "0" x $This->{Size});
     368
     369   return $This;
     370 }
     371
     372 # Set or clear bit...
     373 #
     374 sub SetBitValue {
     375   my($This, $BitNum, $BitValue) = @_;
     376
     377  BITVALUE: {
     378     if ($BitValue == 1) { return $This->SetBit($BitNum); last BITVALUE; }
     379     if ($BitValue == 0) { return $This->ClearBit($BitNum); last BITVALUE; }
     380     croak "Error: ${ClassName}->SetBit: Specified bit value, $BitValue, must be 0 or 1...";
     381   }
     382   return $This;
     383 }
     384
     385 # Flip bit value...
     386 #
     387 sub FlipBit {
     388   my($This, $BitNum) = @_;
     389
     390   $This->_ValidateBitNumber("FlipBit", $BitNum);
     391   return $This->_FlipBit($BitNum);
     392 }
     393
     394 # Flip arbitrary bits specified as a list of bit numbers...
     395 #
     396 sub FlipBits {
     397   my($This, @BitNums) = @_;
     398   my($BitNum);
     399
     400   for $BitNum (@BitNums) {
     401     $This->FlipBit();
     402   }
     403   return $This;
     404 }
     405
     406 # Flip bit value in a specified bit range...
     407 #
     408 sub FlipBitsRange {
     409   my($This, $MinBitNum, $MaxBitNum) = @_;
     410   my($BitNum);
     411
     412   $This->_ValidateBitNumber("FlipBitsRange", $MinBitNum);
     413   $This->_ValidateBitNumber("FlipBitsRange", $MaxBitNum);
     414
     415   for $BitNum ($MinBitNum .. $MaxBitNum) {
     416     $This->_FlipBit();
     417   }
     418   return $This;
     419 }
     420
     421 # Flip all bit valus...
     422 #
     423 sub FlipAllBits {
     424   my($This) = @_;
     425
     426   return $This->FlipBits(0, ($This->{Size} - 1));
     427 }
     428
     429 # Flip bit value...
     430 sub _FlipBit {
     431   my($This, $BitNum) = @_;
     432
     433   if ($This->_GetBitValue($BitNum)) {
     434     return $This->_SetBitValue($BitNum, 0);
     435   }
     436   else {
     437     return $This->_SetBitValue($BitNum, 1);
     438   }
     439 }
     440
     441 # Get bit value...
     442 #
     443 sub GetBit {
     444   my($This, $BitNum) = @_;
     445
     446   $This->_ValidateBitNumber("GetBit", $BitNum);
     447
     448   return $This->_GetBitValue($BitNum);
     449 }
     450
     451 # Is a specific bit set?
     452 #
     453 sub IsBitSet {
     454   my($This, $BitNum) = @_;
     455
     456   if (!(defined($BitNum) && ($BitNum >= 0) && ($BitNum < $This->{Size}))) {
     457     return undef;
     458   }
     459
     460   return $This->_GetBitValue($BitNum) ? 1 : 0;
     461 }
     462
     463 # Is a specific bit clear?
     464 #
     465 sub IsBitClear {
     466   my($This, $BitNum) = @_;
     467
     468   if (!(defined($BitNum) && ($BitNum >= 0) && ($BitNum < $This->{Size}))) {
     469     return undef;
     470   }
     471
     472   return $This->_GetBitValue($BitNum) ? 0 : 1;
     473 }
     474
     475 # Get number of set bits...
     476 #
     477 sub GetNumOfSetBits {
     478   my($This) = @_;
     479
     480   return unpack("%b*", $This->{BitValues});
     481 }
     482
     483 # Get number of clear bits...
     484 #
     485 sub GetNumOfClearBits {
     486   my($This) = @_;
     487
     488   return ($This->{Size} - $This->GetNumOfSetBits());
     489 }
     490
     491 # Get density of set bits...
     492 #
     493 sub GetDensityOfSetBits {
     494   my($This) = @_;
     495
     496   return $This->{Size} ? ($This->GetNumOfSetBits()/$This->{Size}) : 0;
     497 }
     498
     499 # Get density of clear bits...
     500 #
     501 sub GetDensityOfClearBits {
     502   my($This) = @_;
     503
     504   return $This->GetNumOfClearBits()/$This->{Size};
     505 }
     506
     507 # Convert internal bit values stored using Perl vec function with first string byte
     508 # as the lowest byte and first bit within each byte as the lowest bit into a binary
     509 # string with ascending or descending bit order within each byte. The internal
     510 # bit order corresponds to ascending bit order within each byte.
     511 #
     512 sub GetBitsAsBinaryString {
     513   my($This, $BitOrder) = @_;
     514
     515   return $This->_GetBitsAsString('Binary', $BitOrder);
     516 }
     517
     518 # Convert internal bit values stored using Perl vec function with first string byte
     519 # as the lowest byte and first bit within each byte as the lowest bit into a hexadecimal
     520 # string with ascending or descending bit order within each byte. The internal
     521 # bit order corresponds to ascending bit order within each byte.
     522 #
     523 #
     524 sub GetBitsAsHexadecimalString {
     525   my($This, $BitOrder) = @_;
     526
     527   return $This->_GetBitsAsString('Hexadecimal', $BitOrder);
     528 }
     529
     530 # Convert bit values into a octal string value...
     531 #
     532 sub GetBitsAsOctalString {
     533   my($This, $BitOrder) = @_;
     534
     535   return $This->_GetBitsAsString('Octal', $BitOrder);
     536 }
     537
     538 # Convert bit values into a decimal string value...
     539 #
     540 sub GetBitsAsDecimalString {
     541   my($This, $BitOrder) = @_;
     542
     543   return $This->_GetBitsAsString('Decimal', $BitOrder);
     544 }
     545
     546 # Return packed bit values which also contains nonprintable characters...
     547 #
     548 sub GetBitsAsRawBinaryString {
     549   my($This) = @_;
     550
     551   return $This->_GetBitsAsString('RawBinary');
     552 }
     553
     554 # Convert internal bit values stored using Perl vec function with first string byte
     555 # as the lowest byte and first bit within each byte as the lowest bit into a
     556 # string with ascending or descending bit order within each byte. The internal
     557 # bit order corresponds to ascending bit order within each byte.
     558 #
     559 #
     560 sub _GetBitsAsString {
     561   my($This, $Format, $BitOrder) = @_;
     562   my($BinaryTemplate, $HexadecimalTemplate);
     563
     564   ($BinaryTemplate, $HexadecimalTemplate) = $This->_SetupBitsPackUnpackTemplate($BitOrder);
     565
     566   FORMAT : {
     567     if ($Format =~ /^(Hexadecimal|Hex|HexadecimalString)$/i) { return unpack($HexadecimalTemplate, $This->{BitValues}); last FORMAT; }
     568     if ($Format =~ /^(Octal|Oct|OctalString)$/i) { return ConversionsUtil::HexadecimalToOctal(unpack($HexadecimalTemplate, $This->{BitValues})); last FORMAT; }
     569     if ($Format =~ /^(Decimal|Dec|DecimalString)$/i) { return ConversionsUtil::HexadecimalToDecimal(unpack($HexadecimalTemplate, $This->{BitValues})); last FORMAT; }
     570     if ($Format =~ /^(Binary|Bin|BinaryString)$/i) { return unpack($BinaryTemplate, $This->{BitValues}); last FORMAT; }
     571     if ($Format =~ /^(RawBinary|RawBin|RawBinaryString)$/i) { return $This->{BitValues}; last FORMAT; }
     572     croak "Error: ${ClassName}->_GetBitsAsString: Specified bit vector string format, $Format, is not supported. Value values: Binary, Bin, BinaryString, Hexdecimal, Hex, HexadecimalString, Decimal, Dec, DecimalString, Octal, Oct, OctalString, RawBinary, RawBin, RawBinaryString...";
     573   }
     574 }
     575
     576 # Setup templates to unpack bits...
     577 #
     578 sub _SetupBitsPackUnpackTemplate {
     579   my($This, $BitOrder) = @_;
     580   my($BinaryTemplate, $HexadecimalTemplate);
     581
     582   $BitOrder = (defined($BitOrder) && $BitOrder) ? $BitOrder : 'Ascending';
     583
     584   if ($BitOrder =~ /^Ascending$/i) {
     585     $BinaryTemplate = "b*";
     586     $HexadecimalTemplate = "h*";
     587   }
     588   elsif ($BitOrder =~ /^Descending$/i) {
     589     $BinaryTemplate = "B*";
     590     $HexadecimalTemplate = "H*";
     591   }
     592   else {
     593     croak "Warning: ${ClassName}::_SetupBitsPackUnpackTemplate: Specified bit order value, $BitOrder, is not supported. Supported values: Ascending, Descending...";
     594   }
     595   return ($BinaryTemplate, $HexadecimalTemplate);
     596 }
     597
     598 # Set bit values using hexadecimal string. The initial size of bit vector is not changed.
     599 #
     600 sub SetBitsAsHexadecimalString {
     601   my($This, $Hexadecimal, $BitOrder) = @_;
     602
     603   if ($Hexadecimal =~ /^0x/i) {
     604     $Hexadecimal =~ s/^0x//i;
     605   }
     606   return $This->_SetBitsAsString('Hexadecimal', $Hexadecimal, $BitOrder);
     607 }
     608
     609 # Set bit values using octal string. The initial size of bit vector is not changed.
     610 #
     611 sub SetBitsAsOctalString {
     612   my($This, $Octal, $BitOrder) = @_;
     613
     614   if ($Octal =~ /^0/i) {
     615     $Octal =~ s/^0//i;
     616   }
     617   return $This->_SetBitsAsString('Octal', $Octal, $BitOrder);
     618 }
     619
     620 # Set bit values using a decimal number. The initial size of bit vector is not changed.
     621 #
     622 sub SetBitsAsDecimalString {
     623   my($This, $Decimal, $BitOrder) = @_;
     624
     625   if (!TextUtil::IsPositiveInteger($Decimal)) {
     626     croak "Error: ${ClassName}->SetBitsAsDecimalString: Specified decimal value, $Decimal, must be a positive integer...";
     627   }
     628   if ($Decimal =~ /[+]/) {
     629     $Decimal =~ s/[+]//;
     630   }
     631   return $This->_SetBitsAsString('Decimal', $Decimal, $BitOrder);
     632 }
     633
     634 # Set bit values using hexadecimal string. The initial size of bit vector is not changed.
     635 #
     636 sub SetBitsAsBinaryString {
     637   my($This, $Binary, $BitOrder) = @_;
     638
     639   if ($Binary =~ /^0b/i) {
     640     $Binary =~ s/^0b//i;
     641   }
     642   return $This->_SetBitsAsString('Binary', $Binary, $BitOrder);
     643 }
     644
     645 # Set bit values using packed binary string. The size of bit vector is changed to reflect
     646 # the input raw string...
     647 #
     648 sub SetBitsAsRawBinaryString {
     649   my($This, $RawBinary) = @_;
     650
     651   return $This->_SetBitsAsString('RawBinary', $RawBinary);
     652 }
     653
     654 # Set bits using string in a specified format. This size of bit vector is not changed except for
     655 # RawBinary string type...
     656 #
     657 sub _SetBitsAsString {
     658   my($This, $Format, $String, $BitOrder) = @_;
     659   my($Size, $BinaryTemplate, $HexadecimalTemplate);
     660
     661   ($BinaryTemplate, $HexadecimalTemplate) = $This->_SetupBitsPackUnpackTemplate($BitOrder);
     662
     663   $Size = $This->{Size};
     664   FORMAT : {
     665     if ($Format =~ /^(Hexadecimal|Hex|HexadecimalString)$/i) { $This->{BitValues} = pack($HexadecimalTemplate, $String); last FORMAT; }
     666     if ($Format =~ /^(Octal|Oct|OctalString)$/i) { vec($This->{BitValues}, 0, $Size) = ConversionsUtil::OctalToDecimal($String); last FORMAT; }
     667     if ($Format =~ /^(Decimal|Dec|DecimalString)$/i) { vec($This->{BitValues}, 0, $Size) = $String; last FORMAT; }
     668     if ($Format =~ /^(Binary|Bin|BinaryString)$/i) { $This->{BitValues} = pack($BinaryTemplate, $String); last FORMAT; }
     669     if ($Format =~ /^(RawBinary|RawBin|RawBinaryString)$/i) { $This->{BitValues} = $String; last FORMAT; }
     670     croak "Error: ${ClassName}->_SetBitsAsString: Specified bit vector string format, $Format, is not supported. Value values: Binary, Bin, BinaryString, Hexdecimal, Hex, HexadecimalString, Decimal, Dec, DecimalString, Octal, Oct, OctalString, RawBinary, RawBin, RawBinaryString...";
     671   }
     672
     673   # Set size using packed string...
     674   $Size = length($This->GetBitsAsBinaryString());
     675   if ($Size <=0) {
     676     croak "Error: ${ClassName}->_SetBitsAsString: Bit vector size, $Size, must be a positive integer...";
     677   }
     678   $This->{Size} = $Size;
     679
     680   return $This;
     681 }
     682
     683 # Calculate string size in bits...
     684 #
     685 sub _CalculateStringSizeInBits ($$;$) {
     686   my($FirstParameter, $SecondParameter, $ThisParameter) = @_;
     687   my($This, $Format, $String, $Size);
     688
     689   if ((@_ == 3) && (_IsBitVector($FirstParameter))) {
     690     ($This, $Format, $String) = ($FirstParameter, $SecondParameter, $ThisParameter);
     691   }
     692   else {
     693     ($This, $Format, $String) = (undef, $FirstParameter, $SecondParameter);
     694   }
     695
     696   FORMAT : {
     697     if ($Format =~ /^(Hexadecimal|Hex|HexadecimalString)$/i) { $Size = length($String) * 4; last FORMAT; }
     698     if ($Format =~ /^(Octal|Oct|OctalString)$/i) { $Size = length($String) * 3; last FORMAT; }
     699     if ($Format =~ /^(Decimal|Dec|DecimalString)$/i) { $Size = length(ConversionsUtil::DecimalToHexadecimal($String)) * 4; last FORMAT; }
     700     if ($Format =~ /^(Binary|Bin|BinaryString)$/i) { $Size = length($String); last FORMAT; }
     701     if ($Format =~ /^(RawBinary|RawBin|RawBinaryString)$/i) { $Size = length(unpack("B*", $String)); last FORMAT; }
     702     croak "Error: ${ClassName}::_CalculateStringSizeInBits: Specified bit vector string format, $Format, is not supported. Value values: Binary, Bin, BinaryString, Hexdecimal, Hex, HexadecimalString, Decimal, Dec, DecimalString, Octal, Oct, OctalString, RawBinary, RawBin, RawBinaryString...";
     703   }
     704   return $Size;
     705 }
     706
     707 # Set bit value using Perl vec function with bit numbers going from left to right.
     708 # First bit number corresponds to 0.
     709 #
     710 sub _SetBitValue {
     711   my($This, $BitNum, $BitValue) = @_;
     712   my($Offset, $Width);
     713
     714   $Offset = $BitNum;
     715   $Width = 1;
     716
     717   vec($This->{BitValues}, $Offset, $Width) = $BitValue;
     718
     719   return $This;
     720 }
     721
     722 # Get bit value Perl vec function with bit numbers going from left to right.
     723 # First bit number corresponds to 0.
     724 #
     725 sub _GetBitValue {
     726   my($This, $BitNum) = @_;
     727   my($Offset, $Width, $BitValue);
     728
     729   $Offset = $BitNum;
     730   $Width = 1;
     731
     732   $BitValue = vec($This->{BitValues}, $Offset, $Width);
     733
     734   return $BitValue;
     735 }
     736
     737 # Check to make sure it's a valid bit number...
     738 #
     739 sub _ValidateBitNumber {
     740   my($This, $CallerName, $BitNum) = @_;
     741
     742   if (!defined $BitNum) {
     743     croak "Error: ${ClassName}->${CallerName}: Bit number is not defined...";
     744   }
     745   if ($BitNum < 0) {
     746     croak "Error: ${ClassName}->${CallerName}: Bit number value, $BitNum, must be >= 0 ...";
     747   }
     748   if ($BitNum >= $This->{Size}) {
     749     croak "Error: ${ClassName}->${CallerName}: Bit number number value, $BitNum, must be less than the size of bit vector, ", $This->{Size}, "...";
     750   }
     751
     752   return $This;
     753 }
     754
     755 # Set bit values print format for an individual object or the whole class...
     756 #
     757 sub SetBitValuePrintFormat ($;$) {
     758   my($FirstParameter, $SecondParameter) = @_;
     759
     760   if ((@_ == 2) && (_IsBitVector($FirstParameter))) {
     761     # Set bit values print format for the specific object...
     762     my($This, $ValuePrintFormat) = ($FirstParameter, $SecondParameter);
     763
     764     if (!_ValidateBitValuePrintFormat($ValuePrintFormat)) {
     765       return;
     766     }
     767
     768     $This->{ValueFormat} = $ValuePrintFormat;
     769   }
     770   else {
     771     # Set value print format for the class...
     772     my($ValuePrintFormat) = ($FirstParameter);
     773
     774     if (!_ValidateBitValuePrintFormat($ValuePrintFormat)) {
     775       return;
     776     }
     777
     778     $ValueFormat = $ValuePrintFormat;
     779   }
     780 }
     781
     782 # Set bit values bit order for an individual object or the whole class...
     783 #
     784 sub SetBitValueBitOrder ($;$) {
     785   my($FirstParameter, $SecondParameter) = @_;
     786
     787   if ((@_ == 2) && (_IsBitVector($FirstParameter))) {
     788     # Set bit value bit order for the specific object...
     789     my($This, $BitOrder) = ($FirstParameter, $SecondParameter);
     790
     791     if (!_ValidateBitValueBitOrder($BitOrder)) {
     792       return;
     793     }
     794
     795     $This->{ValueBitOrder} = $BitOrder;
     796   }
     797   else {
     798     # Set bit value bit order for the class...
     799     my($BitOrder) = ($FirstParameter);
     800
     801     if (!_ValidateBitValueBitOrder($BitOrder)) {
     802       return;
     803     }
     804
     805     $ValueBitOrder = $BitOrder;
     806   }
     807 }
     808
     809 # Validate print format for bit values...
     810 sub _ValidateBitValueBitOrder {
     811   my($BitOrder) = @_;
     812
     813   if ($BitOrder !~ /^(Ascending|Descending)$/i) {
     814     carp "Warning: ${ClassName}::_ValidateBitValueBitOrder: Specified bit order value, $BitOrder, is not supported. Supported values: Ascending, Descending...";
     815     return 0;
     816   }
     817   return 1;
     818 }
     819
     820 # Validate print format for bit values...
     821 sub _ValidateBitValuePrintFormat {
     822   my($ValuePrintFormat) = @_;
     823
     824   if ($ValuePrintFormat !~ /^(Binary|Bin||BinaryString|Hexadecimal|Hex||HexadecimalString|Decimal|Dec||DecimalString|Octal|Oct||OctalString|RawBinary|RawBin|RawBinaryString)$/i) {
     825     carp "Warning: ${ClassName}::_ValidateBitValuePrintFormat: Specified bit vector print format value, $ValuePrintFormat, is not supported. Supported values: Binary, Bin, BinaryString, Hexdecimal, Hex, HexadecimalString, Decimal, Dec, DecimalString, Octal, Oct, OctalString, RawBinary, RawBin, RawBinaryString...";
     826     return 0;
     827   }
     828   return 1;
     829 }
     830
     831 # Bitwise AND operation for BitVectors...
     832 #
     833 sub _BitVectorAndOperator {
     834   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     835
     836   $ErrorMsg = "_BitVectorAndOperator: Bitwise AND oparation failed";
     837   $CheckBitVectorSizes = 1;
     838   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     839
     840   if (!$OtherIsBitVector) {
     841     if ($OrderFlipped) {
     842       croak "Error: ${ClassName}->${ErrorMsg}: First object must be a bit vector...";
     843     }
     844   }
     845   my($BitVector);
     846   $BitVector = (ref $This)->new($This->{Size});
     847   $BitVector->{BitValues} = $This->{BitValues} & $Other->{BitValues};
     848
     849   return $BitVector;
     850 }
     851
     852 # Bitwise OR operation for BitVectors...
     853 #
     854 sub _BitVectorOrOperator {
     855   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     856
     857   $ErrorMsg = "_BitVectorAndOperator: Bitwise OR oparation failed";
     858   $CheckBitVectorSizes = 1;
     859   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     860
     861   if (!$OtherIsBitVector) {
     862     if ($OrderFlipped) {
     863       croak "Error: ${ClassName}->${ErrorMsg}: First object must be a bit vector...";
     864     }
     865   }
     866   my($BitVector);
     867   $BitVector = (ref $This)->new($This->{Size});
     868   $BitVector->{BitValues} = $This->{BitValues} | $Other->{BitValues};
     869
     870   return $BitVector;
     871 }
     872
     873 # Bitwise XOR operation for BitVectors...
     874 #
     875 sub _BitVectorExclusiveOrOperator {
     876   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     877
     878   $ErrorMsg = "_BitVectorAndOperator: Bitwise XOR oparation failed";
     879   $CheckBitVectorSizes = 1;
     880   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     881
     882   if (!$OtherIsBitVector) {
     883     if ($OrderFlipped) {
     884       croak "Error: ${ClassName}->${ErrorMsg}: First object must be a bit vector...";
     885     }
     886   }
     887   my($BitVector);
     888   $BitVector = (ref $This)->new($This->{Size});
     889   $BitVector->{BitValues} = $This->{BitValues} ^ $Other->{BitValues};
     890
     891   return $BitVector;
     892 }
     893
     894 # Bitwise negation operation for BitVectors...
     895 #
     896 sub _BitVectorNegationOperator {
     897   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     898
     899   $ErrorMsg = "_BitVectorAndOperator: Bitwise negation oparation failed";
     900   $CheckBitVectorSizes = 1;
     901   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     902
     903   my($BitVector);
     904   $BitVector = (ref $This)->new($This->{Size});
     905   $BitVector->{BitValues} = ~ $This->{BitValues};
     906
     907   return $BitVector;
     908 }
     909
     910 # Bit vector equla operator. Two bit vectors are considered equal assuming their size
     911 # is same and bits are on at the same positions...
     912 #
     913 sub _BitVectorEqualOperator {
     914   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     915
     916   $ErrorMsg = "_BitVectorEqualOperator: BitVector == oparation failed";
     917   $CheckBitVectorSizes = 0;
     918   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     919
     920   if (!$OtherIsBitVector) {
     921     if ($OrderFlipped) {
     922       croak "Error: ${ClassName}->${ErrorMsg}: First object must be a bit vector...";
     923     }
     924   }
     925   if ($This->GetSize() != $Other->GetSize()) {
     926     return 0;
     927   }
     928   if ($This->GetNumOfSetBits() != $Other->GetNumOfSetBits()) {
     929     return 0;
     930   }
     931   # Check number of On bits only in This vector. It must be zero for vectors to be equal...
     932   my($BitVector);
     933   $BitVector = $This & ~$Other;
     934
     935   return $BitVector->GetNumOfSetBits() ? 0 : 1;
     936 }
     937
     938 # Bit vector not equal operator. Two bit vectors are considered not equal when their size
     939 # is different or bits are on at the same positions...
     940 #
     941 sub _BitVectorNotEqualOperator {
     942   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $ErrorMsg, $CheckBitVectorSizes);
     943
     944   $ErrorMsg = "_BitVectorEqualOperator: BitVector != oparation failed";
     945   $CheckBitVectorSizes = 0;
     946   ($This, $Other, $OrderFlipped, $OtherIsBitVector) = _ProcessOverloadedOperatorParameters($ErrorMsg, @_, $CheckBitVectorSizes);
     947
     948   if (!$OtherIsBitVector) {
     949     if ($OrderFlipped) {
     950       croak "Error: ${ClassName}->${ErrorMsg}: First object must be a bit vector...";
     951     }
     952   }
     953   if ($This->GetSize() != $Other->GetSize()) {
     954     return 1;
     955   }
     956   if ($This->GetNumOfSetBits() != $Other->GetNumOfSetBits()) {
     957     return 1;
     958   }
     959   # Check number of On bits only in This vector. It must be zero for vectors to be equal...
     960   my($BitVector);
     961   $BitVector = $This & ~$Other;
     962
     963   return $BitVector->GetNumOfSetBits() ? 1 : 0;
     964 }
     965
     966 # Process parameters passed to overloaded operators...
     967 #
     968 # For uninary operators, $SecondParameter is not defined.
     969 sub _ProcessOverloadedOperatorParameters {
     970   my($ErrorMsg, $FirstParameter, $SecondParameter, $ParametersOrderStatus, $CheckBitVectorSizesStatus) = @_;
     971   my($This, $Other, $OrderFlipped, $OtherIsBitVector, $CheckBitVectorSizes);
     972
     973   ($This, $Other) =  ($FirstParameter, $SecondParameter);
     974   $OrderFlipped = (defined($ParametersOrderStatus) && $ParametersOrderStatus) ? 1 : 0;
     975   $CheckBitVectorSizes = (defined $CheckBitVectorSizesStatus) ? $CheckBitVectorSizesStatus : 1;
     976
     977   _ValidateBitVector($ErrorMsg, $This);
     978
     979   $OtherIsBitVector = 0;
     980   if (defined($Other) && (ref $Other)) {
     981     # Make sure $Other is a vector...
     982     _ValidateBitVector($ErrorMsg, $Other);
     983     if ($CheckBitVectorSizes) {
     984       _ValidateBitVectorSizesAreEqual($ErrorMsg, $This, $Other);
     985     }
     986     $OtherIsBitVector = 1;
     987   }
     988   return ($This, $Other, $OrderFlipped, $OtherIsBitVector);
     989 }
     990
     991 # Is it a bit vector object?
     992 sub _IsBitVector {
     993   my($Object) = @_;
     994
     995   return (Scalar::Util::blessed($Object) && $Object->isa($ClassName)) ? 1 : 0;
     996 }
     997
     998 # Make sure it's a bit vector reference...
     999 sub _ValidateBitVector {
    1000   my($ErrorMsg, $Vector) = @_;
    1001
    1002   if (!_IsBitVector($Vector)) {
    1003     croak "Error: ${ClassName}->${ErrorMsg}: Object must be a bit vector...";
    1004   }
    1005 }
    1006
    1007 # Make sure size of the two bit vectors are equal...
    1008 sub _ValidateBitVectorSizesAreEqual {
    1009   my($ErrorMsg, $BitVector1, $BitVector2) = @_;
    1010
    1011   if ($BitVector1->GetSize() != $BitVector2->GetSize()) {
    1012     croak "Error: ${ClassName}->${ErrorMsg}: Size of the bit vectors must be same...";
    1013   }
    1014 }
    1015
    1016 # Return a string containing vector values...
    1017 sub StringifyBitVector {
    1018   my($This) = @_;
    1019   my($BitVectorString, $PrintFormat, $BitOrder, $BitsValue);
    1020
    1021   $PrintFormat = (exists $This->{ValueFormat}) ? $This->{ValueFormat} : $ValueFormat;
    1022   $BitOrder = (exists $This->{ValueBitOrder}) ? $This->{ValueBitOrder} : $ValueBitOrder;
    1023   $BitVectorString = '';
    1024
    1025   FORMAT: {
    1026       if ($PrintFormat =~ /^(Hexadecimal|Hex|HexadecimalString)$/i) { $BitsValue = $This->_GetBitsAsString('Hexadecimal', $BitOrder);  last FORMAT; }
    1027       if ($PrintFormat =~ /^(Octal|Oct|OctalString)$/i) { $BitsValue = $This->_GetBitsAsString('Octal', $BitOrder);  last FORMAT; }
    1028       if ($PrintFormat =~ /^(Decimal|Dec|DecimalString)$/i) { $BitsValue = $This->_GetBitsAsString('Decimal', $BitOrder);  last FORMAT; }
    1029       if ($PrintFormat =~ /^(RawBinary|RawBin|RawBinaryString)$/i) { $BitsValue = $This->_GetBitsAsString('RawBinary');  last FORMAT; }
    1030       # Default is bninary format...
    1031       $BitsValue = $This->_GetBitsAsString('Binary', $BitOrder);
    1032   }
    1033   $BitVectorString = "<Size: ". $This->GetSize() . ";BitOrder: $BitOrder; Value: " . $BitsValue . ">";
    1034
    1035   return $BitVectorString;
    1036 }
    1037