The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::Most;
use Test::FailWarnings;

use FindBin;
use JSON::PP;
use Path::Tiny qw( path );

# 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 $json  = path("$FindBin::Bin/useragents.json")->slurp;
my $tests = JSON::PP->new->ascii->decode($json);

$json = path("$FindBin::Bin/more-useragents.json")->slurp;
my $more_tests = JSON::PP->new->ascii->decode($json);
$tests = { %$tests, %$more_tests };

foreach my $ua ( sort ( keys %{$tests} ) ) {

    my $test = $tests->{$ua};

    my $detected = HTTP::BrowserDetect->new($ua);
    diag( $detected->user_agent );

    foreach my $method (
        'browser', 'browser_string', 'browser_beta',
        'engine',  'engine_string',  'engine_beta',
        'os',      'os_string',      'os_beta',
        ) {
        if ( $test->{$method} ) {
            cmp_ok(
                $detected->$method, 'eq', $test->{$method},
                "$method: $test->{$method}"
            );
        }
    }

    foreach my $method (
        qw(
        os_version
        os_major
        os_minor
        public_version
        public_major
        public_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 $method (
        'language',
        'device', 'device_name', 'device_string',
        'robot',  'robot_name',  'robot_string'
        ) {
        if (    exists $test->{$method}
            and defined $test->{$method}
            and length $test->{$method} ) {
            cmp_ok(
                $detected->$method, 'eq', $test->{$method},
                "$method: $test->{$method}"
            );
        }
    }

    foreach my $type ( @{ $test->{match} } ) {
        ok( $detected->$type, "$type should match" );
    }

    is_deeply(
        [ sort $detected->browser_properties() ],
        [ sort @{ $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)" );
    }

}

my $detected = HTTP::BrowserDetect->new('Nonesuch');
diag( $detected->user_agent );

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();