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