App-Fetchware
view release on metacpan or search on metacpan
t/bin-fetchware-upgrade.t view on Meta::CPAN
for my $fetchware_package (glob catfile(fetchware_database_path(), '*')) {
# Clean up $fetchware_package.
if ($fetchware_package =~ /test-dist/) {
ok((unlink $fetchware_package),
'checked cmd_upgrade() clean up fetchware database path')
if -e $fetchware_package
}
}
# Create a $temp_dir for make_test_dist() to use. I need to do this, so that
# both the old and new test dists can be in the same directory.
my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
CLEANUP => 1, TMPDIR => 1);
# However, not only do I have create the tempdir, but I must also chmod 755
# this temporary directory to ensure read access if this test file is run as
# root, and then drops its privs without the extra read perms this test will
# fail, because the nobody user will not be able to access this directory's
# 700 perms.
chmod 0755, $upgrade_temp_dir or fail(<<EOF);
Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
EOF
note("UPGRADETD[$upgrade_temp_dir]");
my $old_test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num =>'1.00', destination_directory => $upgrade_temp_dir,
append_option => qq{user => 'ENV{FETCHWARE_NONROOT_USER}';});
my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
# Delete all existing httpd fetchware packages in fetchware_database_path(),
# which will screw up the installation and upgrading of httpd below.
for my $fetchware_package (glob catfile(fetchware_database_path(), '*')) {
# Delete *only* httpd.
if ($fetchware_package =~ /test-dist/) {
# Clean up $fetchware_package.
ok((unlink $fetchware_package),
'checked cmd_upgrade() clean up fetchware database path')
if -e $fetchware_package;
}
}
note("INSTALLPATH[$old_test_dist_path]");
# I obviously must install test-dist before I can test upgrading it :)
my $fetchware_package_path = cmd_install($old_test_dist_path);
# And then test if the install was successful.
ok(grep /test-dist/, glob(catfile(fetchware_database_path(), '*')),
'check cmd_install(Fetchware) success.');
# Clear internal %CONFIG variable, because I have to parse a Fetchwarefile
# twice, and it's only supported once.
__clear_CONFIG();
# Sleep for 2 seconds to ensure that the new version is a least a couple of
# seconds newer than the original version. Perl is pretty fast, so it can
# actually execute this whole friggin subtest in less than one second on my
# decent desktop system.
sleep 2;
my $new_test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num => '1.01', destination_directory => $upgrade_temp_dir,
append_option => qq{user => 'ENV{FETCHWARE_NONROOT_USER}';});
my $new_test_dist_path_md5 = md5sum_file($new_test_dist_path);
# cmd_uninstall accepts a string that needs to be found in the fetchware
# database. It does *not* take Fetchwarefiles or fetchware packages as
# arguments.
like(cmd_upgrade('test-dist'), qr/test-dist-1\.01/,
'checked cmd_upgrade() success');
print_ok(sub {cmd_list()},
sub {grep({$_ =~ /test-dist-1\.01/} (split "\n", $_[0]))},
'check cmd_upgrade() success.');
# Test for when cmd_upgrade() determines that the latest version is
# installed.
# Clear internal %CONFIG variable, because I have to pare a Fetchwarefile
# twice, and it's only supported once.
__clear_CONFIG();
is(cmd_upgrade('test-dist'), 'No upgrade needed.',
'checked cmd_upgrade() latest version already installed.');
# Clean up upgrade path.
ok(unlink($old_test_dist_path, $old_test_dist_path_md5,
$new_test_dist_path, $new_test_dist_path_md5),
'checked cmd_upgrade() delete temp upgrade files');
# Clean up installed and upgraded test-dist!
ok(unlink(catfile(fetchware_database_path(), 'test-dist-1.01.fpkg')),
'checked cmd_ugprade() delete useless test-dist from package database.');
};
# Remove this or comment it out, and specify the number of tests, because doing
# so is more robust than using this, but this is better than no_plan.
#done_testing();
( run in 2.315 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )