tCMS/t/Trog-Auth-libravatar.t

#!/usr/bin/env perl
use 5.040;
use re '/aasx';
use warnings FATAL => 'all';

use Test::More;
use Test::MockModule qw{strict};

use FindBin::libs;

# Stub modules absent from the test environment before loading Trog::Auth
BEGIN {
    # Logging stubs -- Log::Dispatch family not installed in test env
    $INC{'Log/Dispatch.pm'}            = 1;
    $INC{'Log/Dispatch/DBI.pm'}        = 1;
    $INC{'Log/Dispatch/Screen.pm'}     = 1;
    $INC{'Log/Dispatch/FileRotate.pm'} = 1;
    $INC{'Trog/Log/DBI.pm'}            = 1;

    # Other missing optional deps
    $INC{'HTTP/Tiny/UNIX.pm'} = 1;
    $INC{'File/LibMagic.pm'}  = 1;
    $INC{'Imager/QRCode.pm'}  = 1;
    $INC{'Config/Simple.pm'}  = 1;

}

require_ok('Trog::Auth') or BAIL_OUT("Can't load Trog::Auth");

subtest 'users_with_emails -- no rows returned' => sub {
    my $sqlite_mock = Test::MockModule->new('Trog::SQLite');
    $sqlite_mock->redefine(
        'dbh',
        sub {
            my $fake_dbh = bless {}, 'FakeDBH_NoRows';
            no warnings 'once';
            *FakeDBH_NoRows::selectall_arrayref = sub { undef };
            return $fake_dbh;
        }
    );
    my $result = Trog::Auth::users_with_emails();
    is( ref $result,     'ARRAY', 'returns arrayref even when DB returns undef' );
    is( scalar @$result, 0,       'empty arrayref when no rows' );
};

subtest 'users_with_emails -- returns populated list' => sub {
    my $fake_rows = [
        { name => 'alice', contact_email => 'alice@example.com' },
        { name => 'bob',   contact_email => 'bob@example.com' },
    ];
    my $sqlite_mock = Test::MockModule->new('Trog::SQLite');
    $sqlite_mock->redefine(
        'dbh',
        sub {
            my $fake_dbh = bless {}, 'FakeDBH_WithRows';
            no warnings 'once';
            *FakeDBH_WithRows::selectall_arrayref = sub { $fake_rows };
            return $fake_dbh;
        }
    );
    my $result = Trog::Auth::users_with_emails();
    is( ref $result,                 'ARRAY',             'returns arrayref' );
    is( scalar @$result,             2,                   'correct number of users' );
    is( $result->[0]{name},          'alice',             'first user name' );
    is( $result->[0]{contact_email}, 'alice@example.com', 'first user email' );
    is( $result->[1]{name},          'bob',               'second user name' );
};

subtest 'libravatar hash matching logic' => sub {
    use Digest::MD5 qw{md5_hex};
    use Digest::SHA qw{sha256_hex};

    my $email  = 'Test@Example.COM';
    my $norm   = lc($email);
    my $sha256 = sha256_hex($norm);
    my $md5    = md5_hex($norm);

    isnt( $sha256, $md5, 'SHA-256 and MD5 hashes differ' );
    is( length($sha256), 64, 'SHA-256 hash is 64 hex chars' );
    is( length($md5),    32, 'MD5 hash is 32 hex chars' );

    # Case-normalisation must be consistent with what the endpoint does
    is( sha256_hex( lc($email) ), $sha256, 'lc() gives stable SHA-256' );
    is( md5_hex( lc($email) ),    $md5,    'lc() gives stable MD5' );

    # Simulate the lookup: given a hash, find the matching email
    my @users = (
        { name => 'alice', contact_email => 'alice@example.com' },
        { name => 'bob',   contact_email => 'bob@example.com' },
    );
    my $target_hash = sha256_hex( lc('alice@example.com') );
    my $matched;
    for my $u (@users) {
        my $e = lc( $u->{contact_email} );
        if ( $target_hash eq sha256_hex($e) || $target_hash eq md5_hex($e) ) {
            $matched = $u->{name};
            last;
        }
    }
    is( $matched, 'alice', 'SHA-256 lookup finds the correct user' );

    my $target_md5 = md5_hex( lc('bob@example.com') );
    $matched = undef;
    for my $u (@users) {
        my $e = lc( $u->{contact_email} );
        if ( $target_md5 eq sha256_hex($e) || $target_md5 eq md5_hex($e) ) {
            $matched = $u->{name};
            last;
        }
    }
    is( $matched, 'bob', 'MD5 lookup finds the correct user' );

    # Unknown hash returns no match
    $matched = undef;
    for my $u (@users) {
        my $e = lc( $u->{contact_email} );
        if ( 'deadbeef' eq sha256_hex($e) || 'deadbeef' eq md5_hex($e) ) {
            $matched = $u->{name};
            last;
        }
    }
    is( $matched, undef, 'unknown hash returns no match' );
};

done_testing;