package provide CueCat 1.0 # CueCat, a CueCat Encoder/Decoder Package # copyright 2000 Michael Jacobson # This software is copyrighted by Michael Jacobson, # 2000. The following terms apply to all files associated with the software # unless explicitly disclaimed in individual files. # # The authors hereby grant permission to use, copy, modify, distribute, # and license this software and its documentation for any purpose, provided # that existing copyright notices are retained in all copies and that this # notice is included verbatim in any distributions. No written agreement, # license, or royalty fee is required for any of the authorized uses. # Modifications to this software may be copyrighted by their authors # and need not follow the licensing terms described here, provided that # the new terms are clearly indicated on the first page of each file where # they apply. # # IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY # FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES # ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY # DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # # THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE # IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE # NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR # MODIFICATIONS. # # GOVERNMENT USE: If you are acquiring this software on behalf of the # U.S. government, the Government shall have only "Restricted Rights" # in the software and related documentation as defined in the Federal # Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you # are acquiring the software on behalf of the Department of Defense, the # software shall be classified as "Commercial Computer Software" and the # Government shall have only "Restricted Rights" as defined in Clause # 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the # authors grant the U.S. Government and others acting in its behalf # permission to use and distribute the software in accordance with the # terms specified in this license. namespace eval CueCat { # make the procedures visiable namespace export Decode Encode InvCase # charater position array used to determine the offset (zero based!!!) variable seq "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-" #0123456789012345678901234567890123456789012345678901234567890123 # 1 2 3 4 5 6 proc Decode {inputstr} { variable seq #remove grouping if brackets get applied regsub -all ^{ $inputstr "" inputstr regsub -all }$ $inputstr "" inputstr set outstr {} foreach catstr [split $inputstr .] { foreach {a b c d} [split $catstr ""] { set shiftnum 0 foreach catlet "$a $b $c $d" { # get the position of each char (zero based) set num [string first $catlet $seq] # shift existing data right 6 and add new data set shiftnum [expr [expr $shiftnum <<6] | $num] } # now take the 24 bits and group them into 8 bit fields set tempstr {} for {set x 0} {$x<3} {incr x} { # xor the data with dec 67 (aka hex 43) and get the char value # add the char to the end of the output string set tempstr [format %c [expr [expr $shiftnum & 255] ^ 0x43]]$tempstr set shiftnum [expr $shiftnum >> 8] } append outstr $tempstr } # add a seperator in the string so you can use lindex command to get results append outstr " " } return [string trim $outstr] } proc Encode {args} { variable seq set outstr {} append outstr . #remove grouping if brackets get applied regsub -all ^{ $args "" args regsub -all }$ $args "" args #loop over each string set foreach catstr $args { #read in 3 chars at a time (need to error check this) foreach {a(0) a(1) a(2)} [split $catstr ""] { set totnum 0 for {set x 0} {$x<3} {incr x} { # scanned char convert to ordinal num scan $a($x) %c decnum # existing number move it overs and put current num in lower 8 bit # also xor 67 into the lower 8 bit number set totnum [expr [expr $totnum << 8] + [expr $decnum ^ 67]] } set tempstr {} for {set x 0} {$x<4} {incr x} { #take the lower 6 bits of the totnum word and find its index in seq index list #prepend it to the tempstr array (to get the order correctly since we are doing it backwards set tempstr [string index $seq [expr $totnum & 0x3F]]$tempstr #get rid of the bits just processed set totnum [expr $totnum >> 6] } #append the decode 3 chars (now 4 chars) to the output string append outstr $tempstr } append outstr . } return [string trim $outstr] } proc InvCase {inputstr} { set original "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" set inverse "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" regsub -all ^{ $inputstr "" inputstr regsub -all }$ $inputstr "" inputstr set outstr {} foreach letter [split $inputstr ""] { set num [string first $letter $original] if {$num > -1} { append outstr [string index $inverse $num] } else { append outstr $letter } } return [string trim $outstr] } proc ISBN {args} { # the procedure to generate ISBN check sum is to: # take first 9 digits, and multiply the MSB by 10 the next by 9 etc # till the last digit is mult by 2. then add all these values and mod 11 # subtract 11 from this value and add it onto the end as the ninth digit #978013022028890000 # 0123456789 #01234567890123 regsub -all ^{ $args "" args regsub -all }$ $args "" args set isbnum [string range [lindex $args [expr [llength $args] -1]] 3 11] set check 0 for {set i 0} {$i < 9} {incr i} { set check [expr $check + [expr [string index $isbnum $i] * (10 - $i)]] } set numcheck [expr $check % 11] if { $numcheck == 0} { append isbnum "0" } elseif { $numcheck == 1} { append isbnum "X" } else { append isbnum [expr 11-$numcheck] } #formated return statement (not needed) but keep just in case I reimplement it #return "[string range $isbnum 0 0]-[string range $isbnum 1 2]-[string range $isbnum 3 8]-[string range $isbnum 9 9]" return $isbnum } }