diff options
| -rwxr-xr-x | challenge-135/mattneleigh/perl/ch-1.pl | 74 | ||||
| -rwxr-xr-x | challenge-135/mattneleigh/perl/ch-2.pl | 106 |
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); + +} + + + |
