39 lines
2.1 KiB
Tcl
39 lines
2.1 KiB
Tcl
proc ordinal-of-alpha {c} { ;# returns ordinal position of c in the alphabet (A=1, B=2...)
|
||
lsearch {_ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} [string toupper $c]
|
||
}
|
||
|
||
proc Cusip-Check-Digit {cusip} { ;# algorithm Cusip-Check-Digit(cusip) is
|
||
if {[string length $cusip] != 8} { ;# Input: an 8-character CUSIP
|
||
return false
|
||
}
|
||
|
||
set sum 0 ;# sum := 0
|
||
for {set i 1} {$i <= 8} {incr i} { ;# for 1 ≤ i ≤ 8 do
|
||
set c [string index $cusip $i-1] ;# c := the ith character of cusip
|
||
if {[string is digit $c]} { ;# if c is a digit then
|
||
set v $c ;# v := numeric value of the digit c
|
||
} elseif {[string is alpha $c]} { ;# else if c is a letter then
|
||
set p [ordinal-of-alpha $c] ;# p := ordinal position of c in the alphabet (A=1, B=2...)
|
||
set v [expr {$p + 9}] ;# v := p + 9
|
||
} elseif {$c eq "*"} { ;# else if c = "*" then
|
||
set v 36 ;# v := 36
|
||
} elseif {$c eq "@"} { ;# else if c = "@" then
|
||
set v 37 ;# v := 37
|
||
} elseif {$c eq "#"} { ;# else if c = "#" then
|
||
set v 38 ;# v := 38
|
||
} ;# end if
|
||
if {$i % 2 == 0} { ;# if i is even then
|
||
set v [expr {$v * 2}] ;# v := v × 2
|
||
} ;# end if
|
||
|
||
incr sum [expr {$v / 10 + $v % 10}] ;# sum := sum + int ( v div 10 ) + v mod 10
|
||
} ;# repeat
|
||
|
||
expr {(10 - ($sum % 10)) % 10} ;# return (10 - (sum mod 10)) mod 10
|
||
}
|
||
proc check-cusip {cusip} {
|
||
set last [string index $cusip end]
|
||
set cusip [string range $cusip 0 end-1]
|
||
expr {$last eq [Cusip-Check-Digit $cusip]}
|
||
}
|