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