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     is( File::Spec->rel2abs(cwd()), File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir)),
  38                                         "   Cwd() is '$Dir'");
  39     ok( $Class->_chdir( dir => $Cwd),   "Chdir back to '$Cwd'" );
  40     like( File::Spec->rel2abs(cwd()), qr/$Cwd/i,
  41                                         "   Cwd() is '$Cwd'" );
  42 }
  43
  44 ### test _move ###
  45 {   ok( $Class->_move( file => $Dir, to => $Move ),
  46                                         "Move from '$Dir' to '$Move'" );
  47     ok(  -d $Move,                      "   Dir '$Move' exists" );
  48     ok( !-d $Dir,                       "   Dir '$Dir' no longer exists" );
  49
  50
  51     {   local $CPANPLUS::Error::ERROR_FH = output_handle();
  52
  53         ### now try to move it somewhere it can't ###
  54         ok( !$Class->_move( file => $Move, to => 'inc' ),
  55                                         "   Impossible move detected" );
  56         like( CPANPLUS::Error->stack_as_string, qr/Failed to move/,
  57                                         "   Expected error found" );
  58     }
  59 }
  60
  61 ### test _rmdir ###
  62 {   ok( -d $Move,                       "Dir '$Move' exists" );
  63     ok( $Class->_rmdir( dir => $Move ), "   Deleted dir '$Move'" );
  64     ok(!-d $Move,                       "   Dir '$Move' no longer exists" );
  65 }
  66
  67 ### _get_file_contents tests ###
  68 {   my $contents = $Class->_get_file_contents( file => basename($0) );
  69     ok( $contents,                      "Got file contents" );
  70     like( $contents, qr/BEGIN/,         "   Proper contents found" );
  71     like( $contents, qr/CPANPLUS/,      "   Proper contents found" );
  72 }
  73
  74 ### _perl_version tests ###
  75 {   my $version = $Class->_perl_version( perl => $^X );
  76     ok( $version,                       "Perl version found" );
  77     like( $version, qr/\d.\d+.\d+/,     "   Looks like a proper version" );
  78 }
  79
  80 ### _version_to_number tests ###
  81 {   my $map = {
  82         '1'     => '1',
  83         '1.2'   => '1.2',
  84         '.2'    => '.2',
  85         'foo'   => '0.0',
  86         'a.1'   => '0.0',
  87     };
  88
  89     while( my($try,$expect) = each %$map ) {
  90         my $ver = $Class->_version_to_number( version => $try );
  91         ok( $ver,                       "Version returned" );
  92         is( $ver, $expect,              "   Value as expected" );
  93     }
  94 }
  95
  96 ### _whoami tests ###
  97 {   sub foo {
  98         my $me = $Class->_whoami;
  99         ok( $me,                        "_whoami returned a result" );
 100         is( $me, 'foo',                 "   Value as expected" );
 101     }
 102
 103     foo();
 104 }
 105
 106 ### _mode_plus_w tests ###
 107 {   open my $fh, ">$File" or die "Could not open $File for writing: $!";
 108     close $fh;
 109
 110     ### remove perms
 111     ok( -e $File,               "File '$File' created" );
 112     ok( chmod( 000, $File ),    "   File permissions set to 000" );
 113
 114     ok( $Class->_mode_plus_w( file => $File ),
 115                                 "   File permissions set to +w" );
 116     ok( -w $File,               "   File is writable" );
 117
 118     1 while unlink $File;
 119
 120     ok( !-e $File,              "   File removed" );
 121 }
 122
 123 ### uri encode/decode tests
 124 {   my $org = 'file://foo/bar';
 125
 126     my $enc = $Class->_uri_encode( uri => $org );
 127
 128     ok( $enc,                   "String '$org' encoded" );
 129     like( $enc, qr/%/,          "   Contents as expected" );
 130
 131     my $dec = $Class->_uri_decode( uri => $enc );
 132     ok( $dec,                   "String '$enc' decoded" );
 133     is( $dec, $org,             "   Decoded properly" );
 134 }
 135
 136
 137
 138 # Local variables:
 139 # c-indentation-style: bsd
 140 # c-basic-offset: 4
 141 # indent-tabs-mode: nil
 142 # End:
 143 # vim: expandtab shiftwidth=4:
 144