cpan/CPANPLUS/t/01_CPANPLUS-Configure.t

   1 ### make sure we can find our conf.pl file
   2 BEGIN {
   3     use FindBin;
   4     require "$FindBin::Bin/inc/conf.pl";
   5 }
   6
   7 use Test::More 'no_plan';
   8 use Data::Dumper;
   9 use strict;
  10 use CPANPLUS::Internals::Constants;
  11
  12 my $Config_pm   = 'CPANPLUS/Config.pm';
  13
  14 ### DO NOT FLUSH TILL THE END!!! we depend on all warnings being logged..
  15
  16 for my $mod (qw[CPANPLUS::Configure]) {
  17     use_ok($mod) or diag qq[Can't load $mod];
  18 }
  19
  20 my $c = CPANPLUS::Configure->new();
  21 isa_ok($c, 'CPANPLUS::Configure');
  22
  23 my $r = $c->conf;
  24 isa_ok( $r, 'CPANPLUS::Config' );
  25
  26
  27 ### EU::AI compatibility test ###
  28 {   my $base = $c->_get_build('base');
  29     ok( defined($base),                 "Base retrieved by old compat API");
  30     is( $base, $c->get_conf('base'),    "   Value as expected" );
  31 }
  32
  33 for my $cat ( $r->ls_accessors ) {
  34
  35     ### what field can they take? ###
  36     my @options = $c->options( type => $cat );
  37
  38     ### copy for use on the config object itself
  39     my $accessor    = $cat;
  40     my $prepend     = ($cat =~ s/^_//) ? '_' : '';
  41
  42     my $getmeth     = $prepend . 'get_'. $cat;
  43     my $setmeth     = $prepend . 'set_'. $cat;
  44     my $addmeth     = $prepend . 'add_'. $cat;
  45
  46     ok( scalar(@options),               "Possible options obtained" );
  47
  48     ### test adding keys too ###
  49     {   my $add_key = 'test_key';
  50         my $add_val = [1..3];
  51
  52         my $found = grep { $add_key eq $_ } @options;
  53         ok( !$found,                    "Key '$add_key' not yet defined" );
  54         ok( $c->$addmeth( $add_key => $add_val ),
  55                                         "   $addmeth('$add_key' => VAL)" );
  56
  57         ### this one now also exists ###
  58         push @options, $add_key
  59     }
  60
  61     ### poke in the object, get the actual hashref out ###
  62     my %hash = map {
  63         $_ => $r->$accessor->$_
  64     } $r->$accessor->ls_accessors;
  65
  66     while( my ($key,$val) = each %hash ) {
  67         my $is = $c->$getmeth($key);
  68         is_deeply( $val, $is,           "deep check for '$key'" );
  69         ok( $c->$setmeth($key => 1 ),   "   $setmeth('$key' => 1)" );
  70         is( $c->$getmeth($key), 1,      "   $getmeth('$key')" );
  71         ok( $c->$setmeth($key => $val), "   $setmeth('$key' => ORGVAL)" );
  72     }
  73
  74     ### now check if we found all the keys with options or not ###
  75     delete $hash{$_} for @options;
  76     ok( !(scalar keys %hash),          "All possible keys found" );
  77
  78 }
  79
  80
  81 ### see if we can save the config ###
  82 {   my $dir     = File::Spec->rel2abs('dummy-cpanplus');
  83     my $pm      = 'CPANPLUS::Config::Test' . $$;
  84     my $file    = $c->save( $pm, $dir );
  85
  86     ok( $file,                  "Config $pm saved" );
  87     ok( -e $file,               "   File exists" );
  88     ok( -s $file,               "   File has size" );
  89
  90     ### include our dummy dir when re-scanning
  91     {   local @INC = ( $dir, @INC );
  92         ok( $c->init( rescan => 1 ),
  93                                 "Reran ->init()" );
  94     }
  95
  96     ### make sure this file is now loaded
  97     ### XXX can't trust bloody dir seperators on Win32 in %INC,
  98     ### so rather than an exact match, do a grep...
  99     my ($found) = grep /\bTest$$/, values %INC;
 100     ok( $found,                 "   Found $file in \%INC" );
 101     ok( -e $file,               "   File exists" );
 102     1 while unlink $file;
 103     ok(!-e $file,               "       File removed" );
 104
 105 }
 106
 107 {   my $env             = ENV_CPANPLUS_CONFIG;
 108     local $ENV{$env}    = $$;
 109     my $ok              = $c->init;
 110     my $stack           = CPANPLUS::Error->stack_as_string;
 111
 112     ok( $ok,                    "Reran init again" );
 113     like( $stack, qr/Specifying a config file in your environment/,
 114                                 "   Warning logged" );
 115 }
 116
 117
 118 {   CPANPLUS::Error->flush;
 119
 120     {   ### try a bogus method call
 121         my $x   = $c->flubber('foo');
 122         my $err = CPANPLUS::Error->stack_as_string;
 123         is  ($x, undef,         "Bogus method call returns undef");
 124         like($err, "/flubber/", "   Bogus method call recognized");
 125     }
 126
 127     CPANPLUS::Error->flush;
 128 }
 129
 130
 131 # Local variables:
 132 # c-indentation-style: bsd
 133 # c-basic-offset: 4
 134 # indent-tabs-mode: nil
 135 # End:
 136 # vim: expandtab shiftwidth=4: