lib/Fedora/Rebuild/RPM.pm

   1 package Fedora::Rebuild::RPM;
   2 use strict;
   3 use warnings;
   4 use Moose;
   5 use File::Path;
   6 use RPM2;
   7 use RPM::VersionCompare;
   8 use namespace::clean;
   9
  10 use version 0.77; our $VERSION = version->declare("v0.8.0");
  11
  12 # FLAGS defined in <rpm/rpmds.h> in enum rpmsenseFlags_e:
  13 use constant {
  14     ANY => 0x0,
  15     LESS => 0x2,
  16     GREATER => 0x4,
  17     EQUAL => 0x8
  18 };
  19
  20 # Return string representation of dependency FLAG qualifier (LESS|EQUAL, ...).
  21 # ANY is represented as an asterisk. Higher bits of flag are ignored.
  22 # XXX This is not a method.
  23 sub flag_as_string {
  24     my $flag = $_[0];
  25     my $text = '';
  26
  27     if ($flag & LESS) { $text .= '<'; }
  28     if ($flag & GREATER) { $text .= '>'; }
  29     if ($flag & EQUAL) { $text .= '='; }
  30     if ($text eq '') { $text = '*'; }
  31
  32     return $text;
  33 }
  34
  35 # Add $needles dependecies into $stash dependecies. The $stash will be
  36 # modified. It does not compact overlapping dependencies because provides and
  37 # requires have opposite ordering. It removes identical dependencies only.
  38 # The added dependency is not copied deeply. All references remain unchaged.
  39 # Hash format is { NAME1 => [ [FLAG1, VERSION1], [FLAG2, VERSION2] ] }.
  40 # XXX: This is not a method.
  41 sub adddeps {
  42     my ($stash, $needles) = @_;
  43     for my $needle (keys %{$needles}) {
  44         if (exists $$stash{$needle}) {
  45             my @subneedles = @{$$needles{$needle}};
  46             my @substraws = @{$$stash{$needle}};
  47             NEEDLE: for (my $n = 0; $n <= $#subneedles; $n++) {
  48                 STRAW: for (my $s = 0; $s <= $#substraws; $s++) {
  49                     if ($subneedles[$n][0] eq $substraws[$s][0] &&
  50                         $subneedles[$n][1] eq $substraws[$s][1]) {
  51                         next NEEDLE;
  52                     }
  53                 }
  54                 push @{$$stash{$needle}}, $subneedles[$n];
  55             }
  56         } else  {
  57             $$stash{$needle} = $$needles{$needle};
  58         }
  59     }
  60 }
  61
  62 # Check whether a requires tripplet (name, flag, version) is fulfilled by
  63 # hash of provides. Return true or false (even in parser error).
  64 # Hash format is { NAME1 => [ [FLAG1, VERSION1], [FLAG2, VERSION2] ] }.
  65 # XXX: FLAG cannot be LESS|GREATER. Not implemented.
  66 # XXX: This is not a method.
  67 sub is_satisfied {
  68     my ($rname, $rflag, $rversion, $provides) = @_;
  69
  70     if (! (exists $$provides{$rname})) {
  71         return 0;
  72     }
  73
  74     for my $provide (@{$$provides{$rname}}) {
  75         my $pflag = $$provide[0];
  76         my $pversion = $$provide[1];
  77
  78         if (($rflag & (LESS|GREATER|EQUAL)) == ANY ||
  79             ($pflag & (LESS|GREATER|EQUAL)) == ANY) {
  80             return 1;
  81         }
  82
  83         my $order = RPM::VersionCompare::labelCompare($rversion, $pversion);
  84         if (!defined $order) {
  85             # Parser error;
  86             return 0;
  87         }
  88
  89         # Satisfaction matrix:
  90         #
  91         # (labelCompare($rversion,$pversion) = $order) == 0:
  92         #           pflag
  93         #           <   <=  ==  >=  >
  94         # rflag <   1   1   0   0   0
  95         #       <=  1   1   1   1   0
  96         #       ==  0   1   1   1   0
  97         #       =>  0   1   1   1   1
  98         #       >   0   0   0   1   1
  99         #
 100         if ($order == 0) {
 101             if (($rflag & EQUAL) && ($pflag & EQUAL)) { return 1; }
 102             if (($rflag & LESS) && ($pflag & LESS)) { return 1; }
 103             if (($rflag & GREATER) && ($pflag & GREATER)) { return 1; }
 104         }
 105
 106         # (labelCompare($rversion,$pversion) = $order) > 0:
 107         #           pflag
 108         #           <   <=  ==  >=  >
 109         # rflag <   1   1   1   1   1
 110         #       <=  1   1   1   1   1
 111         #       ==  0   0   0   1   1
 112         #       =>  0   0   0   1   1
 113         #       >   0   0   0   1   1
 114         #
 115         if ($order > 0) {
 116             if (($rflag & LESS) || ($pflag & GREATER)) { return 1; }
 117         }
 118
 119         # (labelCompare($rversion,$pversion) = $order) < 0:
 120         #           pflag
 121         #           <   <=  ==  >=  >
 122         # rflag <   1   1   0   0   0
 123         #       <=  1   1   0   0   0
 124         #       ==  1   1   0   0   0
 125         #       =>  1   1   1   1   1
 126         #       >   1   1   1   1   1
 127         #
 128         if ($order < 0) {
 129             if (($rflag & GREATER) || ($pflag & LESS)) { return 1; }
 130         }
 131     }
 132
 133     return 0;
 134 }
 135
 136
 137 has 'name' => (is => 'ro', isa => 'Str', required => 1);
 138
 139
 140 # Load local RPM package and return the Header object and package ENVR
 141 sub open_package {
 142     my $self = shift;
 143
 144     my $headers;
 145     if (!eval { $headers = RPM2->open_package($self->name); }) {
 146         $@ = "Could not load RPM package `" . $self->name . "': ". $@;
 147         return undef;
 148     }
 149
 150     my $envr = $headers->as_nvre;
 151     if (! defined $envr) {
 152         $@ = "Could not get ENVR of RPM package`" . $self->name . "'";
 153         return undef;
 154     }
 155
 156     return ($headers, $envr);
 157 }
 158
 159
 160 # Destile provides from local RPM package.
 161 # Return reference to hash of provides and ENVR string of the package in this
 162 # order.
 163 # In case of failure, return undef and set $@.
 164 # Hash format is { NAME1 => [ [FLAG1, VERSION1], [FLAG2, VERSION2] ] }.
 165 sub provides {
 166     my $self = shift;
 167
 168     my ($headers, $envr) = $self->open_package();
 169     if (! defined $headers || ! defined $envr) {
 170         return undef;
 171     }
 172
 173     my @names = $headers->tag('PROVIDENAME');
 174     my @flags = $headers->tag('PROVIDEFLAGS');
 175     my @versions = $headers->tag('PROVIDEVERSION');
 176     if (!($#names == $#flags) && ($#names == $#versions)) {
 177         $@ = "Inconsistent number of provides names, flags, and versions in `"
 178             . $self->name . "' RPM package";
 179         return undef;
 180     }
 181
 182     my %provides;
 183     while (
 184             my $name = shift @names,
 185             my $flag = shift @flags,
 186             defined(my $version = shift @versions)
 187     ) {
 188         # ???: Filter some higher flag bits?
 189         if (!exists $provides{$name}) { $provides{$name} = []; }
 190         push @{$provides{$name}}, [$flag, $version];
 191     }
 192
 193     return (\%provides, $envr);
 194 }
 195
 196
 197 # Destile requires from local RPM package.
 198 # Return reference to hash of requires or in case of failure, return undef
 199 # and set $@.
 200 # Hash format is { NAME1 => [ [FLAG1, VERSION1], [FLAG2, VERSION2] ] }.
 201 sub requires {
 202     my $self = shift;
 203
 204     my ($headers, $envr) = $self->open_package();
 205     if (! defined $headers || ! defined $envr) {
 206         return undef;
 207     }
 208
 209     my @names = $headers->tag('REQUIRENAME');
 210     my @flags = $headers->tag('REQUIREFLAGS');
 211     my @versions = $headers->tag('REQUIREVERSION');
 212     if (!($#names == $#flags) && ($#names == $#versions)) {
 213         $@ = "Inconsistent number of requires names, flags, and versions in `"
 214             . $self->name . "' RPM package";
 215         return undef;
 216     }
 217
 218     my %requires;
 219     while (
 220             my $name = shift @names,
 221             my $flag = shift @flags,
 222             defined(my $version = shift @versions)
 223     ) {
 224         # ???: Filter some higher flag bits?
 225         if (!exists $requires{$name}) { $requires{$name} = []; }
 226         push @{$requires{$name}}, [$flag, $version];
 227     }
 228
 229     return (\%requires, $envr);
 230 }
 231
 232 1;