7 |
use Data::Dump qw/dump/; |
use Data::Dump qw/dump/; |
8 |
use Carp qw/confess/; |
use Carp qw/confess/; |
9 |
|
|
10 |
|
my $debug = 0; |
11 |
|
|
12 |
my $response = { |
my $response = { |
13 |
'd500090400110a0500027250' => 'version?', |
'd500090400110a0500027250' => 'version?', |
14 |
'd60007fe00000500c97b' => 'no tag in range', |
'd60007fe00000500c97b' => 'no tag in range', |
77 |
#$port->stty_inpck(1); |
#$port->stty_inpck(1); |
78 |
#$port->stty_istrip(1); |
#$port->stty_istrip(1); |
79 |
|
|
80 |
cmd( 'D5 00 05 04 00 11 8C66', 'hw version?', |
# initial hand-shake with device |
81 |
'D5 00 09 04 00 11 0A 05 00 02 7250', 'hw 10.5.0.2', sub { |
|
82 |
|
cmd( 'D5 00 05 04 00 11 8C66', 'hw version?', |
83 |
|
'D5 00 09 04 00 11 0A 05 00 02 7250', 'hw 10.5.0.2', sub { |
84 |
my ( $len, $payload, $checksum ) = @_; |
my ( $len, $payload, $checksum ) = @_; |
85 |
assert( 0, 3 ); |
assert( 0, 3 ); |
86 |
print "hardware version ", join('.', unpack('CCCC', substr($payload,3,4))), "\n"; |
print "hardware version ", join('.', unpack('CCCC', substr($payload,3,4))), "\n"; |
87 |
}); |
}); |
88 |
|
|
89 |
cmd( 'D6 00 0C 13 04 01 00 02 00 03 00 04 00 AAF2','stats?' ); |
cmd( 'D6 00 0C 13 04 01 00 02 00 03 00 04 00 AAF2','stats?', |
90 |
# D6 00 0C 13 00 02 01 01 03 02 02 03 00 E778 |
'D6 00 0C 13 00 02 01 01 03 02 02 03 00 E778','FIXME: unimplemented', sub { assert( 0 ) } ); |
91 |
|
|
92 |
cmd( 'D6 00 05 FE 00 05 FA40', "XXX scan $_", |
# start scanning for tags |
|
'D6 00 07 FE 00 00 05 00 C97B -- no tag' ) foreach ( 1 .. 10 ); |
|
93 |
|
|
94 |
|
cmd( 'D6 00 05 FE 00 05 FA40', "XXX scan $_", |
95 |
|
'D6 00 07 FE 00 00 05 00 C97B', 'no tag' ) foreach ( 1 .. 10 ); |
96 |
# D6 00 0F FE 00 00 05 01 E00401003123AA26 941A # seen |
# D6 00 0F FE 00 00 05 01 E00401003123AA26 941A # seen |
97 |
|
|
98 |
cmd( 'D6 00 0D 02 E00401003123AA26 00 03 1CC4', 'read offset: 0 blocks: 3' ); |
cmd( 'D6 00 0D 02 E00401003123AA26 00 03 1CC4', 'read offset: 0 blocks: 3' ); |
160 |
$data .= $b; |
$data .= $b; |
161 |
} |
} |
162 |
$desc ||= '?'; |
$desc ||= '?'; |
163 |
warn "#< ", as_hex($data), "\t$desc\n"; |
warn "#< ", as_hex($data), "\t$desc\n" if $debug; |
164 |
return $data; |
return $data; |
165 |
} |
} |
166 |
|
|
169 |
sub assert { |
sub assert { |
170 |
my ( $from, $to ) = @_; |
my ( $from, $to ) = @_; |
171 |
|
|
172 |
|
$to = length( $assert->{expect} ) if ! defined $to; |
173 |
|
|
174 |
my $p = substr( $assert->{payload}, $from, $to ); |
my $p = substr( $assert->{payload}, $from, $to ); |
175 |
my $e = substr( $assert->{expect}, $from, $to ); |
my $e = substr( $assert->{expect}, $from, $to ); |
176 |
warn "EXPECTED ",as_hex($e), " GOT ", as_hex($p), " [$from-$to] in ",dump( $assert ), "\n" if $e ne $p; |
warn "EXPECTED ",as_hex($e), " GOT ", as_hex($p), " [$from-$to] in ",dump( $assert ), "\n" if $e ne $p; |