#!/usr/bin/perl
use warnings;
use strict;
use feature 'switch';
use Term::ANSIColor ':constants';
use File::Copy 'cp';
use IO::Pty::Easy;
use subs qw/ask_action full_update kernels_in_usr parse_version pipeprint update_world update update_kernel/;

die exec 'sudo',$^X,$0,@ARGV if $<; #exec perl $0 @ARGV as root if we are UID != 0

my ($NOSYNC,$CONFIGURE_KERNEL) = (0,0);
my @remove;
my $opts = "-uND --with-bdeps=y ";
$opts .= $ENV{EXTRA_OPTS} if defined $ENV{EXTRA_OPTS};

for (my $i = 0; $i <= $#ARGV+1; $i++)
{
    if ($i > $#ARGV) { full_update }
    else
    {
        given ($ARGV[$i])
        {
            when ('--nosync')      { printf "setting \$NOSYNC to '%s'\n",$NOSYNC=1 }
            when (/--(\w+)config/) { printf "setting \$CONFIGURE_KERNEL to '%s'\n",$CONFIGURE_KERNEL="${1}config" }
            default                { update $ARGV[$i] }
        }
    }
}

system 'etc-update';
system 'elogv';

print "\n\n";
if (+@remove)
{
    print "Please remove leftover files/folders:\n";
    print "rm -fr @remove\n";
}

sub full_update
{
    system qw/layman -S/ unless $NOSYNC;
    system qw/eix-sync/ unless $NOSYNC;
    my @extra_update = update_world;
    system qw/smart-live-rebuild/;
    system qw/emerge -ca/;
    update @extra_update;
    system 'logrotate -v /etc/logrotate.conf';
}

sub kernels_in_usr
{
    opendir my $DH,'/usr/src';
    my @ret;

    for my $i (readdir $DH)
    {
        push @ret,$1 if $i =~ /linux-(.+-gentoo(-r[1-9][1-9]?)?)/;
    }

    closedir $DH;
    return sort {parse_version($b) <=> parse_version($a)} @ret;
}

sub parse_version
{
    my ($arg) = @_;
    $arg =~ s/^(.+)-gentoo/$1/ or die "sanity check failed on $arg"; #3.6.10-gentoo => 3.6.10
    $arg =~ s/-r([0-9][0-9]?)/.$1/g; #3.6.10-r1 => 3.6.10.1
    my @components = split /\./,$arg; # 3.6.10.1 => 3, 6, 10, 1
    $components[3] = 0 if +@components<4; #3, 6, 10 => 3, 6, 10, 1
    die "parse_version: error: string @components consists of ".@components." parts!\n" if +@components != 4;

    my $ret;
    for (my $i = 0; $i <= 3; $i++)
    {
        $components[$i] *= 10**(3-$i);
        $ret += $components[$i];
    }
    return $ret;
}

sub pipeprint
{
    open my $h,'|less -r';
    print $h @_;
    close $h;
}

sub update_world
{
    my @emerge_cmd = ( q/emerge/,split(/\s+/,$opts),qw/-va --color=y @world @system/ );
    print BOLD,GREEN,"\nCalculating update path...\n",RESET,"(command line is: @emerge_cmd)\n";

    my $pty = IO::Pty::Easy->new;
    $pty->spawn(@emerge_cmd);

    my $line;
    my $emerge_data = q//;
    while ($line = $pty->read)
    {
        print $line;
        $emerge_data .= $line;
        last if $line =~ /Total:/;
    }

    my @pkglist;
    # We need a smart way to parse the data:
    # - extract all packages that are going to be operated upon
    # - return those (push @ret)
    for my $i (split /\n/,$emerge_data)
    {
        # first, remove *relevant* escape sequences by building a regex for them
        $i =~ s/(\[32;01m)|(\[32m)|(\[39;49;00m)//g;
        # now extract the packages that are going to be acted upon
        $i =~ m!^\[.+?\] (.+?)/(.+?) ! or next;
        my $pkg = "$1/$2";
        # now strip off version
        if ($pkg =~ /(^.+)-r[0-9]+/) { $pkg = $1 }
        $pkg =~ /^(.+)\/(.+)-.+?$/ or die "$pkg does not match regex";
        $pkg = "$1/$2";
        push @pkglist,$pkg;
    }
    print BOLD,scalar @pkglist," packages will be affected (full list: @pkglist).\n";

    for (;;)
    {
        print BOLD,WHITE,"\nProceed? ",RED,"[ynrsS]",WHITE,"\n  (r = rerun this step; s = break into shell;\n\t S = scroll output) ",RESET;
        given (<STDIN>)
        {
            when ("y\n") { last                   }
            when ("n\n") { die "Exiting.\n"       }
            when ("r\n") { return update_world    }
            when ("s\n") { system 'bash'; next    }
            when ("S\n") { pipeprint $emerge_data }
            default      { print "What?\n"        }
        }
    }
    $pty->write("y\n");
    while ($pty->is_active)
    {
        my $data = $pty->read;
        print $data if defined $data;
    }
    $pty->close;
    return @pkglist;
}

sub update
{
    for my $arg (@_)
    {
        given ($arg)
        {
            when ('dev-lang/perl' )             { system qw/perl-cleaner --reallyall/ ; push @remove,"those random perl dirs" }
            when ('dev-lang/python' )           { system qw/python-updater/ }
            when ('sys-kernel/gentoo-sources' ) { update_kernel }
            when ('sys-apps/manpages' )         { system qw/makewhatis -u/ }
            when ('sys-devel/gcc' )             { system qw|emerge -1 sys-devel/libtool| }
            when ('dev-libs/icu')               { system qw|emerge -1 dev-qt/qtcore| }
            when ('dev-lang/ocaml')             { system qw|emerge -1 /usr/lib64/ocaml| }
            when ('dev-libs/glib')              { system qw|emerge -1 gobject-introspection dev-libs/dbus-glib| }
            when ('media-gfx/splashutils')      { system qw|splash_geninitramfs -g /boot/initramfs.cpio.gz -r 1280x1024 -v livedvd-12.0| }
            when ('stop')                       { die "Stopped as requested.\n" }
            #default: package does not require special care => do nothing
        }
    }
}

sub update_kernel
{
    my @usr = kernels_in_usr;
    push @remove,"/usr/src/linux-$_","/lib/modules/$_","/boot/*$_" for @usr[2..$#usr];

    chdir '/usr/src/linux';
    cp "/usr/src/linux-$usr[1]/.config",'.config';
    system qw/make -j4 oldconfig/;
    system qw/make -j4/,$CONFIGURE_KERNEL if $CONFIGURE_KERNEL;
    system qw/make -j4/;
    system qw/make -k modules_install install/;
    system qw|grub-mkconfig -o /boot/grub/grub.cfg|;
    system qw/emerge -1 vhba vmware-modules ati-drivers/;
}