#!/usr/bin/perl
#
# $Id$
#
use lib qw(/usr/lib/libDrakX);
use standalone; # Should be set first

use strict;
use LWP::UserAgent; # to retrieve url
my $ua = LWP::UserAgent->new;

use Getopt::Long; # get command line arg

# interactive:
use interactive;
my $in; # will contain interacrive if need
use urpm;

# i18n
use Locale::gettext;
Locale::gettext::textdomain("urpmi.setup");

# Global var
my %param; # user param (ver, arch)
my $softver="0.3.9c";
my %list_source; # list of mirror
my %globinfo; # global info from server

sub help($)
	{
	my %help;
	my ($cmd)=@_;
	$help{'add'}=
_("urpmi.setup add [source=mirror]...\n").
_("Add a package source from mirror list:\n").
_("- source is the name (main, contrib...)\n").
_("- mirror is the dns name (ex: ftp.lip6.fr)\n")
;
	$help{'update'}=
_("urpmi.setup update [source]...\n").
_("update source list\n")
;
	$help{'remove'}=
_("urpmi.setup remove [source]...\n").
_("remove source list\n")
;
	$help{'list'}=
_("urpmi.setup list [name]\n").
_("List available mirror for source name").
_("if no name is given, list availlable source")
;
	
	return
_("Urpmi setup %s (GPL): Olivier Thauvin <thauvin\@aerov.jussieu.fr>\n",$softver) .
_("Usage: urpmi.setup [options] [[add|remove|update|list] [arg]]\n") .
_("options (*= can be set in /etc/urpmi/mirror.config):\n") . 
_("  -h|--help           Give this message\n") .
_("  -t|--test           Only show what it do\n") .
_("* -v|--verbose        Make it verbose\n") .
_("* -u|--url     url    Url to use to retrieve list\n") .
_("*   |--mdkver  ver    force mdk version to ver\n") .
_("*   |--arch    arch   force architecture to arch\n") .
_("*   |--proxy   host   proxy server to use\n") .
_("*   |--proxyport port proxy port\n").
"\n" . $help{$cmd}
;
	}

sub info()
	{
	return	
_("you\'re using url: %s
", $param{'url'}) . _("Mandrake version: %s
", $param{'mdkver'}). _("Arch: %s
", $param{'arch'})._("Proxy server: %s
", "http://".$param{'proxy'}.":".$param{'proxyport'}."/")

;
	}

# Get system info
sub get_current_ver()
	{
	open (VER,"/etc/mandrake-release") or die 'Can\'t open mandrake-release';
	@_=split(" ",<VER>);
	if ( $_[4] =~ /\(Cooker\)/ ) { $param{'mdkver'}='cooker';}
	else { $param{'mdkver'}=$_[3];};
	$param{'arch'}=$_[6];
	close(VER);
	}

# Read the config file
sub parse_config()
	{
	if (open(CONF, "/etc/urpmi/mirror.config")) {
		while (my $line = <CONF>) {
			chomp($line);             # no newline
			$line =~ s/#.*//;         # no comments
			$line =~ s/^\s+//;                # no leading white
			$line =~ s/\s+$//;                # no trailing white
			next unless length($line);        # anything left?
			my ($option, $value) = split(/\s*=\s*/, $line, 2);
			$param{$option}=$value;
			}
		close(CONF);
	} else {
		warn _("Can't open configuration file.\n");
		}
	}

sub urltofile()
	{
	my $file;
	if ( $param{'url'} =~ /^http:\/\// or  $param{'url'} =~ /^ftp:\/\//)
		{
		$file="/tmp/setup.list.tmp";
		if ( $param{'proxy'} and $param{'proxyprot'}) { $ua->proxy(['http','ftp'],"http://".$param{'proxy'}.":".$param{'proxyprot'}."/"); } else {$ua->proxy(['http','ftp'],"");}
		my $req = HTTP::Request->new('GET',$param{'url'});
		my $res = $ua->request($req,$file);
		return "" if (! $res->is_success);
		}
	else {	$file=$param{'url'}; $file =~ s/^file://; }
	return $file;
	}
	
sub parse_url ()
	{
		%globinfo=();
		%list_source=();
		if ( ! open (URLLIST, urltofile())) {
			return 1;
			}
		while ( my $line = <URLLIST>)
			{
			$line =~ s/#.*//;         # no comments
			$line =~ s/^\s+//;                # no leading white
			$line =~ s/\s+$//;                # no trailing white
			next unless length($line);        # anything left?
				
			my ($name,$mdkver,$arch,$location,$url)=split(':',$line,5);
			if ( ! $name ) { $globinfo{$arch}{$location}=$url; }
			else {
				my $mach=$url;
				$mach =~ s/^.*:\/\///;
				$mach =~ s/\/.*$//;
				if ((($mdkver eq $param{'mdkver'}) or ($mdkver eq '*')) and 
	    				(($arch eq $param{'arch'}) or ($arch eq '*') or ($arch eq 'noarch')))
					{$list_source{$name}{$mach}{'url'}=$url;
					$list_source{$name}{$mach}{'location'} = $location;}
				}
			}
		close(URLLIST);
		return (0);
	}
# Batch function
sub batch_add_source(@)
	{
	my @l=@_;
	if (parse_url()) {
		print STDERR  _("Can\'t read mirror list from:\n %s",$param{'url'});
		exit; }
	foreach (@l)
		{
		my ($name,$ftp)=split('=',$_);
		add_source_from_list($name,$ftp);
		}
	}

sub batch_remove_source(@)
	{
	remove_source(@_);
	}

sub batch_update_source(@)
	{
	update_source(@_);
	}

sub batch_list_source(@_)
	{
	my ($name) = @_;
	my %list;
	my @res=list_source($name);
	%list = map { s/\|.*//; $_ => ""} @res;
	print join("\n",sort keys %list) ."\n";
	}
# Interatice function
sub ask_add_source()
	{
	if (parse_url()) {
		$in->ask_warn(_("error"), _("Can\'t read mirror list from:\n %s",$param{'url'}));
		return; }
	if (! scalar %list_source ) {
		$in->ask_warn(_("Nothing can be add"),_("I am sorry, I can\'t find a source of package for your system.\n Are you sure your setting are good"));
		return; }
	
	my %user;
	my @lsource;
	my %msource;
	my %ftp;
	foreach my $name (keys %list_source) 
		{
		%{$msource{$name}}= map { $list_source{$name}{$_}{'location'}.' ('.$_ .')' => $_ } keys %{$list_source{$name}};
		$msource{$name}{_("  -not set-  ")}="";
		push @lsource, { val => \$user{$name}, label => $name ,type => 'combo',
			list => [sort keys %{$msource{$name}} ]
				};
		}
	return if (! $in->ask_from(_("Source list"),_("Select a source to add in your urpmi base"),[@lsource]));
	foreach (keys %user)
		{
		$ftp{$_}= $msource{$_}{$user{$_}} if ($msource{$_}{$user{$_}});	
		}

	if (scalar %ftp and $in->ask_yesorno(_("OK to setup ?"), _("Are you sure you setup urpmi for use %s",join(',',keys %ftp))))
		{
		foreach (keys %ftp) { add_source_from_list($_,$ftp{$_}); }
		}
	}
	
sub menu()
	{
		my %menu=(
			_("Command line help") => "help",
			_("System information") => "info",
			_("Configuration") => "config",
			_("List available source") => "listw",
			_("Remove Source") => "remove",
			_("Update urpmi base") => "update",
			_("Add urpmi sources") => "add"
			);
		return $menu{$in->ask_from_list(_("urpmi setup"),_("What do you want to do ?"),[keys %menu])};
	}

sub ask_remove_source()
	{
	my $media=1;
	my $urpm;
	while ($media)
		{
		my @medias;
		my %toremove;
		$urpm=  new urpm;
		$urpm->configure(nocheck_access => 1);
		foreach (@{$urpm->{media}})
			{ push @medias, { val => \$toremove{$_->{name}}, label => $_->{name}, type => 'bool' };}
		if (! scalar @medias) { 
			$in->ask_warn(_("No source"), _("No source of packages are setup, nothing to remove")); return; }
		return if (! $in->ask_from(_("Installed sources"),_("Choose a source to remove"),[@medias]));
		foreach (keys %toremove) { delete $toremove{$_} if (!$toremove{$_}); }
		remove_source(keys %toremove) if ($media and $in->ask_yesorno(_("Removing source ?"), _("Are you sure you want to remove %s ?",join (',',keys %toremove)))); 
		return if (scalar @medias < 2);
		}
	}

sub ask_update_source()
	{
		my $urpm=new urpm;
		$urpm->configure(nocheck_access => 1);
		my @medias;
		my %toupdate;
		foreach (@{$urpm->{media}})
			{ push @medias, {val => \$toupdate{$_->{name}}, label=> $_->{name}, type => 'bool'};}
		if ($in->ask_from('',_("Select urpmi source want to update"),[@medias]))
			{
			foreach (keys %toupdate) { delete $toupdate{$_} if (!$toupdate{$_}); }
			update_source(keys %toupdate);
			}
	}

sub ask_list_source()
	{
	$in->ask_from_treelist(_("list"),_("list"),"|",[list_source()]);
	}
	
sub config()
	{
		my %paramt=%param;
		%param=%paramt if ($in->ask_from('',_("Here you can change settings.\nTake care to keep compatibility with your system!"),[
			{label => _("Proxy server"),val => \$paramt{"proxy"}, type=> 'entry'},
			{label => _("Proxy port"),val => \$paramt{"proxyport"}, type=> 'entry'},
			{label => _("Mandrake version"),val => \$paramt{"mdkver"}, type=> 'entry'},
			{label => _("Architecture"),val => \$paramt{"arch"}, type=> 'entry'},  
			{label => _("Url for server list"),val => \$paramt{"url"}, type=> 'entry'}  
			]) );
	}


# Non Interactive function
#
#
sub add_source_from_list($$)
	{
	my ($name,$machine)=@_;
	if (!$list_source{$name}{$machine}) { print STDERR _("Mirror %s don't have %s, I can't add it\n",$machine,$name); return; }
	my $is_update=0;
	$is_update=1 if ( $globinfo{'urpmiopt'}{$name} =~ /--update/ );
	my ($url,$with,$hdlist) = split(' ', $list_source{$name}{$machine}{'url'});
	add_source(($name, $url, $hdlist, $is_update));

	}

sub add_source(@)
	{
	my ($name,$url,$hdlist,$is_update)=@_;
	my $urpm=new urpm;
	$urpm->read_config;
	$urpm->{proxy}{http_proxy}="http://".$param{'proxy'}.":".$param{'proxyport'} if ($param{'proxy'} and $param{'proxyport'});
	$urpm->add_medium($name, $url, $hdlist, update => $is_update);
	$urpm->update_media(update => 1);
	}
	
sub update_source(@)
	{	
	my @medias=@_;
	my $urpm=new urpm;
	$urpm->read_config;
	$urpm->{proxy}{http_proxy}="http://".$param{'proxy'}.":".$param{'proxyport'} if ($param{'proxy'} and $param{'proxyport'});
	$urpm->select_media(@medias);
	#- force ignored media to be returned alive.
	foreach (@{$urpm->{media}}) {
        	$_->{modified} and delete $_->{ignore};}
	$urpm->update_media(noclean => 0);
	}

sub remove_source(@)
	{
	my @medias=@_;
	my $urpm=new urpm;
	$urpm->configure(nocheck_access => 1
			);
	$urpm->select_media(@medias);
	$urpm->remove_selected_media;
	$urpm->update_media(noclean => 0);	
	}

sub list_source
	{
	my ($name)=@_;
	my @list;
	return if (parse_url());
	if ($name) { @list = map { $list_source{$name}{$_}{'location'}.' ('.$_ .')' } keys %{$list_source{$name}}; }
 	else {
		foreach my $name (keys %list_source)
			{
			push (@list,map { $name.'|'.$list_source{$name}{$_}{'location'}.' ('.$_ .')' } keys %{$list_source{$name}}); 
			}
		}
	return @list;
	}
	
# Begin main
$ua->agent("Urpmi.Setup/$softver");

get_current_ver;
parse_config;
	
GetOptions (
	"h|help" => \$param{'help'},
	"mdkver=s" => \$param{'mdkver'},
	"arch=s" => \$param{'arch'},
	"u|url=s" => \$param{'url'},
	"t|test" => \$param{'test'},
	"v|verbose" => \$param{'verbose'},
	"proxy" => \$param{'proxy'},
	"proxyport" => \$param{'proxyport'}
);

my ($action,@argument)=@ARGV;

if ($param{'help'})
	{
	print STDERR help($action);
	exit;
	}

if ($action =~ /list$/) {batch_list_source(@argument); exit; }
	
if (scalar @argument)
	{
	batch_add_source(@argument) if ($action =~ /add/);
	batch_update_source(@argument) if ($action =~ /update/);
	batch_remove_source(@argument) if ($action =~ /remove/);
	exit;
	}
	
$in='interactive'->vnew('su','default');
while ($_=$action or $_=menu())
	{
	$in->ask_warn(_("Info"),info()) if /info/;
	$in->ask_warn(_("Help"),help("")) if /help/;
	ask_add_source() if /add/;
	ask_update_source() if /update/;
	ask_remove_source() if /remove/;
	ask_list_source() if /listw/;
	config() if /config/;
	exit if ($action);
	}

$in->exit;