view release on metacpan or  search on metacpan

t/01-detect.t  view on Meta::CPAN

#!/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::More import =>
    [qw( cmp_ok diag done_testing is is_deeply ok subtest )];
use Test::Warnings;

# 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"