diff options
-rw-r--r-- | RPM4/lib/RPM4.pm | 42 | ||||
-rw-r--r-- | RPM4/t/01compile.t | 6 | ||||
-rw-r--r-- | RPM4/t/02header.t | 32 | ||||
-rwxr-xr-x | RPM4/t/03rpmlib.t | 6 | ||||
-rw-r--r-- | RPM4/t/04spec.t | 16 | ||||
-rw-r--r-- | RPM4/t/05transaction.t | 80 | ||||
-rw-r--r-- | RPM4/t/06sign.t | 4 | ||||
-rw-r--r-- | RPM4/t/07dep.t | 28 | ||||
-rw-r--r-- | RPM4/t/07files.t | 20 | ||||
-rw-r--r-- | RPM4/t/09hdlist.t | 6 | ||||
-rwxr-xr-x | rpmconstant/rpmh2tbl | 22 |
11 files changed, 131 insertions, 131 deletions
diff --git a/RPM4/lib/RPM4.pm b/RPM4/lib/RPM4.pm index f3885d9..5723c58 100644 --- a/RPM4/lib/RPM4.pm +++ b/RPM4/lib/RPM4.pm @@ -52,7 +52,7 @@ bootstrap RPM4; # I18N: sub N { my ($msg, @args) = @_; - sprintf($msg, @args) + sprintf($msg, @args); } sub compare_evr { @@ -60,18 +60,18 @@ sub compare_evr { my ($be, $bv, $br) = $_[1] =~ /^(?:([^:]*):)?([^-]*)(?:-(.*))?$/; my $rc = 0; - if(defined($ae) && ! defined($be)) { + if (defined($ae) && ! defined($be)) { return 1; - } elsif(!defined($ae) && defined($be)) { + } elsif (!defined($ae) && defined($be)) { return -1; } else { - $rc = RPM4::rpmvercmp($ae, $be) if (defined($ae) && defined($be)); + $rc = RPM4::rpmvercmp($ae, $be) if defined($ae) && defined($be); if ($rc == 0) { $rc = RPM4::rpmvercmp($av, $bv); if ($rc == 0) { - if(defined($ar) && !defined($br)) { + if (defined($ar) && !defined($br)) { return 1; - } elsif(!defined($ar) && defined($br)) { + } elsif (!defined($ar) && defined($br)) { return -1; } elsif (!defined($ar) && !defined($br)) { return 0; @@ -116,64 +116,64 @@ sub format_rpmpb { my @ret; foreach my $p (@msgs) { $p->{pb} eq "BADARCH" and do { - push @ret, N('package %s is intended for a different architecture', $p->{pkg}); + push @ret, N("package %s is intended for a different architecture", $p->{pkg}); next; }; $p->{pb} eq "BADOS" and do { - push @ret, N('package %s is intended for a different operating system', $p->{pkg}); + push @ret, N("package %s is intended for a different operating system", $p->{pkg}); next; }; $p->{pb} eq "PKG_INSTALLED" and do { - push @ret, N('package %s is allready installed', $p->{pkg}); + push @ret, N("package %s is allready installed", $p->{pkg}); next; }; $p->{pb} eq "BADRELOCATE" and do { - push @ret, N('path %s in package %s is not relocatable', $p->{path}, $p->{pkg}); + push @ret, N("path %s in package %s is not relocatable", $p->{path}, $p->{pkg}); next; }; $p->{pb} eq "NEW_FILE_CONFLICT" and do { - push @ret, N('file %s conflicts between attempted installs of %s and %s', $p->{file}, $p->{pkg}, $p->{pkg2}); + push @ret, N("file %s conflicts between attempted installs of %s and %s", $p->{file}, $p->{pkg}, $p->{pkg2}); next; }; $p->{pb} eq "FILE_CONFLICT" and do { - push @ret, N('file %s from install of %s conflicts with file from package %s', $p->{file}, $p->{pkg}, $p->{pkg2}); + push @ret, N("file %s from install of %s conflicts with file from package %s", $p->{file}, $p->{pkg}, $p->{pkg2}); next; }; $p->{pb} eq "OLDPACKAGE" and do { - push @ret, N('package %s (which is newer than %s) is already installed', $p->{pkg2}, $p->{pkg}); + push @ret, N("package %s (which is newer than %s) is already installed", $p->{pkg2}, $p->{pkg}); next; }; $p->{pb} eq "DISKSPACE" and do { - push @ret, N('installing package %s needs %sB on the %s filesystem', $p->{pkg}, + push @ret, N("installing package %s needs %sB on the %s filesystem", $p->{pkg}, ($p->{size} > 1024 * 1024 ? ($p->{size} + 1024 * 1024 - 1) / (1024 * 1024) - : ($p->{size} + 1023) / 1024 ) . + : ($p->{size} + 1023) / 1024) . ($p->{size} > 1024 * 1024 ? 'M' : 'K'), $p->{filesystem}); next; }; $p->{pb} eq "DISKNODES" and do { - push @ret, N('installing package %s needs %ld inodes on the %s filesystem', $p->{pkg}, $p->{nodes}, $p->{filesystem}); + push @ret, N("installing package %s needs %ld inodes on the %s filesystem", $p->{pkg}, $p->{nodes}, $p->{filesystem}); next; }; $p->{pb} eq "BADPRETRANS" and do { - push @ret, N('package %s pre-transaction syscall(s): %s failed: %s', $p->{pkg}, $p->{'syscall'}, $p->{error}); + push @ret, N("package %s pre-transaction syscall(s): %s failed: %s", $p->{pkg}, $p->{syscall}, $p->{error}); next; }; $p->{pb} eq "REQUIRES" and do { - push @ret, N('%s is needed by %s%s', $p->{pkg2}, + push @ret, N("%s is needed by %s%s", $p->{pkg2}, defined($p->{installed}) ? N("(installed) ") : "", $p->{pkg}); next; }; $p->{pb} eq "CONFLICT" and do { - push @ret, N('%s conflicts with %s%s', $p->{pkg2}, + push @ret, N("%s conflicts with %s%s", $p->{pkg2}, defined($p->{val2}) ? N("(installed) ") : "", $p->{pkg}); next; }; - }; - @ret + } + @ret; } ########################## diff --git a/RPM4/t/01compile.t b/RPM4/t/01compile.t index e2ed8ae..544188e 100644 --- a/RPM4/t/01compile.t +++ b/RPM4/t/01compile.t @@ -4,10 +4,10 @@ use Test::More tests => 3; use_ok('RPM4'); -can_ok('RPM4', qw/rpm2header stream2header dumprc dumpmacros newdb/); +can_ok('RPM4', qw(rpm2header stream2header dumprc dumpmacros newdb)); #Header # Db -can_ok('RPM4::Transaction', qw/traverse transadd transremove transcheck transorder transrun - importpubkey checkrpm transreset/); +can_ok('RPM4::Transaction', qw(traverse transadd transremove transcheck transorder transrun + importpubkey checkrpm transreset)); diff --git a/RPM4/t/02header.t b/RPM4/t/02header.t index 4ded92b..394c92e 100644 --- a/RPM4/t/02header.t +++ b/RPM4/t/02header.t @@ -10,30 +10,30 @@ use File::Temp; my $headerfile; { -my $hdr = RPM4::Header->new(); +my $hdr = RPM4::Header->new; isa_ok($hdr, "RPM4::Header", "Creating empty header works"); -ok(! defined $hdr->tag(1000), "empty tag return nothings"); +ok(! defined($hdr->tag(1000)), "empty tag return nothings"); } { my $hdr = RPM4::Header->new("$Bin/test-rpm-1.0-1mdk.src.rpm"); isa_ok($hdr, "RPM4::Header", "instanciating an header from a source rpm works"); -ok($hdr->hastag(1000) eq 1, "Has tag 1000 (NAME), yes"); -ok($hdr->hastag("NAME") eq 1, "Has 'NAME', yes"); -ok($hdr->hastag(1044) eq 0, "Has tag 1044 (SOURCERPM), yes"); -ok($hdr->listtag(), "can list tag"); +ok($hdr->hastag(1000) == 1, "Has tag 1000 (NAME), yes"); +ok($hdr->hastag("NAME") == 1, "Has 'NAME', yes"); +ok($hdr->hastag(1044) == 0, "Has tag 1044 (SOURCERPM), yes"); +ok($hdr->listtag, "can list tag"); is($hdr->tag(1000), "test-rpm", "accessing tag by id works"); is($hdr->tag("NAME"), "test-rpm", "accessing tag by name works"); is($hdr->tag("URL"), "http://rpm4.zarb.org/", "accessing tag by name works"); -is($hdr->NAME(), "test-rpm", "accessing tag directly works"); +is($hdr->NAME, "test-rpm", "accessing tag directly works"); ok($hdr->queryformat("%{NAME}-%{VERSION}-%{RELEASE}") eq "test-rpm-1.0-1mdk", "Queryformat is ok"); -ok($hdr->nevr() eq "test-rpm-1.0-1mdk", "header->nevr works"); +ok($hdr->nevr eq "test-rpm-1.0-1mdk", "header->nevr works"); ok(scalar($hdr->fullname) eq "test-rpm-1.0-1mdk.src", "scalar fullname works"); ok(join(",", $hdr->fullname) eq "test-rpm,1.0,1mdk,src", "wantarray fullname works"); ok($hdr->issrc == 1, "Is a src, Yes !"); ok($hdr->sourcerpmname eq "test-rpm-1.0-1mdk.src.rpm", "sourcerpmname works"); ok($hdr->removetag(1000) == 0, "Removing a tag"); -ok(! defined $hdr->tag(1000), "tag is not present"); +ok(!defined($hdr->tag(1000)), "tag is not present"); ok($hdr->addtag(1000, 6, "new name") == 1, "Adding a tag (string type)"); ok($hdr->tag(1000) eq "new name", "Added tag return good value"); } @@ -41,22 +41,22 @@ ok($hdr->tag(1000) eq "new name", "Added tag return good value"); { my $hdr = RPM4::Header->new("$Bin/test-rpm-1.0-1mdk.noarch.rpm"); isa_ok($hdr, "RPM4::Header", "instanciating an header from a binary rpm works"); -ok($hdr->hastag(1000) eq 1, "Has tag 1000 (NAME), yes"); -ok($hdr->tagtype(1000) eq RPM4::tagtypevalue("STRING"), "can get type of a tag"); -ok($hdr->hastag(1106) eq 0, "Has tag 1106 (SOURCEPACKAGE), no"); -ok($hdr->listtag(), "can list tag"); +ok($hdr->hastag(1000) == 1, "Has tag 1000 (NAME), yes"); +ok($hdr->tagtype(1000) == RPM4::tagtypevalue("STRING"), "can get type of a tag"); +ok($hdr->hastag(1106) == 0, "Has tag 1106 (SOURCEPACKAGE), no"); +ok($hdr->listtag, "can list tag"); is($hdr->tag(1000), "test-rpm", "accessing tag by id works"); is($hdr->tag("NAME"), "test-rpm", "accessing tag by name works"); -is($hdr->NAME(), "test-rpm", "accessing tag directly works"); +is($hdr->NAME, "test-rpm", "accessing tag directly works"); ok($hdr->queryformat("%{NAME}-%{VERSION}-%{RELEASE}") eq "test-rpm-1.0-1mdk", "Queryformat is ok"); ok(scalar($hdr->fullname) eq "test-rpm-1.0-1mdk.noarch", "scalar fullname works"); ok(join(",", $hdr->fullname) eq "test-rpm,1.0,1mdk,noarch", "wantarray fullname works"); ok($hdr->issrc == 0, "Is a src, No !"); ok($hdr->sourcerpmname eq "test-rpm-1.0-1mdk.src.rpm", "sourcerpmname works"); -$headerfile = scalar($hdr->fullname).".hdr"; +$headerfile = scalar($hdr->fullname) . ".hdr"; -my $hdrcopy = $hdr->copy(); +my $hdrcopy = $hdr->copy; ok(defined $hdrcopy, "copy works"); ok($hdrcopy->tag(1000) eq 'test-rpm', "tag 1000 (NAME) from copy works"); diff --git a/RPM4/t/03rpmlib.t b/RPM4/t/03rpmlib.t index ebedff6..13117b2 100755 --- a/RPM4/t/03rpmlib.t +++ b/RPM4/t/03rpmlib.t @@ -9,7 +9,7 @@ use RPM4; ok(! defined(RPM4::setverbosity("DEBUG")), "Set verbosity works"); { my $marker = 0; -ok(! defined(RPM4::setlogcallback(sub { my %m = @_; $marker = 1; print "$m{priority}: $m{msg}\n" } )), +ok(!defined(RPM4::setlogcallback(sub { my %m = @_; $marker = 1; print "$m{priority}: $m{msg}\n" })), "Setting log callback function works"); ok(!defined(RPM4::rpmlog("ERR", "This is a rpm debug message")), "rpmlog function works"); ok($marker == 1, "rpmlogcallback has been called"); @@ -31,9 +31,9 @@ ok(length(RPM4::buildhost), "Return buildhost"); # Playing with macros my $target_cpu = RPM4::expand("%_target_cpu"); -ok(($target_cpu !~ /^\%/), "Getting _target_cpu macro"); +ok($target_cpu !~ /^\%/, "Getting _target_cpu macro"); # setting test_macro to test -ok(RPM4::expand("%test_macro") eq "%test_macro", "\%test_macro is no set"); +ok(RPM4::expand("%test_macro") eq "%test_macro", '%test_macro is no set'); RPM4::add_macro("test_macro test"); ok(RPM4::expand("%test_macro") eq "test", "add_macro works"); RPM4::del_macro("test_macro"); diff --git a/RPM4/t/04spec.t b/RPM4/t/04spec.t index 6743cfa..38bbed0 100644 --- a/RPM4/t/04spec.t +++ b/RPM4/t/04spec.t @@ -9,8 +9,8 @@ use RPM4; my %info = RPM4::moduleinfo(); -my $testdir = tempdir( CLEANUP => 1 ); -mkdir("$testdir/$_") foreach (qw(BUILD RPMS RPMS/noarch SRPMS)); +my $testdir = tempdir(CLEANUP => 1); +mkdir("$testdir/$_") foreach qw(BUILD RPMS RPMS/noarch SRPMS); RPM4::add_macro("_tmppath $testdir"); RPM4::add_macro("_builddir $testdir"); @@ -25,9 +25,9 @@ ok(!RPM4::installsrpm("$Bin/test-rpm-1.0-1mdk.noarch.rpm"), "installsrpms works" my $spec; if ($info{Hack} eq "Yes") { - ok( defined(RPM4::Spec->new()), "Create an empty spec object"); + ok(defined(RPM4::Spec->new), "Create an empty spec object"); } else { - ok(! defined(RPM4::Spec->new()), "Create an empty spec object don't works"); + ok(! defined(RPM4::Spec->new), "Create an empty spec object don't works"); } ok(!defined($spec = RPM4::Spec->new("$Bin/test-rpm-1.0-1mdk.noarch.rpm")), "Loading a bad spec file"); ok($spec = RPM4::Spec->new("$Bin/test-rpm.spec"), "Loading a spec file"); @@ -38,10 +38,10 @@ ok($rpms[0] =~ m!noarch/test-rpm-1.0-1mdk.noarch.rpm$!, "binrpm return good valu ok($spec->srcrpm =~ m!SRPMS/test-rpm-1.0-1mdk.src.rpm$!, "srcrpm return good value"); -ok(!defined($spec->check()), "Running spec::check"); +ok(!defined($spec->check), "Running spec::check"); my $h; -ok(defined($h = $spec->srcheader()), "Geting source header before build"); +ok(defined($h = $spec->srcheader), "Geting source header before build"); ok($h->queryformat("%{NAME}") eq "test-rpm", "can querying header give by spec"); ok($spec->build([ qw(PREP) ]) == 0, "simulate rpm -bp (check prep)"); @@ -53,11 +53,11 @@ ok($spec->build([ qw(PACKAGESOURCE) ]) == 0, "simulate rpm -bs"); #ok($spec->rpmbuild("bb") == 0, "testing spec->rpmbuild(-bb)"); ok($spec->build([ qw(RMBUILD RMSOURCE) ]) == 0, "simulate cleaning spec, source, build"); -ok(defined($h = $spec->srcheader()), "Geting source header after build"); +ok(defined($h = $spec->srcheader), "Geting source header after build"); ok($h->queryformat("%{NAME}") eq "test-rpm", "can querying header give by spec"); is($h->tag("URL"), "http://rpm4.zarb.org/", "can get url give by spec"); -my ($bh) = $spec->binheader(); +my ($bh) = $spec->binheader; ok(defined($bh), "Can get binary header from spec"); ok($bh->queryformat("%{NAME}") eq "test-rpm", "can querying header give by spec"); diff --git a/RPM4/t/05transaction.t b/RPM4/t/05transaction.t index c70d765..f91b025 100644 --- a/RPM4/t/05transaction.t +++ b/RPM4/t/05transaction.t @@ -5,13 +5,13 @@ use strict; use Test::More tests => 42; use FindBin qw($Bin); use File::Path; -use File::Temp qw/tempdir/; +use File::Temp qw(tempdir); use RPM4; use RPM4::Transaction::Problems; # Test on wrong db RPM4::add_macro("_dbpath /dev/null"); -ok(RPM4::rpmdbverify() != 0, "Verify non existing database (get error)"); +ok(RPM4::rpmdbverify != 0, "Verify non existing database (get error)"); my $tempdir = tempdir(); my $testdir = "$tempdir/testdb"; @@ -19,13 +19,13 @@ 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"); +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(), "Open a new database"); -ok($ts->traverse(sub { print STDERR $_->tag(1000) . "\n"; }) != -1, "db->traverse()"); +ok($ts = RPM4::Transaction->new, "Open a new database"); +ok($ts->traverse(sub { print STDERR $_[0]->tag(1000) . "\n" }) != -1, "db->traverse"); ok($ts->importpubkey("$Bin/gnupg/test-key.gpg") == 0, "Importing a public key"); @@ -33,10 +33,10 @@ 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"); +ok($ts->transcheck == 0, "Checking transaction works"); +ok($ts->transorder == 0, "Run transaction order"); -if (0){ +if (0) { my $pbs = RPM4::Transaction::Problems->new($ts); isa_ok( $pbs, @@ -46,17 +46,17 @@ isa_ok( ok($pbs->count, "Can get number of problems"); -ok($pbs->init() || 1, "Resetting problems counter"); +ok($pbs->init || 1, "Resetting problems counter"); my $strpb; -while($pbs->hasnext()) { - $strpb .= $pbs->problem(); +while ($pbs->hasnext) { + $strpb .= $pbs->problem; } ok($strpb, "Can get problem description"); } ok(defined($ts->transflag([qw(TEST)])), "Set transflags"); #ok($ts->transrun([ qw(LABEL PERCENT) ]) == 0, "Running transaction justdb"); -ok(!defined($ts->transreset()), "Resetting transaction"); +ok(!defined($ts->transreset), "Resetting transaction"); my $h = RPM4::rpm2header("$Bin/test-rpm-1.0-1mdk.noarch.rpm"); ok($h, "Reading the header works"); @@ -67,21 +67,21 @@ ok($ts->traverse_transaction(sub { 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($ts->transcheck == 0, "Checking transaction works"); +ok($ts->transorder == 0, "Run transaction order"); ok(defined($ts->transflag([qw(JUSTDB)])), "Set transflags"); -ok($ts->transrun( sub { my %a = @_; print STDERR "$a{what} $a{filename} $a{amount} / $a{total}\n"; }) == 0, "Running transaction justdb"); +ok($ts->transrun(sub { my %a = @_; print STDERR "$a{what} $a{filename} $a{amount} / $a{total}\n" }) == 0, "Running transaction justdb"); #ok($ts->injectheader($hd) == 0, "Injecting header in a db"); my $found = 0; -my ($rhf, $roffset); -ok($ts->traverse( sub { +my $roffset; +ok($ts->traverse(sub { my ($hf, $offset) = @_; - scalar($hf->fullname()) eq "test-dep-1.0-1mdk.noarch" and do { + scalar($hf->fullname) eq "test-dep-1.0-1mdk.noarch" and do { $found++; - ($rhf, $roffset) = ($hf, $offset); + (undef, $roffset) = ($hf, $offset); }; 1; }), "Running traverse"); @@ -94,49 +94,49 @@ $ts = undef; # explicitely calling DESTROY to close database ok($ts = RPM4::newdb(1), "Open existing database"); $found = 0; -($rhf, $roffset) = (undef, undef); -ok($ts->traverse( sub { +$roffset = undef; +ok($ts->traverse(sub { my ($hf, $offset) = @_; - scalar($hf->fullname()) eq "test-rpm-1.0-1mdk.noarch" and do { + scalar($hf->fullname) eq "test-rpm-1.0-1mdk.noarch" and do { $found++; - ($rhf, $roffset) = ($hf, $offset); - } + (undef, $roffset) = ($hf, $offset); + }; }), "Running traverse"); ok($found == 1, "The previously installed rpm is found"); ok($roffset > 0, "Retrieve offset db"); #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->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($ts->transorder == 0, "Run transaction order"); +ok($ts->transcheck == 0, "Checking transaction works"); ok(defined($ts->transflag([qw(JUSTDB)])), "Set transflags"); #ok($ts->transrun([ qw(LABEL PERCENT) ]) == 0, "Running transaction justdb"); $found = 0; -ok($ts->traverse( sub { +ok($ts->traverse(sub { my ($hf, $offset) = @_; - scalar($hf->fullname()) eq "test-rpm-1.0-1mdk.noarch" and do { + scalar($hf->fullname) eq "test-rpm-1.0-1mdk.noarch" and do { $found++; - ($rhf, $roffset) = ($hf, $offset); - } + (undef, $roffset) = ($hf, $offset); + }; }), "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->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"); +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"); diff --git a/RPM4/t/06sign.t b/RPM4/t/06sign.t index 5ce13ff..4a8817a 100644 --- a/RPM4/t/06sign.t +++ b/RPM4/t/06sign.t @@ -10,11 +10,11 @@ use RPM4; my $passphrase = "RPM4"; -my $testdir = tempdir( CLEANUP => 1 ); +my $testdir = tempdir(CLEANUP => 1); RPM4::add_macro("_dbpath $testdir"); -copy("$Bin/test-rpm-1.0-1mdk.noarch.rpm", "$testdir"); +copy("$Bin/test-rpm-1.0-1mdk.noarch.rpm", $testdir); RPM4::add_macro("_signature gpg"); RPM4::add_macro("_gpg_name RPM4 test key"); diff --git a/RPM4/t/07dep.t b/RPM4/t/07dep.t index 2dd352f..f4552a3 100644 --- a/RPM4/t/07dep.t +++ b/RPM4/t/07dep.t @@ -7,7 +7,7 @@ use FindBin qw($Bin); use RPM4; use RPM4::Header::Dependencies; -my %minfo = RPM4::moduleinfo; +my %_minfo = RPM4::moduleinfo; isa_ok( RPM4::rpmlibdep(), @@ -41,7 +41,7 @@ isa_ok( '$hdep->dep("PROVIDENAME")' ); ok( - ! defined $hdep->dep("TRIGGERNAME"), + ! defined($hdep->dep("TRIGGERNAME")), "fetching triggers returns undef" ); @@ -65,27 +65,27 @@ ok(! $htest->is_better_than($hdep), "test-rpm better than test-dep: no"); my ($dep1, $dep2, $dep3); isa_ok( RPM4::Header::Dependencies->new("REQUIRENAME", - [ "test-rpm", [ qw/LESS EQUAL/ ], "1.0-1mdk" ] + [ "test-rpm", [ qw(LESS EQUAL) ], "1.0-1mdk" ] ), 'RPM4::Header::Dependencies', 'New REQUIRENAME dependencies' ); -ok($dep1 = RPM4::newdep("REQUIRENAME", "test-rpm", [ qw/LESS EQUAL/ ], "1.0-1mdk"), "Build a new dep"); -ok($dep2 = RPM4::newdep("REQUIRENAME", "test-rpm", [ qw/GREATER EQUAL/ ], "1.0-1mdk"), "Build a new dep"); +ok($dep1 = RPM4::newdep("REQUIRENAME", "test-rpm", [ qw(LESS EQUAL) ], "1.0-1mdk"), "Build a new dep"); +ok($dep2 = RPM4::newdep("REQUIRENAME", "test-rpm", [ qw(GREATER EQUAL) ], "1.0-1mdk"), "Build a new dep"); ok($dep3 = RPM4::newdep("REQUIRENAME", "test-rpm", [ "GREATER" ], "1.0-1mdk"), "Build a new dep"); -is($dep1->count(), 1, "dependencies number"); -ok(defined($dep1->move()), "Can move into dep"); -ok($dep1->next() == -1, "no further dependency"); +is($dep1->count, 1, "dependencies number"); +ok(defined($dep1->move), "Can move into dep"); +ok($dep1->next == -1, "no further dependency"); -ok($dep1->add("test-dep", [ qw/LESS EQUAL/ ], "1.0-1mdk"), "Add a dep entry into existing dep"); +ok($dep1->add("test-dep", [ qw(LESS EQUAL) ], "1.0-1mdk"), "Add a dep entry into existing dep"); -ok(scalar($dep1->info()) eq "R test-rpm <= 1.0-1mdk", "Can get info from RPM4::Header::Dep"); -ok(($dep1->info())[3] eq "1.0-1mdk", "Can get info from RPM4::Header::Dep"); -ok($dep1->name() eq 'test-rpm', "Get dep name from RPM4::Header::Dep"); -ok($dep1->flags(), "Get dep flags from RPM4::Header::Dep"); -ok($dep1->evr() eq '1.0-1mdk', "Get dep evr from RPM4::Header::Dep"); +ok(scalar($dep1->info) eq "R test-rpm <= 1.0-1mdk", "Can get info from RPM4::Header::Dep"); +ok(($dep1->info)[3] eq "1.0-1mdk", "Can get info from RPM4::Header::Dep"); +ok($dep1->name eq 'test-rpm', "Get dep name from RPM4::Header::Dep"); +ok($dep1->flags, "Get dep flags from RPM4::Header::Dep"); +ok($dep1->evr eq '1.0-1mdk', "Get dep evr from RPM4::Header::Dep"); ok($dep1->overlap($dep2), "compare two dep"); ok($dep1->overlap($dep3) == 0, "compare two dep"); diff --git a/RPM4/t/07files.t b/RPM4/t/07files.t index 8ca7e80..f5ac229 100644 --- a/RPM4/t/07files.t +++ b/RPM4/t/07files.t @@ -9,31 +9,31 @@ use RPM4; my $htest = RPM4::Header->new("$Bin/test-rpm-1.0-1mdk.noarch.rpm"); isa_ok($htest, 'RPM4::Header', '$htest'); -my $files = $htest->files(); +my $files = $htest->files; isa_ok($files, 'RPM4::Header::Files', '$files'); is( - $files->count(), + $files->count, 1, "files count OK" ); like( - $files->filename(), + $files->filename, qr!^/!, "filename OK" ); like( - $files->dirname(), + $files->dirname, qr!^/!, "dirname OK" ); -ok(defined($files->basename()), "Can get Files::basename()"); -ok(defined($files->fflags()), "Can get Files::fflags()"); +ok(defined($files->basename), "Can get Files::basename"); +ok(defined($files->fflags), "Can get Files::fflags"); is( - $files->md5(), + $files->md5, "6e5e49d3e3743eb3d5737ce8aca1fb02", "md5 is OK" ); -ok(!defined($files->link()), "Can get Files::link()"); -ok(defined($files->mode()), "Can get Files::mode()"); -ok($files->mode() > 0, "Files::mode() is positive value"); +ok(!defined($files->link), "Can get Files::link"); +ok(defined($files->mode), "Can get Files::mode"); +ok($files->mode > 0, "Files::mode is positive value"); diff --git a/RPM4/t/09hdlist.t b/RPM4/t/09hdlist.t index ce45371..1027b2c 100644 --- a/RPM4/t/09hdlist.t +++ b/RPM4/t/09hdlist.t @@ -7,15 +7,15 @@ use FindBin qw($Bin); use File::Temp qw(tempdir); use File::Glob; -my $testdir = tempdir( CLEANUP => 1 ); +my $testdir = tempdir(CLEANUP => 1); use_ok('RPM4'); use_ok('RPM4::Index'); my @headers; -my $callback = sub { my %arg = @_; defined($arg{header}) and push(@headers, $arg{header}); }; +my $callback = sub { my %arg = @_; defined($arg{header}) and push(@headers, $arg{header}) }; -my @rpms = <$Bin/*.rpm>; +my @rpms = glob("$Bin/*.rpm"); RPM4::parserpms(callback => $callback, rpms => [ @rpms ]); ok(scalar(@headers) == 4, "RPM4::parserpms works"); diff --git a/rpmconstant/rpmh2tbl b/rpmconstant/rpmh2tbl index a198526..3f989c8 100755 --- a/rpmconstant/rpmh2tbl +++ b/rpmconstant/rpmh2tbl @@ -129,7 +129,7 @@ my $ch = *STDOUT; sub parseconst { my ($header) = @_; - my ($hbasename) = $header =~ m#(?:.*/)(.*)$#; + my ($hbasename) = $header =~ m!(?:.*/)(.*)$!; my $hconstant = $file_const{$hbasename} or return; open(my $hheader, "<", $header) or die "Can't open $header\n"; @@ -138,14 +138,14 @@ sub parseconst { my $i; my $line = <$hheader>; - $line =~ /^\s*#\s*ifndef\s+(\S+)/; - my $headerdef = $1 if($1); + my $headerdef; + $headerdef = $1 if $line =~ /^\s*#\s*ifndef\s+(\S+)/; while ($line = <$hheader>) { - $line =~ s#^\s*/\*[^\*]*\*/##; + $line =~ s!^\s*/\*[^\*]*\*/!!; my ($w, $c) = $line =~ m!(?:#\s*define\s*)?([\w_]+)[^(/\*)]*(/\*.*\*/)?!; defined($w) or next; - foreach my $regexp (keys %{$hconstant}) { + foreach my $regexp (keys %$hconstant) { if ($w =~ /$regexp/) { $constants_found{$hconstant->{$regexp}}{$w}{n} ||= ++$i; $constants_found{$hconstant->{$regexp}}{$w}{c} ||= $c; @@ -156,7 +156,7 @@ sub parseconst { close($hheader); - while (my ($tbl, $const) = each (%constants_found)) { + while (my ($tbl, $const) = each %constants_found) { $tableprefix{$tbl} ||= ""; print $ch <<EOF; @@ -166,12 +166,12 @@ sub parseconst { EOF printf $ch "static const struct rpmconstant_s %sctbl[] = {\n", $tbl; - print $ch "#ifdef $headerdef\n" if ($headerdef); + print $ch "#ifdef $headerdef\n" if $headerdef; foreach my $c (sort { $const->{$a}{n} <=> $const->{$b}{n} } keys %$const) { - printf $ch "\t{ \"%s\", %s }, %s\n", + printf $ch qq(\t{ "%s", %s }, %s\n), uc($const->{$c}{s} || $c), $c, $const->{$c}{c} || ""; } - print $ch "#endif /* $headerdef */\n" if ($headerdef); + print $ch "#endif /* $headerdef */\n" if $headerdef; printf $ch "\t{ %s, %s } /* NULL terminated (%s) */\n", "NULL", "0", $tbl; print $ch "};\n"; printf $ch "const struct rpmconstant_s * %sctable = %sctbl;\n\n", $tbl, $tbl; @@ -203,9 +203,9 @@ foreach (@ARGV) { print $ch "static const struct rpmconstantlist_s rpmconstanttp[] = {\n"; foreach (sort(@availlabletables)) { printf $ch "\t{ %s, %s, %s },\n", - '(void *)'.$_."ctbl", + '(void *)' . $_ . "ctbl", '"' . lc($_) . '"', - $tableprefix{$_} ? "\"$tableprefix{$_}\"" : "NULL"; + $tableprefix{$_} ? qq("$tableprefix{$_}") : "NULL"; } printf $ch "\t{ %s, %s, %s } /* NULL terminated */\n", "(void *) NULL", "NULL", "NULL"; print $ch "};\n"; |