rocklinux/scripts/Check-Deps-2

#!/usr/bin/perl -w

use strict;
use English;

my (@pkg, %opr, %pri, %dep, %rep, %rdp, %ign, %lop, %deldeps, %bas);
my @useddeps;	# deps used for visualization of cross dependencies
my %pkg_redone; # packages built in stages 6-8

my $config = "";

while ($_ = shift @ARGV) {
	if ( $_ eq "-cfg" ) {
		$config = shift @ARGV;
	} else {
		$ign{$_} = 1;
	}
}

print "Reading package priorities ...\n";
if ( $config eq "" ) {
	open(F, "./scripts/Create-PkgList |") || die $!;
} else {
	open(F, "< config/$config/packages") || die $!;
}
while (<F>) {
	@_ = split /\s+/;
	next if $_[1] =~ /[1234]/ or $_[1] !~ /5/;
	$pkg_redone{$_[4]} = 1 if $_[1] =~ /[678]/;
	next if defined $ign{$_[3]} || defined $ign{$_[4]};
	my ($b, $p) = ($_[4], $_[4]);
	($b, $p) = ($1, $2) if $_[4] =~ /(.*)=(.*)/;
	$opr{$p} = $_[2];
	$pri{$p} = $_[2];
	$rep{$p} = $_[3];
	$bas{$p} = $b;
	$pkg[$#pkg+1] = $p;
}
close F;

print "Reading dependency fixes ...\n";
open(F, "scripts/dep_fixes.txt") or die $!;
while (<F>) {
	chomp;
	if (/^([^#\s]\S*)\s+del\s+(.*)$/) {
		my ($p, $l) = ($1, $2);
		$deldeps{$p}{$_} = 1 foreach (split /\s+/, $l);
		next;
	}
	if (/^([^#\s]\S*)\s+add\s+(.*)$/) {
		my ($p, $l) = ($1, $2);
		foreach ( split /\s+/, $l ) {
			push @{$dep{$p}}, $_;
			push @{$rdp{$_}}, $p;
		}
		next;
	}
}
close F;

print "Reading package dependencies ...\n";
open(F, "scripts/dep_db.txt") || die $!;
while (<F>) {
	chomp;
	if ( ! /^(\S+): \d+ \d+ (.*)$/ ) {
		print "Format Error: $_\n";
		exit 1;
	}
	my ($p, $l) = ($1, $2);
	next if defined $pkg_redone{$p};
	
	foreach ( split /\s+/, $l ) {
		next if defined $deldeps{$p}{$_};
		push @{$dep{$p}}, $_;
		push @{$rdp{$_}}, $p;
	}
}
close F;

sub count_errs($) {
	my $package = $_[0];
	my $dependency;
	my $errors = 0;

	foreach $dependency (@{$dep{$package}}) {
		next unless defined $pri{$dependency};
		$errors++ if $pri{$package} < $pri{$dependency};
	}
	foreach $dependency (@{$rdp{$package}}) {
		next unless defined $pri{$dependency};
		$errors++ if $pri{$package} > $pri{$dependency};
	}

	return $errors;
}

my ($iteration, $package, $dependency, $a, $b);
my $did_something=0;

print "\nLoop    Old/New Errors  Package                   Dependency\n".
"------------------------------------------------------------------------\n";

for $iteration (1..99) {
  my $looplog = '';
  foreach $package (@pkg) {
    foreach $dependency (@{$dep{$package}}) {
	next unless defined $pri{$dependency};
	if ( $pri{$package} < $pri{$dependency} ) {
		$a = count_errs($package) + count_errs($dependency);
		$_ = $pri{$dependency};
		$pri{$dependency} = $pri{$package};
		$pri{$package} = $_;
		$b = count_errs($package) + count_errs($dependency);

		$looplog.="[$package,$dependency]";

		$_ = sprintf "[%02d]    %-7d %-7d %-25s %s\n",
		       $iteration, $a, $b, $pri{$dependency}." ".$package,
			$pri{$package}." ".$dependency;
		$useddeps[$iteration]{$package}{$dependency} = 1;
		s/   / . /g; s/\.  /.. /g; s/\.  /.. /g;
		s/\. (\s*)\./..$1./g; s/\. (\s*)\./..$1./g;
		print; $did_something=1;
	}
    }
  }
  last if $looplog eq "";
  if (defined $lop{$looplog}) {
	my %crossdeps;

	print "[XX] Detected endless-loop ".
	      "(cross-dependency) -> Aborting now.\n";
	print "[XX] Debug graph printed to dependencies.dot.\n";

	foreach my $i ($lop{$looplog} .. $iteration) {
		foreach my $p (keys %{$useddeps[$i]}) {
			foreach my $d (keys %{$useddeps[$i]{$p}}) {
				$crossdeps{$d}{$p} = 1;
			}
		}
	}

	open(F, ">dependencies.dot") || die $!;
	print F "# run this thru e.g. 'dot -Tps dependencies.dot -o dependencies.ps'\n";
	print F "digraph \"Cross-Dependencies Graph\" {\n";
	print F "	Package_X -> Has_X_in_Dep_List;\n";
	foreach my $p (sort keys %crossdeps) {
		foreach my $d (sort keys %{$crossdeps{$p}}) {
			my $p_ = $p; $p_ =~ s/[^a-z0-9]/_/g;
			my $d_ = $d; $d_ =~ s/[^a-z0-9]/_/g;
			print F "\t$p_ -> $d_;\n";
		}
	}
	print F "}\n";
	close F;

	open(F, ">dependencies.dbg") || die $!;
	foreach my $p (sort keys %crossdeps) {
		foreach my $d (sort keys %{$crossdeps{$p}}) {
			print F "$p $d\n";
		}
	}
	close F;

	system("dot -Tps dependencies.dot -o dependencies.ps");

	last;
  }
  $lop{$looplog} = $iteration;
}

sub patchfile($$$$) {
	my ($tmpfile, $descfile, $re1, $re2) = @_;

	if ( ! open(IN, $descfile) )
		{ print "ERROR: $descfile: $!\n"; return; }
	if ( ! open(OUT, ">$tmpfile") )
		{ print "ERROR: $descfile: $!\n"; close IN; return; }
	$did_something = 0;
	while (<IN>) {
		$did_something = 1 if eval "s/$re1/$re2/i";
		print OUT;
	}
	close IN; close OUT;
	if (not $did_something) {
		print "ERROR: Can't patch $descfile!\n";
		print "ERROR: Regex was s/$re1/$re2/\n";
	}
	system("diff -U 0 ./$descfile $tmpfile >> dependencies.patch");
}

sub setpri($$$$$$) {
	my ($pri, $opr, $rep, $bas, $package, $tmpfile) = @_;

	if ($bas eq "cpan") {
		my $r = $package; $r =~ s/^cpan-//g; $r =~ s/-/(-|::)/g;
		patchfile($tmpfile, "package/import/cpan/hosted_cpan.txt",
			"$opr ($r)", "$pri \$1");
		patchfile($tmpfile, "package/import/cpan/hosted_cpan.cfg",
			"(pkgfork cpan $package .*) $opr;", "\$1 $pri;");
		return;
	}

	patchfile($tmpfile, "package/$rep/$bas/$package.desc",
		"(\\[P\\] . \\S+) $opr", "\$1 $pri");
}

if ( $did_something ) {
	print "\nCreate dependencies.patch ...\n";
	my $tmpfile = `mktemp`; chomp $tmpfile;
	unlink "dependencies.patch";

	foreach $package (@pkg) {
		if ($pri{$package} != $opr{$package}) {
			print "Setting priority $pri{$package} on package $rep{$package}/$bas{$package}=$package.\n";
			setpri($pri{$package}, $opr{$package}, $rep{$package}, $bas{$package}, $package, $tmpfile);
		}
	}
	unlink $tmpfile;
	print "Done. Please check moves manually bofore applying the patch.\n";
} else {
	print "No unresolved dependencies found.\n";
}