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 - http://www.cartochka.ru/
# [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.
MS
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
} ;#RSYou 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!
See also Check digits, CCVS (Credit Card Verification System)