#!/usr/bin/perl

use strict;
use lib qw(/usr/lib/libDrakX);
use common qw(:common :file :functional :system);
use my_gtk qw(:all);
use POSIX ":sys_wait_h";
use interactive_gtk;
use c;

local $_ = join '', @ARGV;

/-h/ and die "usage: rpmdrake [--uninstall] [--bigmem] [--lowmem]\n";

$> && `id -Gn` !~ /urpmi/ and exec "kdesu", "-c", "$0 @ARGV";

$::isStandalone = 1;

my $DIR = "/var/lib/urpmi";
my $bigMem = availableRam() > 60000;

c::rpmReadConfigFiles();

my $in = interactive_gtk->new;
my $w = $in->wait_message('', _("reading configuration"));

my %installed; @installed{split ' ', `rpm -qa --queryformat "%{NAME} "`} = ();

my @medias = map { /list\.(.*)$/ } glob_("$DIR/list.*");
my @media_types = qw(CDROM local FTP HTTP);
my (%entries2node, $current_name, %groups, %entries, $provides, $root, $tree_title, $isUninstall, %provides);

$isUninstall = 1 if /-uninstall/;
$bigMem = 1 if /-bigmem/;
$bigMem = 0 if /-lowmem/;

my $window = new Gtk::Window;
my $tree_window = new Gtk::ScrolledWindow(undef, undef);
my $tree;

$window->signal_connect(delete_event => sub { Gtk->main_quit });
$window->set_title("rpmdrake");
gtkadd($window, gtkpack_(new Gtk::VBox(0,4),
  0, gtkappend(new Gtk::MenuBar,
	create_menu(_("File"),
	      gtksignal_connect(new Gtk::MenuItem(_("Quit")), 'activate' => sub { Gtk->main_quit }),
        ),
	create_menu(_("Search"),
	    gtksignal_connect(new Gtk::MenuItem(_("Package")), 'activate' => \&SearchPackage),
	    gtksignal_connect(new Gtk::MenuItem(_("File")), 'activate' => \&SearchPackageFile),
	    gtksignal_connect(new Gtk::MenuItem(_("Text")), 'activate' => \&SearchPackageDescr),
	),
	create_menu(_("Tree"), 
	      create_menu(_("Sort by"),
	          gtksignal_connect(new Gtk::MenuItem(_("Category")), 'activate' => sub { CreateTree($isUninstall, 'noflat') }),
	          gtksignal_connect(new Gtk::MenuItem(_("Package")), 'activate' => sub { CreateTree($isUninstall, 'flat') }),
	      ),
	      create_menu(_("See"),
		  gtksignal_connect(new Gtk::MenuItem(_("Installed packages")), 'activate' => sub { CreateTree(1) }),
		  gtksignal_connect(new Gtk::MenuItem(_("Available packages")), 'activate' => sub { CreateTree(0) }),
	      ),
	      my $w_leaves = gtksignal_connect(new Gtk::MenuItem(_("Show only leaves")), 'activate' => sub { CreateTree($isUninstall, 'urpmi_rpm-find-leaves --show-unknown') }),
#	       my $w_leaves = create_menu(_("Show only leaves"),
#		   gtksignal_connect(new Gtk::MenuItem(_("Fast but dirty")), 'activate' => sub { CreateTree($isUninstall, 'urpmi_rpm-find-leaves') }),
#		   gtksignal_connect(new Gtk::MenuItem(_("Precise but slow")), 'activate' => sub { CreateTree($isUninstall, 'rpm-find-leaves') }),
#	       ),
	      gtksignal_connect(new Gtk::MenuItem(_("Expand all")), 'activate' => sub { $tree->expand_recursive(undef) }),
	      gtksignal_connect(new Gtk::MenuItem(_("Collapse all")), 'activate' => sub { $tree->collapse_recursive(undef) }),
	),
	create_menu(_("Configuration"),
	      create_menu(_("Add location of packages"),
	           map { my $m = $_; gtksignal_connect(new Gtk::MenuItem($_), 
						       'activate' => sub { AddMedia($m) }) 
			 } @media_types),
	      create_menu(_("Update location"),
	           map { my $e = $_; gtksignal_connect(new Gtk::MenuItem($_), 
						       'activate' => sub { UpdateMedia($e) }) 
			 } @medias),
              create_menu(_("Remove"),
		   map { my $e = $_; gtksignal_connect(new Gtk::MenuItem($_), 
						       'activate' => sub { RemoveMedia($e) })
			 } @medias),
	),
  ),
  0, my $toolbar = new Gtk::Toolbar('horizontal', 'icons'),
  1, gtkpack(new Gtk::HBox(0,0),
	     gtkadd($tree_title = new Gtk::Frame(''),
		    gtkset_usize($tree_window, 180, 300)),
	     gtkpack_(gtkset_usize(new Gtk::VBox(0,0), 350, 0),
		      1, createScrolledWindow(my $info_widget = new Gtk::Text),
		      0, my $button = new Gtk::Button,
			     )))
);
$tree_window->add($tree = Gtk::CTree->new(1, 0));
$tree->set_selection_mode('browse');
$tree->realize;

my %toolbar = my @toolbar = 
(
 fileopen=>[ _("Configuration: Add Location"), sub { AddMedia($in->ask_from_list('', "Which media?", \@media_types) || return) } ],
 ftout =>  [ _("Expand Tree") , sub { $tree->expand_recursive(undef) } ],
 ftin  =>  [ _("Collapse Tree") , sub { $tree->collapse_recursive(undef) } ],
 find  =>  [ _("Find Package"), \&SearchPackage ],
 findf =>  [ _("Find Package containing file"), \&SearchPackageFile ],
 reload=>  [ _("Toggle between Installed and Available"), sub { CreateTree(!$isUninstall) } ],
);
$toolbar->show;
$toolbar->set_button_relief("none");
foreach (grep_index { $::i % 2 == 0 } @toolbar) {
    gtksignal_connect($toolbar->append_item(undef, $toolbar{$_}[0], undef, gtkxpm($tree, "/usr/lib/libDrakX/icons/$_.xpm")),
		      clicked => $toolbar{$_}[1]);
}
$toolbar->set_style("icons");

my @icon = xpm_d($tree, my @icon_xpm);
my @group_open  = xpm_d($tree, my @group_open_xpm);
my @group_close = xpm_d($tree, my @group_close_xpm);

CreateTree();

$window->show;
$button->hide;
$button->signal_connect('clicked' => sub { $isUninstall ? Uninstall() : Install() });
$w = undef; #- remove it
Gtk->main;
$in->exit(0);

sub select_row {
    my ($name) = @_;    
    if (my $e = $entries{$name}) {
	my (undef, $version, $release, $size, $summary, $description, @files) = @$e;

	$button->show;
	$current_name = $name;
	gtktext_insert($info_widget, "$summary\n\n" .
		       _("Version: %s\n", "$version-$release") .
		       _("Size: %d KB\n", $size / 1024) . "\n" .
		       formatLines($description) .
		       (@files ? "\n\n" . _("Files:\n") . join("\n", @files) : "")
		       );
    } else {
	$button->hide;
	gtktext_insert($info_widget, '');
    }
}

sub CreateTree {
    $isUninstall = $_[0] if defined $_[0];
    my $option = $_[1];
    %entries = (); %groups = (); %entries2node = ();
    $isUninstall ? read_installed($option =~ "leaves" && $option) : read_hdlists();

    $w_leaves->set_sensitive($isUninstall);

    $tree_window->remove($tree);
    $tree->destroy;
    gtkadd($tree_window, $tree = Gtk::CTree->new(1, 0));
    $tree->set_selection_mode('browse');

    $button->remove($button->children) if $button->children;
    gtkadd($button, $isUninstall ? _("Uninstall") : _("Install"));

    $tree_title->set_label($isUninstall ? _("Installed packages") : _("Choose package to install"));

    $root = {};

    my $flat if 0;
    $flat = 1 if $option eq 'flat';
    $flat = 0 if $option eq 'noflat';

    if ($flat) {
	$entries2node{$_} = node($root, $_, 1, 0) foreach sort keys %entries;
    } else {
	foreach (sort keys %groups) {
	    my $r = $root;
	    $r = $r->{$_} ||= node($r, $_, 0, 0) foreach split '/';
	    $entries2node{$_} = node($r, $_, 1, 0) foreach sort uniq @{$groups{$_}};
	}
    }
    $tree->signal_connect("select_row" => sub { select_row($tree->get_pixtext($_[1], 0)) });
}

sub Install { 
    fork || exec "gurpmi", $current_name;
    $tree->remove_node($entries2node{$current_name});
    $installed{$current_name} = 1;
}

sub Uninstall { 
    my $w = $in->wait_message(_("Wait"), _("Checking dependencies"));
    chop(my $n = `rpm -q $current_name`); #- assure we get only one named $current_name in case of multiple packages with same name
    %provides or load_provides();

    my %toremove; @toremove{$n, @{$provides{$n} || []}} = (); 
    my $changed = 1; while ($changed) { $changed = 0;
	local *F;
	open F, "rpm -e --test " . join(" ", keys %toremove) . " 2>&1 |";
	foreach (<F>) {
	    if (/package (\S+) is not installed/) {
		delete $toremove{$1};
	    } elsif (/is needed by (\S+)/ && ! exists $toremove{$1}) {
		$toremove{$1} = 1;
		$changed = 1;
	    }
	}
    }
    $w = undef;
    my @toremove = keys %toremove or return;
    @toremove == 1 or $in->ask_yesorno(_("Uninstall"), [ _("The following packages are going to be uninstalled"), @toremove ], 1) or return;
    tryExec( _("Uninstalling the RPMs"), su("rpm", "-e", @toremove));

    foreach (`rpm -q @toremove 2>&1`) {
	/ (.*)-.+-/ or next;
	delete $installed{$1};
	$tree->remove_node($entries2node{$1});
	delete $entries{$1};
    }
}

sub select_node {
    my ($n) = @_;
    my $r = $root; if (%$r) { $tree->expand($r = $r->{$_}) foreach split '/', $entries{$n}[0] }
    $tree->select($entries2node{$n});
    $tree->node_moveto($entries2node{$n}, 0, 0.5, 0);
    select_row($n);
}
sub SearchPackage {
    my ($old, $nb) if 0;
    my $s = $in->ask_from_entry(_("Search"), _("Which package are looking for"), _("Regexp"), $old) or return;
    $old eq $s ? $nb++ : (($old, $nb) = ('', 0));
    my $i = 0; foreach (keys %entries) {
	if ($i < $nb) {
	    $i++ if /$old/i;
	} else {
	    /$s/i and select_node($_), goto found;
	}
    }
    $in->ask_warn(_("No match"), $nb ? _("No more match") : _("%s not found", $s));
    $nb = -1;
found:
    $old = $s;
}
sub SearchPackageFile {
    unless ($bigMem) {
	$in->ask_okcancel('', 
_("rpmdrake is currently in ``low memory'' mode.
I'm going to relaunch rpmdrake to allow searching files"), 1) or return;
	$bigMem = 1;
	my $w = $in->wait_message('', '');
	CreateTree();
    }
    my ($old, $nb) if 0;
    my $s = $in->ask_from_entry(_("Search"), _("Which file are you looking for"), _("File"), $old) or return;
    $old eq $s ? $nb++ : (($old, $nb) = ('', 0));
    my $i = 0; while (my ($n, $v) = each %entries) {
	if ($i < $nb) {
	    $i++ if index($v->[-1], $old) >= 0;
	} else {
	    index($v->[-1], $s) >= 0 and select_node($n), goto found;
	}
    }
    $in->ask_warn(_("No match"), $nb ? _("No more match") : _("%s not found", $s));
    $nb = -1;
found:
    $old = $s;
}
sub SearchPackageDescr {
    my ($old, $nb) if 0;
    my $s = $in->ask_from_entry(_("Search"), _("What are looking for"), _("Regexp"), $old) or return;
    $old eq $s ? $nb++ : (($old, $nb) = ('', 0));
    my $i = 0; while (my ($n, $v) = each %entries) {
	if ($i < $nb) {
	    $i++ if $v->[4] =~ /$old/ || $v->[5] =~ /$old/;
	} else {
	    $v->[4] =~ /$s/ || $v->[5] =~ /$s/ and select_node($n), goto found;
	}
    }
    $in->ask_warn(_("No match"), $nb ? _("No more match") : _("%s not found", $s));
    $nb = -1;
found:
    $old = $s;
}

sub AddMedia {
    local ($_) = lc $_[0];
    my ($name, $dir, $with);
    for (my $i = 1; member($name = "${_}_$i", @medias); $i++) {}

    my @e = (_("Give a name (eg: `extra', `commercial')"), => \$name);
    if (/local/) {
	push @e, _("Directory") => \$dir;
    } elsif (/cdrom/) {
	eval { all("/mnt/cdrom") } && !$@ or system("mount /mnt/cdrom");
	eval { all("/mnt/cdrom") } && !$@ or $in->ask_warn(_("Error"), _("No cdrom available (nothing in /mnt/cdrom)")), return;
    } else {
	$dir = "$_://";
	$with = "../base/hdlist";
	push @e, _("URL of the directory containing the RPMs") => \$dir;
	push @e, _("For FTP and HTTP, you need to give the location for hdlist
It must be relative to the URL above") => \$with;
    }
    $in->ask_from_entries_refH(_("Add"), _("Please submit the following information"), \@e,
			       complete => sub {
				   member($name, @medias) and $in->ask_warn(_("Error"), _("%s is already in use", $name)), return (1, 0);
			       }) or return;
    my $param;
    if (/local/) {
	$param = "file:/$dir";
    } elsif (/cdrom/) {
	my $nb = -e "/mnt/cdrom/Mandrake/base" ? 1 : 3;
	$param = "removable_cdrom_$nb://mnt/cdrom";
    } else {
	$param = "$dir with $with";
    }
    tryExec(_("Updating the RPMs base"), su("/usr/sbin/urpmi.addmedia", $name, $param));
    exec $0; #- restart (needed to clean the menu)
}

sub UpdateMedia {
    my ($m) = @_;
    tryExec(_("Updating the RPMs base"), su("/usr/sbin/urpmi.update", $m));
    CreateTree();
}


sub RemoveMedia {
    my ($m) = @_;
    $in->ask_okcancel(_("Remove"), _("Going to remove entry %s", $m), 1) or return;
    tryExec(_("Updating the RPMs base"), su("/usr/sbin/urpmi.removemedia", $m));
    exec $0; #- restart (needed to clean the menu)
}

sub add_header {
    my ($h, $name) = @_;
    if (exists $entries{$name}) {
	my $i; for ($i = 2; exists $entries{"$name-$i"}; $i++) {}
	$name = "$name-$i";
    }
    push @{$groups{c::headerGetEntry($h, "group")}}, $name;
    $entries{$name} = [ map { c::headerGetEntry($h, $_) } qw(group version release size summary description) ]; #- be carefull not to modify the order here! (or look through the code)
    push @{$entries{$name}}, join("\n", c::headerGetEntry($h, 'filenames')) if $bigMem;
}

sub read_hdlists {
    foreach (glob_("$DIR/hdlist.*")) {
	local *F; 
	open F, /\.gz$/ ? "gzip -dc $_ |" : $_ or next;
	while (my $h = c::headerRead(fileno *F, 1)) {
	    my $name = c::headerGetEntry($h, "name") or next;
	    next if exists $installed{$name};
	    add_header($h, $name);
	    c::headerFree($h);
	}
    }
}

sub read_installed {
    my ($leaves) = @_;
    my %leaves; do { 
	my $w = $in->wait_message(_("Finding leaves"), _("Finding leaves takes some time"));
#	if ($leaves =~ /urpmi/) {
	    @leaves{ map { chop; $_ } `$leaves` } = ();
#	} else {
#	    @leaves{ map { /(.*)-[^-]+-/ } `$leaves` } = ();
#	}
    } if $leaves;

    my $db = c::rpmdbOpenForTraversal('') or die "unable to open /var/lib/rpm/packages.rpm";
    c::rpmdbTraverse($db, sub {
	my $name = c::headerGetEntry($_[0], "name") or return;
	return if $leaves && !exists $leaves{$name};
	add_header($_[0], $name);
    });
    c::rpmdbClose($db);
}

sub load_provides {
    local *F;
    open F, "$DIR/depslist" or return;
    foreach (<F>) {
	my ($p, undef, @l) = split;
	push @{$provides{$_}}, $p foreach @l;
    }
}

sub xpm { my $w = shift; Gtk::Gdk::Pixmap->create_from_xpm($w->window, $w->style->bg('normal'), @_) }
sub xpm_d { my $w = shift; Gtk::Gdk::Pixmap->create_from_xpm_d($w->window, undef, @_) }
sub gtkxpm { new Gtk::Pixmap(xpm(@_)) }
sub node { 
    my ($node, $text, $leaf, $expanded) = @_;
    $node = undef unless ref $node eq "Gtk::CTreeNode";
    if ($leaf) {
	$tree->insert_node($node, undef, [ $text ], 5, 
			   $icon[0], $icon[1],
			   undef, undef,
			   1, $expanded);
    } else {
	$tree->insert_node($node, undef, [ $text ], 5, 
			   $group_close[0], $group_close[1],
			   $group_open[0],  $group_open[1],
			   0, $expanded);
    }
}

sub su { $> ? ("kdesu", "-c", join(" ", @_)) : @_ }
sub tryExec {
    my $mesg = shift;
    my $pid = fork or exec @_;
    my $w = $in->wait_message(_("Wait"), $mesg);
    until (waitpid($pid, &WNOHANG)) { my_gtk::flush; sleep 1 }
}

BEGIN {
@icon_xpm = (
'15 16 11 1',
' 	c None',
'.	c #020204',
'+	c #637BA6',
'@	c #D3AE24',
'#	c #F9C80B',
'$	c #433C27',
'%	c #7489AA',
'&	c #605F53',
'*	c #332F21',
'=	c #A79445',
'-	c #887837',
'               ',
'               ',
'         #$    ',
'    -   @#*    ',
'   $##@@##*    ',
'    -#####=    ',
'     @######@- ',
'     ######@-$ ',
'    @#####&.   ',
'   -#=%@##*    ',
'    *$%&@#*    ',
'     %%* @*    ',
'     +&&       ',
'     %*        ',
'    %%         ',
'    %*         ',
);
@group_open_xpm = (
'16 16 8 1',
' 	c None',
'.	c #020204',
'+	c #938A6D',
'@	c #D4C495',
'#	c #B0A57E',
'$	c #605A4A',
'%	c #363531',
'&	c #E4DBC0',
'                ',
'                ',
'    ....        ',
'   .####.       ',
'  .#+#+#+...... ',
'  .#+#+#+#++++$.',
' ...........$%+.',
'.&&&&&&@&&&@.$$.',
'.&@#@#@#@#@#.$$.',
' .&@#@#@#@#@+.$.',
' %&#@#@#@#@#@.$.',
'  %&#@#@#@#@#$..',
'  .@#+#+#+#+#+..',
'   ............ ',
'                ',
'                ',
);

@group_close_xpm = (
'16 16 11 1',
' 	c None',
'.	c #020204',
'+	c #8E866C',
'@	c #CCC4A8',
'#	c #AEA683',
'$	c #E9E3CF',
'%	c #C5B993',
'&	c #676352',
'*	c #7E7361',
'=	c #DACFA8',
'-	c #A09578',
'                ',
'                ',
'    ....        ',
'   .%-%-.       ',
'  .#+#+#+...... ',
'  .$$$$$$$$@=$%.',
'  .=%=%=%=%%#%+.',
'  .$=%=%=%%#%#*.',
'  .=%=%@%%#%##&.',
'  .$=%=%%#%##-*.',
'  .=%=#%#%##--&.',
'  .$=%%#%##--+&.',
'  .=*+*-*+*&&&&.',
'   ............ ',
'                ',
'                ',
);

}
