cpan/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 # File::Spec and Cwd might return different values for a
  22 # symlinked directory, so we need to be careful.
  23 sub paths_are_same {
  24     my($have, $want, $name) = @_;
  25
  26     $have = _resolve_symlinks($have);
  27     $want = _resolve_symlinks($want);
  28
  29     my $builder = Test::More->builder;
  30     return $builder->like( $have, qr/\Q$want/i, $name );
  31 }
  32
  33 # Resolve any symlinks in a path
  34 sub _resolve_symlinks {
  35     my $path = shift;
  36     my($vol, $dirs, $file) = File::Spec->splitpath($path);
  37
  38     my $resolved = File::Spec->catpath( $vol, "", "" );
  39
  40     for my $dir (File::Spec->splitdir($dirs)) {
  41         # Resolve the next part of the path
  42         my $next = File::Spec->catdir( $resolved, $dir );
  43         $next = eval { readlink $next } || $next;
  44
  45         # If its absolute, use it.
  46         # Otherwise tack it onto the end of the previous path.
  47         $resolved = File::Spec->file_name_is_absolute($next)
  48                        ? $next
  49                        : File::Spec->catdir( $resolved, $next );
  50     }
  51
  52     return File::Spec->catfile($resolved, $file);
  53 }
  54
  55 my $Cwd     = File::Spec->rel2abs(cwd());
  56 my $Class   = 'CPANPLUS::Internals::Utils';
  57 my $Dir     = 'foo';
  58 my $Move    = 'bar';
  59 my $File    = 'zot';
  60
  61 rmdir $Move if -d $Move;
  62 rmdir $Dir  if -d $Dir;
  63
  64 ### test _mdkir ###
  65 {   ok( $Class->_mkdir( dir => $Dir),   "Created dir '$Dir'" );
  66     ok( -d $Dir,                        "   '$Dir' is a dir" );
  67 }
  68
  69 ### test _chdir ###
  70 {   ok( $Class->_chdir( dir => $Dir),   "Chdir to '$Dir'" );
  71
  72     my $abs = File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir));
  73     paths_are_same( File::Spec->rel2abs(cwd()), $abs,
  74                                         "   Cwd() is '$Dir'");
  75
  76     ok( $Class->_chdir( dir => $Cwd),   "Chdir back to '$Cwd'" );
  77     paths_are_same( File::Spec->rel2abs(cwd()), $Cwd,
  78                                         "   Cwd() is '$Cwd'" );
  79 }
  80
  81 ### test _move ###
  82 {   ok( $Class->_move( file => $Dir, to => $Move ),
  83                                         "Move from '$Dir' to '$Move'" );
  84     ok(  -d $Move,                      "   Dir '$Move' exists" );
  85     ok( !-d $Dir,                       "   Dir '$Dir' no longer exists" );
  86
  87
  88     {   local $CPANPLUS::Error::ERROR_FH = output_handle();
  89
  90         ### now try to move it somewhere it can't ###
  91         ok( !$Class->_move( file => $Move, to => 'inc' ),
  92                                         "   Impossible move detected" );
  93         like( CPANPLUS::Error->stack_as_string, qr/Failed to move/,
  94                                         "   Expected error found" );
  95     }
  96 }
  97
  98 ### test _rmdir ###
  99 {   ok( -d $Move,                       "Dir '$Move' exists" );
 100     ok( $Class->_rmdir( dir => $Move ), "   Deleted dir '$Move'" );
 101     ok(!-d $Move,                       "   Dir '$Move' no longer exists" );
 102 }
 103
 104 ### _get_file_contents tests ###
 105 {   my $contents = $Class->_get_file_contents( file => basename($0) );
 106     ok( $contents,                      "Got file contents" );
 107     like( $contents, qr/BEGIN/,         "   Proper contents found" );
 108     like( $contents, qr/CPANPLUS/,      "   Proper contents found" );
 109 }
 110
 111 ### _perl_version tests ###
 112 {   my $version = $Class->_perl_version( perl => $^X );
 113     ok( $version,                       "Perl version found" );
 114     like( $version, qr/\d.\d+.\d+/,     "   Looks like a proper version" );
 115 }
 116
 117 ### _version_to_number tests ###
 118 {   my $map = {
 119         '1'     => '1',
 120         '1.2'   => '1.2',
 121         '.2'    => '.2',
 122         'foo'   => '0.0',
 123         'a.1'   => '0.0',
 124     };
 125
 126     while( my($try,$expect) = each %$map ) {
 127         my $ver = $Class->_version_to_number( version => $try );
 128         ok( $ver,                       "Version returned" );
 129         is( $ver, $expect,              "   Value as expected" );
 130     }
 131 }
 132
 133 ### _whoami tests ###
 134 {   sub foo {
 135         my $me = $Class->_whoami;
 136         ok( $me,                        "_whoami returned a result" );
 137         is( $me, 'foo',                 "   Value as expected" );
 138     }
 139
 140     foo();
 141 }
 142
 143 ### _mode_plus_w tests ###
 144 {   open my $fh, ">$File" or die "Could not open $File for writing: $!";
 145     close $fh;
 146
 147     ### remove perms
 148     ok( -e $File,               "File '$File' created" );
 149     ok( chmod( 000, $File ),    "   File permissions set to 000" );
 150
 151     ok( $Class->_mode_plus_w( file => $File ),
 152                                 "   File permissions set to +w" );
 153     ok( -w $File,               "   File is writable" );
 154
 155     1 while unlink $File;
 156
 157     ok( !-e $File,              "   File removed" );
 158 }
 159
 160 ### uri encode/decode tests
 161 {   my $org = 'file://foo/bar';
 162
 163     my $enc = $Class->_uri_encode( uri => $org );
 164
 165     ok( $enc,                   "String '$org' encoded" );
 166     like( $enc, qr/%/,          "   Contents as expected" );
 167
 168     my $dec = $Class->_uri_decode( uri => $enc );
 169     ok( $dec,                   "String '$enc' decoded" );
 170     is( $dec, $org,             "   Decoded properly" );
 171 }
 172
 173
 174
 175 # Local variables:
 176 # c-indentation-style: bsd
 177 # c-basic-offset: 4
 178 # indent-tabs-mode: nil
 179 # End:
 180 # vim: expandtab shiftwidth=4:
 181