Updated 2013-11-17 21:03:22 by RLE

BPay is a broadly used Australian bill payment system. http://www.bpay.com.au

The system uses check digits with a sort of 'mix and match' 'Check Digit Rule Name' to select the checkdigit algorithm.

This is of the format "WxxMyyyFza" where Wxx indicates the key of an entry in a weights table

Myyy indicates the key of an entry in a modulus table

Fz indicates the key of an entry in a flags table

a, which must only be specified for Modulus 11 check digits, indicates the translations required for check digit values 10 and 11.

BPay recommends the check digit rule: W01M101F3 (MOD10V01) for billers who don't already have a preferred method. This happens to be the same algorithm used for many credit cards and other systems - the Luhn Algorithm or 'mod 10 algorithm'.

--- Below is a *minimally tested* tcl8.5 package to return and test BPay checkdigits.

Save it as bpaycheckdigit-0.2.tm and place it on your module path (see output of [tcl::tm::list])
    synopsis:
    %package require bpaycheckdigit
    0.2
    %bpaycheckdigit::get  2007050100001
    1
    %bpaycheckdigit::test 20070501000012
    0
    %bpaycheckdigit::test 20070501000011
    1
    %bpaycheckdigit::get  2007050100001   W17M971F1
    49
    %bpaycheckdigit::test 200705010000149 W17M971F1
    1
    %bpaycheckdigit::test 200705010500149 W17M971F1
    0

    WARNING: This has not been properly tested, reviewed or used in a production environment.
    You should review the code, and USE AT YOUR OWN RISK.
    In particular - weights array member 19 may need to be extended to contain further powers of 2
    to support larger inputs (or better; the code adjusted to extrapolate values)
    Also - this work was done by working from an old bpay document.
    Things may have changed, comments/updates welcome.
    According to this wikipedia article: http://en.wikipedia.org/wiki/Luhn_algorithm
    the Luhn Algorithm itself is public domain.
    The package supplied here is also released as public domain.

 #jmn 2007-05
 package require Tcl 8.5  ;#require 8.5 features such as lreverse, in

 package provide bpaycheckdigit [namespace eval bpaycheckdigit {
        variable version 0.2

        set version
 }]

 proc bpaycheckdigit::init {} {
        variable weights
        variable modulii
        variable flags
        variable translations
        

        set weights(01,array) {1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2}
        set weights(01,maxdigits) ""

        set weights(02,array) {2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1}
        set weights(02,maxdigits) ""

        set weights(03,array) {2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 1 2 0 0 0}
        set weights(03,maxdigits) ""

        set weights(04,array) {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20}
        set weights(04,maxdigits) ""

        set weights(05,array) {20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1}
        set weights(05,maxdigits) ""

        set weights(06,array) {2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21}
        set weights(06,maxdigits) ""

        set weights(07,array) {21 20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 4 3 2}
        set weights(07,maxdigits) ""

        set weights(08,array) {2 1 7 4 5 3 2 1 7 4 5 3 2 1 7 4 5 3 2 1}
        set weights(08,maxdigits) ""

        set weights(09,array) {3 2 7 6 5 4 3 2 7 6 5 4 3 2 7 6 5 4 3 2}
        set weights(09,maxdigits) ""

        set weights(10,array) {3 2 9 8 7 4 3 2 9 8 7 4 3 2 9 8 7 4 3 2}
        set weights(10,maxdigits) ""


        set weights(11,array) {3 5 2 4 6 1 3 5 2 4 6 1 3 5 2 4 6 1 3 5}
        set weights(11,maxdigits) ""

        set weights(12,array) {3 7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7}
        set weights(12,maxdigits) ""

        set weights(13,array) {6 2 7 5 3 2 8 6 2 7 5 3 2 8 6 2 7 5 3 2}
        set weights(13,maxdigits) ""

        set weights(14,array) {7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7 1 3 7 1}
        set weights(14,maxdigits) ""

        set weights(15,array) {9 7 3 1 9 7 3 1 9 7 3 1 9 7 3 1 9 7 3 1}
        set weights(15,maxdigits) ""

        set weights(16,array) {9 7 5 3 1 9 7 5 3 1 9 7 5 3 1 9 7 5 3 1}
        set weights(16,maxdigits) ""

        set weights(17,array) {20 19 18 17 16 15 14 13 12 11 10 9 8 7 6 5 2 1 4 3}
        set weights(17,maxdigits) ""

        set weights(18,array) {39 37 35 33 31 29 27 25 23 21 19 17 15 13 11 9 7 5 3 1}
        set weights(18,maxdigits) ""

        set weights(19,array) {1024 512 256 128 64 32 16 8 4 2}
        set weights(19,maxdigits) ""

        set weights(20,array) {0 0 5 2 7 4 3}
        set weights(20,maxdigits) "7"

        set weights(21,array) {0 0 7 6 9 2 3}
        set weights(21,maxdigits) "7"

        set weights(22,array) {0 0 11 3 7 19 13}
        set weights(22,maxdigits) "7"

        set weights(23,array) {5 8 4 2 1 6 3 7}
        set weights(23,maxdigits) "8"

        set weights(24,array) {6 9 7 5 3 8 4 2}
        set weights(24,maxdigits) "8"

        set weights(25,array) {0 0 15 17 12 13 07 18 14 3}
        set weights(25,maxdigits) "10"

        set weights(26,array) {0 0 7 1 3 9 1 7 9 1 3 7 9 1}
        set weights(26,maxdigits) "14"

        set weights(27,array) {1 6 7 2 9 4}
        set weights(27,maxdigits) "6"

        set weights(28,array) {7 9 10 5 8 4 2}
        set weights(28,maxdigits) "7"

        set weights(29,array) {3 9 7 3 1 7 5 3 1}
        set weights(29,maxdigits) "9"

        set weights(30,array) {13 11 7 5 3 2 1 13 11 7 5 3 2 1 13 11 7 5 3 2}
        set weights(30,maxdigits) ""

        set weights(31,array) {10 7 8 4 6 3 5 2}
        set weights(31,maxdigits) "8"

        set weights(32,array) {17 13 3 5 7}
        set weights(32,maxdigits) "5"


        set mlist {
        090 9         0        1
        091 9         9        1
        100 10        0        1
        101        10        10        1
        102        10        9        1
        103        10        17        1
        110        11        0        1
        111        11        11        1
        112        11        0        1
        113        11        0        1
        130        13        0        2
        131        13        13        2
        132        13        61        2
        970        97        00        2
        971        97        97        2
        }
        foreach {num divideby subtractfrom cdlength} $mlist {
                set modulii($num,divideby) $divideby
                set modulii($num,subtractfrom) $subtractfrom
                set modulii($num,cdlength) $cdlength
        }


        set flist {
        0        N        N        N
        1        N        N        Y
        2        N        Y        N
        3        N        Y        Y
        4        N        T        N
        5        N        T        Y
        6        Y        N        N
        7        Y        N        Y
        8        Y        Y        N
        9        Y        Y        Y
        }
        foreach {num start_left add_digits keep_zero} $flist {
                set flags($num,start_left)        $start_left
                set flags($num,add_digits)        $add_digits
                set flags($num,keep_zero)        $keep_zero
        }

        set tlist {
        a        ""        ""
        b        ""        0
        c        ""        1
        d        0        ""
        e        0        1
        f        0        10
        g        1        ""
        h        1        0
        i        1        10
        j        11        0
        k        11        1
        l        11        10
        }
        foreach {name cd10 cd11} $tlist {
                set translations($name,cd10) $cd10
                set translations($name,cd11) $cd11
        }

 }

 # cdrule format WxxMyyyFza
 # (a optional)
 #e.g cdrule -> W17M971F1
 #return a dict containing rule values required by algorithm
 proc bpaycheckdigit::getrule {cdrule} {
        variable weights
        variable modulii
        variable flags
        variable translations

        set cdrule [string trim $cdrule]
        if {![string length $cdrule]} {
                error "empty rule string supplied"
        }
        if {[string length $cdrule] ni {9 10}} {
                error "expected rule string of format WxxMyyyFz or WxxMyyyFza"
        }


        set w [string tolower [string index $cdrule 0]]
        if {$w ne "w"} {
                error "bad rule string: expected firstchar 'w'"
        }                
        set weight [string range $cdrule 1 2]
        
        set m [string tolower [string index $cdrule 3]]
        if {$m ne "m"} {
                error "bad rule string: expected 'm' at char index 3"
        }
        set modulus [string range $cdrule 4 6]
        
        set f [string tolower [string index $cdrule 7]]
        if {$f ne "f"} {
                error "bad rule string: expected 'f' at char index 7"
        }
        set flag [string index $cdrule 8]

        set translation ""
        if {[string length $cdrule] == 10} {
                set translation [string index $cdrule 9]
        }

        set result [list weight $weight modulus $modulus flag $flag translation $translation]

        dict set result weightarray $weights($weight,array)
        if {![string length $weights($weight,maxdigits)]} {
                dict set result maxdigits [llength $weights($weight,array)]
        } else {
                dict set result maxdigits $weights($weight,maxdigits)
        }

        
        dict set result divideby                 $modulii($modulus,divideby)
        dict set result subtractfrom        $modulii($modulus,subtractfrom)
        dict set result cdlength                $modulii($modulus,cdlength)

        dict set result startleft                $flags($flag,start_left)
        dict set result adddigits                $flags($flag,add_digits)
        dict set result keepzero                $flags($flag,keep_zero)

        if {[string length $translation]} {
                dict set result cd10                         $translations($translation,cd10)
                dict set result cd11                        $translations($translation,cd11)
        } else {
                dict set result cd10 ""
                dict set result cd11 ""
        }

        return $result
 }

 proc bpaycheckdigit::test {completenumber {cdrule W01M101F3}} {
        set rule [getrule $cdrule]
        set cdlength [dict get $rule cdlength]
        set refnumber [string range $completenumber 0 end-$cdlength]
        if {[string length $refnumber] > [dict get $rule maxdigits]} {
                error "number is longer than maxdigits specified by the supplied rule"
        }
                
        set cd [string range $completenumber end-[expr {$cdlength - 1}] end]
        
        if {$cd eq [bpaycheckdigit::get $refnumber $cdrule]} {
                return 1
        } else {
                return 0
        }
 }

 proc bpaycheckdigit::get {refnumber {cdrule W01M101F3}} {
        #rule recommended by bpay for billers that haven't currently got a check digit routine.
        #W01M101F3 = MOD10V01 (STANDARD LUHNS MODULUS 10)
        #(also works for visa/mastercard)

        set rule [getrule $cdrule]
        if {[string length $refnumber] > [dict get $rule maxdigits]} {
                error "number is longer than maxdigits specified by the supplied rule"
        }
        
        set refdigits [split $refnumber {}]
        if {[string tolower [dict get $rule startleft]] eq "n"} {
                set refdigits [lreverse $refdigits]
                set weights [lreverse [dict get $rule weightarray]]
        } else {
                set weights [dict get $rule weightarray]
        }
        set adddigits [string tolower [dict get $rule adddigits]]
        set keepzero [string tolower [dict get $rule keepzero]]

        set cd 0
        set i 0
        foreach ref $refdigits wt $weights {
                set weighted [expr {$wt * $ref}]
                if {$weighted > 9} {
                        if {$adddigits eq "y"} {
                                set weighted [expr [join [split $weighted {}] +]]  ;#not fastest way to sum a list.. but should be fine here.
                        } elseif {$adddigits eq "t"} {
                                set weighted [string index $weighted end] ;#(efficiency warning: will shimmer)
                        }
                }
                incr cd $weighted
                incr i
                if {$i >= [llength $refdigits]} {
                        break
                }
        }

        set divideby [dict get $rule divideby]
        set subtractfrom [dict get $rule subtractfrom]
        set cd10 [dict get $rule cd10]
        set cd11 [dict get $rule cd11]
        set cdlength [dict get $rule cdlength]


        set cd [expr {$cd % $divideby}]

        if {($cd != 0) && ($subtractfrom != 0)} {
                set cd [expr {$subtractfrom - $cd}]
        } elseif {($cd == 0) && !$keepzero} {
                set cd $subtractfrom
        }

        set cd [expr {abs($cd)}]

        if {($cd == 10) && [string length $cd10]} {
                set cd $cd10
        } elseif {($cd == 11) && [string length $cd11]} {
                set cd $cd11
        }

        if {($cdlength == 2) && ([string length $cd] == 1)} {
                set cd "0$cd"
        } 

        return $cd
 }

 bpaycheckdigit::init