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]}
|
|||
|
|
}
|