view release on metacpan or  search on metacpan

t/05transaction.t  view on Meta::CPAN

        };
        1;
    }), "Running traverse on transaction");

ok($found, "Can find header in transaction");

$ts = undef; # explicitely calling DESTROY to close database

# FIXME/TODO: rename as $db?
ok($ts = RPM4::newdb(1), "Open existing database");
$found = 0;

$roffset = undef;
ok($ts->traverse(sub {
        my ($hf, $offset) = @_;
        scalar($hf->fullname) eq "test-rpm-1.0-1mdk.noarch" and do {
            $found++;
            (undef, $roffset) = ($hf, $offset);
        };
        1;
    }), "Running traverse on DB");

ok($found == 1, "The previously installed rpm is found");
ok($roffset > 0, "Retrieve offset db");

ok($ts->transremove_pkg("foobar") == 0, "Try to remove a non existing rpm");
ok($ts->transremove_pkg("test-rpm(1.0-1mdk)") == 1, "Try to remove a rpm");
ok($ts->transcheck == 0, "Checking transaction works");
ok(!defined($ts->transreset), "Reseting current transaction");

ok($ts->transremove($roffset), "Removing pkg from header and offset");
ok($ts->transorder == 0, "Run transaction order");
ok($ts->transcheck == 0, "Checking transaction works");
ok(defined($ts->transflag([qw(JUSTDB)])), "Set transflags");
SKIP: {
# rpmal.c:293: rpmalAdd: Assertion `dspool == ((void *)0) || dspool == al->pool' failed.
# on at least mga[3-7], aka with rpm-4.1[14], status is unknown for 4.10 & 4.15
skip 'assertion failure on older rpm', 1  if `rpm --version` =~ /4\.1[0-5]\./;
ok($ts->transrun(\&callback) == 0, "Running transaction justdb");
process_problems();

$found = 0;

ok($ts->traverse(sub {
        my ($hf, $offset) = @_;
        scalar($hf->fullname) eq "test-rpm-1.0-1mdk.noarch" and do {
            $found++;
            (undef, $roffset) = ($hf, $offset);
        };
        1;
    }), "Running traverse");

ok($found == 0, "The previously removed rpm is not found");
};

ok($ts->transadd($h, "test-rpm-1.0-1mdk.noarch.rpm", 1, "/usr", 1) == 0, "Adding a package to transaction with prefix");
ok($ts->transorder == 0, "Run transaction order");
ok($ts->transcheck == 0, "Checking transaction works");
ok(!defined($ts->transreset), "Reseting current transaction");

ok($ts->transadd($h, "test-rpm-1.0-1mdk.noarch.rpm", 1, {"/etc" => "/usr" }, 1) == 0, "Adding a package to transaction with relocation works");
ok($ts->transorder == 0, "Run transaction order");
ok($ts->transcheck == 0, "Checking transaction works");
ok(!defined($ts->transreset), "Reseting current transaction");

{
my $spec = $ts->newspec("$Bin/test-rpm.spec");
isa_ok($spec, 'RPM4::Spec', 'ts->newspec');
}

$ts = undef; # explicitely calling DESTROY to close database
rmtree($tempdir);

done_testing();

sub callback {
    my %a = @_;
    print STDERR "$a{what} $a{amount} / $a{total}\n";
}

sub process_problems() {
    my $pbs = RPM4::Transaction::Problems->new($ts);
    return if !$pbs;
    isa_ok(
	$pbs,
	'RPM4::Transaction::Problems',
	'Can retrieve pb from transaction'
	);

    ok($pbs->count, "Can get number of problems");

    ok($pbs->init || 1, "Resetting problems counter");
    my $strpb;
    while ($pbs->hasnext) {
	$strpb .= $pbs->problem;
    }
    warn "Transaction problems: $strpb\n";
    ok($strpb, "Can get problem description");
}