#
# This function compares its arguments, and if they are all made up
# of the same characters but perhaps rearranged in different order,
# then the function returns 1; otherwise returns zero.
#
# Note: This function not only makes sure that the same characters
# occur in both strings but that they are the same count as well.
# So, hasSameChars("ABC", "AABC") will return zero.
#
# Usage: INTEGER = hasSameChars(STRINGS...)
#
sub hasSameChars
{
  # First, we make sure each argument has the same type and same lengt
+h.
  @_ > 1 or return 0;

  my $THISLEN = -2;  # Current argument length
  my $PREVLEN = -2;  # Previous argument length
  # When we encounter an undefined scalar,
  # we treat it as if it had length -1.
  # IF ALL arguments are undefined, then the function should return 1.
  # If one argument is undefined, then all arguments should be undefin
+ed.
  # If one argument is a string, then all arguments
  # must be a string of the same length. So, this is what we're
  # trying to decide here:
  foreach (@_)
  {
    $THISLEN = (defined $_) ? length($_) : -1;
    if ($PREVLEN > -2) { $PREVLEN == $THISLEN or return 0; }
    $PREVLEN = $THISLEN;
  }

  # Okay, at this point, we know that all arguments are
  # the same type and same length. If they are all undefined or
  # empty, then we can exit right here:
  $THISLEN < 1 and return 1;

# --------------------------------------------------------------
#
# This was my first solution, however
# I found a much more efficient and faster way than this:
#
#  my $SAMPLE = join('', sort(split(//, shift)));
#  foreach (@_)
#  {
#    join('', sort(split(//, $_))) eq $SAMPLE or return 0;
#  }
#  return 1;
#
# Instead of sorting the characters of both strings, I use a regex
# replace to remove each character from both strings. For example,
# after we remove every instance of letter "A" from a string, its
# length will be reduced. If the string contains 15 As, then any other
# string that has the same makeup must have 15 As. So, if we remove
# all the letter As from any other string, the length of those
# strings must drop by the same amount. So, we just have to make
# sure that as we remove characters from other strings, the
# length drops by the same amount as it did in the first string.
# If the length-drops match, then the strings
# have the same character makeup.

  # Here we analyze the character makeup of the first string:
  my $A = shift;     # A copy of the first argument
  my $CHARS = '';    # Unique characters in the first string
  my @LEN;           # Remaining string length after chars removed
  my $C;             # just a character
  while (length($A))
  {
    $C = substr($A, 0, 1);     # Take the first character
    $A =~ s/\Q$C\E//g;         # Remove every trace of it
    push(@LEN, length($A));    # Record length drop after removed
    $CHARS .= $C;              # Record the character itself
  }
  # $CHARS now contains a list of unique characters
  # used in the first argument.
  my $U = length($CHARS);      # Number of unique characters used
  my $P;                       # Unique Character Pointer

  # === COMPARE CHARACTER MAKEUP OF OTHER STRINGS ==================
  foreach (@_)
  {
    $A = $_;                        # Copy next argument
    $P = 0;                         # Start with first unique char
    while ($P < $U)
    {
      $C = substr($CHARS, $P, 1);   # Look at next unique character
      $A =~ s/\Q$C\E//g;            # Remove every trace of it
      length($A) == $LEN[$P++] or return 0;   # Check length drop
    }
  }

  return 1;
}
[download]