#!/usr/bin/perl -T

load_po();

$ENV{PATH} = "/sbin:/usr/sbin:/bin:/usr/bin:/usr/X11R6/bin";
delete $ENV{ENV};
$< = $>;

log_it(scalar localtime, " urpmi called with @ARGV\n");

if (@ARGV and $ARGV[0] eq '--auto') {
    $auto = 1;
    shift @ARGV;
}

if (@ARGV and $ARGV[0] eq '--X') {
    $X = 1;
    shift @ARGV;
}

if (@ARGV and $ARGV[0] eq '-a') {
    $all = 1;
    shift @ARGV;
}

while (@ARGV and $ARGV[0] eq '--comment') {
    shift @ARGV;
    shift @ARGV;
}

@ARGV or die(_("usage: urpmi [--auto] [-a] package_name [package_names...]\n"));

$dir = "/var/lib/urpmi";
$dir2 = "/etc/urpmi";
$depsfile = "$dir/depslist";

open SAVEOUT, ">&STDOUT";
open SAVEERR, ">&STDERR";
open STDOUT, "|tee -a /var/log/urpmi.log" or die;
open STDERR, "|tee -a /var/log/urpmi.log" or die;
select STDERR; $| = 1;     # make unbuffered
select STDOUT; $| = 1;     # make unbuffered

open F, $depsfile or die "run urpmi.addmedia first\n";
foreach (<F>) {
    my ($pack, $size, $deps) = /(\S+)\s+(\S+)\s+(.*)/ or die("urpmi: bad format file $depsfile\n");
    $size{$pack} = $size;
    $deps{$pack} = [ split ' ', $deps ];
    
    foreach $v (@ARGV) { 
	$_ = quotemeta $v;
	$pack =~ /^$_-[^-]+-[^-]+$/ and $exact{$v} = $pack;
	$pack =~ /^$_-[^-]+$/ and $exact{$v} = $pack;
	$pack =~ /^$_$/ and $exact{$v} = $pack;
	$pack =~ /$_/ and push @{$found{$v}}, $pack;
	$pack =~ /$_/i and push @{$foundi{$v}}, $pack; 
    }
}
close F or die();

my $ok = 1;
foreach (@ARGV) {
    my $pack = $exact{$_};
    if ($pack) {
	push @packages, $pack;
    } else {
	my $l = $found{$_} || $foundi{$_};
	if (@$l == 0) { 
	    warn(_("no package named %s\n", $_)); $ok = 0; 
	} elsif (@$l > 1 && !$all) {
	    warn(_("The following packages contain %s: %s\n", $_, join(' ', @$l))); $ok = 0; 
	} else {
	    push @packages, @$l;
	}
    }
}
$ok or exit 1;

@installed = `/bin/rpm -qa`; $? and die(_("rpm database query failed\n"));
foreach (@installed) {
    my ($name, $v, $r) = /(.*)-([^-]+)-([^-]+)\n/;
    exists $installed{$name} && le_version([$v, $r], $installed{$name}) or $installed{$name} = [$v, $r];
}
@installed{map { chop; $_ } @installed} = ();
my %to_install; closure_deps(\%to_install, @packages); @to_install = keys %to_install;

if (!$auto and difference2(\@to_install, \@packages)) {
    my $sum = 0; map { $sum += $size{$_} } @to_install;
    my $msg = _("To satisfy dependencies, the following packages are going to be installed (%d MB)", toMb($sum));
    my $msg2 = _("Is it ok?");
    if ($X) {
	my $p = join "\n", @to_install;
	my $ok = _("Ok");
	my $cancel = _("Cancel");
	`gmessage -default $ok -buttons "$ok:0,$cancel:2" "$msg:\n$p\n\n$msg2"`;
	$? and exit 0;
    } else {
	print SAVEOUT "$msg:\n@to_install\n$msg2 (Y/n) ";
	<STDIN> =~ /n/i and exit 0;
    }
}

$to_install = join '|', map { quotemeta($_) } @to_install;

foreach $list (rpmlistfiles($dir)) {
    open F, "$dir/$list" or die("urpmi: error opening $list\n");
    $list =~ s/list\.//;
    foreach (<F>) { chop; m|/($to_install)| and $long{$1} = $_, $name{$1} = $file; }
    close F;
}
foreach $l (@to_install) {
    local $_ = $long{$l} or die("urpmi: package $l is not available\n");
    if (s|removable_(\w+)_(\d*):/||) {
	my $n = "$2-$name{$l}";
	$removables{$n}->{name} = $name{$l};
	$removables{$n}->{device} = $1;
	push @{$removables{$n}->{list}}, $_;
    } else {
	if (s|^file:/||) {
	    if (m|^(/mnt/.*?)/|) {
		-e $_ || $try2mount{$1} or $try2mount{$1} = 1, `mount $1 2>/dev/null`;
	    }
	}
	push @to_install_long, $_;
    }
}

install(@to_install_long) unless $removables{0} || $removables{1};

foreach (sort keys %removables) {
    my $f = @{$removables{$_}->{list}}[0];
    my $dev = $removables{$_}->{device};
    `mount /dev/$dev 2>/dev/null`;
    unless (-e $f) {
	`umount /dev/$dev  2>/dev/null ; eject $dev  2>/dev/null`;
	message(_("Please insert the %s named %s", $removables{$_}->{device}, $removables{$_}->{name}));
	unless ($X) {
	    print SAVEOUT _("Press enter when it's done...");
	    <STDIN>;
	}
	`mount /dev/$dev  2>/dev/null`;
	unless (-e $f) {
	    message(_("Sorry can't find file %s, exiting", $f));
	    exit 1;
	}
    }
    install(@{$removables{$_}->{list}});
}

install(@to_install_long) if $removables{0} || $removables{1};

$something_was_installed or message(_("everything already installed"));

sub install {
    @_ or return;
	
    $something_was_installed = 1;
    print SAVEOUT _("installing %s\n", join(' ', @_));
    log_it(scalar localtime, " @_\n");
    system($X ? "grpmi" : ("rpm", "-U"), @_);
    if ($?) {
	message(_("Installation failed"));
	$X and exit 1; #- grpmi handles --nodeps and --force by itself

	print SAVEOUT _("Try installation without cheking dependencies?"), " (Y/n) ";
	<STDIN> =~ /n/i and exit 1;
	system("rpm", "-U", "--nodeps", @_);	

	if ($?) {
	    message(_("Installation failed"));
	    print SAVEOUT _("Try installation even more strongly (--force)?"), " (Y/n) ";
	    <STDIN> =~ /n/i and exit 0;
	    system("rpm", "-U", "--nodeps", "--force", @_);	
	}
    }
}

# uses @deps and @installed
sub closure_deps {
    my $to_install = shift;
    foreach (@_) {
	exists $to_install->{$_} and next;
	my ($name, $v, $r) = /(.*)-([^-]+)-([^-]+)/;
	exists $installed{$name} && le_version([$v, $r], $installed{$name}) and next;

	$to_install->{$_} = undef;
	my @d = @{$deps{$_}} or return $_;
      up: foreach (@d) {
	  my %l; 
	  foreach (split '\|') { 
	      exists $to_install->{$_} and next up;
	      my ($name, $v, $r) = /(.*)-([^-]+)-([^-]+)/;
	      if (exists $installed{$name}) {
		  le_version([$v, $r], $installed{$name}) and next up;
		  %l = ($name => [$v, $r]);
		  last;
	      }	      
	      $l{$name} = [$v, $r] unless $l{$name} && le_version([$v, $r], $l{$name});
	  }
	  my ($l) = my @l = map { "$_-$l{$_}[0]-$l{$_}[1]" } keys %l;

	  if (@l > 1 && !$auto) {
	      $msg = _("One of the following packages is needed:");
	      my $n;
	      if ($X) {
		  `gchooser "$msg" @l`;
		  $n = $? >> 8 || die;
	      } else {		  
		  print SAVEOUT "$msg\n";
		  my $i = 0; foreach (@l) { print SAVEOUT " ", ++$i, "- $_\n"; }
		  while (1) {
		      print SAVEOUT _("What is your choice? (1-%d) ", $i);
		      $n = <STDIN>;
		      1 <= $n && $n <= $i and last;
		      print SAVEOUT _("Sorry, bad choice, try again\n");
		  }
	      }
	      $l = $l[$n - 1];
	  }
	  closure_deps($to_install, $l);
      }
    }
}

#- compare a version string.
sub version_compare {
    my ($a, $b) = @_;
    local $_;

    while ($a && $b) {
	my ($sb, $sa) =  map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D+)// } ($b, $a);
	$_ = length($sa) cmp length($sb) || $sa cmp $sb and return $_;
    }
}
sub le_version {
    my $cmp = version_compare($_[0][0], $_[1][0]);
    return $cmp < 0 || $cmp == 0 && version_compare($_[0][1], $_[1][1]) <= 0;
}

sub toMb {
    my $nb = $_[0] / 1024 / 1024;
    int $nb + 0.5;
}

sub message { $X ? `gmessage -default Ok -buttons Ok "$_[0]"` : print SAVEOUT "$_[0]\n"; }
sub member($@) { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
sub uniq { my %l; @l{@_} = (); keys %l }
sub difference2(\@\@) { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
sub _ {
    my $s = shift @_; my $t = translate($s);
    $t && ref $t or return sprintf $t, @_;
    my ($T, @p) = @$t;
    sprintf $T, @_[@p];
}
sub translate { $I18N{$_[0]} || $_[0]; }

sub log_it {
    local *LOG;
    open LOG, ">>/var/log/urpmi.log" or die;
    print LOG @_;
}

sub untaint {
    my @r = ();
    foreach (@_) {
        /(.*)/;
	push @r, $1;
    }
    @r == 1 ? $r[0] : @r
}

sub load_po {
    my ($from, $to, $state, $fuzzy);

    my $lang = $ENV{LANGUAGE} || $ENV{LC_ALL} || $ENV{LC_MESSAGES} || $ENV{LANG};
    my $f; -e ($f = "/usr/share/locale/$_/LC_MESSAGES/urpmi.po") and last foreach split ':', $lang;

    local *F; open F, $f or return;
    foreach (<F>) {
	/^msgstr/ and $state = 1;
	/^msgid/  && !$fuzzy and $state = 2;

	if (/^(#|$)/ && $state != 3) {
	    $state = 3;
            s/\\n/\n/g foreach $from, $to;

	    if (my @l = $to =~ /%(\d+)\$/g) {
		$to =~ s/%(\d+)\$/%/g;
		$to = [ $to, map { $_ - 1 } @l ];
	    }
	    $I18N{$from} = $to if $from;
	    $from = $to = '';
	}
	$to .= (/"(.*)"/)[0] if $state == 1;
	$from .= (/"(.*)"/)[0] if $state == 2;

	$fuzzy = /^#, fuzzy/;
    }
}

sub rpmlistfiles {
    my ($d) = @_;
    local *F;
    opendir F, $d or die "all: can't open dir $d: $!\n";
    my @l = grep { /^list\.*/ } readdir F;
    closedir F;

    @l;
}