perl id number validation south africa
# NB--> Language: Perl
# NB--> Country of ID: South Africa (RSA)
use Scalar::Util 'looks_like_number';
sub Validate_IdNum($);
sub GetLuhnDigit($);
#----------------------------------------------------------------#
# Validates the id number being parsed and returns a boolean,
# If the id number is valid, returns 0, otherwise returns 1
# PARAMETERS
# <sIdNo> The id number that needs to be validated
# EXAMPLES
# <IN:94091850160a0> <OUTPUT:[0]["Id number cannot contain numeric values"]>
sub Validate_IdNum($)
{
my $sSubName = (caller(0))[3]; # This is just a reference to the function/subroutine name
my $bFaulty = 0;
my $sIdNo = $_[0];
my $iStrLen = length $sIdNo;
my $LastChar = substr($sIdNo, - 1);
if ( looks_like_number($sIdNo) == 0 ) {
$bFaulty = 1;
}
else {
if ( (length $sIdNo) != 13 ) {
$bFaulty = 1;
}
elsif ( substr($sIdNo, - 1) != GetLuhnDigit($sIdNo) ){
$bFaulty = 1;
}
}
if ($sRetMsg eq "") {
$sRetMsg = "0";
}
return ($sRetMsg,$bFaulty);
}
#----------------------------------------------------------------#
# Used to validate rsa id numbers: (finds expected last digit given the first 12)
# {See the Luhn algorithm: https://en.wikipedia.org/wiki/Luhn_algorithm}
sub GetLuhnDigit($)
{
my $sSubName = (caller(0))[3]; # This is just a reference to the function/subroutine name
my $iLastDigit = -1;
my $s12Digits = $_[0];
my $iSumOdd = 0;
my $iEvenDigits = "";
for (my $i=0;$i<6;$i++) {
$iSumOdd = $iSumOdd + substr($s12Digits,2 * $i,1);
}
for (my $i=0;$i<6;$i++) {
$iEvenDigits = $iEvenDigits . substr($s12Digits,(2 * $i) + 1,1);
}
my $iDblEven = 2 * $iEvenDigits;
my $iSumDblEvens = 0;
for (my $i = 0; $i < length($iDblEven); $i++) {
$iSumDblEvens = $iSumDblEvens + substr($iDblEven,$i,1);
}
my $iUnitVal = $iDblEven;
my $iFinalBase = $iSumOdd + $iSumDblEvens;
$iLastDigit = 10 - substr($iFinalBase, - 1);
if ($iLastDigit == 10) {
$iLastDigit = 0;
}
return $iLastDigit;
}
Are there any code examples left?
New code examples in category Perl
-
Perl 2022-01-31 06:16:22 perl format decimal 2 places not rounding
-
Perl 2022-01-22 12:46:02 perl add key value pair to hash
-
Perl 2021-11-22 01:55:21 unique in perl
-
Perl 2021-11-13 15:55:08 perl lowercase
-
Perl 2021-11-11 03:30:19 perl write to file
-
Perl 2021-11-06 22:53:11 perl for loop
-
Perl 2021-11-05 17:26:13 perl sprintf YYYYMMDD sample