Merge pull request #5068 from mattneleigh/pwc135

	new file:   challenge-135/mattneleigh/perl/ch-1.pl

2 files changed, 180 insertions, 0 deletions

diff --git a/challenge-135/mattneleigh/perl/ch-1.pl b/challenge-135/mattneleigh/perl/ch-1.pl
new file mode 100755
index 0000000000..e2f1ed4c09
--- /dev/null
+++ b/challenge-135/mattneleigh/perl/ch-1.pl
@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @numbers = (
+    # Given test cases
+    1234567,
+    -123,
+    1,
+    10,
+
+    # Additional test cases
+    -626.4537,
+    "Six and a half"
+);
+my $number;
+
+foreach $number (@numbers){
+    print("Input: \$n = $number\n");
+    print("Output: ", middle_three_digits($number), "\n\n\n");
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Get the middle three digits from a number, regardless of where they might
+# appear relative to any negative signs or decimal places
+# Takes one argument:
+# * The number to process
+# Returns on success:
+# * The middle three digits of the number
+# Returns on error:
+# * A message describing the problem with an invalid number
+################################################################################
+sub middle_three_digits{
+    my $number = shift();
+
+    my $length;
+
+    # Get rid of any leading negative sign
+    # or dicemal point, and find the length
+    # of the number
+    $number =~ s/^-//;
+    $number =~ s/\.//;
+    $length = length($number);
+
+    # Return specific messages if the
+    # number isn't one we can process
+    # further
+    return("Not a number") if($number =~ m/\D/);
+    return("Even number of digits") unless($length % 2);
+    return("Too short") unless($length > 2);
+
+    # Extract and return the middle
+    # three digits
+    return(
+        substr($number, int($length / 2) - 1, 3)
+    );
+
+}
+
+
+
diff --git a/challenge-135/mattneleigh/perl/ch-2.pl b/challenge-135/mattneleigh/perl/ch-2.pl
new file mode 100755
index 0000000000..ddb38291f3
--- /dev/null
+++ b/challenge-135/mattneleigh/perl/ch-2.pl
@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use English;
+
+################################################################################
+# Begin main execution
+################################################################################
+
+my @SEDOLs = (
+    # Given cases
+    "2936921",
+    "1234567",
+    "B0YBKL9",
+
+    # Additional test cases
+    "ZZZZZZ0",
+    "ABCDEF0"
+);
+my $SEDOL;
+
+foreach $SEDOL (@SEDOLs){
+    print("Input: \$SEDOL = '", $SEDOL, "'\n");
+    print("Output: ", is_valid_SEDOL_number($SEDOL), "\n\n");
+}
+
+exit(0);
+################################################################################
+# End main execution; subroutines follow
+################################################################################
+
+
+
+################################################################################
+# Determine whether a string contains a valid SEDOL number
+# Takes one argument:
+# * A string of seven characters that comprise a SEDOL number WITH the check
+#   digit- this must consist of exactly seven digits or upper-case consonants
+# Returns:
+# * 1 if the string is a valid SEDOL number
+# * 0 if the string is not a valid SEDOL number
+# NOTE: This function does not differentiate between mismatched check digits
+# and strings that may be invalid SEDOL numbers for other reasons
+################################################################################
+sub is_valid_SEDOL_number{
+    my $SEDOL = shift();
+
+    # Get the check digit
+    my $check = compute_SEDOL_check_digit(substr($SEDOL, 0, 6));
+
+    # See if it's defined and  matches
+    # what's in the supplied string
+    return(1)
+        if(
+            defined($check)
+            &&
+            ($check eq substr($SEDOL, 6, 1))
+        );
+
+    return(0);
+
+}
+
+
+
+################################################################################
+# Calculate the check digit that's associated with a SEDOL number
+# Takes one argument:
+# * A string of six characters that comprise a SEDOL number WITHOUT the check
+#   digit- this must consist of exactly six digits or upper-case consonants
+# Returns on success:
+# * The check digit calculated from the string provided
+# Returns on error:
+# * undef if the string does not contain a valid checksum-less SEDOL number
+################################################################################
+sub compute_SEDOL_check_digit{
+    my $unchecked_SEDOL = shift();
+
+    my @weights = (1, 3, 1, 7, 3, 9);
+    my $i = 0;
+    my $sum = 0;
+
+    # Require six characters, digits and
+    # upper-case consonants only
+    unless($unchecked_SEDOL =~ m/^[0-9B-DF-HJ-NP-TV-Z]{6}$/){
+        return(undef);
+    }
+
+    foreach(split("", $unchecked_SEDOL)){
+        $sum +=
+            $weights[$i++]
+            *
+            # 'A' (which we don't use...) has an
+            # ordinal value of 65 so we subtract
+            # to give letters effective values
+            # from 10 upward
+            ($_ =~ m/\d/ ? $_ : ord($_) - 55);
+    }
+
+    return((10 - $sum % 10) % 10);
+
+}
+
+
+