Trog-Auth-libravatar.t 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124
  1. use strict;
  2. use warnings;
  3. use Test::More;
  4. use Test::MockModule qw{strict};
  5. use FindBin;
  6. use lib "$FindBin::Bin/../lib";
  7. # Stub modules absent from the test environment before loading Trog::Auth
  8. BEGIN {
  9. # Logging stubs — Log::Dispatch family not installed in test env
  10. $INC{'Log/Dispatch.pm'} = 1;
  11. $INC{'Log/Dispatch/DBI.pm'} = 1;
  12. $INC{'Log/Dispatch/Screen.pm'} = 1;
  13. $INC{'Log/Dispatch/FileRotate.pm'} = 1;
  14. $INC{'Trog/Log/DBI.pm'} = 1;
  15. # Other missing optional deps
  16. $INC{'HTTP/Tiny/UNIX.pm'} = 1;
  17. $INC{'File/LibMagic.pm'} = 1;
  18. $INC{'Imager/QRCode.pm'} = 1;
  19. $INC{'Config/Simple.pm'} = 1;
  20. }
  21. require_ok('Trog::Auth') or BAIL_OUT("Can't load Trog::Auth");
  22. subtest 'users_with_emails — no rows returned' => sub {
  23. my $sqlite_mock = Test::MockModule->new('Trog::SQLite');
  24. $sqlite_mock->redefine(
  25. 'dbh',
  26. sub {
  27. my $fake_dbh = bless {}, 'FakeDBH_NoRows';
  28. no warnings 'once';
  29. *FakeDBH_NoRows::selectall_arrayref = sub { undef };
  30. return $fake_dbh;
  31. }
  32. );
  33. my $result = Trog::Auth::users_with_emails();
  34. is( ref $result, 'ARRAY', 'returns arrayref even when DB returns undef' );
  35. is( scalar @$result, 0, 'empty arrayref when no rows' );
  36. };
  37. subtest 'users_with_emails — returns populated list' => sub {
  38. my $fake_rows = [
  39. { name => 'alice', contact_email => 'alice@example.com' },
  40. { name => 'bob', contact_email => 'bob@example.com' },
  41. ];
  42. my $sqlite_mock = Test::MockModule->new('Trog::SQLite');
  43. $sqlite_mock->redefine(
  44. 'dbh',
  45. sub {
  46. my $fake_dbh = bless {}, 'FakeDBH_WithRows';
  47. no warnings 'once';
  48. *FakeDBH_WithRows::selectall_arrayref = sub { $fake_rows };
  49. return $fake_dbh;
  50. }
  51. );
  52. my $result = Trog::Auth::users_with_emails();
  53. is( ref $result, 'ARRAY', 'returns arrayref' );
  54. is( scalar @$result, 2, 'correct number of users' );
  55. is( $result->[0]{name}, 'alice', 'first user name' );
  56. is( $result->[0]{contact_email}, 'alice@example.com', 'first user email' );
  57. is( $result->[1]{name}, 'bob', 'second user name' );
  58. };
  59. subtest 'libravatar hash matching logic' => sub {
  60. use Digest::MD5 qw{md5_hex};
  61. use Digest::SHA qw{sha256_hex};
  62. my $email = 'Test@Example.COM';
  63. my $norm = lc($email);
  64. my $sha256 = sha256_hex($norm);
  65. my $md5 = md5_hex($norm);
  66. isnt( $sha256, $md5, 'SHA-256 and MD5 hashes differ' );
  67. is( length($sha256), 64, 'SHA-256 hash is 64 hex chars' );
  68. is( length($md5), 32, 'MD5 hash is 32 hex chars' );
  69. # Case-normalisation must be consistent with what the endpoint does
  70. is( sha256_hex( lc($email) ), $sha256, 'lc() gives stable SHA-256' );
  71. is( md5_hex( lc($email) ), $md5, 'lc() gives stable MD5' );
  72. # Simulate the lookup: given a hash, find the matching email
  73. my @users = (
  74. { name => 'alice', contact_email => 'alice@example.com' },
  75. { name => 'bob', contact_email => 'bob@example.com' },
  76. );
  77. my $target_hash = sha256_hex( lc('alice@example.com') );
  78. my $matched;
  79. for my $u (@users) {
  80. my $e = lc( $u->{contact_email} );
  81. if ( $target_hash eq sha256_hex($e) || $target_hash eq md5_hex($e) ) {
  82. $matched = $u->{name};
  83. last;
  84. }
  85. }
  86. is( $matched, 'alice', 'SHA-256 lookup finds the correct user' );
  87. my $target_md5 = md5_hex( lc('bob@example.com') );
  88. $matched = undef;
  89. for my $u (@users) {
  90. my $e = lc( $u->{contact_email} );
  91. if ( $target_md5 eq sha256_hex($e) || $target_md5 eq md5_hex($e) ) {
  92. $matched = $u->{name};
  93. last;
  94. }
  95. }
  96. is( $matched, 'bob', 'MD5 lookup finds the correct user' );
  97. # Unknown hash returns no match
  98. $matched = undef;
  99. for my $u (@users) {
  100. my $e = lc( $u->{contact_email} );
  101. if ( 'deadbeef' eq sha256_hex($e) || 'deadbeef' eq md5_hex($e) ) {
  102. $matched = $u->{name};
  103. last;
  104. }
  105. }
  106. is( $matched, undef, 'unknown hash returns no match' );
  107. };
  108. done_testing;