### make sure we can find our conf.pl file
BEGIN {
use FindBin;
require "$FindBin::Bin/inc/conf.pl";
}
use strict;
### make sure to keep the plan -- this is the only test
### supported for 'older' T::H (pre 2.28) -- see Makefile.PL for details
use Test::More tests => 40;
use Cwd;
use Data::Dumper;
use File::Spec;
use File::Basename;
use CPANPLUS::Error;
use CPANPLUS::Internals::Utils;
my $Cwd = File::Spec->rel2abs(cwd());
my $Class = 'CPANPLUS::Internals::Utils';
my $Dir = 'foo';
my $Move = 'bar';
my $File = 'zot';
rmdir $Move if -d $Move;
rmdir $Dir if -d $Dir;
### test _mdkir ###
{ ok( $Class->_mkdir( dir => $Dir), "Created dir '$Dir'" );
ok( -d $Dir, " '$Dir' is a dir" );
}
### test _chdir ###
{ ok( $Class->_chdir( dir => $Dir), "Chdir to '$Dir'" );
my $abs_re = quotemeta File::Spec->rel2abs(File::Spec->catdir($Cwd,$Dir));
like( File::Spec->rel2abs(cwd()), qr/$abs_re/i,
" Cwd() is '$Dir'");
my $cwd_re = quotemeta $Cwd;
ok( $Class->_chdir( dir => $Cwd), "Chdir back to '$Cwd'" );
like( File::Spec->rel2abs(cwd()), qr/$cwd_re/i,
" Cwd() is '$Cwd'" );
}
### test _move ###
{ ok( $Class->_move( file => $Dir, to => $Move ),
"Move from '$Dir' to '$Move'" );
ok( -d $Move, " Dir '$Move' exists" );
ok( !-d $Dir, " Dir '$Dir' no longer exists" );
{ local $CPANPLUS::Error::ERROR_FH = output_handle();
### now try to move it somewhere it can't ###
ok( !$Class->_move( file => $Move, to => 'inc' ),
" Impossible move detected" );
like( CPANPLUS::Error->stack_as_string, qr/Failed to move/,
" Expected error found" );
}
}
### test _rmdir ###
{ ok( -d $Move, "Dir '$Move' exists" );
ok( $Class->_rmdir( dir => $Move ), " Deleted dir '$Move'" );
ok(!-d $Move, " Dir '$Move' no longer exists" );
}
### _get_file_contents tests ###
{ my $contents = $Class->_get_file_contents( file => basename($0) );
ok( $contents, "Got file contents" );
like( $contents, qr/BEGIN/, " Proper contents found" );
like( $contents, qr/CPANPLUS/, " Proper contents found" );
}
### _perl_version tests ###
{ my $version = $Class->_perl_version( perl => $^X );
ok( $version, "Perl version found" );
like( $version, qr/\d.\d+.\d+/, " Looks like a proper version" );
}
### _version_to_number tests ###
{ my $map = {
'1' => '1',
'1.2' => '1.2',
'.2' => '.2',
'foo' => '0.0',
'a.1' => '0.0',
};
while( my($try,$expect) = each %$map ) {
my $ver = $Class->_version_to_number( version => $try );
ok( $ver, "Version returned" );
is( $ver, $expect, " Value as expected" );
}
}
### _whoami tests ###
{ sub foo {
my $me = $Class->_whoami;
ok( $me, "_whoami returned a result" );
is( $me, 'foo', " Value as expected" );
}
foo();
}
### _mode_plus_w tests ###
{ open my $fh, ">$File" or die "Could not open $File for writing: $!";
close $fh;
### remove perms
ok( -e $File, "File '$File' created" );
ok( chmod( 000, $File ), " File permissions set to 000" );
ok( $Class->_mode_plus_w( file => $File ),
" File permissions set to +w" );
ok( -w $File, " File is writable" );
1 while unlink $File;
ok( !-e $File, " File removed" );
}
### uri encode/decode tests
{ my $org = 'file://foo/bar';
my $enc = $Class->_uri_encode( uri => $org );
ok( $enc, "String '$org' encoded" );
like( $enc, qr/%/, " Contents as expected" );
my $dec = $Class->_uri_decode( uri => $enc );
ok( $dec, "String '$enc' decoded" );
is( $dec, $org, " Decoded properly" );
}
# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4: