#!/usr/bin/perl -w
use strict;

# Copyright 1999-2005 Gentoo Foundation
# Distributed under the terms of the GNU General Public License v2
# $Header: /var/cvsroot/gentoo-src/ufed/ufed.pl,v 1.20 2005/04/06 13:19:54 truedfx Exp $

use File::Temp qw(tempfile);
use Switch;
use Term::ReadKey;

my $version = '0.37';

my @packages;
my @make_defaults_flags;
my @use_defaults_flags;
my @default_flags;
my @make_conf_flags;
my $make_conf_only;
my @all_flags;
my @use_masked_flags;
my %use_descriptions;
my @ebuild_flags;
my @local_flags;
my $global_only = '';
my @working_set;

my @portagedirs;

sub finalise(@);
sub flags_dialog();
sub have_package($);
sub read_make_conf();
sub read_packages();
sub read_profile($;$);
sub read_sh($$);
sub read_use_descs();
sub resolve_flags(@);
sub save_flags($);
sub show_help();
sub word_wrap($@);
sub read_ebuilds(@);

if (@ARGV) {
	$global_only = $ARGV[0] eq '-g' && shift @ARGV;
	read_ebuilds(@ARGV);
}

read_packages;
read_profile '/etc/make.profile';
read_make_conf;
read_use_descs;
@default_flags = resolve_flags @make_defaults_flags, @use_defaults_flags;
@all_flags = resolve_flags @default_flags, @make_conf_flags;
@use_masked_flags = resolve_flags @use_masked_flags;

for(@make_defaults_flags, @use_defaults_flags, @make_conf_flags) {
	next if $_ eq '-*';
	my $flag = substr $_, /^-/;
	$use_descriptions{$flag} = "(Unknown)"
	if not defined $use_descriptions{$flag};
}

for(@use_masked_flags)
{ delete $use_descriptions{$_} }

if (@ebuild_flags) {
	my %tmp;
	for (@ebuild_flags) { $tmp{$_} = $use_descriptions{$_} }
	%use_descriptions = %tmp;
	@working_set = @ebuild_flags;
}

if ($global_only) {
	for (@local_flags) { delete $use_descriptions{$_} }
	if (!@working_set) { @working_set = @all_flags; }
	for (@local_flags) {
		for (my $i = 0; $i < scalar(@working_set); $i++) {
			if ($_ eq $working_set[$i]) {
				splice(@working_set, $i, 1);
				$i = scalar(@working_set);
			}
		}
	}
}

my @flags;

DIALOG: {
	@flags = flags_dialog;
	if(@flags==1) {
		switch($flags[0]) {
			case 'CANCEL' {
				exit
			}
			case 'ERROR' {
				print STDERR "fatal error: the dialog couldn't be opened\n";
				exit 1
			}
			case 'HELP' {
				show_help;
				redo DIALOG
			}
		}
	}
}

# resolve returned flags with working_set and all_flags
if (@working_set) {
	for (@flags) {
		# remove all returned flags from the working_set
		for (my $i = 0; $i < scalar(@working_set); $i++) {
			if ($_ eq $working_set[$i]) {
				splice(@working_set, $i, 1);
				$i = scalar(@working_set);
			}
		}
	}

	# the working set now contains only the flags that have been removed
	# add them back with minus signs and resolve with all_flags
	for (@working_set) {
		@flags = ("-$_", @flags);
	}

	@flags = resolve_flags @all_flags, @flags
}

# we don't check for use.masked flags here anymore
# the checks were broken. they were filtered out earlier anyway
@flags = finalise @flags;
if(-w '/etc/make.conf')
{ save_flags word_wrap 72, @flags }
exit;

sub have_package($) {
	my ($cp) = @_;
	return (grep { $cp eq $_ } @packages) > 0;
}

sub read_make_conf() {
	my %env = (
		PORTDIR         => '/usr/portage',
		PORTDIR_OVERLAY => '',
		USE             => '',
	);
	read_sh '/etc/make.conf', \%env;
	@portagedirs = split ' ', "$env{PORTDIR} $env{PORTDIR_OVERLAY}";
	s/\/$// for @portagedirs;
	@make_conf_flags = split ' ', $env{USE};
	$make_conf_only = (grep { $_ eq '-*' } @make_conf_flags) > 0;
}

sub read_packages() {
	chdir "/var/db/pkg";
	for(glob "*/*") {
		if(open my $provide, "$_/PROVIDE") {
			if(open my $use, "$_/USE") {
				# could be shortened, but make sure not to strip off part of the name
				s/-\d+(?:\.\d+)*\w?(?:_(?:alpha|beta|pre|rc|p)\d*)?(?:-r\d+)?$//;
				push @packages, $_;
				local $/;
				my @provide = split ' ', <$provide>;
				my @use = split ' ', <$use>;
				for(my $i=0; $i<@provide; $i++) {
					my $pkg = $provide[$i];
					next if $pkg eq '(' || $pkg eq ')';
					if($pkg !~ s/\?$//) {
						$pkg =~ s/-\d+(?:\.\d+)*\w?(?:_(?:alpha|beta|pre|rc|p)\d*)?(?:-r\d+)?$//;
						push @packages, $pkg;
					} else {
						my $musthave = $pkg !~ s/^!//;
						if($musthave != (grep { $pkg eq $_ } @use) > 0) {
							my $level = 0;
							for($i++;$i<@provide;$i++) {
								$level++ if $provide[$i] eq '(';
								$level-- if $provide[$i] eq ')';
								last if $level==0;
							}
						}
					}
				}
				close $use;
			}
			close $provide;
		}
	}
}

sub read_profile($;$) {
	my ($profiledir, $env) = @_;
	$env = {
		USE => '',
	} if not defined $env;
	read_sh "$profiledir/make.defaults", $env;
	@make_defaults_flags = (split(' ', $env->{USE}), @make_defaults_flags);
	if(open my $file, "$profiledir/use.defaults") {
		while(<$file>) {
			s/\s*(?:#.*)?\n$//;
			next if $_ eq '';
			my ($flag, @packages) = split;
			for(@packages)
			{ @use_defaults_flags = ($flag, @use_defaults_flags) if have_package $_ }
		}
		close $file;
	}
	if(open my $file, "$profiledir/use.mask") {
		while(<$file>) {
			s/\*(?:#.*)?\n$//;
			next if $_ eq '';
			@use_masked_flags = ($_, @use_masked_flags);
		}
		close $file;
	}
	if(open my $file, "$profiledir/parent") {
		while(<$file>) {
			s/\s*(?:#.*)?\n$//;
			next if $_ eq '';
			read_profile "$profiledir/$_", $env;
		}
		close $file;
	}
}

sub read_sh($$) {
	my ($fname, $env) = @_;
	if(open my $file, $fname) {
		while(<$file>) {
			s/#.*//;
			# let lines be combined by backslash-newline or by open quotes (odd number of quotes read so far)
			# abort if we can't read the next line
			# use [""] instead of " for better syntax highlighting - proof that this is ugly
			$_ .= <$file> || last while(s/\\\n$// or @{[ /[""]/g ]} % 2);
			s/"//g;
			if(s/^\s*(\w+)=\s*//) {
				my $name = $1;
				chomp;
				s/	(?<!\\)    # unless preceded by an unescaped backslash
					\$         # replace a $
					({)?
					(\w+)      # followed by an identifier
					(?(1)})    # optionally enclosed in braces
				/	$env->{$2} # with the corresponding envvar
					|| ''      # or nothing, if it doesn't exist
				/egx;          # FIXME: \\${VAR} should be replaced but isn't
				$env->{$name} = $_;
			}
		}
		close $file;
	}
}

sub read_use_descs() {
	for my $portagedir(@portagedirs) {
		if(open my $file, "$portagedir/profiles/use.desc") {
			while(<$file>) {
				s/\s*(?:#.*)\n$//;
				next if $_ eq '';
				s/[\\"]/\\$&/g;
				my ($flag, $desc) = /^(.*?)\s+-\s+(.*)$/ or next;
				if($desc !~ /internal|indicates.*architecture/)
				{ $use_descriptions{$flag} = $desc }
				else
				{ push @use_masked_flags, $flag }
			}
			close $file;
		}
		if(open my $file, "$portagedir/profiles/use.local.desc") {
			while(<$file>) {
				s/\s*(?:#.*)\n$//;
				next if $_ eq '';
				s/[\\"]/\\$@/g;
				my ($pkg, $flag, $desc) = /^(.*?):(.*?)\s+-\s+(.*)$/ or next;
				@local_flags = ($flag, @local_flags);
				$use_descriptions{$flag} = "Local Flag: $desc ($pkg)";
			}
			close $file;
		}
	}
}

sub flags_dialog() {
	my $cols     = 80;
	my $lines    = 20;
	my @termsize = GetTerminalSize();
	if(@termsize == 4) {
		$cols  = $termsize[0];
		$lines = $termsize[1] - 4;
	}

	my($tempfh, $tempfile) = tempfile('use.XXXXXX', DIR => '/tmp', UNLINK => 1);

	my $save;
	if(-w '/etc/make.conf')
	{ $save = "Save" }
	else
	{ $save = "Read Only/No Saving" }

	my $items;
	for my $flag(sort { uc $a cmp uc $b } keys %use_descriptions) {
		$items .= $flag . ' " ';

		if(grep { $_ eq "-$flag" } @make_defaults_flags)
		{ $items .= '(-' }
		elsif(grep { $_ eq $flag } @make_defaults_flags)
		{ $items .= '(+' }
		else
		{ $items .= '( ' }

		if(grep { $_ eq "-$flag" } @use_defaults_flags)
		{ $items .= '-' }
		elsif(grep { $_ eq $flag } @use_defaults_flags)
		{ $items .= '+' }
		else
		{ $items .= ' ' }

		if(grep { $_ eq "-$flag" } @make_conf_flags)
		{ $items .= '-) ' }
		elsif(grep { $_ eq $flag } @make_conf_flags)
		{ $items .= '+) ' }
		else
		{ $items .= ' ) ' }

		$items .= $use_descriptions{$flag} . '" ';

		if(grep { $_ eq $flag } @all_flags)
		{ $items .= 'on' }
		else
		{ $items .= 'off' }

		$items .= ' "'.$use_descriptions{$flag}.'" ';
	}
	# bug 51781, in some cased dialog was outputting to stderr and it was messing up
	# the expected results from dialog.  Brandon Edens provided a patch so that the
	# stderr output was not messing up the parsing of the results anymore.
	# Thanks Brandon
	my ($cmdfh, $cmdfile) = tempfile('dialog.XXXXXX', DIR => '/tmp', UNLINK => 1);
	print $cmdfh ' --output-fd 3'
	           . ' --separate-output '
	           . '--no-shadow --backtitle "Gentoo Linux USE flags editor '.$version.'" '
	           . '--ok-label "'.$save.'" --cancel-label Exit --help-label "What are USE flags?/Help" '
	           . '--item-help --help-button --checklist "Select desired set of USE flags '
	           . 'from the list below:\\n(press SPACE to toggle, cursor keys to select)" '
	           . $lines . ' ' . $cols . ' ' . ($lines - 8) . ' ' . $items;
	my $rc = system('exec 3> '.$tempfile.' ; DIALOG_ESC="" dialog --file '.$cmdfile) >> 8;
	if($rc == 1 || $rc == 255) # no difference between CANCEL and ESC
	{ return 'CANCEL' }
	if($rc == 2)
	{ return 'HELP' }
	if($rc != 0)
	{ return 'ERROR' }

	my @flags;
	open my $file, $tempfile or die 'couldn\'t open temporary file';
	while (<$file>) {
		chomp;
		push @flags, $_;
	}
	close $file;
	return @flags;
}

sub show_help() {
	my $cols     = 80;
	my $lines    = 20;
	my @termsize = GetTerminalSize();

	if(@termsize == 4) {
		$cols  = $termsize[0];
		$lines = $termsize[1] - 4;
	}

	my ($tempfh, $tempfile) = tempfile('use.XXXXXX', DIR => '/tmp', UNLINK => 1);

	# bug 50112 fixed, url for howto changed
	open my $file, '>'.$tempfile or return;
	print $file qq((press UP/DOWN to scroll, RETURN to go back)

UFED is a simple program designed to help you configure the systems
USE flags (see below) to your liking.  To select of unselect a flag
highlight it and hit space.

UFED attempts to show you where a  particular use setting came from.
Each USE flag has a 3 character descriptor that represents the three
ways a use flag can be set.

The 1st char is the setting from the /etc/make.profile/make.defaults
file. These are the defaults for Gentoo as a whole. These should not
be changed.

The 2nd char is the setting from the /etc/make.profile/use.defaults
file. These will change as packages are added and removes from the
system.

The 3rd char is the settings from the /etc/make.conf file. these are
the only ones that should be changed by the user and these are the
ones that UFED changes.

If the character is a + then that USE flag was set in that file, if
it is a space then the flag was not mentioned in that file and if it
is a - then that flag was unset in that file.

------------------- What Are USE Flags -----------------------------

The USE settings system is a flexible way to enable or disable various
features at package build-time on a global level and for individual
packages. This allows an administrator control over how packages are built
in regards to the optional features which can be compiled into those
packages.


For instance, packages with optional GNOME support can have this support
disabled at compile time by disabling the "gnome" USE setting. Enabling
the "gnome" USE setting would enable GNOME support in these same packages.

The effect of USE settings on packages is dependent on whether both the
software itself and the package ebuild supports the USE setting as an
optional feature. If the software does not have support for an optional
feature then the corresponding USE setting will obviously have no effect.

Also many package dependencies are not considered optional by the software
and thus USE settings will have no effect on those mandatory dependencies.

A list of USE keywords used by a particular package can be found by
checking the IUSE line in any ebuild file.


See http://www.gentoo.org/doc/en/handbook/handbook-x86.xml?part=2&chap=1
for more information on USE flags.


Please also note that if UFED describes a flag as (Unknown) it generally means
that it is either a spelling error in one of the three configuration files or
it is not an ofically sanctioned USE flag. Sanctioned USE flags can be found in
${portagedirs[0]}/profiles/use.desc and in ${portagedirs[0]}/profiles/use.local.desc.


* * * * *

ufed was originally written by Maik Schreiber <blizzy\@blizzy.de>.
ufed is currently maintained by Robin Johnson <robbat2\@gentoo.org>,
Fred Van Andel <fava\@gentoo.org> and Arun Bhanu <codebear\@gentoo.org>.

Copyright 1999-2005 Gentoo Foundation
Distributed under the terms of the GNU General Public License v2
);
	close $file;

	system('dialog --exit-label Back --no-shadow --title "What are USE flags?" '
	     . '--backtitle "Gentoo Linux USE flags editor '
	     . $version
	     . ' - Help" '
	     . '--textbox '
	     . $tempfile . ' '
	     . $lines . ' '
	     . $cols);
}

sub resolve_flags(@) {
	my %results = ();
	for(@_) {
		if(/^-/) {
			if($_ eq '-*') {
				%results = ();
			} else {
				delete $results{substr $_, 1};
			}
		} else {
			$results{$_} = 1;
		}
	}
	return keys %results;
}

sub finalise(@) {
	if($make_conf_only) {
		return '-*', sort @_;
	} else {
		return
			# all enabled flags that aren't in the default set
			sort(              grep { my $flag = $_; !grep { $flag eq $_ } @default_flags } @_),
			# all default flags that aren't in the enabled set, with a - in front
			sort(map { "-$_" } grep { my $flag = $_; !grep { $flag eq $_ } @_ } @default_flags);
	}
}

sub save_flags($) {
	my ($flags) = @_;
	my $contents;

	unlink('/etc/make.conf.old');
	rename('/etc/make.conf', '/etc/make.conf.old');

	open(FILE, '/etc/make.conf.old') or die('couldn\'t open /etc/make.conf.old');
	open(OUTFILE, '>/etc/make.conf') or die('couldn\'t open /etc/make.conf');

	{ local $/; $contents = <FILE> }

	if($contents =~ s/^([^\S\n]*)USE="[^"]*"/
		my $i = $1;
		$_ = "USE=\"$flags\"";
		s!^!$i!mg; # preserve indentation
		$_
	/me) {
		# nothing here, s/// did all the work
	} elsif($contents =~ s/^\#USE=(.*)/\#USE=$1\nUSE=\"$flags\"\n/m) {
		# nothing here, s/// did all the work
	} else {
		$contents .= "\nUSE=\"$flags\"\n";
	}

	print OUTFILE $contents;

	close(OUTFILE);
	close(FILE);

	chmod(0644, '/etc/make.conf');
}

sub word_wrap($@) {
	(my $maxlength, $_, my @words) = @_;
	return "" if not defined $_;
	my ($length, $result) = (length, $_);
	for(@words) {
		if($length+1+length>$maxlength)
		{ $length =5+length; $result .= "\n     $_" }
		else
		{ $length+=1+length; $result .= " $_" }
	}
	return $result;
}

sub read_ebuilds(@) {
	for (@_) {
		my $file = `equery which $_`;
		chop($file);
		if (-e $file) {
			my $use = `grep IUSE $file`;
			chop($use);
			chop($use);
			$use =~ s/IUSE="//;
			@ebuild_flags = (@ebuild_flags, split " ", $use);
		}
	}
}