convert_to_repomd

#!/usr/bin/perl
#
# convert the crappy stuff to repomd for easier handling
# Author: Ludwig Nussel, 2011
#
# TODO:
# 1. include all archs at the same time via extended syntax
# 2. include translations
# 4. generate yast2 style sel files from the repomd files
# 5. generate patterns-openSUSE-* packages from repomd files
# 6. get rid of the old crap
# 7. profit!
#
# http://de.opensuse.org/Standards/RPM_Metadata/repomd
# http://en.opensuse.org/openSUSE:Standards_Rpm_Metadata_patterns

use strict;
#use YAML qw/Dump Load DumpFile LoadFile/;
#use Data::Dumper;

my $version = "12.1";
my $release = "99";
my $arch = 'x86_64';

my @want = @ARGV;

my %sel;

opendir (my $dh, "data") || die "$!";
%sel = map { $_ => undef } grep { !/\.\.?/ } readdir($dh);
closedir $dh;

sub read_pkg_list($;$)
{
	my $fn = shift;
	my $forcetype = shift;
	my $fh;
	unless (open ($fh, '<', "$fn")) {
		warn "$fn: $!";
		next;
	}
	my $data = {};
	my $nested = 0;
	my $type;
	my $exclarch;
	my $onlyarch;
	while (<$fh>) {
		chomp;
		s/\/\/.*//;
		if (s/^#if\s*//) {
			++$nested;
			die "nesting not supported\n" if $nested > 1;
			my @d = split(/\|\|/);
			for (@d) {
				my $neg = s/^!//;
				die "invalid define \"$_\"\n" unless s/^ *defined//;
				s/ +//g;
				s/\(?__(.+)__\)?/\1/;
				if ($neg) {
					push @$exclarch, $_;
				} else {
					push @$onlyarch, $_;
				}
			}
			next;
		}
		if (/^#else/) {
			my $x = $exclarch;
			$exclarch = $onlyarch;
			$onlyarch = $x;
			next;
		}
		if (/^#endif/) {
			--$nested;
			$exclarch = undef;
			$onlyarch = undef;
			die "too many endif\n" if $nested < 0;
			next;
		}
		if (/^#/) {
			warn "unknown preprocessor directive \"$_\" ignored";
			next;
		}
		s/^ +//; s/ +$//;
		next if /^$/;
		if ($forcetype) {
			$type = $forcetype;
		} else {
			if (/^\+P(cn|rc|rq|sg)/) {
				$type = $1;
				next;
			}
			if (/^-P(cn|rc|rq|sg)/) {
				$type = undef;
				next;
			}
		}
		if ($type) {
			my $c = undef;
		       	$c->{'excl'} = [ @$exclarch ] if $exclarch;
		       	$c->{'arch'} = [ @$onlyarch ] if $onlyarch;
			$data->{$type}->{$_} = $c;
		} else {
			warn "line without type: $_";
		}
	}
	close $fh;
	if ($forcetype) {
		return $data->{$forcetype};
	}
	return $data;
}

for my $f (keys %sel) {
	next if $f =~ /^\.\.?/;
	my $fn = "data/$f";
	$sel{$f} = read_pkg_list($fn);
}

#print STDERR Dump(\%sel);

my %toinstall;

opendir (my $dh, "toinstall") || die "$!";
%toinstall = map { $_ => undef } grep { !/\.\.?/ } readdir($dh);
closedir $dh;

sub slurp($) {
	my $fh;
	return undef unless (open($fh, '<', $_[0]));
	my @c = grep { chomp; $_ } <$fh>;
	close $fh;
	if (@c > 1) {
		return [ @c ];
	} else {
		return $c[0];
	}
}

for my $f (keys %toinstall) {
	for my $tag (qw/category icon order role sel visible/) {
		my $fn = "toinstall/$f/$tag";
		unless (-r $fn) {
			warn "$f lacks tag '$tag'";
			next;
		}
		$toinstall{$f}->{$tag} = slurp($fn);
	}
	for my $tag (qw/conflicts extends freshens obsoletes provides recommends requires supplements/) {
		my $fn = "toinstall/$f/$tag";
		next unless -r $fn;
		$toinstall{$f}->{$tag} = read_pkg_list($fn, $tag);
	}
}

#print Dump(\%toinstall);

### now dump repomd patterns

sub archok($)
{
	my $h = shift;
	return 1 unless $h && ref $h eq 'HASH';
	if ($h->{'arch'}) {
		return 1 if grep { $_ eq $arch} @{$h->{'arch'}};
		return 0;
	}
	if ($h->{'excl'}) {
		return 0 if grep { $_ eq $arch} @{$h->{'excl'}};
		return 1;
	}
	return 1;
}

sub tag($$)
{
	my $tag = shift;
	my $value = shift;
	sprintf("<%s>%s</%s>\n", $tag, $value, $tag);
}

sub rpmentry($)
{
	my $n = shift;
	my @e = split(/ +/, $n);
	my %flagmap = (
		'<' => 'LT',
		'<=' => 'LE',
		'>' => 'GT',
		'>=' => 'GE',
		'=' => 'EQ',
		'!=' => 'NE',
	);
	$e[0] =~ s/^patterns-openSUSE-/pattern:/;
	my $s = sprintf ("<rpm:entry name=\"%s\"", $e[0]);
	if (@e > 1) {
		$s .= sprintf " flags=\"%s\"", $flagmap{$e[1]};
		my @v = split(/-/, $e[2], 2);
		$s .= sprintf " ver=\"%s\"", $v[0];
		$s .= sprintf " rel=\"%s\"", $v[1] if @v > 1;
	}
	$s .= "/>\n";
}

my @patterns;
@want = keys %toinstall unless @want;
for my $f (@want) {
	unless (exists $toinstall{$f}) {
		warn "toinstall/$f does not exist, ignored.";
		next;
	}
	#print STDERR Dumper($toinstall{$f});
	my $s = '<pattern xmlns="http://novell.com/package/metadata/suse/pattern" xmlns:rpm="http://linux.duke.edu/metadata/rpm" xmlns:suse="http://localhost/">';
	$s .= tag("name", $f);
	$s .= sprintf '<version epoch="0" ver="%s" rel="%s" />', $version, $release;
	$s .= "<uservisible/>\n" if (($toinstall{$f}->{'visible'}||'') eq 'true');

	$s .= tag("category", $toinstall{$f}->{'category'});

	$s .= tag("icon", $toinstall{$f}->{'icon'});
	$s .= tag("order", $toinstall{$f}->{'order'});
	$s .= tag("summary", $toinstall{$f}->{'role'});

	my %deps;

	for my $tag (qw/conflicts extends freshens obsoletes provides recommends requires supplements/) {
		next unless exists $toinstall{$f}->{$tag};
		my $dep = '';
		for my $entry (keys %{$toinstall{$f}->{$tag}}) {
			my $match = archok($toinstall{$f}->{$tag}->{$entry});
			$dep .= "<!--\n" unless $match;
			$dep .= rpmentry("patterns-openSUSE-$entry");
			$dep .= "-->\n" unless $match;
		}
		$deps{$tag} = $dep;
	}

	$toinstall{$f}->{'sel'} = [] unless exists $toinstall{$f}->{'sel'};
	$toinstall{$f}->{'sel'} = [ $toinstall{$f}->{'sel'} ] unless ref $toinstall{$f}->{'sel'} eq 'ARRAY';
	for my $n (@{$toinstall{$f}->{'sel'}}) {
		if (!exists $sel{$n}) {
			warn "data/$n included from $f does not exist, ignored";
			next;
		}
		my %tagmap = (
			"conflicts" => "cn",
			"recommends" => "rc",,
			"requires" => "rq",,
			"suggests" => "sg",,
		);
		for my $tag (keys %tagmap) {
			next unless exists $sel{$n}->{$tagmap{$tag}};
			my $dep = '';
			while (my ($k, $v) = each %{$sel{$n}->{$tagmap{$tag}}}) {
				my $match = archok($v);
				$dep .= "<!--\n" unless $match;
				$dep .= rpmentry($k);
				$dep .= "-->\n" unless $match;
			}

			$deps{$tag} ||= '';
			$deps{$tag} .= $dep;
		}
	}

	while (my ($tag, $v) = each %deps) {
		$s .= "<rpm:$tag>\n";
		$s .= $v;
		$s .= "</rpm:$tag>\n";
	}

	$s .= "</pattern>\n";
	push @patterns, $s;
}
mkdir "repodata" unless -d "repodata";
my $fh;
unless (open($fh, '>', "repodata/patterns.xml")) {
	die "xxx xxx: $!\n";
}
printf $fh "<patterns count=\"%d\">\n", scalar @patterns;
for my $s (@patterns) {
	print $fh $s;
}
print $fh "</patterns>\n";
close $fh;

unless (open($fh, '>', "repodata/repomd.xml")) {
	die "xxx repomd.xml: $!\n";
	next;
}
print $fh <<EOF
<?xml version="1.0" ?>
<repomd xmlns="http://linux.duke.edu/metadata/repo"
  xmlns:rpm="http://linux.duke.edu/metadata/rpm"
  xmlns:suse="http://novell.com/package/metadata/suse/common">
  <revision>1</revision>
  <data type="patterns">
  <location href="patterns.xml"/>
  </data>
</repomd>
EOF
;
close $fh;