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] MC_8
         set len [ string length $acct ]
         foreach { card apat lpat } $cards {
            if { [ regexp ^${apat}.+($lpat)\$ $acct$len ] } {
               return $card
            }
         }
      };   # [1] MC_8
      return invalid
 }

 # proc revised 07.21.02  -- Carl M. Gregory, MC_8 - http://mc.purehype.net/
 #   [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
 } ;#RS

----
[Arts and crafts of Tcl-Tk programming]