#!/usr/bin/perl -w
#
# Copyright 2003-2010, Gentoo Foundation
# Distributed under the terms of the GNU General Public License v2
# Written by Aron Griffis <agriffis@gentoo.org>
#
# ekeyword: Update the KEYWORDS in an ebuild.  For example:
#
#   $ ekeyword ~alpha oaf-0.6.8-r1.ebuild
#     - ppc sparc x86
#     + ~alpha ppc sparc x86

use strict;

my ($kw_re) = '^(?:([-~^]?)(\w[\w-]*)|([-^]\*))$';
my (@kw);

my $PORTDIR = undef;
my %ARCH = ();

sub file_parse {
	my $fname = shift;
	my @content = ();

	if ( ! -r $fname ) {
		printf STDERR ("Error: File '%s' doesn't exist or is not readable!\n", $fname);
		exit(1);
	}

	open(my $fh, '<', $fname);
	while(defined(my $line = <$fh>)) {
		chomp($line);
		$line =~ s/^\s*//g;
		$line =~ s/\s*$//g;
		$line =~ s/\s+/ /g;
		next if length($line) eq 0;

		next if $line =~ m/^#/;

		push(@content, $line);
	}
	close($fh);

	return @content;
}

sub get_portdir {
	open(my $ph, '-|', 'portageq portdir');
	chomp(my $portdir = <$ph>);
	close($ph);

	if (length($portdir) eq 0) {
		printf STDERR ("Error: Couldn't determine your PORTDIR...\n");
		exit(1);
	}
	return $portdir;
}

sub get_architectures {
	foreach my $arch (file_parse("${PORTDIR}/profiles/arch.list")) {
		$ARCH{$arch} = 0;
	}
}

sub get_architectures_status {
	foreach my $line (file_parse("${PORTDIR}/profiles/profiles.desc")) {
		my ($arch, undef, $status) = split(/\s/, $line, 3);

		if(defined($ARCH{$arch})) {
			$ARCH{$arch} = 1 if $status eq "dev" and $ARCH{$arch} < 3; # Don't override stable
			$ARCH{$arch} = 2 if $status eq "exp" and $ARCH{$arch} < 3; # Don't override stable
			$ARCH{$arch} = 3 if $status eq "stable";
		}
	}
}

# make sure the cmdline consists of keywords and ebuilds
unless (@ARGV > 0) {
	# NOTE: ~all will ignore all -arch keywords
	print STDERR "syntax: ekeyword { arch | ~[arch] | -[arch] } ebuild...\n";
	print STDERR "instead of 'arch' you can also use 'all' which covers all existing keywords...\n";
	exit(1);
}
for my $a (@ARGV) {
	$a = '~all' if $a eq '~' or $a eq $ENV{'HOME'};	# for vapier
	next if $a =~ /$kw_re/o;				# keyword
	next if $a =~ /^\S+\.ebuild$/;			# ebuild
	die "I don't understand $a\n";
}

$PORTDIR = get_portdir();
get_architectures();
get_architectures_status();

my $files = 0;
my $line;
for my $f (@ARGV) {
	if ($f =~ m/$kw_re/o) {
		my $arch = $2;

		if(length($arch) > 0 && $arch ne "all") {
			if(!defined($ARCH{$arch})) {
				printf STDERR ("'%s' is an unknown architecture! skipping...\n", $arch);
				next;
			}
		}

		push(@kw, $f);
		next;
	}

	print "$f\n";

	open(my $fh_in, "<", $f) or die "Can't read $f: $!\n";
	open(my $fh_out, ">", "${f}.new") or die "Can't create ${f}.new: ${!}\n";

	my $count = 0;
	while($line = <$fh_in>) {
		$count++ if $line =~ m/^\s*KEYWORDS=/;
	}
	seek($fh_in, 0, 0);

	while ($line = <$fh_in>) {
		if ($line =~ m/^\s*KEYWORDS=/) {

			# extract the quoted section from KEYWORDS
			while ($line !~ m/^\s*KEYWORDS=["'](?:.+)?["']/) {
				chomp($line);
				my $next = <$fh_in>;
				$line = join(" ", $line, $next);
			}
			(my $quoted = $line) =~ s/^.*?["'](.*?)["'].*/$1/s;

			if($count > 1 && length($quoted) eq 0) {
				# Skip empty KEYWORDS variables in case they occur more than
				# once, bug 321475.
				print $fh_out $line;
				next;
			}

			# replace -* with -STAR for our convenience below
			$quoted =~ s/-\*/-STAR/;

			# Pre sort/unique
			# NOTE: It will not detect duplicates where one is e.g. ~amd64 and
			# one amd64
			my %hash = map { $_, 1 } split(/\s+/, $quoted);
			$quoted = join(" ", keys(%hash));

			for my $k (@kw) {
				my ($leader, $arch, $star) = ($k =~ /$kw_re/o);

				# handle -* and ^*
				if (defined $star) {
					$leader = substr($star, 0, 1);
					$arch = 'STAR';
				}

				# remove keywords
				if ($leader eq '^') {
					if ($arch eq 'all') {
						$quoted = '';
					} else {
						$quoted =~ s/[-~]?\Q$arch\E(\s|$)/$1/;
					}

				# add or modify keywords
				} else {
					if ($arch eq 'all') {
						# modify all non-masked keywords in the list

						# Don't add stable keywords for != stable architectures
						if(length($leader) eq 0) {
							my @new;
							foreach my $tmp (split(/\s/, $quoted)) {
								my ($_leader, $_arch, undef) = ($tmp =~ m/$kw_re/o);
								$_leader = "" if !defined($_leader);
								$_arch = "" if !defined($_arch);

								if($_leader eq "~" && ($ARCH{$_arch} && $ARCH{$_arch} eq 3) ) {
									push(@new, $_arch);
									next;
								}
								else {
									push(@new, "${_leader}${_arch}");
									next;
								}
							}
							$quoted = join(" ", @new);
						}
						else {
							$quoted =~ s/(^|\s)~?(?=\w)/$1$leader/g;
						}
					} else {
						# modify or add keyword
						unless ($quoted =~ s/[-~]?\Q$arch\E(\s|$)/$leader$arch$1/) {
							# modification failed, need to add
							if ($arch eq 'STAR') {
								$quoted = "$leader$arch $quoted";
							} else {
								$quoted .= " $leader$arch";
							}
						}
					}
				}
			}

			# replace -STAR with -*
			$quoted =~ s/-STAR\b/-*/;

			# sort keywords and fix spacing
			$quoted = join " ", sort {
				(my $sa = $a) =~ s/^\W//;
				(my $sb = $b) =~ s/^\W//;
				return -1 if $sa eq '*';
				return +1 if $sb eq '*';
				$sa .= "-";
				$sb .= "-";
				$sa =~ s/([a-z0-9]+)-([a-z0-9]*)/$2-$1/g;
				$sb =~ s/([a-z0-9]+)-([a-z0-9]*)/$2-$1/g;
				$sa cmp $sb;
			} split(/\s+/, $quoted);

			# re-insert quoted to KEYWORDS
			$line =~ s/(["']).*?["']/$1$quoted$1/;

			print $fh_out $line or die "Can't write $f.new: $!\n";
		} else {
			print $fh_out $line;
			next;
		}
	}

	close($fh_in);
	close($fh_out);

	system("diff -U 0 ${f} ${f}.new");
	rename("$f.new", "$f") or die "Can't rename: $!\n";
	$files++;
}

if ($files == 0) {
    die "No ebuilds processed!";
}

# vim:ts=4 sw=4
