Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: 2a7bb0531b
Fetching contributors…

Cannot retrieve contributors at this time

executable file 136 lines (125 sloc) 3.748 kB
#!/usr/bin/perl -w
BEGIN {
unshift @INC, ($::ENV{'BUILD_DIR'} || '/usr/lib/build');
}
use Build;
use strict;
my $limit = 80; # throw away deltas bigger than this percentage of the reference
my %oldpkgs;
sub query {
my ($file) = @_;
return undef if $file =~ /\.(?:patch|delta)\.rpm$/; # XXX: rpmtags?
my %res = Build::Rpm::rpmq($file, qw/NAME EPOCH VERSION RELEASE ARCH SOURCERPM NOSOURCE NOPATCH 1124/);
return undef unless %res;
return undef if $res{'1124'}->[0] && $res{'1124'}->[0] eq 'drpm';
my $arch;
if ($res{'SOURCERPM'}->[0]) {
$arch = $res{'ARCH'}->[0];
} else {
# no src rpm deltas for now
# if ($res{'NOSOURCE'}->[0] || $res{'NOPATCH'}->[0]) {
# $arch = 'nosrc';
# } else {
# $arch = 'src';
# }
return undef;
}
return { file => $file, name => $res{'NAME'}->[0], epoch => $res{'EPOCH'} ? $res{'EPOCH'}->[0] : '', version => $res{'VERSION'}->[0], release => $res{'RELEASE'}->[0], arch => $arch};
}
sub lsrpms {
local *D;
if (-f "$_[0]") {
return ($_[0]) if $_[0] =~ /\.rpm$/;
return ();
}
opendir(D, $_[0]) || return ();
my @r = grep {$_ ne '.' && $_ ne '..'} readdir(D);
closedir D;
return map {"$_[0]/$_"} grep {/\.rpm$/} sort(@r);
}
while (@ARGV) {
if ($ARGV[0] eq '--limit') {
shift @ARGV;
die("--limit needs an argument\n") unless @ARGV;
$limit = shift @ARGV;
next;
}
last;
}
my $prevbuild = shift @ARGV || die "USAGE: $0 <oldpkgdir> <directories...>";
my @prevbuild = ($prevbuild);
my $i = 1;
while (-d $prevbuild.$i) {
push @prevbuild, $prevbuild.$i;
++$i;
}
for my $dir (@prevbuild) {
for my $file (lsrpms($dir)) {
my $q = query($file);
next unless $q;
my $n = $q->{'name'}.'.'.$q->{'arch'};
push @{$oldpkgs{$n}}, $q;
}
}
my $sysret = 0;
for my $dir (@ARGV) {
for my $file (lsrpms($dir)) {
my $q = query($file);
next unless $q;
my $n = $q->{'name'}.'.'.$q->{'arch'};
for my $oq (@{$oldpkgs{$n} || []}) {
my $v = $oq->{'version'};
my $r = $oq->{'release'};
if ($v eq $q->{'version'} && $r eq $q->{'release'}) {
# skip if same version and release
next;
}
$v .= '_'.$q->{'version'} unless $v eq $q->{'version'};
$r .= '_'.$q->{'release'} unless $r eq $q->{'release'};
my $dn = sprintf("%s-%s-%s.%s.drpm", $q->{'name'}, $v, $r, $q->{'arch'});
my $sn = sprintf("%s-%s-%s.%s.dseq", $q->{'name'}, $v, $r, $q->{'arch'});
print "$dn ... ";
my $dndir = $q->{'file'};
$dndir =~ s/[^\/]+$//s;
$dn = "$dndir$dn";
my $ret = system('makedeltarpm', '-s', $sn, $oq->{'file'}, $q->{'file'}, $dn);
if ($ret || ! -e $dn) {
unlink($dn);
unlink($sn);
print "FAILED\n";
$sysret = 1;
} else {
my $ns = (stat($dn))[7] || 1;
my $os = (stat($q->{'file'}))[7] || 1;
my $factor = int($ns / $os * 100);
if ($factor > $limit) {
print "too big ($factor%), removed\n";
unlink($dn);
unlink($sn);
} else {
local *F;
my $seq = '';
if (!open(F, '<', $sn)) {
print "missing sequence file, removed\n";
unlink($dn);
unlink($sn);
next;
}
1 while sysread(F, $seq, 8192, length($seq));
close F;
chomp $seq;
unlink($sn);
$seq = "Name: $q->{'name'}\nEpoch: $q->{'epoch'}\nVersion: $q->{'version'}\nRelease: $q->{'release'}\nArch: $q->{'arch'}\nOldName: $oq->{'name'}\nOldEpoch: $oq->{'epoch'}\nOldVersion: $oq->{'version'}\nOldRelease: $oq->{'release'}\nOldArch: $oq->{'arch'}\nSeq: $seq\n";
if (!open(F, '>', $sn) || syswrite(F, $seq) != length($seq) || !close(F)) {
print "sequence file write error, removed\n";
unlink($dn);
unlink($sn);
next;
}
print "ok ($factor%)\n";
}
}
}
}
}
exit $sysret;
Jump to Line
Something went wrong with that request. Please try again.