Although this program backs it up too, and runs without problems for me, I can't promise it will for you.
Main differences from ufed, not counting minor ufed bugs:
- Automatically removes invalid USE flags
- Doesn't give any explanation of the general concept of USE flags
- Doesn't need to be run as root
- Shows which USE flags affect any currently installed package
- Supports custom USE flags for ebuilds in your overlay directories
- New: No need to see the whole list of USE flags
I posted an older version a couple of days ago, without much interest, but hopefully this update will be more interesting.
I'm hoping to get some feedback, and I'd especially like to hear about any bugs you can find.
Code: Select all
#!/usr/bin/perl -w
use strict;
sub readsh
{
my ($name, $env) = @_;
if(open FILE, $name) {
while(<FILE>) {
s/#.*//;
$_ .= <FILE> || last while(s/\\\n$// or m/^([^"]*|"[^"]*")*"[^"]*$/);
s/"//g;
if(s/^[ \t]*(\w+)=//) {
my $name = $1;
chomp;
s/(?<!\\)\${(\w+)}/$env->{$1}/g;
$env->{$name} = $_;
}
}
close FILE;
}
}
my @portdirs;
my %makeconfuse;
my $makeconfonly;
{
my %env = (
'PORTDIR' => '/usr/portage',
'PORTDIR_OVERLAY' => '',
'USE' => '' );
readsh '/etc/make.conf', \%env;
push @portdirs, $_ for(split ' ', "$env{PORTDIR} $env{PORTDIR_OVERLAY}");
for(split ' ', $env{'USE'}) {
if(m/^\-\*$/) { %makeconfuse = () ;
$makeconfonly = 1 }
elsif(s/^\-//) { $makeconfuse{$_} = 0 }
elsif(s/^\+//) { $makeconfuse{$_} = 1 }
else { $makeconfuse{$_} = 1 }
}
}
my (%iuse, @packages);
{
opendir PKG, "/var/db/pkg" or next;
for my $cat (readdir PKG) {
opendir CAT, "/var/db/pkg/$cat" or next;
for my $pkg (readdir CAT) {
if(open IUSE, "/var/db/pkg/$cat/$pkg/IUSE") {
while(<IUSE>) {
for(split)
{ $iuse{$_} = 1 }
}
close IUSE;
}
if(open PROV, "/var/db/pkg/$cat/$pkg/PROVIDE") {
while(<PROV>) {
for(split) {
s/-\d+(\.\d+)*\w?(_\w+\d*)?(-r\d+)?$//;
push @packages, $_;
}
}
close PROV;
}
$pkg =~ s/-\d+(\.\d+)*\w?(_\w+\d*)?(-r\d+)?$// and
push @packages, "$cat/$pkg";
}
closedir CAT;
}
closedir PKG;
}
my (%packageuse, %profileuse, @usemask);
sub readprofile;
sub readprofile {
my $profile = $_[0];
if(open FILE, "$profile/parent") {
my @parent;
while(<FILE>) {
chomp;
s/#.*//;
if($_ ne '')
{ push @parent, $_ }
}
close FILE;
readprofile "$profile/$_" for(@parent);
}
if(open FILE, "$profile/use.mask") {
while(<FILE>) {
s/#.*//;
for(split) {
if(s/^-//)
{ @usemask = grep(!/^\Q$_\E$/, @usemask) }
else
{ push @usemask, $_ }
}
}
close FILE;
}
if(open FILE, "$profile/use.defaults") {
while(<FILE>) {
s/#.*//;
my ($use, @pkgs) = split;
for my $pkg (@pkgs)
{ do { $packageuse{$use} = 1 if $pkg eq $_ } for(@packages) }
}
close FILE;
}
my %env = ( 'USE' => '' );
if(readsh "$profile/make.defaults", \%env) {
for(split ' ', $env{'USE'}) {
if(m/^\-\*$/) { %profileuse = () }
elsif(s/^\-//) { $profileuse{$_} = 0 }
elsif(s/^\+//) { $profileuse{$_} = 1 }
else { $profileuse{$_} = 1 }
}
}
}
readprofile '/etc/make.profile';
my %flag;
{
for my $portdir (@portdirs) {
if(open FILE, "$portdir/profiles/use.desc") {
while(<FILE>) {
s/#.*//;
m/(.*?) +- +(.*)/ or next;
my $on = 'off';
if(defined $profileuse{$1})
{ if($profileuse{$1}) { $_ ='(+' ; $on = 'on' }
else { $_ ='(-' ; $on = 'off' } }
else { $_ ='( ' }
if(defined $packageuse{$1}) { $_.= '+' ; $on = 'on' }
else { $_.= ' ' }
if(defined $makeconfuse{$1})
{ if($makeconfuse{$1}) { $_.= '+)'; $on = 'on' }
else { $_.= '-)'; $on = 'off' } }
elsif($makeconfonly) { $_.= '-)'; $on = 'off' }
else { $_.= ' )'; }
if(defined $iuse{$1}) { $_.= ' *'}
else { $_.= ' '}
$flag{$1}{'Global'} = [ "$_ $2", $on ];
$flag{$1}{'Global'}[0] =~ s/'/'\\''/g;
}
close FILE;
}
if(open FILE, "$portdir/profiles/use.local.desc") {
while(<FILE>) {
s/#.*//;
m!((.*?)-(.*?)/.*?):(.*?) +- +(.*)! or next;
my $on = 'off';
if(defined $profileuse{$4})
{ if($profileuse{$4}) { $_ ='(+' ; $on = 'on' }
else { $_ ='(-' ; $on = 'off' } }
else { $_ ='( ' ; }
if(defined $packageuse{$4}) { $_.= '+' ; $on = 'on' }
else { $_.= ' ' ; }
if(defined$makeconfuse{$4})
{ if($makeconfuse{$4}) { $_.= '+)'; $on = 'on' }
else { $_.= '-)'; $on = 'off' } }
elsif($makeconfonly) { $_.= '-)'; $on = 'off' }
else { $_.= ' )'; }
if(defined $iuse{$4}) { $_.= ' *'}
else { $_.= ' '}
$flag{$4}{$2} = [ "$_ $5 ($1)", $on, $3 ];
$flag{$4}{$2}[0] =~ s/'/'\\''/g;
}
close FILE;
}
}
}
delete $flag{$_} for(@usemask);
do {
my $warn = 0;
for(sort keys %makeconfuse) {
if(!defined $flag{$_})
{ print "Flag `", $_, "' unrecognised.\n" }
elsif(!defined $iuse{$_})
{ print "Flag `", $_, "' unused.\n" }
else
{ next }
$warn = 1;
}
<STDIN> if $warn;
} if 0;
sub checklist(;$) {
my ($cat) = @_;
my $dialog = "dialog --separate-output --ok-label 'Save & Return' --cancel-label 'Return' "
. "--item-help --no-shadow --stdout --checklist 'USEd: Gentoo Linux USE flag editor' 0 0 0";
for(sort{lc $a cmp lc $b}grep { !$cat or defined $flag{$_}{$cat} } keys %flag) {
$dialog .= " '$_'";
$_ = $flag{$_};
$dialog .= " '$$_{$cat}[0]'";
$dialog .= " '$$_{$cat}[1]'";
$dialog .= " '" . substr($$_{$cat}[0], 8) . "'";
}
$_ = `$dialog`;
return if $?;
for my $f(grep { !$cat or defined $flag{$_}{$cat} } keys %flag)
{ $flag{$f}{$_}[1] = 'off' for(keys %{$flag{$f}}) }
for my $f(split)
{ $flag{$f}{$_}[1] = 'on' for(keys %{$flag{$f}}) }
}
{
my $dialog = "dialog --ok-label 'Select' --extra-button --extra-label 'Save & Exit' --cancel-label 'Exit' "
. "--item-help --no-shadow --stdout --menu 'USEd: Gentoo Linux USE flag editor' 0 0 0";
my %hash;
for(keys %flag) {
for my $cat(keys %{$flag{$_}})
{ $hash{$cat}{$flag{$_}{$cat}[2]} = 1 if defined $flag{$_}{$cat}[2] }
}
$hash{Global} = 'Global USE flags';
for(keys %hash)
{ $hash{$_} = join(', ', sort keys %{$hash{$_}}) if(defined(%{$hash{$_}})) }
for(sort {$a cmp $b} keys %hash)
{ $dialog .= " '$_' '$hash{$_}' '$hash{$_}'" }
for(;;) {
$_ = `$dialog`;
if($? == 0<<8) { checklist($_) }
elsif($? == 3<<8) { last }
else { print "Nothing to save!\n" and exit }
}
}
my @newuse;
{
if($makeconfonly) {
@newuse = ('-*', sort grep { my(undef,$flag)=%{$flag{$_}}; $$flag[1] eq 'on' } keys %flag);
} else {
my (@disabled, @enabled);
for(sort keys %flag) {
my(undef,$flag)=%{$flag{$_}};
my $selected = $$flag[1] eq 'on';
if($selected != (defined $profileuse{$_} or defined $packageuse{$_}))
{ if($selected) { push @enabled , "$_" }
else { push @disabled, "-$_" } }
}
@newuse = (@enabled, @disabled);
}
}
my $newuse;
{
$newuse="USE=\"";
my $len = 0;
for(@newuse) {
if($len + length() >= 73) {
$newuse =~ s/ $/\n /;
$len = 0;
}
$newuse .= "$_ ";
$len += length() + 1;
}
$newuse =~ s/ ?$/"\n/;
}
undef $/;
{
open FILE, '/etc/make.conf';
$_ = <FILE>;
close FILE;
open FILE, '>/etc/make.conf.old' and print FILE and close FILE or die "Couldn't back up make.conf!";
my $set = 0;
s/^[ \t]*USE=("[^"]*"|[^"\\\n]+|\\.)*\n/ $set ? ( '' ) : ( $set = 1, $newuse ) /emsg;
$_ .= $newuse if not $set;
open FILE, '>/etc/make.conf' and print FILE and close FILE or die "Couldn't save make.conf!";
}Old update: Hopefully fix the bug where some flags are removed from make.conf.
New update: Renamed subject, and changed the description. No changes to the script.
