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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
#!/usr/bin/perl
use strict;
use warnings;
use FindBin ();
use JSON::PP ();
use List::Util 1.49 qw( uniq );
use Path::Tiny qw( path );
use Test::Differences qw( eq_or_diff );
use Test::Warnings;
use Test::More import =>
[qw( cmp_ok diag done_testing is is_deeply ok subtest )];
# test that the module loads without errors
my $w;
{
local $SIG{__WARN__} = sub { $w = shift };
require HTTP::BrowserDetect;
}
ok( !$w, 'no warnings on require' );
my $tests = get_json('useragents.json');
my $more_tests = get_json('more-useragents.json');
sub get_json {
my $file = shift;
my $json = path( $FindBin::Bin, $file )->slurp;
return JSON::PP->new->ascii->decode($json);
}
my $first_test_count = keys %{$tests};
my $second_test_count = keys %{$more_tests};
my $expected_total_test_count = $first_test_count + $second_test_count;
my $all_tests = { %$tests, %$more_tests };
my $got_total_test_count = keys %{$all_tests};
is( $expected_total_test_count, $got_total_test_count, 'no tests clobbered' );
my @robot_tests = uniq map { $_->[1] } HTTP::BrowserDetect->_robot_tests;
my %ids = map { $_ => 1 } HTTP::BrowserDetect->all_robot_ids;
my @methods = (
'browser', 'browser_beta', 'browser_string', 'browser_version',
'browser_major', 'browser_minor', 'device', 'device_beta', 'device_name',
'device_string', 'engine', 'engine_beta', 'engine_string', 'language',
'os', 'os_beta', 'os_string', 'robot', 'robot_beta', 'robot_name',
'robot_string', 'webview',
);
foreach my $ua ( sort ( keys %{$all_tests} ) ) {
my $test = $all_tests->{$ua};
my $detected = HTTP::BrowserDetect->new($ua);
subtest $ua => sub {
foreach my $method (@methods) {
if ( exists $test->{$method} ) {
if ( defined $test->{$method} ) {
eq_or_diff(
$detected->$method, $test->{$method},
"$method: $test->{$method}"
);
}
else {
eq_or_diff(
$detected->$method, $test->{$method},
"$method: undef"
);
}
}
}
foreach my $method (
qw(
os_version
os_major
os_minor
public_version
public_major
public_minor
robot_version
robot_major
robot_minor
version
major
minor
engine_version
engine_major
engine_minor
ios
tablet
)
) {
if ( exists $test->{$method}
and defined $test->{$method}
and length $test->{$method} ) {
cmp_ok(
$detected->$method, '==', $test->{$method},
"$method: $test->{$method}"
);
}
}
foreach my $type ( @{ $test->{match} } ) {
# New bots aren't getting added to methods
next
if List::Util::any { lc($type) eq lc($_) } @robot_tests,
'robot_id';
ok( $detected->can($type), "$type is a method" );
ok(
$detected->can($type) && $detected->$type,
"$type should match"
);
}
# for now, avoid having to add robot_id to a bunch of profiles
eq_or_diff(
[
sort grep { $_ !~ m{\Arobot_id\z} && $_ !~ m{\Awebview\z} }
$detected->browser_properties()
],
[ sort grep { $_ !~ m{\Arobot_id\z} } @{ $test->{match} } ],
'browser properties match'
);
# Test that $ua doesn't match a specific method
foreach my $type ( @{ $test->{no_match} } ) {
ok( !$detected->$type, "$type shouldn't match (and doesn't)" );
}
if ( $detected->robot ) {
if ( $detected->robot_id ) {
ok(
$ids{ $detected->robot_id },
'id exists in list: ' . $detected->robot_id
);
}
else {
diag $detected->robot . ' has no id';
}
}
};
}
my $detected = HTTP::BrowserDetect->new('Nonesuch');
subtest $detected->user_agent, sub {
foreach my $method (
qw(
engine_string
engine_version
engine_major
engine_minor
device
device_name
gecko_version
)
) {
is_deeply(
[ $detected->$method ],
[undef], "$method should return undef in list context"
);
}
};
done_testing();
|
