mkdrpms

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4   unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
   5 }
   6
   7 use Build;
   8 use strict;
   9
  10 my $limit = 80; # throw away deltas bigger than this percentage of the reference
  11 my %oldpkgs;
  12
  13 sub query
  14 {
  15     my $file = shift;
  16     return undef if $file =~ /\.(?:patch|delta)\.rpm$/; # XXX: rpmtags?
  17     my %res = Build::Rpm::rpmq($file, qw/NAME VERSION RELEASE ARCH SOURCERPM NOSOURCE NOPATCH 1124/);
  18     return undef unless %res;
  19     return undef if $res{'1124'}->[0] && $res{'1124'}->[0] eq 'drpm';
  20     my $arch;
  21     if ($res{'SOURCERPM'}->[0]) {
  22         $arch = $res{'ARCH'}->[0];
  23     } else {
  24 #       if ($res{'NOSOURCE'}->[0] || $res{'NOPATCH'}->[0]) {
  25 #           $arch = 'nosrc';
  26 #       } else {
  27 #           $arch = 'src';
  28 #       }
  29         return undef;
  30     }
  31     return { name => $res{'NAME'}->[0], file => $file, version => $res{'VERSION'}->[0], release => $res{'RELEASE'}->[0], arch => $arch};
  32 }
  33
  34 while (@ARGV) {
  35   if ($ARGV[0] eq '--limit') {
  36     shift @ARGV || die "--limit needs an argument\n";
  37     $limit = shift @ARGV;
  38     next;
  39   }
  40   last;
  41 }
  42
  43 my $prevbuild = shift @ARGV || die "USAGE: $0 <oldpkgdir> <directories...>";
  44 my @prevbuild = ($prevbuild);
  45 my $i = 1;
  46 while (-e $prevbuild.$i) {
  47     push @prevbuild, $prevbuild.$i;
  48     ++$i;
  49 }
  50 for my $dir (@prevbuild) {
  51     for my $file (glob $dir.'/*.rpm') {
  52         my $q = query($file);
  53         next unless $q;
  54         my $n = $q->{'name'}.'.'.$q->{'arch'};
  55         push @{$oldpkgs{$n}}, $q;
  56     }
  57 }
  58
  59 my $sysret = 0;
  60 for my $dir (@ARGV) {
  61     for my $file (glob $dir.'/*.rpm') {
  62         my $q = query($file);
  63         next unless $q;
  64         my $n = $q->{'name'}.'.'.$q->{'arch'};
  65         next unless exists $oldpkgs{$n};
  66         for my $old (@{$oldpkgs{$n}}) {
  67             my $v = $old->{'version'};
  68             my $r = $old->{'release'};
  69             if ($v eq $q->{'version'} && $r eq $q->{'release'}) {
  70                 # skip if same version and release
  71                 next;
  72             }
  73             $v .= '_'.$q->{'version'} unless $v eq $q->{'version'};
  74             $r .= '_'.$q->{'release'} unless $r eq $q->{'release'};
  75             my $on = $old->{'file'};
  76             my $nn = $q->{'file'};
  77             my $dn = sprintf("%s-%s-%s.%s.drpm", $q->{'name'}, $v, $r, $q->{'arch'});
  78             print "$dn ... ";
  79             $dn = $dir.'/'.$dn;
  80             my $ret = system('makedeltarpm', $on, $nn, $dn);
  81             if ($ret || ! -e $dn) {
  82                 print "FAILED\n";
  83                 $sysret = 1;
  84             } else {
  85                 my $ns = (stat($dn))[7] || 1;
  86                 my $os = (stat($file))[7] || 1;
  87                 my $factor = int($ns / $os * 100);
  88                 if ($factor > $limit) {
  89                     print "too big ($factor%), removed\n";
  90                     unlink $dn;
  91                 } else {
  92                     print "ok ($factor%)\n";
  93                 }
  94             }
  95         }
  96     }
  97 }
  98
  99 exit $sysret;