#!/usr/bin/perl
DEBUG
=>
$ENV
{DEVICE_RFXCOM_TX_TEST_DEBUG}
};
$|=1;
BEGIN {
eval
{
require
AnyEvent;
import
AnyEvent;
if
($@) {
import
Test::More
skip_all
=>
'Missing AnyEvent module(s): '
.$@;
}
if
($@) {
import
Test::More
skip_all
=>
'No AnyEvent::MockTCPServer module: '
.$@;
}
import
Test::More;
}
my
@connections
=
(
[
{
transmit
=>
undef
,
desc
=>
'version check'
,
recv
=>
'F030F030'
,
send
=>
'10'
,
init
=> 0,
},
{
transmit
=>
undef
,
desc
=>
'set mode'
,
recv
=>
'F037F037'
,
send
=>
'37'
,
init
=> 1,
},
{
transmit
=> {
type
=>
'x10'
,
command
=>
'off'
,
device
=>
'i10'
},
desc
=>
'x10/i10/off'
,
recv
=>
'20E41B30CF'
,
send
=>
'37'
,
init
=> 1,
},
{
transmit
=> {
type
=>
'x10'
,
command
=>
'on'
,
device
=>
'i2,i3,q0'
},
desc
=>
'x10/i2,i3/on - i2'
,
recv
=>
'20E01F10EF'
,
send
=>
'37'
,
init
=> 1,
},
{
transmit
=>
undef
,
desc
=>
'x10/i2,i3/on - i3'
,
recv
=>
'20E01F08F7'
,
send
=>
'37'
,
init
=> 1,
},
{
transmit
=> {
type
=>
'x10'
,
command
=>
'bright'
,
house
=>
'j'
},
desc
=>
'x10/j/bright'
,
recv
=>
'20F00F8877'
,
send
=>
'37'
,
init
=> 1,
},
{
transmit
=> {
type
=>
'homeeasy'
,
command
=>
'off'
,
address
=>
'xmas'
,
unit
=> 10 },
desc
=>
'homeeasy/xmas/10/off'
,
recv
=>
'2101D5EA0A00'
,
send
=>
'37'
,
init
=> 1,
},
{
transmit
=> {
type
=>
'homeeasy'
,
command
=>
'on'
,
address
=>
'0x3333'
,
unit
=> 1 },
desc
=>
'homeeasy/0x3333/1/on'
,
recv
=>
'21000CCCD100'
,
send
=>
'37'
,
init
=> 1,
},
{
transmit
=> {
type
=>
'homeeasy'
,
command
=>
'preset'
,
address
=>
'test'
,
unit
=> 9,
level
=> 5 },
desc
=>
'homeeasy/test/9/preset/5'
,
recv
=>
'2401CD490950'
,
send
=>
'37'
,
init
=> 1,
},
],
[
{
transmit
=> {
type
=>
'homeeasy'
,
command
=>
'on'
,
address
=>
'console'
,
unit
=>
'group'
},
desc
=>
'homeeasy/console/group/on'
,
recv
=>
'F030F030'
,
send
=>
'10'
,
init
=> 0,
},
{
transmit
=>
undef
,
desc
=>
'enable harrison'
,
recv
=>
'F03CF03C'
,
send
=>
'33'
,
init
=> 0,
},
{
transmit
=>
undef
,
desc
=>
'enable koko'
,
recv
=>
'F03DF03D'
,
send
=>
'33'
,
init
=> 0,
},
{
transmit
=>
undef
,
desc
=>
'enable flamingo'
,
recv
=>
'F03EF03E'
,
send
=>
'33'
,
init
=> 0,
},
{
transmit
=>
undef
,
desc
=>
'disabling x10'
,
recv
=>
'F03FF03F'
,
send
=>
'37'
,
init
=> 0,
},
{
transmit
=>
undef
,
desc
=>
'set mode'
,
recv
=>
'F033F033'
,
send
=>
'33'
,
init
=> 1,
},
{
transmit
=>
undef
,
desc
=>
'homeeasy/console/group/on'
,
recv
=>
'21AA163DB000'
,
send
=>
'33'
,
init
=> 1,
},
],
);
my
@sc
= ();
foreach
my
$con
(
@connections
) {
my
@a
= ();
foreach
my
$rec
(
@$con
) {
my
(
$recv
,
$send
,
$desc
) = @{
$rec
}{
qw/recv send desc/
};
push
@a
,
[
packrecv
=>
$recv
,
$desc
],
[
packsend
=>
$send
,
$desc
];
}
push
@sc
, \
@a
;
}
my
$server
;
eval
{
$server
= AnyEvent::MockTCPServer->new(
connections
=> \
@sc
); };
plan
skip_all
=>
"Failed to create dummy server: $@"
if
($@);
my
(
$host
,
$port
) =
$server
->connect_address;
my
$addr
=
join
':'
,
$host
,
$port
;
import
Test::More
tests
=> 56;
use_ok(
'Device::RFXCOM::TX'
);
my
$tx
;
my
$w
;
my
%args
= ();
my
$cv
;
foreach
my
$con
(
@connections
) {
my
$init
= 0;
$tx
= Device::RFXCOM::TX->new(
%args
,
device
=>
$addr
,
init_callback
=>
sub
{
$init
++ });
ok(
$tx
,
'instantiate Device::RFXCOM::TX object'
);
$w
= AnyEvent->io(
fh
=>
$tx
->filehandle,
poll
=>
'r'
,
cb
=>
sub
{
$cv
->
send
(
$tx
->wait_for_ack()) });
$cv
= AnyEvent->condvar;
foreach
my
$rec
(
@$con
) {
my
(
$tran
,
$desc
,
$sent
,
$init_exp
) = @{
$rec
}{
qw/transmit desc send init/
};
if
(
$tran
) {
print
STDERR
"Transmitting: $desc\n"
if
DEBUG;
$tx
->transmit(
%$tran
)
if
(
$tran
);
}
my
$res
=
$cv
->
recv
;
print
STDERR
"Received ack for $desc\n"
if
DEBUG;
is((
unpack
'H*'
,
$res
),
$sent
,
'response - '
.
$desc
);
is(
$init
,
$init_exp
,
'init == '
.
$init_exp
.
' - '
.
$desc
);
$cv
= AnyEvent->condvar;
}
%args
=
(
receiver_connected
=> 1,
harrison
=> 1,
koko
=> 1,
flamingo
=> 1,
x10
=> 0,
);
}
undef
$server
;
eval
{
$tx
->transmit(
type
=>
'magic'
,
command
=>
'fetch cake'
); };
like($@,
qr!^\Q$tx\E->transmit: magic encoding not supported at !
,
'invalid transmit type'
);
like(test_warn(
sub
{
$tx
->transmit(
type
=>
'x10'
,
command
=>
'on'
); }),
qr!->encode: Invalid x10 message!
,
'invalid x10 message'
);
SKIP: {
skip
'fails with some event loops'
, 1
unless
(
$AnyEvent::MODEL
eq
'AnyEvent::Impl::Perl'
);
eval
{
my
$res
=
$cv
->
recv
; };
like($@,
qr!^closed at \Q$0\E line \d+!
,
'check close'
);
}
undef
$tx
;
undef
$w
;
eval
{ Device::RFXCOM::TX->new(
device
=>
$addr
) };
like($@,
qr!^TCP connect to '\Q$addr\E' failed:!
o,
'connection failed'
);
undef
$tx
;
eval
{ Device::RFXCOM::TX->new(
device
=>
$host
,
port
=>
$port
) };
like($@,
qr!^TCP connect to '\Q$addr\E' failed:!
o,
'connection failed (default port)'
);
undef
$tx
;