#!/usr/bin/perl

use strict;
use warnings;

Test();

sub hasSameChars
{
  @_ > 1 or return 0;
  my $THISLEN = -2;
  my $PREVLEN = -2;
  foreach (@_)
  {
    $THISLEN = (defined $_) ? length($_) : -1;
    if ($PREVLEN > -2) { $PREVLEN == $THISLEN or return 0; }    
    $PREVLEN = $THISLEN;
  }
  $THISLEN < 1 and return 1;

  my $A;
  my $B;
  my $char;
  my $X = @_;
  while ($X-- > 1)
  {
    $A = $_[0];
    $B = $_[$X];
    length($A) == length($B) or return 0;
    while (length($A) > 0)
    {
      $char = chop($A);
      $A =~ s/\Q$char\E//g;
      $B =~ s/\Q$char\E//g;
      length($A) == length($B) or return 0;
    }
  }
  return 1;
}

sub Test
{
  my $ERRORS = 0;

  # TESTING TRUE:
  hasSameChars("Hello World!", "Hello World!")                 == 1 or $ERRORS++;
  hasSameChars("Hello World!", "Hdll!ooreWl ")                 == 1 or $ERRORS++;
  hasSameChars("Hello World!", "Hdll!ooreWl ", "Hlde! Wlloor") == 1 or $ERRORS++;
  hasSameChars("FALLEN", "LENFAL", "ELFALN")                   == 1 or $ERRORS++;
  hasSameChars('', '', '', '')                                 == 1 or $ERRORS++;
  hasSameChars('A', 'A', 'A', 'A')                             == 1 or $ERRORS++;
  hasSameChars("\r\n\t\0\0\1", "\0\1\t\0\n\r", "\n\1\r\t\0\0") == 1 or $ERRORS++;
  hasSameChars('ABB', 'BBA', 'BAB', 'BBA')                     == 1 or $ERRORS++;
  hasSameChars('   ', '   ', '   ', '   ')                     == 1 or $ERRORS++;
  hasSameChars("ABC", "CAB", "BAC", "BCA", "ACB", "ABC")       == 1 or $ERRORS++;

  # TESTING FALSE:
  hasSameChars("\r\n\t\0\1\2", "\0\2\t\1\n\r", "\t\t\r\1\2\n") == 0 or $ERRORS++;
  hasSameChars("Hello World!", "Hdll!ooreWl ", "Hlde! Wlloo")  == 0 or $ERRORS++;
  hasSameChars("Hello World!", "Hdll!ooreWl")                  == 0 or $ERRORS++;
  hasSameChars("ABC", "C_B", "BAC", "BCA", "ACB", "ABC")       == 0 or $ERRORS++;
  hasSameChars("ALLEN", "ELLEN", "HALLEN", "HELLEN")           == 0 or $ERRORS++;
  hasSameChars("FALLEN", "Lenfal", "ELFALN")                   == 0 or $ERRORS++;
  hasSameChars("FALLEN", "FALLEN ")                            == 0 or $ERRORS++;
  hasSameChars('', "FALLEN", "FALLEN")                         == 0 or $ERRORS++;
  hasSameChars("FALLEN", '', "FALLEN")                         == 0 or $ERRORS++;
  hasSameChars("FALLEN", "FALLEN", '')                         == 0 or $ERRORS++;
  hasSameChars('ABB', 'ABA', 'BAA', 'BAA')                     == 0 or $ERRORS++;
  hasSameChars('   ', '   ', '   ', "\t")                      == 0 or $ERRORS++;

  print "\n\n ERRORS = $ERRORS \n\n";
}

##</code><code>##

sub hasSameChars
{
  # Make sure each argument has the same type and same length.
  @_ > 1 or return 0;

  my $THISLEN = -2;  # Current argument length
  my $PREVLEN = -2;  # Previous argument length
  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;

# So, the idea is we use a regex 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.

  # === ANALYZE CHARACTER MAKEUP OF THE FIRST ARGUMENT =============
  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;
}