t/CXGN/config.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use English;
   5
   6 use File::Temp;
   7 use Path::Class;
   8
   9 use Test::More tests => 51;
  10 use Test::Exception;
  11
  12 use Memoize;
  13
  14 BEGIN {
  15   use_ok(  'CXGN::Config'  )
  16     or BAIL_OUT('could not include the module being tested');
  17 }
  18
  19 my $tempdir = File::Temp->newdir;
  20
  21 { # test a bare config superclass
  22     local $CXGN::Config::defaults = {
  23                                      test1 => 'foo',
  24                                      test2 => 'bar',
  25                                     };
  26
  27     # unset the search path to prevent loading any config files, just defaults
  28     local @CXGN::Config::search_path = ( );
  29
  30     my $cfg = CXGN::Config->load;
  31     ok( defined($cfg), 'got back a config' );
  32     is_deeply($cfg, $CXGN::Config::defaults, 'got just default values');
  33 }
  34
  35 {
  36
  37     local $CXGN::Config::defaults = {
  38                                      test1 => 'foo',
  39                                      test2 => 'bar',
  40                                     };
  41
  42     # set the search path to prevent loading any config files except the test ones (if any)
  43     local @CXGN::Config::search_path = ( $tempdir );
  44
  45     { my $d = {%$CXGN::Config::defaults, %$Foo::Config::Bar::test_defaults};
  46       test_cfg( class => 'Foo::Config::Bar', load => $d, defaults => $d );
  47     }
  48
  49     { my $d = {%$CXGN::Config::defaults, %$Foo::Config::Bar::test_defaults, %$MyConfig::test_defaults };
  50       test_cfg( class => 'MyConfig', load => $d, defaults => $d );
  51     }
  52
  53
  54     my $global_file   = file( $tempdir, 'Global.conf' );
  55     my $bar_file      = file( $tempdir, 'Foo.conf'  );
  56     my $myconfig_file = file( $tempdir, 'MyConfig.conf' );
  57     $myconfig_file->touch;
  58
  59     { my $d = {%$CXGN::Config::defaults, %$Foo::Config::Bar::test_defaults, %$MyConfig::test_defaults };
  60       test_cfg( class => 'MyConfig', load => $d, defaults => $d );
  61     }
  62
  63     my $myconfig_vals = {  test1 => 'needle', test2 => 'haystack' };
  64     $myconfig_file->openw->print(map "$_  $myconfig_vals->{$_}\n", keys %$myconfig_vals);
  65
  66     {
  67       my $d = {%$CXGN::Config::defaults, %$Foo::Config::Bar::test_defaults, %$MyConfig::test_defaults};
  68       my $l = { %$d, %$myconfig_vals };
  69       test_cfg( class => 'MyConfig', load => $l, defaults => $d );
  70     }
  71
  72     $bar_file->openw->print("fog boo baz beep\n");
  73
  74     { my $d = {%$CXGN::Config::defaults, %$Foo::Config::Bar::test_defaults};
  75       my $l = {%$d, fog => 'boo baz beep'};
  76       test_cfg( class => 'Foo::Config::Bar', load => $l, defaults => $d );
  77     }
  78
  79     my $global_vals = { global1 => 13244, global8 => 'asdlkajg' };
  80     $global_file->openw->print(map "$_  $global_vals->{$_}\n", keys %$global_vals);
  81
  82     {
  83       my $d = {%$CXGN::Config::defaults, %$Foo::Config::Bar::test_defaults, %$MyConfig::test_defaults};
  84       my $l = { %$d, %$global_vals, %$myconfig_vals };
  85       test_cfg( class => 'MyConfig', load => $l, defaults => $d );
  86     }
  87
  88 }
  89
  90
  91 ########### SUBS
  92
  93 sub test_cfg {
  94     my %a = @_;
  95
  96     Memoize::flush_cache('CXGN::Config::load_locked'); #< clear Memoize-cached data
  97
  98     is_deeply($a{class}->load, $a{load}, "$a{class}: got the right defaults from load");
  99     is_deeply($a{class}->load_locked, $a{load}, "$a{class}: got the right defaults from load_locked");
 100     is_deeply($a{class}->defaults, $a{defaults}, "$a{class}: got the right defaults from the defaults() method");
 101     my $merge = {foofoofoofoo => 'booze'};
 102     is_deeply($a{class}->defaults($merge), {%{$a{defaults}}, %$merge}, "$a{class}: defaults() method merges config");
 103
 104     my $add_vals = { fonebone => 'tonka truck' };
 105     is_deeply($a{class}->load(add_vals => $add_vals), {%{$a{load}},%$add_vals}, "$a{class}: got the right defaults from load with add_vals");
 106
 107     my $locked = $a{class}->load_locked( add_vals => { writeme => 'boo' });
 108     throws_ok {
 109         my $v = $locked->{doesnotexist};
 110     } qr/disallowed/i, 'throws an error accessing nonexistent key in hash from load_locked';
 111     throws_ok {
 112         $locked->{writeme} = 'bar';
 113     } qr/modification/i, 'throws an error writing to locked hash';
 114     is( $locked->{writeme}, 'boo' );
 115 }
 116
 117
 118 BEGIN { # some test config subclasses
 119     package Foo::Config::Bar;
 120     use base 'CXGN::Config';
 121
 122     our $test_defaults = { bee => 'bo', 'bar' => __PACKAGE__};
 123     sub defaults {
 124         shift->SUPER::defaults( $test_defaults, @_ );
 125     }
 126
 127     package MyConfig;
 128     use base 'Foo::Config::Bar';
 129
 130     our $test_defaults = { noggin => 'nudge', bunk => ['booz','noggin',{ fooish => 'bar'},] };
 131     sub defaults {
 132         shift->SUPER::defaults( $test_defaults, @_ );
 133     }
 134 }