Test program that will save dialog parameters to a file.

ufed2 (text/plain), 21.34 KB, created by Fred Van Andel (RETIRED) on 2003-09-04 20:45:06 UTC

#!/usr/bin/perl

# Copyright 1999-2003 Gentoo Technologies, Inc.
# Distributed under the terms of the GNU General Public License v2
# $Header: /home/cvsroot/gentoo-src/ufed/ufed.pl,v 1.18 2003/08/11 04:44:03 fava Exp $

# If you make ANY changes, please put them directly to the CVS log. The
# ChangeLog file is generated automatically from that data.

use File::Temp qw(tempfile);
use Term::ReadKey;
use strict "vars";

# version number format is x.yy
# if y<10, you NEED the trailing zero!
my $version = '0.34';

my @make_defaults_flags;
my @use_defaults_flags;
my $make_conf_flags;
my @use_mask_flags;
my @combined_flags;
my $PartialResults;
my $InfoBlock;
my %portage_env;
my $All;

my %use_desc_flags;

my $PortageBase = '/usr/portage';

sub get_flag_from_file
{

   #Tries to retrieve a variable set in a file in any of these forms
   #   flag = "something"
   #   flag = 'something'
   #   flag =  something
   #
   # Note it does NOT resolve correctly
   #   flag = ${BASE}/something
   # I have no particular desire to recreate bash here

   my ($file, $flag) = @_;
   my $contents = '';

   open(FILE, $file) or die ('couldn\'t open ' . $file);
   undef $/;              # set slurp mode
   $contents = <FILE>;    # now slurp
   $/        = "\n";
   close(FILE, $file);

   # try to match whatever = "something"
   if (($contents =~ m![\t ]*$flag[ \t]*=[ \t]*"([^"]*)"!s) == 1) 
      { return ($1); }

   # try to match whatever = 'something'
   if (($contents =~ m![\t ]*$flag[ \t]*=[ \t]*'([^']*)'!s) == 1) 
      { return ($1); }

   # try to match whatever = something
   if (($contents =~ m![\t ]*$flag[ \t]*=([^\n]*)!s) == 1) 
      { return ($1); }

   # fall off the bottom with no match 
   return (undef);
}

# @flags = get_use_flags_from_file($file, $break_if_found)
sub get_use_flags_from_file
{
   my $file           = shift ();
   my $break_if_found = shift ();
   my @lines;
   my $line;
   my $contents = '';
   my $use;
   my @flags = ();

   open(FILE, $file) or die ('couldn\'t open ' . $file);
   undef $/;              # set slurp mode
   $contents = <FILE>;    # now slurp
   $/        = "\n";
   close(FILE, $file);

   $use = $contents;
   $use =~ s/(.*[\r\n]|^)USE="([^"]*)".*/\2/s;
   if ($use eq $contents)
   {
      if ($break_if_found == 1)
         { die ('did not find USE in ' . $file); }
      return 'EMPTY';
   }

   # remove leading and trailing spaces
   $use =~ s![\r\n\t\\]+! !g;
   $use =~ s!^[ ]*!!;
   $use =~ s![ ]*$!!;
   @flags = split (/[ ]+/, $use);

   return @flags;
}

# @flags = get_make_defaults_flags()
sub get_make_defaults_flags
{
    # yes this ineffecient, until we can recreate bashes interpolation functions it will do (but slowly)
    my $flags = `source /etc/make.profile/make.defaults ; echo \$USE`;
    return(split(m! !, CleanUpFlags($flags)));
}

sub get_make_conf_flags
{
    # yes this ineffecient, until we can recreate bashes interpolation functions it will do (but slowly)
    my $flags = `source /etc/make.profile/make.defaults ; source /etc/make.conf ; echo \$USE`;
    return($flags);
}

sub get_portdir
{
    # yes this ineffecient, until we can recreate bashes interpolation functions it will do (but slowly)
    my $flags = `source /etc/make.profile/make.defaults ; source /etc/make.conf ; echo \$PORTDIR`;
    chomp($flags);     
    return($flags);
}

# %flags = get_use_desc_flags()
sub get_use_desc_flags
{
   my %flags = ();
   my $flag;
   my $desc;
   my @lines;
   my $line;

   open(FILE, "$PortageBase/profiles/use.desc")
     or die ("couldn\'t open $PortageBase/profiles/use.desc");
   @lines = <FILE>;
   close(FILE);

   foreach $line (@lines)
   {
      $line =~ s/[\r\n]//g;
      ($flag, $desc) =  ($line =~ m!([^ ]+)[ \t]+-[ \t]+(.*)!); # match the "flag - description" syntax
      $desc =~ s/[ \t]+/ /;
      $flag =~ s/[ \t]+//;

      # now eliminate comments, blanklines and internal flags
      unless (($flag eq "") or ($flag =~ m/\#/) or ($desc =~ /(internal|indicates.*architecture)/))
      { %flags->{$flag} = $desc; }
      if ($desc =~ /(internal|indicates.*architecture)/)
      {
         push (@use_mask_flags, $flag);  # we are cheating here, this is not part of the use.mask file
                                         # but the end result is the same so we will set it here
      }

   }
   return %flags;
}
sub get_use_local_desc_flags
{
   my %flags = ();
   my $flag;
   my $desc;
   my $package;
   my @lines;
   my $line;

   open(FILE, "$PortageBase/profiles/use.local.desc")
     or die ("couldn\'t open $PortageBase/profiles/use.local.desc");
   @lines = <FILE>;
   close(FILE);

   foreach $line (@lines)
   {
      $line =~ s/[\r\n]//g;
      ($package, $flag, $desc) =  ($line =~ m!([^:]*):([^ ]+)[ \t]+-[ \t]+(.*)!); # match the "package:flag - description" syntax
      $desc =~ s/[ \t]+/ /;
      $flag =~ s/[ \t]+//;
      
      # now eliminate comments, blanklines
      unless (($flag eq "") or ($flag =~ m/\#/))
        { %flags->{$flag} = "Local Flag: $desc ($package)"; }
   }
   return %flags;
}

sub get_use_mask_flags
{

   # these are not actuallt flags, everyting here represents flags that do not actually exist
   # usually because the software does not exist on that platform.
   my @flags;
   my $flag;
   my $desc;
   my @lines;
   my $line;

   open(FILE, "/etc/make.profile/use.mask")
     or return (());    # no die, this file often doesnt exist

   while (<FILE>)
   {
      s!#.*!!;          # kill comments
      s![ \t\n]!!g;     # kill whitespace
      if ($_ ne "") 
         { push (@flags, $_); }
   }
   return @flags;
}

# @flags = flags_dialog()
sub flags_dialog
{
   my $tempfh;
   my $tempfile;
   my $items = '';
   my $flag;
   my @flags;
   my $on;
   my $rc;
   my $cols     = 80;
   my $lines    = 20;
   my @termsize = GetTerminalSize();
   my $SaveLabel; 

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

   ($tempfh, $tempfile) = tempfile('use.XXXXXX', DIR => '/tmp', UNLINK => 1);
   if(-w '/etc/make.conf')
      { $SaveLabel = "Save"; }
   else
      { $SaveLabel = "Read Only/No Saving"; }
      
   my $make_defaults_temp = ' ' . join (" ", @make_defaults_flags) . ' ';
   my $use_defaults_temp  = ' ' . join (" ", @use_defaults_flags) . ' ';
   my $make_conf_temp     = ' ' . $make_conf_flags . ' ';
   my $combined_temp      = ' ' . join (" ", @combined_flags) . ' ';

   foreach $flag (sort({uc($a) cmp uc($b)} keys(%use_desc_flags)))
   {
      my $re = $flag;
      $re =~ s!\+!\\\+!g;
      next if ($re eq "");

      $items .= $flag . ' " ';

      next if ($re eq "");

      if (($make_defaults_temp    =~ m! -$re !) != 0) 
         { $items .= '(-'; }
      elsif (($make_defaults_temp =~ m! $re !) != 0)  
         { $items .= '(+'; }
      else 
         { $items .= '( '; }

      if (($use_defaults_temp    =~ m! -$re !) != 0) 
         { $items .= '-'; }
      elsif (($use_defaults_temp =~ m! $re !) != 0) 
         { $items .= '+'; }
      else 
         { $items .= ' '; }

      if (($make_conf_temp    =~ m! -$re !) != 0) 
         { $items .= '-) '; }
      elsif (($make_conf_temp =~ m! $re !) != 0)  
         { $items .= '+) '; }
      else
         { $items .= ' ) '; }

      $items .= %use_desc_flags->{$flag} . '" ';

      if (($make_conf_temp =~ m! -$re !) != 0) 
         { $items .= 'off '; }
      elsif (($combined_temp  =~ m! $re !) != 0)  
         { $items .= 'on '; }
      else 
         { $items .= 'off '; }

      $items .= '"' . %use_desc_flags->{$flag} . '"' . "\n ";
   }

   open(TEMPFILE, ">ufed-output.txt") or die ('couldn\'t open tempfile');
   
   print TEMPFILE 'DIALOG_ESC="" '
               . $tempfile
               . ' --separate-output '
               . '--no-shadow --backtitle "Gentoo Linux USE flags editor '
               . $version . '" '
               . '--ok-label "' . $SaveLabel . '" --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;
   exit();
   if ($rc == 1)
      { return 'CANCEL'; }
   if ($rc == 255)
      { return 'ESC'; }
   elsif ($rc != 0)
      { return 'ERROR'; }
   

   open(FILE, $tempfile) or die ('couldn\'t open temporary file');
   while (<FILE>)
   {
      s/[\r\n]//;
      if (/^HELP/)
         { return 'HELP'; }
      push (@flags, $_);
   }
   close(FILE);

   return @flags;
}

# save_use_flags($selected_flags)
sub save_use_flags
{
   my $selected_flags = shift();
   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');

   undef $/;             # set slurp mode
   $contents = <FILE>;   # now slurp
   $/ = "\n"; 

   if ($contents =~ s!^[ \t]*USE="[^"]*"!USE="$selected_flags"!m)
   {

      # replace the existing flag
      # no actual body here, the substitution did all the work
   }
   elsif ($contents =~ s!^\#USE=(.*)!\#USE=\1\nUSE=\"$selected_flags\"\n!m)
   {

      # after the example flags
      # no actual body here, the substitution did all the work
   }
   else
   {
      #tack it onto the end      
      $contents .= "\nUSE=\"$selected_flags\"\n";
   }

   print OUTFILE $contents;

   close(OUTFILE);
   close(FILE);

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

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

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

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

   open(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/use-howto.xml 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 
$PortageBase/profiles/use.desc and in $PortageBase/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-2003 Gentoo Technologies, Inc.
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
{

   # When given 2 lists of flags resolve them into one combined list
   # The second list is assumed to have proiority over the first list
   # The parameters are 2 strings and not 2 lists

   my ($First, $Second) = @_;
   my ($u);
   #$All .= "1st:$First\n2nd:$Second\n";
   
   $First =~ s![ \t]+! !g;        # remove multiple ' ' , tabs
   $First =~ s! \+! !g;           # remove leading +'s
   $First = ' ' . $First . ' ';   # add leading & trailing space so we can tell 'ab' and 'abc' apart
   for $u (split (m![ \t\+]+!, $Second))
   {
      next if ($u eq "");
      if ($u =~ m!^-+!)
      {
         $u     =~ s!^-!!g;
         $First =~ s! -?$u ! !g;
      }
      else
      {
         $First =~ s! $u ! !;
         $First .= " $u ";
      }
   }
   $First =~ s![ ]+! !g;    # fix the spacing that is now broken
   #$All .= "3rd:$First\n\n";
   return ($First);
}

sub get_use_defaults_flags
{

   # use.defaults is a list of flag/package pairs. I the package is installed then 
   # the associated flag is emabled
   my ($flag, $package);
   my @flags;
   open(FILE, '/etc/make.profile/use.defaults') or die ('couldn\'t open ' . "use.defaults");

   while (<FILE>)
   {
      s!#.*!!;
      ($flag, $package) = split (m![\t ]+!);
      $flag    =~ s![ \t]!!g;
      $package =~ s![ \t]!!g;
      chomp($package);

      if ((defined($package)) and my_glob("/var/db/pkg/$package"))
      {

         #the package exists, therefore we add the use flag
         push (@flags, $flag);
      }
   }
   close(FILE);
   return (@flags);
}

sub my_glob
{

   # glob() is broken (at least on my machine) because it compleatly misses
   # some directories, (ie readline)

   my ($pat) = @_;
   my ($base, $end, $f);

   $pat =~ m!(.*)/(.*)!;    # counts on * being greedy
   $base = $1;
   $end  = $2;

   # we need to escape some metachars in $end or we will have problems with gtk++
   $end =~ s!\+!\\\+!g;

   opendir(CURDIR, $base);
   for $f (readdir(CURDIR))
   {
      #Bug 26360: myglob is recognizing partial matches when it shouldnt be
      #           ie. its finding the mozilla-firebird directory when looking for mozilla,
      #           so we need to strip the version number fron the directory and then try to
      #           match the entire string rather than just the beginning 
      $f =~ m!(.*?)-[0-9]!;  
      $f = $1;
      # end of bug fix 
      if ($f =~ m!^$end$! != 0) 
         { return (1); }
   }
   return (0);
}

sub create_final_list
{

   # create the final, minimal list of flags to get the desired results
   my (@selected) = @_;
   my ($f, $final);

   $PartialResults = ' ' . $PartialResults . ' ';

   # if something in $selected is allready in $combined it is removed from both lists
   # everything left in selected stays, everything left in $results is a - flag

   for $f (@selected)
   {
      $f =~ s!\+!\\\+!g;
      if (($PartialResults =~ s! $f ! !ig) != 0) 
         { $f = ''; }
   }
   $PartialResults =~ s! ([^ ]+)! -\1!g;
   $final = join (' ', @selected);

   $final = $final . ' ' . $PartialResults;
   $final =~ s!- ! !g;
   $final =~ s![ ]+! !g;

   return ($final);
}

sub Simple_Word_Wrap
{
   my($line, $MaxLen, $header) = @_;
   my($CurLen, $Lines);
   my $word;

   $Lines = $header;
   $CurLen = 0;
   for $word (split(m! !, $line))
      {
         if($CurLen + length($word) +1 > $MaxLen)
            {
               $Lines .= "\n$header";
               $CurLen = 0;
            }
         $Lines .= "$word ";
         $CurLen += length($word) + 1;
     }
   $Lines .= "\n";

   return($Lines);      
}    

sub CleanUpFlags
{
   #cleans us a string of flags
   my ($flags) = @_;
   
   $flags =~ s!\n! !g;
   $flags =~ s!\\! !g; 
   $flags =~ s!\t! !g;   
   $flags =~ s!\r! !g;
   $flags =~ s!\'! !g;
   $flags =~ s!\"! !g;
   $flags =~ s![ ]+! !g;
   $flags =~ s!^ !!g;
   $flags =~ s! $!!g;

   return($flags);
}

sub main
{
   my @flags;
   my $selected_flags;
   my $flag;
   my $num_flags;
   my $Results;
   my $final_list;
   my ($i, $j);

   $PortageBase = get_portdir();
   unless($PortageBase)
      { $PortageBase = '/usr/portage'; }

   # for the purposes of ufed USE flags can be (re)set 4 different ways
   #   1) By make.defaults and a USE=" ... " statement
   #   2) By use.defaults and a list of flags/programs
   #   3) By make.conf and a USE=" ... " statements   
   #   4) by use.mask and a list, this makes flags dissapear

   #step 0) get the data
   @make_defaults_flags = get_make_defaults_flags();
   @use_defaults_flags = get_use_defaults_flags();
   $make_conf_flags = CleanUpFlags(get_make_conf_flags());

   #special case. If make.conf contains -* it compleatly ignores make.defaults
   if($make_conf_flags =~ m!\-\*!)
      {  
         @make_defaults_flags = (); 
         $make_conf_flags =~ s!\-\*!!;
         $make_conf_flags =~ CleanUpFlags($make_conf_flags);
         
         # bug 24670: ufed was ignoring use.defaults when processing the -* syntax
         #            carpaski confirmes that we should be ignoring it
         @use_defaults_flags = ();
      }
   #step 1)
   #$All = "Make.def : " . join(' ', @make_defaults_flags) . "\n";

   #Step 2)
   $Results =  resolve_flags(join (' ', @make_defaults_flags),
                             join (' ', @use_defaults_flags));

   #$All .= "Use.def : " . join(' ', @use_defaults_flags) . "\n";
   #$All .= "PartResults : $Results\n";
   $PartialResults  = $Results;    # we need PartialResults in order to calculate the final flags

   #Step 3)   
   #$All .= "make.conf : " . $make_conf_flags . "\n";
   $Results         = resolve_flags($Results, $make_conf_flags);
   #$All .= "Results : $Results\n";

   #Intermission
   %use_desc_flags = get_use_desc_flags();
   my %use_local_desc_flags = get_use_local_desc_flags();

   # now merge the two sets of flags
   for $i (keys(%use_local_desc_flags))
      { $use_desc_flags{$i} =  $use_local_desc_flags{$i}; }

   # as a visual alert or possible problems, if a flag appears in any of the use lists but not
   # in use.desc then it will be added and labled as (Unknown)

   for $i (@make_defaults_flags, @use_defaults_flags, split(m! !, $make_conf_flags))
   {
      $j = $i;    # yes I mean to do that,  dont 'fix' it, Im serious, really dont
      $j =~ s!^[\-\+]+!!;
      unless (exists($use_desc_flags{$j})) 
         { $use_desc_flags{$j} = "(Unknown)"; }
   }

   #Step 4
   # warning @use_mask_flags is allready set by get_use_desc_flags() so
   # so dont just blindly set it
   push (@use_mask_flags, get_use_mask_flags());


   # @use_mask_flags arent flags, they are flags that shouldnt exist on 
   # this platform, so we delete them from @use_mask_desc
   for $i (@use_mask_flags) 
      { delete $use_desc_flags{$i}; }

   # End of steps

   @combined_flags = split (m![ ]+!, $Results);

   for (; ;)
   {
      @flags     = flags_dialog();
      $num_flags = $#flags + 1;

      if ($num_flags == 1)
      {
         if (@flags[0] eq 'CANCEL')
            { last; }
         if (@flags[0] eq 'HELP')
         {
            show_help();
            next;
         }
         if (@flags[0] eq 'ERROR')
         {
            print STDERR "fatal error: the dialog couldn't be opened\n";
            last;
         }
         # bug 22680: not really a crash, just an innappropriate error message 
         if (@flags[0] eq 'ESC')
         {  
            print STDERR "ESC pressed, changes not saved\n";
            last;
         }

      }

      $final_list = create_final_list(@flags);

      # now lets get rid on any verboten flags that sneaked in
      #$All .= "use.mask: "; 
      for $i (@use_mask_flags) 
         { 
            next if($i eq "");
            $final_list =~ s!-?$i!!g; 
            #$All .= "$i ";            
         }
      #$All .= "\n";            
      $final_list =~ s![ ]+! !g;    # delete all unnecessaty spaces
      $final_list =~ s!^[ ]!!g;
      $final_list =~ s![ ]$!!g;
      # special case if @make_default_flags is empty it means that the -* syntax was used so lets put it back
      if(@make_defaults_flags == 0)
         {$final_list = "-* $final_list"; }

      #$All .= "Final : $final_list\n";
      # now lets nicly wrap so robbat2 pathologically long list of flags wraps nicely
      $final_list = Simple_Word_Wrap($final_list, 70, "");
      $final_list =~ s!\n!\\\n     !sg;
      $final_list =~ s! \\\n[ ]*$!!s;        

      #$InfoBlock = Simple_Word_Wrap(join(' ', sort(@flags)), 65, '#All USE flags:');

      if(-w '/etc/make.conf')
         { save_use_flags($final_list); }
      #print $All;
      last;

   }
}

main();
exit(0);