1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
use lib 't/lib';
use TestHelp;
my @frames;
{no warnings 'redefine';
sub Net::Stomp::send_frame {push @frames,$_[1];return;}
}
my ($s,$fh)=mkstomp_testsocket();
sub _testit {
my ($method,$arg,@tests) = @_;
@frames=();
my $ret = $s->$method($arg);
ok($ret,"$method returned true");
cmp_deeply(
\@frames,
[all(
isa('Net::Stomp::Frame'),
methods(@tests),
)],
"$method sent ok",
);
}
subtest 'send and ack' => sub {
_testit(
send => {'message-id'=>12,body=>'string'},
command=>'SEND',
headers=>{'message-id'=>12},
body=>'string',
);
my $message = $frames[0];
_testit(
ack => {frame=>$message},
command=>'ACK',
headers=>{'message-id'=>12},
body=>undef,
);
_testit(
ack => {frame=>$message,receipt=>'foo'},
command=>'ACK',
headers=>{'message-id'=>12,receipt=>'foo'},
body=>undef,
);
};
subtest 'send and nack' => sub {
_testit(
send => {'message-id'=>12,body=>'string'},
command=>'SEND',
headers=>{'message-id'=>12},
body=>'string',
);
my $message = $frames[0];
_testit(
nack => {frame=>$message},
command=>'NACK',
headers=>{'message-id'=>12},
body=>undef,
);
_testit(
nack => {frame=>$message,receipt=>'foo'},
command=>'NACK',
headers=>{'message-id'=>12,receipt=>'foo'},
body=>undef,
);
};
subtest '(un)subscribe by id' => sub {
_testit(
subscribe => {id=>1,destination=>'/queue/foo'},
command=>'SUBSCRIBE',
headers=>{id=>1,destination=>'/queue/foo'},
body => undef,
);
cmp_deeply(
$s->subscriptions,
{'id-1'=>{id=>1,destination=>'/queue/foo'}},
'recorded ok',
);
_testit(
unsubscribe => {id=>1,destination=>'/queue/foo'},
command=>'UNSUBSCRIBE',
headers=>{id=>1,destination=>'/queue/foo'},
body => undef,
);
cmp_deeply(
$s->subscriptions,
{},
'recorded ok',
);
};
subtest 'subscribe without id' => sub {
_testit(
subscribe => {destination=>'/queue/foo'},
command=>'SUBSCRIBE',
headers=>{destination=>'/queue/foo'},
body => undef,
);
cmp_deeply(
$s->subscriptions,
{'dest-/queue/foo'=>{destination=>'/queue/foo'}},
'recorded ok',
);
_testit(
unsubscribe => {destination=>'/queue/foo'},
command=>'UNSUBSCRIBE',
headers=>{destination=>'/queue/foo'},
body => undef,
);
cmp_deeply(
$s->subscriptions,
{},
'recorded ok',
);
};
done_testing;
|
