forked from OpenKore/openkore
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathNetworkTest.pm
More file actions
138 lines (122 loc) · 2.87 KB
/
NetworkTest.pm
File metadata and controls
138 lines (122 loc) · 2.87 KB
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
# Unit test for Network
package NetworkTest;
use strict;
use Test::More;
use Misc;
use Network::Receive;
use Network::Send;
sub start {
my %tests = (
'Network::Receive' => [
{
switch => 'quest_update_mission_hunt',
mobs => [
{questID => 1001, mobID => 2001, count => 10},
{questID => 1002, mobID => 2002, count => 100},
]
},
],
'Network::Send' => [
{
switch => 'master_login',
version => 1,
master_version => 123456,
username => 'username',
password => 'password',
},
{
switch => 'buy_bulk_vender',
items => [
{itemIndex => 0, amount => 1},
{itemIndex => 2, amount => 30000},
]
},
],
);
for my $serverType (qw(
0
1
2
3
4
5
6
7
8
8_1
8_2
8_3
8_4
8_5
9
10
11
12
13
14
15
16
17
18
19
20
21
22
aRO
bRO
fRO
idRO
iRO
mRO
pRO
rRO
tRO
twRO
kRO_RagexeRE_0
)) {
subtest "serverType $serverType" => sub {
for my $module (keys %tests) {
SKIP: {
# kRO has too many base classes (more than 100), and perl dies trying to load it
skip 'known to be broken', 1 if $serverType =~ /^(kRO_RagexeRE_0|twRO)$/;
my $instance = eval { $module->create(undef, $serverType) };
ok($instance, "create $module") or skip 'failed', 1;
# idRO and pRO have broken packet_list
next if $serverType =~ /^(idRO|pRO)$/;
for (keys %{$instance->{packet_lut}}) {
subtest sprintf('$_{packet_list}{$_{packet_lut}{%s}}', $_) => sub { SKIP: {
ok(my $handler = $instance->{packet_list}{$instance->{packet_lut}{$_}}, 'exists') or skip 'failed', 1;
is($_, $handler->[0], 'matches');
}}
}
# do not test unsupported STs further
next if $serverType =~ /^[1-9]/;
# do not test kRO tree further
next if $serverType =~ /^kRO/;
for my $expected (@{$tests{$module}}) {
subtest "reconstruct and parse $expected->{switch}" => sub { SKIP: {
my ($reconstruct_callback, $parse_callback);
subtest 'callbacks exist' => sub {
ok($reconstruct_callback = $instance->can("reconstruct_$expected->{switch}"), 'reconstruct');
ok($parse_callback = $instance->can("parse_$expected->{switch}"), 'parse');
} or skip 'failed', 1;
my $got = Storable::dclone($expected);
$instance->$reconstruct_callback($got);
$instance->$parse_callback($got);
# there may be additional keys after reconstruct_callback
$got = reduce_struct($got, $expected);
is_deeply($got, $expected, 'test data');
}}
}
}
}
}
}
}
sub reduce_struct {
my ($got, $expected) = @_;
ref $got eq 'HASH' ? {map { exists $expected->{$_} ? ($_ => reduce_struct($got->{$_}, $expected->{$_})) : () } keys %$got}
: ref $got eq 'ARRAY' ? [List::MoreUtils::pairwise { reduce_struct($a, $b) } @$got, @$expected]
: $got
}
1;