lib/CPANPLUS/t/00_CPANPLUS-Internals-Utils.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 strict;
   8
   9 ### make sure to keep the plan -- this is the only test
  10 ### supported for 'older' T::H (pre 2.28) -- see Makefile.PL for details
  11 use Test::More tests => 40;
  12
  13 use Cwd;
  14 use Data::Dumper;
  15 use File::Spec;
  16 use File::Basename;
  17
  18 use CPANPLUS::Error;
  19 use CPANPLUS::Internals::Utils;
  20
  21 my $Cwd     = File::Spec->rel2abs(cwd());
  22 my $Class   = 'CPANPLUS::Internals::Utils';
  23 my $Dir     = 'foo';
  24 my $Move    = 'bar';
  25 my $File    = 'zot';
  26
  27 rmdir $Move if -d $Move;
  28 rmdir $Dir  if -d $Dir;
  29
  30 ### test _mdkir ###
  31 {   ok( $Class->_mkdir( dir => $Dir),   "Created dir '$Dir'" );
  32     ok( -d $Dir,                        "   '$Dir' is a dir" );
  33 }
  34
  35 ### test _chdir ###
  36 {   ok( $Class->_chdir( dir => $Dir),   "Chdir to '$Dir'" );
  37
  38     my $abs_re = quotemeta File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir));
  39     like( File::Spec->rel2abs(cwd()), qr/$abs_re/i,
  40                                         "   Cwd() is '$Dir'");
  41
  42     my $cwd_re = quotemeta $Cwd;
  43     ok( $Class->_chdir( dir => $Cwd),   "Chdir back to '$Cwd'" );
  44     like( File::Spec->rel2abs(cwd()), qr/$cwd_re/i,
  45                                         "   Cwd() is '$Cwd'" );
  46 }
  47
  48 ### test _move ###
  49 {   ok( $Class->_move( file => $Dir, to => $Move ),
  50                                         "Move from '$Dir' to '$Move'" );
  51     ok(  -d $Move,                      "   Dir '$Move' exists" );
  52     ok( !-d $Dir,                       "   Dir '$Dir' no longer exists" );
  53
  54
  55     {   local $CPANPLUS::Error::ERROR_FH = output_handle();
  56
  57         ### now try to move it somewhere it can't ###
  58         ok( !$Class->_move( file => $Move, to => 'inc' ),
  59                                         "   Impossible move detected" );
  60         like( CPANPLUS::Error->stack_as_string, qr/Failed to move/,
  61                                         "   Expected error found" );
  62     }
  63 }
  64
  65 ### test _rmdir ###
  66 {   ok( -d $Move,                       "Dir '$Move' exists" );
  67     ok( $Class->_rmdir( dir => $Move ), "   Deleted dir '$Move'" );
  68     ok(!-d $Move,                       "   Dir '$Move' no longer exists" );
  69 }
  70
  71 ### _get_file_contents tests ###
  72 {   my $contents = $Class->_get_file_contents( file => basename($0) );
  73     ok( $contents,                      "Got file contents" );
  74     like( $contents, qr/BEGIN/,         "   Proper contents found" );
  75     like( $contents, qr/CPANPLUS/,      "   Proper contents found" );
  76 }
  77
  78 ### _perl_version tests ###
  79 {   my $version = $Class->_perl_version( perl => $^X );
  80     ok( $version,                       "Perl version found" );
  81     like( $version, qr/\d.\d+.\d+/,     "   Looks like a proper version" );
  82 }
  83
  84 ### _version_to_number tests ###
  85 {   my $map = {
  86         '1'     => '1',
  87         '1.2'   => '1.2',
  88         '.2'    => '.2',
  89         'foo'   => '0.0',
  90         'a.1'   => '0.0',
  91     };
  92
  93     while( my($try,$expect) = each %$map ) {
  94         my $ver = $Class->_version_to_number( version => $try );
  95         ok( $ver,                       "Version returned" );
  96         is( $ver, $expect,              "   Value as expected" );
  97     }
  98 }
  99
 100 ### _whoami tests ###
 101 {   sub foo {
 102         my $me = $Class->_whoami;
 103         ok( $me,                        "_whoami returned a result" );
 104         is( $me, 'foo',                 "   Value as expected" );
 105     }
 106
 107     foo();
 108 }
 109
 110 ### _mode_plus_w tests ###
 111 {   open my $fh, ">$File" or die "Could not open $File for writing: $!";
 112     close $fh;
 113
 114     ### remove perms
 115     ok( -e $File,               "File '$File' created" );
 116     ok( chmod( 000, $File ),    "   File permissions set to 000" );
 117
 118     ok( $Class->_mode_plus_w( file => $File ),
 119                                 "   File permissions set to +w" );
 120     ok( -w $File,               "   File is writable" );
 121
 122     1 while unlink $File;
 123
 124     ok( !-e $File,              "   File removed" );
 125 }
 126
 127 ### uri encode/decode tests
 128 {   my $org = 'file://foo/bar';
 129
 130     my $enc = $Class->_uri_encode( uri => $org );
 131
 132     ok( $enc,                   "String '$org' encoded" );
 133     like( $enc, qr/%/,          "   Contents as expected" );
 134
 135     my $dec = $Class->_uri_decode( uri => $enc );
 136     ok( $dec,                   "String '$enc' decoded" );
 137     is( $dec, $org,             "   Decoded properly" );
 138 }
 139
 140
 141
 142 # Local variables:
 143 # c-indentation-style: bsd
 144 # c-basic-offset: 4
 145 # indent-tabs-mode: nil
 146 # End:
 147 # vim: expandtab shiftwidth=4:
 148