@ -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)
# - 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
#"C" specifier not available in tcl 8.6
#dict set sdict title [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]} {
dict set sdict title [format %-35s $str]
} else {
dict set sdict title [string repeat " " 35]
}
set str [lib::get_string $rawtitle]
dict set sdict title [format %-35s $str]
#dict set sdict author [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]} {
dict set sdict author [format %-20s $str]
} else {
dict set sdict author [string repeat " " 20]
}
set str [lib::get_string $rawauthor]
dict set sdict author [format %-20s $str]
#dict set sdict group [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]} {
dict set sdict group [format %-20s $str]
} else {
dict set sdict group [string repeat " " 20]
}
set str [lib::get_string $rawgroup]
dict set sdict group [format %-20s $str]
#dict set sdict date [string range $saucerecord 82 89] ;#8 bytes 'character'
set rawdata [string range $saucerecord 82 89] ;#8 bytes 'character'
if {![catch {binary scan $rawdate C* str} errM]} {
dict set sdict date [format %-8s $str]
} else {
dict set sdict date [string repeat " " 8]
}
set rawdate [string range $saucerecord 82 89] ;#8 bytes 'character'
set str [lib::get_string $rawdate]
dict set sdict date [format %-8s $str]
if {[binary scan [string range $saucerecord 90 93] iu v]} {
#4 bytes - unsigned littlendian
@ -407,13 +397,8 @@ tcl::namespace::eval punk::ansi::sauce {
dict set sdict tflags ""
}
set rawzstring [string range $saucerecord 106 127]
#Null terminated string use C to terminate at first null
if {[binary scan $rawzstring C* str]} {
dict set sdict tinfos $str
} else {
dict set sdict tinfos ""
}
set str [lib::get_string $rawzstring]
dict set sdict tinfos $str
@ -503,6 +488,23 @@ tcl::namespace::eval punk::ansi::sauce {
tcl::namespace::eval punk::ansi::sauce::lib {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
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
}
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
