#!/usr/bin/perl


##~#~~#~~~#~~~~#~~~~~#~~~~~~#~~~~~~~#~~~~~~~~#~~~~~~~~~#~~~~~~~~~~#
# Name: clean_world                                                #
# Version: 0.0.2                                                   #
# Description: Tool for clean up the world file.                   #
# Programmer: Jiri Tyr                                             #
# Last update: 04.08.2006                                          #
##~#~~#~~~#~~~~#~~~~~#~~~~~~#~~~~~~~#~~~~~~~~#~~~~~~~~~#~~~~~~~~~~#


use strict;
use warnings;
use utf8;
use Getopt::Long;
use Term::ANSIColor qw(:constants);


binmode(STDOUT, ':utf8');
$| = 1;


# global variables
my $name = $0;
   $name =~ s/\.\///;
my $log_path = '/var/log/';
my $log_file = 'emerge.log';
my $log = $log_path.$log_file;
my $world_path = '/var/lib/portage/';
my $world_file = 'world';
my $world = $world_path.$world_file;
my $found = 0;
my (@lines_orig, @lines_new);
my (@pkgs, $test, $quiet, $debug, $help);


# get options
my $p = new Getopt::Long::Parser();
$p->configure('bundling');
$p->getoptions(
		'p|package=s'	=> \@pkgs,
		't|test'	=> \$test,
		'q|quiet'	=> \$quiet,
		'd|debug'	=> \$debug,
		'h|help'	=> \$help
);


# help
if (defined $help or scalar @pkgs == 0) {
	&help();
	exit 0;
}


&checkUserPermission();
&logFileInfo();

for (my $i=0; $i<scalar(@pkgs); $i++) {
	my $pkg = $pkgs[$i];
	my $time = time;

	# package name
	unless (defined $quiet) {
		&message('i', 'Looking for: '.$pkg);
	}


	&changeLogFile($pkg, $time);


	if ($found > 0) {
		&changeWorldFile($pkg, $time);
	}

	$found = 0;
}

# done
unless (defined $quiet) {
        &message('i', 'Done!');
}


exit 0;


####################~#~~#~~~#~~~~#~~~~~#~~~~~~#
### SUBPROGRAMS ###~~#~~~#~~~~#~~~~~#~~~~~~#
####################~#~~#~~~#~~~~#~~~~~#~~~~~~#


sub checkUserPermission() {
	unless (defined $test) {
		# check user (root account required)
		if ($> != 0) {
			&message('e', 'You have to be root to modify log file and world file or try to use -t option.');
			exit 1;
		}
	}
}


sub logFileInfo() {
	# log file informations
	unless (defined $quiet) {
		# log size
		my $file = `ls -lah $log`;
		my @file_info = split /\s/, $file;
		&message('i', 'Log size: '.$file_info[5]);

		if (defined $test) {
			&message('i', 'Test only!');
		}
	}
}


sub changeLogFile() {
	my $pkg = shift;
	my $time = shift;
	my (@lines_orig, @lines_new);

	# read log
	unless (defined $quiet) {
		&message('i', ' * Read original log file and write temp log file.');
	}

	open F_ORIG, $log or die 'Can not open original log file!';

	unless (defined $test) {
		open F_NEW, '>'.$log_path.'_'.$log_file or die 'Can not open new log file!';
	}

	my $pkg_tmp = $pkg;
	$pkg_tmp =~ s/\+/\\+/g;
	$pkg_tmp =~ s/\-/\\-/g;

	while (my $line = <F_ORIG>) {
		if ($line =~ /\*\*\* emerge/ and $line !~ /unmerge/ and $line !~ /\s+search\s+/ and $line !~ /--oneshot/ and $line !~ /emerge \(/ and ($line =~ /$pkg_tmp\s+/ or $line =~ /\s+=.[^\/]*\/$pkg_tmp\-.[^\s]+\s+/ or $line =~ /\s+=$pkg_tmp\-.[^\s]+\s+/)) {
			push @lines_orig, $line;

			# remove package name from lines
			$line =~ s/\$/ \$/;
			$line =~ s/(\s+$pkg_tmp\s+|\s+.[^\/\s]*\/$pkg_tmp\s+|\s+=.[^\/\s]*\/$pkg_tmp\-.[^\s]+\s+|\s+=$pkg_tmp\-.[^\s]+\s+)/ /;
			$line =~ s/ $/\n/;

			if ($line =~ /emerge\s+$/ or $line =~ /emerge\s.*--\w+$/) {
				$line = '';
			}

			push @lines_new, $line;

			$found++;
		}

		unless (defined $test) {
			print F_NEW $line
		}
	}

	unless (defined $test) {
		close F_NEW or die 'Can not close new log file!';
	}

	close F_ORIG or die 'Can not close original log file!';


	if ($found == 0) {
		&message('e', ' * No record found! This package is not in world.');
		return;
	} else {
		&message('i', ' * Found '.$found.' records.');
	}


	if (defined $debug) {
		# show found lines
		&message('i', ' * Found lines:');
		print @lines_orig;

		# show modified lines
	    	&message('i', ' * Modified lines:');
		print @lines_new;
	}


	unless (defined $test) {
		# backup log file
		unless (defined $quiet) {
			&message('i', ' * Backup log file.');
		}

		system("mv $log $log\_$pkg\-$time.bak");
		system("mv $log_path\_$log_file $log");
	}
}


sub changeWorldFile() {
	my $pkg = shift;
	my $time = shift;

	unless (defined $test) {
		# backup world file
		unless (defined $quiet) {
			&message('i', ' * Backup world file.');
		}
		system("mv $world $world\_$pkg\-$time.bak");

		unless (defined $quiet) {
			&message('i', ' * Run regenworld.');
		}
		my $dbg = '';
		unless (defined $debug) {
			$dbg = '1>/dev/null';
		}
		system('/usr/sbin/regenworld '.$dbg);
	}
}


sub message() {
	my $type = shift;
	my $mess = shift;

	unless (defined $quiet) {
		if ($type eq 'i') {
			print WHITE, BOLD, 'I: ', RESET;
		} elsif ($type eq 'e') {
			print RED, 'E: ', RESET;
		} else {
			die 'Undefined type of message!';
		}

		print $mess."\n";
	}
}


sub help() {
	print <<END;
Usage: $name [OPTIONS] --package=NAME

OPTIONS:
  -p, --package=NAME	package name
  -t, --test		only test
  -q, --quiet		do not print info messages
  -d, --debug		show all messages
  -h, --help		print this help

Examples:
  $name --package=apr
  $name -t -p apr-util
  $name -q -p id3lib -p arp-util

Report bugs to <jiri.tyr(at)e-learning(dot)vslib(dot)cz>.
END
}