Validating Credit Card Check Digits

Sometimes when dealing with e-commerce type applications where a credit card cannot be validated in real-time, it's still useful to make sure the card number's check digit at least checks out. I haven't seen any other Tcl code to do this here on the Wiki, so here's my first contribution.

For a reference on credit card check digit calculations, see http://www.beachnet.com/~hstiles/cardtype.html

-- Michael A. Cleverly

 proc valid_cc {acct} {
     regsub -all -- {[^0-9]} $acct "" acct
 
     set len [string length $acct]
     if {!([string match 5* $acct]       && $len == 16)                 && \
         !([string match 4* $acct]       && ($len == 13 || $len == 16)) && \
         !([string match {3[47]*} $acct] && $len == 15)                 && \
         !([string match 6011* $acct]    && $len == 16)} {
         return 0
     }
 
     if {[expr [string length $acct] % 2]} {
         append acct 0
         set odd_factor 1
         set even_factor 2
     } else {
         set odd_factor 2
         set even_factor 1
     }
 
     foreach {odd even} [split $acct ""] {
         append digits "[expr $odd * $odd_factor][expr $even * $even_factor]"
     }
 
     set sum 0
     foreach digit [split $digits ""] {
         incr sum $digit
     }
 
     if {[expr $sum % 10] == 0} {
         return 1
     } else {
         return 0
     }
 } 

 
 proc card_type {acct} {
     if {[valid_cc $acct]} {
         set len [string length $acct]
         if {[string match 5* $acct] && $len == 16} {
             return mastercard
         } elseif {[string match 4* $acct] && ($len == 13 || $len == 16)} {
             return visa
         } elseif {[string match {3[47]*} $acct] && $len == 15} {
             return amex
         } elseif {[string match 6011* $acct] && $len == 16} {
             return discover
         }
     }
  }

Maybe we will want to add more cards in the future? (I would actually make cards a global in production code)

 proc card_type { acct } {
      set cards {
          mastercard 5     16
          visa       4     13|16
          amex       3[47] 15
          discover   6011  16
      }
      if { [ valid_cc2 $acct ] } {
         regsub -all {[^0-9]} $acct "" acct   ;# [2]
         set len [ string length $acct ]
         foreach { card apat lpat } $cards {
            if { [ regexp ^${apat}.+,($lpat)\$ $acct,$len ] } {
               return $card
            }
         }
      }   ;# [1]
      return invalid
 }

 # proc revised 07.21.02  -- Carl M. Gregory, MC_8
 #   [1] Missing a '}'.
 #   [2] Should only worry about 0-9, remove the rest (as does valid_cc2).

Thanks! I implemented the check-digit validation as an exercise, and found to my surprise that my version runs 4 times faster (in tclsh8.4). Not that I expect speed to be critical, but anyway here goes:

 proc valid_cc2 {acct} {
    regsub -all {[^0-9]} $acct "" acct
    set even 0
    set sum 0
    set len [string length $acct]
    while {$len} {
       set new [string index $acct [incr len -1]]
       if {$even} {
          incr new $new
          set new [expr {($new%10)+($new/10)}]
       }
       incr sum $new
       set even [expr {!$even}]
    }
    return [expr {($sum%10) == 0}]
 }

Note that I have omitted here the first part of the above algorithm: I am not checking the correspondence between initial digits and length. The speed increase was measured against the correspondingly reduced valid_cc.

Another exercise in terseness (cf. UIC vehicle number validator), building a string and finally summing all digits (don't know whether it's faster, but it looks more compact):

 proc valid_cc3 {acct} {
        regsub -all {[^0-9]} $acct "" acct
        set even [expr {!([string length $acct]%2)}]
        foreach i  [split $acct ""] {
                if {$even} {incr i $i}
                append t $i
                set even [expr {!$even}]
        }
        expr ([join [split $t ""] +])%10==0
 } ;#RS

You can try an online version here:

http://ats.nist.gov/cgi-bin/cgi.tcl/creditcard.cgi

(live)
http://ats.nist.gov/cgi-bin/cgi.tcl/display.cgi?scriptname=creditcard.cgi

(source)

Amusingly, if creditcard.cgi finds the check digit doesn't match, it tells you what check digit would make it match!

Arts and crafts of Tcl-Tk programming

Category Business