t/helper/user_preferencess.t

   1 use Test::More;
   2 use Test::Exception;
   3 use Test::Deep qw(bag cmp_deeply);
   4
   5 use strict;
   6 use lib 't';
   7
   8 use Support::TestSetup;
   9 use_ok 'SL::Helper::UserPreferences';
  10
  11 Support::TestSetup::login();
  12
  13 my $prefs;
  14 $prefs = new_ok 'SL::Helper::UserPreferences', [ current_version => 1 ];
  15
  16
  17 $prefs->store('test1', "val");
  18 $prefs->store('test2', "val2");
  19
  20 cmp_deeply [ $prefs->get_keys ], bag('test1', 'test2'), 'get_keys works';
  21
  22 is $prefs->get('test1'), 'val', 'get works';
  23 is $prefs->get_tuple('test2')->{value}, 'val2', 'get tuple works';
  24 is $prefs->get_all->[1]{value}, 'val2', 'get all works';
  25 is scalar @{ $prefs->get_all }, 2, 'get all works 2';
  26
  27 $prefs = new_ok 'SL::Helper::UserPreferences', [
  28   current_version => 2,
  29   upgrade_callbacks => {
  30     2 => sub { my ($val) = @_; $val . ' in space!'; }
  31   }
  32 ];
  33
  34 is $prefs->get('test1'), 'val in space!', 'upgrading works';
  35
  36 $prefs = new_ok 'SL::Helper::UserPreferences', [ current_version => 2 ];
  37 is $prefs->get('test1'), 'val in space!', 'auto store back works';
  38
  39 $prefs = new_ok 'SL::Helper::UserPreferences', [ current_version => 1, namespace => 'namespace2' ];
  40 is $prefs->get('test1'), undef, 'other namespace does not find prior data';
  41
  42 $prefs->store('test1', "namespace2 test");
  43 is $prefs->get('test1'), 'namespace2 test', 'other namespace finds data with same key';
  44
  45 $prefs = new_ok 'SL::Helper::UserPreferences', [ current_version => 2 ];
  46 is $prefs->get('test1'), 'val in space!', 'original namepsace is not affected';
  47
  48 $prefs = new_ok 'SL::Helper::UserPreferences', [ current_version => 1, login => 'demo2' ];
  49 $prefs->store('test1', "login test");
  50
  51 $prefs = new_ok 'SL::Helper::UserPreferences', [ current_version => 2 ];
  52 is $prefs->get('test1'), 'val in space!', 'original login is not affected';
  53
  54 $prefs->store('test1', 'new value');
  55 is scalar @{ $prefs->get_all }, 2, 'storing an existing value overwrites';
  56
  57 my @array = $prefs->get_all;
  58 is scalar @array, 1, 'get_all in list context returns 1 element';
  59 isa_ok $array[0], 'ARRAY', 'get_all in list context returns 1 arrayref';
  60
  61 $prefs = new_ok 'SL::Helper::UserPreferences', [ current_version => 1 ];
  62 dies_ok { $prefs->get('test1') } 'reading newer version dies';
  63
  64 $prefs = new_ok 'SL::Helper::UserPreferences', [ current_version => 2 ];
  65 $prefs->delete('test1');
  66 is $prefs->get('test1'), undef, 'deleting works';
  67
  68 $prefs->delete_all;
  69 is $prefs->get('test2'), undef, 'delete_all works';
  70
  71 done_testing;