124 |
print "read_tag $tag\n"; |
print "read_tag $tag\n"; |
125 |
return if $read_cached->{ $tag }++; |
return if $read_cached->{ $tag }++; |
126 |
|
|
127 |
cmd( "D6 00 0D 02 $tag 00 03 1CC4", 'read offset: 0 blocks: 3' ); |
cmd( "D6 00 0D 02 $tag 00 03 1CC4", 'read $tag offset: 0 blocks: 3', |
128 |
|
"D6 00 0F FE 00 00 05 01 $tag 941A", "$tag ready?", sub { |
129 |
|
dispatch( "D6 00 1F 02 00 $tag ", sub { # 03 00 00 04 11 00 01 01 00 31 32 33 34 02 00 35 36 37 38 531F\n"; |
130 |
|
my $rest = shift || die "no rest?"; |
131 |
|
warn "## DATA ", dump( $rest ) if $debug; |
132 |
|
my $blocks = ord(substr($rest,0,1)); |
133 |
|
my @data; |
134 |
|
foreach my $nr ( 0 .. $blocks - 1 ) { |
135 |
|
my $block = substr( $rest, 1 + $nr * 6, 6 ); |
136 |
|
warn "## block ",as_hex( $block ) if $debug; |
137 |
|
my $ord = unpack('v',substr( $block, 0, 2 )); |
138 |
|
die "got block $ord, expected block $nr from ",dump( $block ) if $ord != $nr; |
139 |
|
my $data = substr( $block, 2 ); |
140 |
|
die "data payload should be 4 bytes" if length($data) != 4; |
141 |
|
warn sprintf "## tag %08s %02d %s |%-4s|\n", $tag, $ord, as_hex( $data ), $data; |
142 |
|
$data[ $ord ] = $data; |
143 |
|
} |
144 |
|
$read_cached->{ $tag } = join('', @data); |
145 |
|
print "DATA $tag ",dump( $read_cached->{ $tag } ), "\n"; |
146 |
|
}) |
147 |
|
}); |
148 |
|
|
149 |
# D6 00 1F 02 00 $tag 03 00 00 04 11 00 01 01 00 30 30 30 30 02 00 30 30 30 30 E5F4 |
# D6 00 1F 02 00 $tag 03 00 00 04 11 00 01 01 00 30 30 30 30 02 00 30 30 30 30 E5F4 |
|
warn "?? D6 00 1F 02 00 $tag 03 00 00 04 11 00 01 01 00 31 32 33 34 02 00 35 36 37 38 531F\n"; |
|
150 |
if (0) { |
if (0) { |
151 |
cmd( "D6 00 0D 02 $tag 03 04 3970", 'read offset: 3 blocks: 4' ); |
cmd( "D6 00 0D 02 $tag 03 04 3970", 'read offset: 3 blocks: 4' ); |
152 |
|
|
188 |
{ |
{ |
189 |
my $str=shift; |
my $str=shift; |
190 |
my $count = $port->write($str); |
my $count = $port->write($str); |
191 |
print "#> ", as_hex( $str ), "\t[$count]\n"; |
print "#> ", as_hex( $str ), "\t[$count]" if $debug; |
192 |
} |
} |
193 |
|
|
194 |
sub as_hex { |
sub as_hex { |
275 |
warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug; |
warn "## checksum ",dump( $bytes, $xor, $checksum ) if $debug; |
276 |
|
|
277 |
my $len = ord(substr($bytes,2,1)); |
my $len = ord(substr($bytes,2,1)); |
278 |
my $len_real = length($bytes); |
my $len_real = length($bytes) - 1; |
279 |
print "length wrong: $len_real != $len\n" if $len_real != $len; |
|
280 |
|
if ( $len_real != $len ) { |
281 |
|
print "length wrong: $len_real != $len\n"; |
282 |
|
$bytes = substr($bytes,0,2) . chr($len_real) . substr($bytes,4); |
283 |
|
} |
284 |
|
|
285 |
if ( defined $checksum && $xor ne $checksum ) { |
if ( defined $checksum && $xor ne $checksum ) { |
286 |
print "checksum doesn't match: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n"; |
print "checksum doesn't match: ", as_hex($xor), " != ", as_hex($checksum), " data: ", as_hex($bytes), "\n"; |
320 |
sub str2bytes { |
sub str2bytes { |
321 |
my $str = shift || confess "no str?"; |
my $str = shift || confess "no str?"; |
322 |
my $b = $str; |
my $b = $str; |
323 |
$b =~ s/\s+(\S\S)(\S\S)+\s*/ $1 $2/; # fix checksum |
$b =~ s/\s+//g; |
324 |
$b =~ s/\s+$//; |
$b =~ s/(..)/\\x$1/g; |
325 |
$b =~ s/\s+/\\x/g; |
$b = "\"$b\""; |
|
$b = '"\x' . $b . '"'; |
|
326 |
my $bytes = eval $b; |
my $bytes = eval $b; |
327 |
die $@ if $@; |
die $@ if $@; |
328 |
warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug; |
warn "## str2bytes( $str ) => $b => ",as_hex($bytes) if $debug; |