#!/usr/bin/perl -w
# Script for regenerating world-file in Gentoo Linux
# http://forums.gentoo.org/viewtopic.php?t=2480
#
# 2002-09-12 - Updated for use with app-admin/gentoolkit-0.1.11
#
# 2003-01-31 - jyrki muukkonen (sibbe@localhost)
#   - proper date format :P
#   - removed root-uid check
#   - added some command line parameters (uses Getopt::Std)
#       -o file,    print output to file, defaults to "-" (stdout)
#       -v,         be verbose, turned off by default
#       -h          print usage
#

use strict;
use Getopt::Std;

my %syspackages;    # System packages (filtered - shouldn't be in world)
my @array;          # Temp array
my %opts;           # hash for command line options

# parse command line options
getopts("hvo:", \%opts);
$opts{o} = "-"  unless defined $opts{o}; # print to stdout if no file given
$opts{v} = 0    if $opts{o} eq "-";      # be non-verbose if writing to stdout

# print usage and exit if we got -h as a parameter
if($opts{h}) {
    print "usage: $0 [-h] [-v] [-o filename]\n";
    print "\t-h\t\tthis help screen\n";
    print "\t-v\t\tbe verbose\n";
    print "\t-o filename\twrite output to \"filename\", "
          ."defaults to \"-\" (stdout)\n";
    print "\t\t\t-v flag is disabled when using stdout\n";
    print "\n";
    exit 0;
}

print "Writing output to \"$opts{o}\".\n" if($opts{v});

# Determine which packages are part of the "system" set
print "Determining system packages for exclusion (use emerge system for "
      ."updating such packages)...\n" if($opts{v});
my @temp = `emerge --pretend --emptytree system`
    or die "Problem invoking emerge!\n";
foreach (@temp) {
    # Push system packages into temporary array
    if (/\] .+\/(.+?)-.+\ /s) {
        push @array, $1 => 1;
    }
}

# Assign to hash for fast checking below
%syspackages = @array;

# Grab list of installed packages
print "Determining installed packages on your system...\n" if($opts{v});
my @packages = `qpkg -I`
    or die "Problem invoking qpkg, make sure you have gentoolkit installed!\n";

# Now filter and output to world.new
print "Lists compiled. "
      ."Attempting to write to \"$opts{o}\"...\n" if($opts{v});
open(FILE, "> $opts{o}")
    or die "Couldn't write to \"$opts{o}\" - check permissions?\n";
foreach (@packages) {
    # Grab pure package name
    /^\x1B.+?m(.+)\/\x1B.+?m(.+)\ /s;
    my $package = "$1\/$2";
    my $name = $2;
    # Output package to world.new unless it is a system package
    unless ($syspackages{$name}) {
        print FILE "$package\n" or
            die "Could not output $package to \"$opts{o}\"";
        print "Added: $package\n" if($opts{v});
    }
}
close(FILE);

# Finished
print "Success. Please edit the \"$opts{o}\" file to your satisfaction. "
      ."Then copy it to \"/var/cache/edb/world\"\n\n" if($opts{v});
1;