@ -271,40 +271,30 @@ tcl::namespace::eval punk::ansi::sauce {
#sauce spec says 'character' type is a string encoded according to code page 437 (IBM PC / OEM ASCII) #sauce spec says 'character' type is a string encoded according to code page 437 (IBM PC / OEM ASCII)
# - in the wild - string may be terminated with null and have following garbage # - in the wild - string may be terminated with null and have following garbage
# - 'binary scan $rawchars C* str' to get null-terminated string and pad rhs with spaces to cater for this possibility # - 'binary scan $rawchars C* str' to get null-terminated string and pad rhs with spaces to cater for this possibility
#"C" specifier not available in tcl 8.6
#dict set sdict title [string range $saucerecord 7 41] ;#35 bytes 'character' #dict set sdict title [string range $saucerecord 7 41] ;#35 bytes 'character'
set rawtitle [string range $saucerecord 7 41] ;#35 bytes 'character' set rawtitle [string range $saucerecord 7 41] ;#35 bytes 'character'
if {![catch {binary scan $rawtitle C* str} errM]} { set str [lib::get_string $rawtitle]
dict set sdict title [format %-35s $str] dict set sdict title [format %-35s $str]
} else {
dict set sdict title [string repeat " " 35]
}
#dict set sdict author [string range $saucerecord 42 61] ;#20 bytes 'character' #dict set sdict author [string range $saucerecord 42 61] ;#20 bytes 'character'
set rawauthor [string range $saucerecord 42 61] ;#20 bytes 'character' set rawauthor [string range $saucerecord 42 61] ;#20 bytes 'character'
if {![catch {binary scan $rawauthor C* str} errM]} { set str [lib::get_string $rawauthor]
dict set sdict author [format %-20s $str] dict set sdict author [format %-20s $str]
} else {
dict set sdict author [string repeat " " 20]
}
#dict set sdict group [string range $saucerecord 62 81] ;#20 bytes 'character' #dict set sdict group [string range $saucerecord 62 81] ;#20 bytes 'character'
set rawgroup [string range $saucerecord 62 81] ;#20 bytes 'character' set rawgroup [string range $saucerecord 62 81] ;#20 bytes 'character'
if {![catch {binary scan $rawgroup C* str} errM]} { set str [lib::get_string $rawgroup]
dict set sdict group [format %-20s $str] dict set sdict group [format %-20s $str]
} else {
dict set sdict group [string repeat " " 20]
}
#dict set sdict date [string range $saucerecord 82 89] ;#8 bytes 'character' #dict set sdict date [string range $saucerecord 82 89] ;#8 bytes 'character'
set rawdata [string range $saucerecord 82 89] ;#8 bytes 'character' set rawdate [string range $saucerecord 82 89] ;#8 bytes 'character'
if {![catch {binary scan $rawdate C* str} errM]} { set str [lib::get_string $rawdate]
dict set sdict date [format %-8s $str] dict set sdict date [format %-8s $str]
} else {
dict set sdict date [string repeat " " 8]
}
if {[binary scan [string range $saucerecord 90 93] iu v]} { if {[binary scan [string range $saucerecord 90 93] iu v]} {
#4 bytes - unsigned littlendian #4 bytes - unsigned littlendian
@ -407,13 +397,8 @@ tcl::namespace::eval punk::ansi::sauce {
dict set sdict tflags "" dict set sdict tflags ""
} }
set rawzstring [string range $saucerecord 106 127] set rawzstring [string range $saucerecord 106 127]
#Null terminated string use C to terminate at first null set str [lib::get_string $rawzstring]
if {[binary scan $rawzstring C* str]} { dict set sdict tinfos $str
dict set sdict tinfos $str
} else {
dict set sdict tinfos ""
}
@ -503,6 +488,23 @@ tcl::namespace::eval punk::ansi::sauce {
tcl::namespace::eval punk::ansi::sauce::lib { tcl::namespace::eval punk::ansi::sauce::lib {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
tcl::namespace::path [tcl::namespace::parent] tcl::namespace::path [tcl::namespace::parent]
#get_string caters for possible null-terminated strings as these may be seen in the wild even though sauce doesn't specify they should be null-terminated
if {[catch {binary scan x C v}]} {
#fallback for tcl 8.6
proc get_string {bytes} {
set cstr [lindex [split $bytes \0] 0]
binary scan $cstr a* str
return $str
}
} else {
proc get_string {bytes} {
binary scan $bytes C* str
return $str
}
}
} }
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
