[sisyphus] Re: sisyphus-daily?

[Alexey Tourbin]

On Wed, Nov 19, 2003 at 08:21:48PM +0300, Sergey S. Skulachenko wrote:
> Я тут же подпишусь. Процесс обновления будет более осмысленным и
> интересным.

Скрипт, который делает это "почти совсем правильно", я уже сделал. :)
Теперь только такой вопрос: кому интересно смотреть диффы от полностью
развернутых исходников, а кому нет.  Мне интересно.  Если наберется
критическое число тех, кому также интересно, то...

Но они могут быть большими, порядка 100 кб на пакет.
----------- следующая часть -----------
#!/usr/bin/perl

use Cwd qw(realpath);
use File::Temp qw(tempdir);
use Getopt::Long qw(GetOptions);
use strict;

GetOptions "deep" => \my $opt_deep;

sub tmp_unpack($) {
	my $rpm = shift;
	my $dir = tempdir(CLEANUP => 1);
	chdir $dir;
	system "rpm2cpio $rpm | cpio -idm 2>/dev/null";
	return $dir;
}

sub uncompress($) {
	my $dir = shift;
	chdir $dir;
	system "gunzip *.gz &>/dev/null";
	system "bunzip *.bz2 &>/dev/null";
	system "tar xf *.tar &>/dev/null && rm -f *.tar";
}

sub cmp_rm($$) {
	my ($f1, $f2) = @_;
	my $rv;
	if (-e $f1 && -e $f2) {
		$rv = `LC_ALL=C TZ=UTC0 diff -abBdpruw $f1 $f2`;
		system "rm -rf $f1 $f2";
	}
	return $rv;
}

sub _cmp_eq($$) {
	return $_[0] eq $_[1];
}

sub _cmp_az($$) {
	(my $az1 = $_[0]) =~ s/[^a-z]//g;
	(my $az2 = $_[1]) =~ s/[^a-z]//g;
	return $az1 eq $az2;
}

sub same_type($$) {
	my ($f1, $f2) = @_;
	return "f" if -f $f1 && -f $f2;
	return "d" if -d $f1 && -d $f2 && $opt_deep;
	return;
}

sub supercmp($$$) {
	my ($dir1, $dir2, $glob) = @_;
	my $diff;
try:	while (1) {
		foreach my $cmp_func (\&_cmp_eq, \&_cmp_az) {
			chdir $dir1; my @f1 = <*>;
			foreach my $f1 (@f1) {
				chdir $dir2; my @f2 = <*>;
				foreach my $f2 (@f2) {
					if ($cmp_func->($f1, $f2) && same_type("$dir1/$f1", "$dir2/$f2")) {
						$diff .= cmp_rm "$dir1/$f1", "$dir2/$f2";
						next try;
					}
				}
			}
		}
		last;
	}
	return $diff;
}

sub rpmcmp ($$) {
	my ($rpm1, $rpm2) = map { realpath($_) } @_;
	my ($name1, $name2) = map { /.*\/(.+?)\.src\.rpm/ } ($rpm1, $rpm2);
	-f $rpm1 or die "$rpm1: $!\n";
	-f $rpm2 or die "$rpm2: $!\n";

	my $dir1 = tmp_unpack $rpm1; uncompress $dir1;
	my $dir2 = tmp_unpack $rpm2; uncompress $dir2;

	my $diff = supercmp($dir1, $dir2, "*.spec");
	$diff .= supercmp($dir1, $dir2, "*.patch");
	$diff .= supercmp($dir1, $dir2, "*");

# see the rest
	$diff .= "End of diff\n";
	my $rest1 = `/bin/ls -AF $dir1`;
	$diff .= "\nFiles not compared in $dir1\:\n$rest1\n" if $rest1 =~ /\S/;
	my $rest2 = `/bin/ls -AF $dir2`;
	$diff .= "\nFiles not compared in $dir2\:\n$rest2\n" if $rest2 =~ /\S/;

# filter out temporary dirs
	$diff =~ s/\Q$dir1/$name1/g;
	$diff =~ s/\Q$dir2/$name2/g;
	return $diff;
}

@ARGV == 2 and -f $ARGV[0] and -f $ARGV[1] or print <<EOF and exit 1;
usage:
$0 [--deep] package1.src.rpm package2.src.rpm
EOF
print rpmcmp $ARGV[0], $ARGV[1];
----------- следующая часть -----------
Было удалено вложение не в текстовом формате...
Имя     : =?iso-8859-1?q?=CF=D4=D3=D5=D4=D3=D4=D7=D5=C5=D4?=
Тип     : application/pgp-signature
Размер  : 189 байтов
Описание: =?iso-8859-1?q?=CF=D4=D3=D5=D4=D3=D4=D7=D5=C5=D4?=
Url     : <http://lists.altlinux.org/pipermail/sisyphus/attachments/20031119/9800c231/attachment-0009.bin>