view release on metacpan or  search on metacpan

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

#!/usr/bin/perl
# $Id$

use strict;
use Test::More;
use FindBin qw($Bin);
use File::Path;
use File::Temp qw(tempdir);
use RPM4;
use RPM4::Transaction::Problems;

if (-e '/etc/debian_version' || `uname -a` =~ /BSD/i) {
    plan skip_all => "*BSD/Debian/Ubuntu do not have a system wide rpmdb";
}

# For debugging:
#RPM4::setverbosity('DEBUG');

# Test on wrong db
RPM4::add_macro("_dbpath /dev/null");
ok(RPM4::rpmdbverify != 0, "Verify non existing database (get error)");

my $tempdir = tempdir();
my $testdir = "$tempdir/testdb";
mkdir $testdir || die $!;

RPM4::add_macro("_dbpath $testdir");

ok(RPM4::rpmdbinit == 0 || -f "$testdir/Packages", "initdb works");
ok(RPM4::rpmdbrebuild == 0, "rebuild database");
ok(RPM4::rpmdbverify == 0, "Verify empty");

my $ts;
ok($ts = RPM4::Transaction->new, "Create a new transaction");
ok($ts->traverse(sub { print STDERR $_[0]->tag(1000) . "\n" }) != -1, "ts->traverse");

ok($ts->importpubkey("$Bin/gnupg/test-key.gpg") == 0, "Importing a public key");

my $hd = RPM4::rpm2header("$Bin/test-dep-1.0-1mdk.noarch.rpm");
ok($hd, "Reading the header works");

ok($ts->transadd($hd, "$Bin/test-dep-1.0-1mdk.noarch.rpm") == 0, "Adding a package to transaction works");
ok($ts->transcheck == 0, "Checking transaction works");
ok($ts->transorder == 0, "Run transaction order");

process_problems();

ok(defined($ts->transflag([qw(TEST)])), "Set transflags");
ok($ts->transrun(\&callback) == 1, "Running test transaction with pkg obsoleting its deps");
process_problems();
ok(!defined($ts->transreset), "Resetting transaction");

my $h = RPM4::rpm2header("$Bin/test-rpm-1.0-1mdk.noarch.rpm");
ok($h, "Reading the header works");

ok($ts->transadd($h, "$Bin/test-rpm-1.0-1mdk.noarch.rpm") == 0, "Adding a package to transaction works");
ok($ts->traverse_transaction(sub { 
    ok($_[0]->fullname, "Can get name from te");
SKIP: {
# segfault on mga[2-7], aka with rpm-4.9 & rpm-4.1[04], status is unknown for 4.15
skip 'segfault on older rpm', 1  if `rpm --version` =~ /4\.(9|1[0-5])\./;
    ok($_[0]->files, "Can get files from te");
}
    ok($_[0]->type, "Can get type from te");
}), "traverse_transaction works");

ok($ts->transcheck == 0, "Checking transaction works");
ok($ts->transorder == 0, "Run transaction order");

ok(defined($ts->transflag([qw(JUSTDB)])), "Set transflags");
ok($ts->transrun(\&callback) == 0, "Running transaction justdb");
process_problems();

my $found = 0;
my $roffset;
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 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++;