#!/usr/bin/perl

# Copyright 1999-2002 Gentoo Technologies, Inc.
# Distributed under the terms of the GNU General Public License v2
# $Header: /home/cvsroot/gentoo-src/ufed/ufed.pl,v 1.2 2002/12/29 02:05:14 blizzy Exp $

# modified fava Apr 20/03
# added use strict vars and cleaned up resulting errors
# bug 15124 fixed (libg++ not listing)
# added processing of use.defaults and use.bask, virtuals not processed
# added (+ -) notation for flags how flags are enabled
# bug 19479 partially fixed. ignoring PortDir, if PORTDIR is based on something else ie ${BASE}/dir it will still fail
 
use File::Temp qw(tempfile);
use Term::ReadKey;
use strict "vars";

our $version = '0.3';

my @make_defaults_flags;
my @use_defaults_flags;
my @make_conf_flags;
my @use_mask_flags;
my @combined_flags;
my $PartialResults;

my %use_desc_flags;

our $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);
  $/ = "<<seperator>>";  # 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);
  $/ = "<<seperator>>";  # 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';
  }

  @flags = split(/[\r\n ]+/, $use);

  return @flags;
}

# @flags = get_make_defaults_flags()
sub get_make_defaults_flags
{
  return get_use_flags_from_file('/etc/make.profile/make.defaults', 1);
}

# @flags = get_make_conf_flags()
sub get_make_conf_flags
{
  my @flags = get_use_flags_from_file('/etc/make.conf', 0);

  if (($#flags + 1) == 1)
  {
    if (@flags[0] eq 'EMPTY')
    {
      #use_in_conf = 0;
      return;
    }
  }

  #use_in_conf = 1;
  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_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();

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

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

  my $make_defaults_temp = join(" ", @make_defaults_flags) . ' ';
  my $use_defaults_temp  = join(" ", @use_defaults_flags)  . ' ';
  my $make_conf_temp     = join(" ", @make_conf_flags)     . ' ';
  my $combined_temp      = join(" ", @combined_flags)      . ' ';

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

    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} . '" ';
  }
  $rc = system('dialog 2>' . $tempfile . ' --separate-output ' .
               '--no-shadow --backtitle "Gentoo Linux USE flags editor ' . $version . '" ' .
               '--ok-label Save --cancel-label Exit --help-label "What are USE flags?" ' .
               '--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)
        >> 8;
  if ($rc == 1)
  {
    return 'CANCEL';
  }
  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');

  $/ = "<<seperator>>";  # 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\"";
     }	

  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)


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 ufed will ignore any USE flags that are not
sanctioned by the Gentoo Linux developers team. Sanctioned USE flags can
be found in $PortageBase/profiles/use.desc


* * * * *

ufed was written by Maik Schreiber <blizzy\@gentoo.org>

Copyright 1999-2002 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
{
   # Then 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);
   my($Result) = $First;

   $Result =~ s![ \+\t]+! !g;  # remove multiple ' ' , tabs and +'s
   $Result = ' ' . $Result . ' ';           # add leading & trailing space so we can tell 'ab' and 'abc' apart
   for $u (split(m![ \+\t]+!, $Second))
   {
      #First we remove the flag from the Result list, and add it back in if required
      $Result =~ s! -?$u ! !ig;
      if($u =~ m![^\-]!) 
         {
	    $Result .= " $u ";
	 }
    }
    $Result =~ s![ ]+! !g;      # fix the spacing that is now broken
    return($Result);
}       

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))
   {
      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 . ' '; 

   print "Part:$PartialResults\n\n";
   print "Sel:" . join(' ', @selected) . "\n\n";
   # if something in $selected is allready in $combined it is removed from both lists
   # everything left in selected is a +flag, everything left in $results is a - flag
   
   for $f (@selected)
   {
      if(($PartialResults =~ s! $f ! !ig) != 0)
         { print "-:$f "; $f = ''; }
   }	 
  print "\nPart2:$PartialResults\n\n";
  $final = join(' ', @selected);
  print "Final:$final\n\n";
  $PartialResults =~ s! ([^ ]+)! -\1!g;
  $final = $final . ' ' . $PartialResults;
  $final =~ s!- ! !g;
  $final =~ s![ ]+! !g;

  return($final);
}  

sub main
{
  my @flags;
  my $selected_flags;
  my $flag;
  my $num_flags;
  my $Results;
  my $final_list;
  my( $i, $j);
  
  if( defined( $ENV{PORTDIR}))
     { $PortageBase = $ENV{PORTDIR}; }
  else
     {
        my $tmp = get_flag_from_file('/etc/make.conf', 'PORTDIR');
	if(defined($tmp))
	   {  $PortageBase = $tmp; }
     }
    
    # 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 1)
    @make_defaults_flags = get_make_defaults_flags();

    #Step 2)
    @use_defaults_flags = get_use_defaults_flags();
    $Results = resolve_flags(join(' ', @make_defaults_flags), join(' ', @use_defaults_flags));
    
    #Step 3)   
    @make_conf_flags = get_make_conf_flags();
    $Results = resolve_flags($Results, join(' ', @make_conf_flags));
    $PartialResults = $Results;  # we need PartialResults in order to calculate the final flags

    #Intermission
    %use_desc_flags = get_use_desc_flags();  
    # 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, @make_conf_flags)
       {
          $j = $i;    # yes I mean to do that,  dont 'fix' it
          $j =~ s!^[\-\+]+!!;
          if(exists($use_desc_flags{$j}) and $j ne "" )
	     { $use_desc_flags{$j} = "(Unknown)"; }
	}     

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

   # @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;
      }
    }
    
    $final_list = create_final_list(@flags);    
    # now lets get rid on any verboten flags that sneaked in
    for $i (@use_mask_flags)
      { $final_list =~ s![\-]?$i!!g; }
    $final_list =~ s![ ]+i! !g;  # delete all unnecessaty spaces
    $final_list =~ s!^[ ]+i!!g; 
    $final_list =~ s![ ]+$i! !g; 

    save_use_flags($final_list);
    
    last;
    
  }
}

main();
exit(0);