[Bio] / FigKernelPackages / Tracer.pm Repository: Repository Listing Bio # Diff of /FigKernelPackages/Tracer.pm

revision 1.120, Thu Jun 4 18:27:33 2009 UTC revision 1.121, Thu Jun 18 01:29:19 2009 UTC
# Line 3696  Line 3696
3696      my \$cmp = Tracer::Cmp(\$a, \$b);      my \$cmp = Tracer::Cmp(\$a, \$b);
3697
3698  This method performs a universal sort comparison. Each value coming in is  This method performs a universal sort comparison. Each value coming in is
3699  separated into a leading text part and a trailing number part. The text  separated into a text parts and number parts. The text
3700  part is string compared, and if both parts are equal, then the number  part is string compared, and if both parts are equal, then the number
3701  parts are compared numerically. A stream of just numbers or a stream of  parts are compared numerically. A stream of just numbers or a stream of
3702  just strings will sort correctly, and a mixed stream will sort with the  just strings will sort correctly, and a mixed stream will sort with the
3703  numbers first. Strings with a label and a number will sort in the  numbers first. Strings with a label and a number will sort in the
3704  expected manner instead of lexically.  expected manner instead of lexically. Undefined values sort last.
3705
3706  =over 4  =over 4
3707
# Line 3735  Line 3735
3735          \$retVal = 1;          \$retVal = 1;
3736      } else {      } else {
3737          # Here we have two real values. Parse the two strings.          # Here we have two real values. Parse the two strings.
3738          my \$aParsed = _Parse(\$a);          my @aParsed = _Parse(\$a);
3739          my \$bParsed = _Parse(\$b);          my @bParsed = _Parse(\$b);
3740            # Loop through the first string.
3741            while (! \$retVal && @aParsed) {
3742                # Extract the string parts.
3743                my \$aPiece = shift(@aParsed);
3744                my \$bPiece = shift(@bParsed) || '';
3745                # Extract the number parts.
3746                my \$aNum = shift(@aParsed);
3747                my \$bNum = shift(@bParsed) || 0;
3748          # Compare the string parts insensitively.          # Compare the string parts insensitively.
3749          \$retVal = (lc \$aParsed-> cmp lc \$bParsed->);              \$retVal = (lc(\$aPiece) cmp lc(\$bPiece));
3750          # If they're equal, compare them sensitively.          # If they're equal, compare them sensitively.
3751          if (! \$retVal) {          if (! \$retVal) {
3752              \$retVal = (\$aParsed-> cmp \$bParsed->);                  \$retVal = (\$aPiece cmp \$bPiece);
}
3753          # If they're STILL equal, compare the number parts.          # If they're STILL equal, compare the number parts.
3754          if (! \$retVal) {          if (! \$retVal) {
3755              \$retVal = \$aParsed-> <=> \$bParsed->;                      \$retVal = \$aNum <=> \$bNum;
3756                    }
3757                }
3758          }          }
3759      }      }
3760      # Return the result.      # Return the result.
3761      return \$retVal;      return \$retVal;
3762  }  }
3763
3764  # This method parses an input string into a string part and a number part.  # This method parses an input string into a string parts alternating with
3765    # number parts.
3766  sub _Parse {  sub _Parse {
3767        # Get the incoming string.
3768      my (\$string) = @_;      my (\$string) = @_;
3769      my (\$alpha, \$num);      # The pieces will be put in here.
3770      if (\$string =~ /^(.*?)(\d+(?:\.\d+)?)\$/) {      my @retVal;
3771          \$alpha = \$1;      # Loop through as many alpha/num sets as we can.
3772          \$num = \$2;      while (\$string =~ /^(\D*)(\d+)(.*)/) {
3773      } else {          # Push the alpha and number parts into the return string.
3774          \$alpha = \$string;          push @retVal, \$1, \$2;
3775          \$num = 0;          # Save the residual.
3776            \$string = \$3;
3777        }
3778        # If there's still stuff left, add it to the end with a trailing
3779        # zero.
3780        if (\$string) {
3781            push @retVal, \$string, 0;
3782      }      }
3783      return [\$alpha, \$num];      # Return the list.
3784        return @retVal;
3785  }  }
3786