1 package TextUtil;
   2 #
   3 # File: TextUtil.pm
   4 # Author: Manish Sud <msud@san.rr.com>
   5 #
   6 # Copyright (C) 2024 Manish Sud. All rights reserved.
   7 #
   8 # This file is part of MayaChemTools.
   9 #
  10 # MayaChemTools is free software; you can redistribute it and/or modify it under
  11 # the terms of the GNU Lesser General Public License as published by the Free
  12 # Software Foundation; either version 3 of the License, or (at your option) any
  13 # later version.
  14 #
  15 # MayaChemTools is distributed in the hope that it will be useful, but without
  16 # any warranty; without even the implied warranty of merchantability of fitness
  17 # for a particular purpose.  See the GNU Lesser General Public License for more
  18 # details.
  19 #
  20 # You should have received a copy of the GNU Lesser General Public License
  21 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or
  22 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330,
  23 # Boston, MA, 02111-1307, USA.
  24 #
  25 
  26 use strict;
  27 use Exporter;
  28 use Text::ParseWords;
  29 
  30 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  31 
  32 @ISA = qw(Exporter);
  33 @EXPORT = qw(AddNumberSuffix ContainsWhiteSpaces GetTextLine GetTextFileDataByUniqueKey GetTextFileDataByNonUniqueKey HashCode IsEmpty IsNumberPowerOfNumber IsInteger IsPositiveInteger IsFloat IsNotEmpty IsNumerical JoinWords SplitWords  QuoteAWord RemoveLeadingWhiteSpaces RemoveTrailingWhiteSpaces RemoveLeadingAndTrailingWhiteSpaces WrapText);
  34 @EXPORT_OK = qw();
  35 %EXPORT_TAGS = (all  => [@EXPORT, @EXPORT_OK]);
  36 
  37 # Add number suffix...
  38 sub AddNumberSuffix {
  39   my($Value) = @_;
  40   my($ValueWithSuffix, $Suffix);
  41 
  42   $ValueWithSuffix = $Value;
  43   if (!IsPositiveInteger($Value)) {
  44     return $ValueWithSuffix;
  45   }
  46   $Suffix = "th";
  47   if ($Value < 10 || $Value > 20) {
  48     my $Remainder = $Value % 10;
  49     $Suffix = ($Remainder == 1) ? "st" : (($Remainder == 2) ? "nd" : (($Remainder == 3) ? "rd" : "th"));
  50   }
  51   $ValueWithSuffix = "${ValueWithSuffix}${Suffix}";
  52   return $ValueWithSuffix;
  53 }
  54 
  55 # Check out the string: Doen it contain any white space characters?
  56 sub ContainsWhiteSpaces {
  57   my($TheString) = @_;
  58   my($Status) = 0;
  59 
  60   if (defined($TheString) && length($TheString)) {
  61     $Status = ($TheString =~ /[ \t\r\n\f]/ ) ? 1 : 0;
  62   }
  63   return $Status;
  64 }
  65 
  66 # Read the line, change to UNIX new line char, and chop off new line char as well...
  67 sub GetTextLine {
  68   my($TextFileRef) = @_;
  69   my($Line) = '';
  70 
  71   # Get the next non empty line...
  72   LINE: while (defined($_ = <$TextFileRef>)) {
  73     # Change Windows and Mac new line char to UNIX...
  74     s/(\r\n)|(\r)/\n/g;
  75 
  76     # Take out any new line char at the end by explicitly removing it instead of using
  77     # chomp, which might not always work correctly on files generated on a system
  78     # with a value of input line separator different from the current system...
  79     s/\n$//g;
  80 
  81     # Doesn't hurt to chomp...
  82     chomp;
  83 
  84     $Line = $_;
  85     if (length $Line) {
  86       last LINE;
  87     }
  88   }
  89   return $Line;
  90 }
  91 
  92 # Load data from a CSV file into the specified hash reference using a specific
  93 # column for unique data key values.
  94 #
  95 # The lines starting with # are treated as comments and ignored. First line
  96 # not starting with # must contain column labels and the number of columns in
  97 # all other data rows must match the number of column labels.
  98 #
  99 # The first column is assumed to contain data key value by default; all other columns
 100 # contain data as indicated in their column labels.
 101 #
 102 # In order to avoid dependence of data access on the specified column labels, the
 103 # column data is loaded into hash with Column<Num> hash keys, where column number
 104 # start from 1. The data key column is not available as Colnum<Num> hash key;
 105 #
 106 # The format of the data structure loaded into a specified hash reference is:
 107 #
 108 # @{$TextDataMapRef->{DataKeys}} - Array of unique data keys
 109 # @{$TextDataMapRef->{ColLabels}} - Array of column labels
 110 # @{$TextDataMapRef->{DataColIDs}} - Array of data column IDs
 111 # $TextDataMapRef->{NumOfCols} - Number of columns
 112 # %{$TextDataMapRef->{DataKey}} - Hash keys pair: <DataKey, DataKey>
 113 # %{$TextDataMapRef->{DataCol<Num>}} - Hash keys pair: <DataCol<Num>, DataKey>
 114 #
 115 # Caveats:
 116 #   . The column number start from 1.
 117 #   . Column data for data key column column is not loaded into <Column<Num>, DataKey> hash keys pairs.
 118 #
 119 sub GetTextFileDataByUniqueKey {
 120   my($TextDataFile, $TextDataMapRef, $DataKeyColNum, $InDelim) = @_;
 121 
 122   return _GetTextFileData("UniqueKey", $TextDataFile, $TextDataMapRef, $DataKeyColNum, $InDelim);
 123 }
 124 
 125 # Load data from a CSV file into the specified hash reference using a specific
 126 # column for non-unique data key values.
 127 #
 128 # The lines starting with # are treated as comments and ignored. First line
 129 # not starting with # must contain column labels and the number of columns in
 130 # all other data rows must match the number of column labels.
 131 #
 132 # The first column is assumed to contain data key value by default; all other columns
 133 # contain data as indicated in their column labels.
 134 #
 135 # In order to avoid dependence of data access on the specified column labels, the
 136 # column data is loaded into hash with Column<Num> hash keys, where column number
 137 # start from 1. The data key column is not available as Colnum<Num> hash key;
 138 #
 139 # The format of the data structure loaded into a specified hash reference is:
 140 #
 141 # @{$TextDataMapRef->{DataKeys}} - Array of unique data keys
 142 # @{$TextDataMapRef->{ColLabels}} - Array of column labels
 143 # @{$TextDataMapRef->{DataColIDs}} - Array of data column IDs
 144 # $TextDataMapRef->{NumOfCols} - Number of columns
 145 # %{$TextDataMapRef->{DataKey}} - Hash keys pair: <DataKey, DataKey>
 146 # @{$TextDataMapRef->{DataCol<Num>}} - Hash keys pair with data as an array: <DataCol<Num>, DataKey>
 147 #
 148 # Caveats:
 149 #   . The column number start from 1.
 150 #   . Column data for data key column column is not loaded into <Column<Num>, DataKey> hash keys pairs.
 151 #
 152 sub GetTextFileDataByNonUniqueKey {
 153   my($TextDataFile, $TextDataMapRef, $DataKeyColNum, $InDelim) = @_;
 154 
 155   return _GetTextFileData("NonUniqueKey", $TextDataFile, $TextDataMapRef, $DataKeyColNum, $InDelim);
 156 }
 157 
 158 # Loadtext file data using unique or non-uniqye data column key...
 159 #
 160 sub _GetTextFileData {
 161   my($DataKeyMode, $TextDataFile, $TextDataMapRef, $DataKeyColNum, $InDelim) = @_;
 162   my($DataKeyColIndex, $LineCount, $IgnoredLineCount, $UniqueDataKeyMode, $DataKey, $Line, $NumOfCols, $ColIndex, $ColNum, $ColID, $ColValue, @LineWords, @ColLabels, @DataColIDs, @DataColNums);
 163 
 164   print "\nProcessing text data file $TextDataFile...\n";
 165 
 166   $UniqueDataKeyMode = 0;
 167   if ($DataKeyMode =~ /^UniqueKey$/i) {
 168     $UniqueDataKeyMode = 1;
 169   }
 170 
 171   # Setup default values...
 172   $DataKeyColNum = defined  $DataKeyColNum ? $DataKeyColNum : 1;
 173 
 174   if (defined $InDelim) {
 175     if ($InDelim =~ /^tab$/i) {
 176       $InDelim = "\t";
 177     }
 178     elsif ($InDelim =~ /^semicolon$/i) {
 179       $InDelim = "\;";
 180     }
 181     elsif ($InDelim =~ /^comma$/i) {
 182       $InDelim = "\,";
 183     }
 184     else {
 185       warn "Warning: Ignoring specified input delimiter: $InDelim. Supported values: comma, semicolon or tab. Using default comma delimiter...";
 186       $InDelim = "\,";
 187     }
 188   }
 189   else {
 190     if ($TextDataFile =~ /\.tsv$/i) {
 191       $InDelim = "\t";
 192     }
 193     elsif ($TextDataFile =~ /\.csv$/i) {
 194       $InDelim = "\,";
 195     }
 196     else {
 197       warn "Warning: Unknown file extension. Using default comma delimiter...";
 198       $InDelim = "\,";
 199     }
 200   }
 201 
 202   ($LineCount, $IgnoredLineCount) = (0) x 2;
 203 
 204   open TEXTDATAFILE, "$TextDataFile" or die "Couldn't open $TextDataFile: $! ...";
 205 
 206   # Skip lines up to column labels...
 207   LINE: while ($Line = TextUtil::GetTextLine(\*TEXTDATAFILE)) {
 208     $LineCount++;
 209     if ($Line =~ /^#/) {
 210       $IgnoredLineCount++;
 211     }
 212     else {
 213       last LINE;
 214     }
 215   }
 216 
 217   # Initialize data map...
 218   %{$TextDataMapRef} = ();
 219   @{$TextDataMapRef->{DataKeys}} = ();
 220   @{$TextDataMapRef->{ColLabels}} = ();
 221   @{$TextDataMapRef->{DataColIDs}} = ();
 222   $TextDataMapRef->{NumOfCols} = undef;
 223 
 224   # Process column labels...
 225   @ColLabels= quotewords($InDelim, 0, $Line);
 226   $NumOfCols = @ColLabels;
 227 
 228   if ($DataKeyColNum < 1 || $DataKeyColNum > $NumOfCols) {
 229     warn "Warning: Ignoring text data file $TextDataFile: Invalid data key column number, $DataKeyColNum, specified. It must be > 0 or <= $NumOfCols, number of columns in the text file ...";
 230     return;
 231   }
 232   $DataKeyColIndex = $DataKeyColNum - 1;
 233 
 234   $TextDataMapRef->{NumOfCols} = $NumOfCols;
 235   push @{$TextDataMapRef->{ColLabels}}, @ColLabels;
 236 
 237   # Set up column data IDs for tracking the data...
 238   @DataColNums = ();
 239   @DataColIDs = ();
 240   COLNUM: for $ColNum (1 .. $NumOfCols) {
 241     if ($ColNum == $DataKeyColNum) {
 242       next COLNUM;
 243     }
 244     push @DataColNums, $ColNum;
 245     $ColID = "DataCol${ColNum}";
 246     push @DataColIDs, $ColID;
 247   }
 248   push @{$TextDataMapRef->{DataColIDs}}, @DataColIDs;
 249 
 250   # Initialize column data hash...
 251   %{$TextDataMapRef->{DataKey}} = ();
 252   for $ColIndex (0 .. $#DataColNums) {
 253     $ColNum = $DataColNums[$ColIndex];
 254     $ColID = $DataColIDs[$ColIndex];
 255     %{$TextDataMapRef->{$ColID}} = ();
 256   }
 257 
 258   LINE: while ($Line = TextUtil::GetTextLine(\*TEXTDATAFILE)) {
 259     $LineCount++;
 260     if ($Line =~ /^#/) {
 261       $IgnoredLineCount++;
 262       next LINE;
 263     }
 264 
 265     @LineWords = quotewords($InDelim, 0, $Line);
 266     if (@LineWords != $NumOfCols) {
 267       $IgnoredLineCount++;
 268       warn "Warning: The number of data fields, @LineWords, in $TextDataFile must be $NumOfCols.\nIgnoring line number $LineCount: $Line...\n";
 269       next LINE;
 270     }
 271     $DataKey = $LineWords[$DataKeyColIndex];
 272 
 273     if ($UniqueDataKeyMode) {
 274       if (exists $TextDataMapRef->{DataKey}{$DataKey}) {
 275         $IgnoredLineCount++;
 276         warn "Warning: The data key, $DataKey, in data column key number, $DataKeyColNum, is already present.\nIgnoring line number $LineCount: $Line...\n";
 277         next LINE;
 278       }
 279       push @{$TextDataMapRef->{DataKeys}}, $DataKey;
 280       $TextDataMapRef->{DataKey}{$DataKey} = $DataKey;
 281     }
 282     else {
 283       if (!exists $TextDataMapRef->{DataKey}{$DataKey}) {
 284         push @{$TextDataMapRef->{DataKeys}}, $DataKey;
 285         $TextDataMapRef->{DataKey}{$DataKey} = $DataKey;
 286 
 287         for $ColIndex (0 .. $#DataColNums) {
 288           $ColNum = $DataColNums[$ColIndex];
 289           $ColID = $DataColIDs[$ColIndex];
 290           @{$TextDataMapRef->{$ColID}{$DataKey}} = ();
 291         }
 292       }
 293     }
 294 
 295     # Track column data values...
 296     for $ColIndex (0 .. $#DataColNums) {
 297       $ColID = $DataColIDs[$ColIndex];
 298 
 299       $ColNum = $DataColNums[$ColIndex];
 300       $ColValue = $LineWords[$ColNum - 1];
 301 
 302       if ($UniqueDataKeyMode) {
 303         $TextDataMapRef->{$ColID}{$DataKey} = $ColValue;
 304       }
 305       else {
 306         push @{$TextDataMapRef->{$ColID}{$DataKey}}, $ColValue;
 307       }
 308     }
 309 
 310   }
 311 
 312   print "\nTotal number of lines in file $TextDataFile: $LineCount\n";
 313   print "Total number of lines ignored: $IgnoredLineCount\n";
 314 
 315   close TEXTDATAFILE;
 316 }
 317 
 318 # Returns a 32 bit integer hash code using One-at-a-time algorithm By Bob Jenkins [Ref 38]. It's also implemented in
 319 # Perl for internal hash keys in hv.h include file.
 320 #
 321 # It's not clear how to force Perl perform unsigned integer arithmetic irrespective of the OS/Platform and
 322 # the value of use64bitint flag used during its compilation.
 323 #
 324 # In order to generate a consistent 32 bit has code across OS/platforms, the following methodology appear
 325 # to work:
 326 #
 327 #    o Use MaxHashCodeMask to retrieve appropriate bits after left shifting by bit operators and additions
 328 #    o Stay away from "use integer" to avoid signed integer arithmetic for bit operators
 329 #
 330 #
 331 #   MaxHashCodeMask (2147483647) corresponds to the maximum value which can be stored in 31 bits
 332 #
 333 my($MaxHashCodeMask);
 334 $MaxHashCodeMask = 2**31 - 1;
 335 
 336 sub HashCode {
 337   my($String) = @_;
 338   my($HashCode, $Value, $ShiftedHashCode);
 339 
 340   $HashCode = 0;
 341   for $Value (unpack('C*', $String)) {
 342     $HashCode += $Value;
 343 
 344     $ShiftedHashCode = $HashCode << 10;
 345     if ($ShiftedHashCode > $MaxHashCodeMask) {
 346       $ShiftedHashCode = $ShiftedHashCode & $MaxHashCodeMask;
 347     }
 348 
 349     $HashCode += $ShiftedHashCode;
 350     if ($HashCode > $MaxHashCodeMask) {
 351       $HashCode = $HashCode & $MaxHashCodeMask;
 352     }
 353 
 354     $HashCode ^= ($HashCode >> 6);
 355   }
 356 
 357   $ShiftedHashCode = $HashCode << 3;
 358   if ($ShiftedHashCode > $MaxHashCodeMask) {
 359     $ShiftedHashCode = $ShiftedHashCode & $MaxHashCodeMask;
 360   }
 361 
 362   $HashCode += $ShiftedHashCode;
 363   if ($HashCode > $MaxHashCodeMask) {
 364     $HashCode = $HashCode & $MaxHashCodeMask;
 365   }
 366   $HashCode ^= ($HashCode >> 11);
 367 
 368   $ShiftedHashCode = $HashCode << 15;
 369   if ($ShiftedHashCode > $MaxHashCodeMask) {
 370     $ShiftedHashCode = $ShiftedHashCode & $MaxHashCodeMask;
 371   }
 372 
 373   $HashCode += $ShiftedHashCode;
 374   if ($HashCode > $MaxHashCodeMask) {
 375     $HashCode = $HashCode & $MaxHashCodeMask;
 376   }
 377   return $HashCode;
 378 }
 379 
 380 # Check out the string: Is it defined and has a non zero length?
 381 sub IsEmpty {
 382   my($TheString) = @_;
 383   my($Status) = 1;
 384 
 385   $Status = (defined($TheString) && length($TheString)) ? 0 : 1;
 386 
 387   return $Status;
 388 }
 389 
 390 # Is first specified number power of second specified number...
 391 sub IsNumberPowerOfNumber {
 392   my($FirstNum, $SecondNum) = @_;
 393   my($PowerValue);
 394 
 395   $PowerValue = log($FirstNum)/log($SecondNum);
 396 
 397   return IsInteger($PowerValue) ? 1 : 0;
 398 }
 399 
 400 # Check out the string: Is it an integer?
 401 sub IsInteger {
 402   my($TheString) = @_;
 403   my($Status) = 0;
 404 
 405   if (defined($TheString) && length($TheString)) {
 406     $TheString = RemoveLeadingAndTrailingWhiteSpaces($TheString);
 407     $TheString =~ s/^[+-]//;
 408     $Status = ($TheString =~ /[^0-9]/) ? 0 : 1;
 409   }
 410   return $Status;
 411 }
 412 
 413 # Check out the string: Is it an integer with value > 0?
 414 sub IsPositiveInteger {
 415   my($TheString) = @_;
 416   my($Status) = 0;
 417 
 418   $Status = IsInteger($TheString) ? ($TheString > 0 ? 1 : 0) : 0;
 419 
 420   return $Status;
 421 }
 422 
 423 
 424 # Check out the string: Is it a float?
 425 sub IsFloat {
 426   my($TheString) = @_;
 427   my($Status) = 0;
 428 
 429   if (defined($TheString) && length($TheString)) {
 430     $TheString = RemoveLeadingAndTrailingWhiteSpaces($TheString);
 431     $TheString =~ s/^[+-]//;
 432     $Status = ($TheString =~ /[^0-9.eE]/) ? 0 : (((length($TheString) == 1) && ($TheString =~ /[.eE]/)) ? 0 : 1);
 433   }
 434   return $Status;
 435 }
 436 
 437 # Check out the string: Is it defined and has a non zero length?
 438 sub IsNotEmpty {
 439   my($TheString) = @_;
 440   my($Status);
 441 
 442   $Status = IsEmpty($TheString) ? 0 : 1;
 443 
 444   return $Status;
 445 }
 446 
 447 # Check out the string: Does it only contain numerical data?
 448 sub IsNumerical {
 449   my($TheString) = @_;
 450   my($Status) = 0;
 451 
 452   if (defined($TheString) && length($TheString)) {
 453     $TheString = RemoveLeadingAndTrailingWhiteSpaces($TheString);
 454     $TheString =~ s/^[+-]//;
 455     $Status = ($TheString =~ /[^0-9.eE]/) ? 0 : (((length($TheString) == 1) && ($TheString =~ /[.eE]/)) ? 0 : 1);
 456   }
 457   return $Status;
 458 }
 459 
 460 # Join different words using delimiter and quote parameters. And return as
 461 # a string value.
 462 sub JoinWords {
 463   my($Words, $Delim, $Quote) = @_;
 464 
 465   if (!@$Words) {
 466     return "";
 467   }
 468 
 469   $Quote = $Quote ? "\"" : "";
 470   my(@NewWords) = map { (defined($_) && length($_)) ? "${Quote}$_${Quote}" : "${Quote}${Quote}" } @$Words;
 471 
 472   return join $Delim, @NewWords;
 473 }
 474 
 475 # Split string value containing quoted or unquoted words in to an array containing
 476 # unquoted words.
 477 #
 478 # This function is used to split strings generated by JoinWords.
 479 #
 480 sub SplitWords {
 481   my($Line, $Delim) = @_;
 482 
 483   if (!$Line) {
 484     return ();
 485   }
 486 
 487   # Is it a quoted string?
 488   if ($Line =~ /^\"/) {
 489     # Take out first and last quote...
 490     $Line =~ s/^\"//; $Line =~ s/\"$//;
 491 
 492     $Delim = "\"$Delim\"";
 493   }
 494   return split /$Delim/, $Line;
 495 }
 496 
 497 # Based on quote parameter, figure out what to do
 498 sub QuoteAWord {
 499   my($Word, $Quote) = @_;
 500   my($QuotedWord);
 501 
 502   $QuotedWord = "";
 503   if ($Word) {
 504     $QuotedWord = $Word;
 505   }
 506   if ($Quote) {
 507     $QuotedWord = "\"$QuotedWord\"";
 508   }
 509   return ($QuotedWord);
 510 }
 511 
 512 # Remove leading white space characters from the string...
 513 sub RemoveLeadingWhiteSpaces {
 514   my($InString) = @_;
 515   my($OutString, $TrailingString, $LeadingWhiteSpace);
 516 
 517   $OutString = $InString;
 518   if (length($InString) && ContainsWhiteSpaces($InString)) {
 519     $OutString =~ s/^([ \t\r\n\f]*)(.*?)$/$2/;
 520   }
 521   return $OutString;
 522 }
 523 
 524 # Remove Trailing white space characters from the string...
 525 sub RemoveTrailingWhiteSpaces {
 526   my($InString) = @_;
 527   my($OutString, $LeadingString, $TrailingWhiteSpace);
 528 
 529   $OutString = $InString;
 530   if (length($InString) && ContainsWhiteSpaces($InString)) {
 531     $OutString =~ s/^(.*?)([ \t\r\n\f]*)$/$1/;
 532   }
 533   return $OutString;
 534 }
 535 
 536 # Remove both leading and trailing white space characters from the string...
 537 sub RemoveLeadingAndTrailingWhiteSpaces {
 538   my($InString) = @_;
 539   my($OutString);
 540 
 541   $OutString = $InString;
 542   if (length($InString) && ContainsWhiteSpaces($InString)) {
 543     $OutString =~ s/^([ \t\r\n\f]*)(.*?)([ \t\r\n\f]*)$/$2/;
 544   }
 545   return $OutString;
 546 }
 547 
 548 # Wrap text string...
 549 sub WrapText {
 550   my($InString, $WrapLength, $WrapDelimiter);
 551   my($OutString);
 552 
 553   $WrapLength = 40;
 554   $WrapDelimiter = "\n";
 555   if (@_ == 3) {
 556     ($InString, $WrapLength, $WrapDelimiter) = @_;
 557   }
 558   elsif (@_ == 2) {
 559     ($InString, $WrapLength) = @_;
 560   }
 561   else {
 562     ($InString, $WrapLength) = @_;
 563   }
 564   $OutString = $InString;
 565   if ($InString && (length($InString) > $WrapLength)) {
 566     $OutString = "";
 567     my($Index, $Length, $FirstPiece, $StringPiece);
 568     $Index = 0; $Length = length($InString);
 569     $FirstPiece = 1;
 570     for ($Index = 0; $Index < $Length; $Index += $WrapLength) {
 571       if (($Index + $WrapLength) < $Length) {
 572         $StringPiece = substr($InString, $Index, $WrapLength);
 573       }
 574       else {
 575         # Last piece of the string...
 576         $StringPiece = substr($InString, $Index, $WrapLength);
 577       }
 578       if ($FirstPiece) {
 579         $FirstPiece = 0;
 580         $OutString = $StringPiece;
 581       }
 582       else {
 583         $OutString .= "${WrapDelimiter}${StringPiece}";
 584       }
 585     }
 586   }
 587   return $OutString;
 588 }
 589