Initial revisionV2_0topic/RPMDRAKE

1 files changed, 284 insertions, 0 deletions

diff --git a/rpmdrake.pm b/rpmdrake.pm
new file mode 100644
index 00000000..22c5b158
--- /dev/null
+++ b/rpmdrake.pm
@@ -0,0 +1,284 @@
+#*****************************************************************************
+# 
+#  Copyright (c) 2002 Guillaume Cottenceau (gc at mandrakesoft dot com)
+# 
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License version 2, as
+#  published by the Free Software Foundation.
+# 
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+# 
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+# 
+#*****************************************************************************
+#
+# $Id$
+
+use standalone;     #- warning, standalone must be loaded very first, for 'explanations'
+
+use MDK::Common;
+use urpm;
+use URPM;
+use URPM::Resolve;
+use packdrake;
+use vars qw($configfile %config $mandrakeupdate_wanted_categories $already_splashed);
+use my_gtk qw(:helpers :wrappers :ask);
+my_gtk::add_icon_path('/usr/share/rpmdrake/icons');
+
+use curl_download;
+
+sub translate {
+    my ($s) = @_;
+    $s ? c::dgettext('rpmdrake', $s) : '';
+}
+sub _ {
+    my $s = shift @_; my $t = translate($s);
+    sprintf $t, @_;
+}
+
+$ENV{HOME} ||= '/root';
+
+sub readconf {
+    $configfile = "$ENV{HOME}/.rpmdrake";
+    %config = ( mandrakeupdate_wanted_categories => { var => \$mandrakeupdate_wanted_categories, default => [ qw(security) ] },
+		already_splashed => { var => \$already_splashed, default => [] },
+	      );
+    ${$config{$_}{var}} = $config{$_}{default} foreach keys %config;
+    
+    foreach my $l (cat_($configfile)) {
+	$l =~ /^\Q$_\E (.*)/ and ${$config{$_}{var}} = [ split ' ', $1 ] foreach keys %config;
+    }
+}
+
+sub writeconf {
+    output $configfile, map { "$_ " . join(' ', @${$config{$_}{var}}) . "\n" } keys %config;
+}
+
+sub interactive_msg {
+    my ($title, $contents, $yesno) = @_;
+    my $d = my_gtk->new($title);
+    gtkadd($d->{window},
+	   gtkpack_(new Gtk::VBox(0,5),
+		    1, new Gtk::Label($contents),
+		    0, gtkpack(create_hbox(),
+			       $yesno ? (gtksignal_connect(new Gtk::Button(_("Yes")), clicked => sub { $d->{retval} = 1; Gtk->main_quit }),
+					 gtksignal_connect(new Gtk::Button(_("No")), clicked => sub { $d->{retval} = 0; Gtk->main_quit }))
+			       : gtksignal_connect(new Gtk::Button(_("Ok")), clicked => sub { Gtk->main_quit })
+			      )));
+    $d->main;
+}
+
+sub interactive_list {
+    my ($title, $contents, @list) = @_;
+    my $d = my_gtk->new($title);
+    my $vbradios = gtkpack__(new Gtk::VBox(0, 0), my @radios = gtkradio('', @list));
+    gtkadd($d->{window},
+	   gtkpack__(new Gtk::VBox(0,5),
+		     new Gtk::Label($contents),
+		     int(@list) > 8 ? gtkset_usize(createScrolledWindow($vbradios), 250, 320) : $vbradios,
+		     gtkpack__(create_hbox(), gtksignal_connect(new Gtk::Button(_("Ok")), clicked => sub { Gtk->main_quit }))));
+    $d->main;
+    my $tmp;
+    each_index { $_->get_active and $tmp = $::i } @radios;
+    $tmp;
+}
+
+sub fatal_msg {
+    interactive_msg @_;
+    exit -1;
+}
+
+sub wait_msg {
+    local $::isEmbedded = 0;
+    my $mainw = my_gtk->new('rpmdrake');
+    my $label = new Gtk::Label($_[0]);
+    gtkadd($mainw->{window}, gtkpack(gtkadd(create_vbox(), $label)));
+    $label->signal_connect(expose_event => sub { $mainw->{displayed} = 1 });
+    $mainw->sync until $mainw->{displayed};
+    gtkset_mousecursor_wait($mainw->{rwindow}->window);
+    $mainw->flush;
+    $mainw;
+}
+sub remove_wait_msg { $_[0]->destroy }
+
+sub progress_msg {
+    my ($msg, $max) = @_;
+    my $mainw = my_gtk->new('rpmdrake');
+    my $label = new Gtk::Label($msg);
+    my $progressbar = gtkset_usize(new Gtk::ProgressBar, 400, 0);
+    gtkadd($mainw->{window}, gtkpack(gtkadd(create_vbox(), $label, $progressbar)));
+    $mainw->{rwindow}->set_position('center');
+    $mainw->sync;
+    my $progress_val; my $progress_callback = sub {
+	$progressbar->update($max == -1 ? $_[0] : $progress_val++/$max); #/);
+	$mainw->flush;
+    };
+    ($mainw, $progress_callback);
+}
+
+sub but { "    $_[0]    " }
+
+sub slow_func($&) {
+    my ($param, $func) = @_;
+    if (ref($param) =~ /^Gtk/) {
+	gtkset_mousecursor_wait($param);
+	my_gtk::flush;
+	&$func;
+	gtkset_mousecursor_normal($param);
+    } else {
+	my $w = wait_msg($param);
+	&$func;
+	remove_wait_msg($w);
+    }
+}
+
+
+my %u2l = (
+	   at => _("Austria"),
+	   be => _("Belgium"),
+	   br => _("Brazil"),
+	   ca => _("Canada"),
+	   cr => _("Costa Rica"),
+	   cz => _("Czech Republic"),
+	   de => _("Germany"),
+	   dk => _("Danmark"),
+	   el => _("Greece"),
+	   es => _("Spain"),
+	   fi => _("Finland"),
+	   fr => _("France"),
+	   gr => _("Greece"),
+	   il => _("Israel"),
+	   it => _("Italy"),
+	   jp => _("Japan"),
+	   ko => _("Korea"),
+	   nl => _("Netherlands"),
+	   no => _("Norway"),
+	   pl => _("Poland"),
+	   pt => _("Portugal"),
+	   ru => _("Russia"),
+	   se => _("Sweden"),
+	   tw => _("Taiwan"),
+	   uk => _("United Kingdom"),
+	   zh => _("China"),
+	   com => _("United States"),
+	   org => _("United States"),
+	   net => _("United States"),
+	   edu => _("United States"),
+	  );
+my $us = [ qw(com org net edu) ];
+my %t2l = (
+	   'America/\w+' =>       $us,
+	   'Asia/Tel_Aviv' =>     [ qw(il ru cz at) ],
+	   'Asia/Tokyo' =>        [ qw(jp ko tw), @$us ],
+	   'Asia/Seoul' =>        [ qw(ko jp tw), @$us ],
+	   'Asia/(Taipei|Beijing)' => [ qw(zn jp), @$us ],
+	   'Atlantic/Reykjavik' => [ qw(uk no se dk) ],
+	   'Australia/\w+' =>     [ qw(au jp ko tw), @$us ],
+	   'Brazil/East' =>       [ 'br', @$us ],
+	   'Canada/\w+' =>        [ 'ca', @$us ],
+	   'Europe/Amsterdam' =>  [ qw(nl be de at) ],
+	   'Europe/Athens' =>     [ qw(gr pl de nl at) ],
+	   'Europe/Berlin' =>     [ qw(de be at nl fr) ],
+	   'Europe/Brussels' =>   [ qw(be de nl fr at) ],
+	   'Europe/Budapest' =>   [ qw(it cz at de at) ],
+	   'Europe/Copenhagen' => [ qw(dk nl de be at) ],
+	   'Europe/Dublin' =>     [ qw(uk fr be nl) ],
+	   'Europe/Helsinki' =>   [ qw(fi se no nl at) ],
+	   'Europe/Istanbul' =>   [ qw(il ru cz at) ],
+	   'Europe/Lisbon' =>     [ qw(pt es fr it) ],
+	   'Europe/London' =>     [ qw(uk fr be nl at) ],
+	   'Europe/Madrid' =>     [ qw(es fr pt it) ],
+	   'Europe/Moscow' =>     [ qw(ru de pl at) ],
+	   'Europe/Oslo' =>       [ qw(no se fi dk at) ],
+	   'Europe/Paris' =>      [ qw(fr be de at) ],
+	   'Europe/Prague' =>     [ qw(cz be de at) ],
+	   'Europe/Rome' =>       [ qw(it fr de at) ],
+	   'Europe/Stockholm' =>  [ qw(se no dk fi at) ],
+	   'Europe/Vienna' =>     [ qw(at de cz it) ],
+	  );
+my %sites2countries = ('proxad.net' => 'fr');
+
+sub mirrors {
+    my ($cachedir, $class) = @_;
+    my $mirrorslist = "$cachedir/mirrorsfull.list";
+    unlink $mirrorslist;
+    my $proxy;
+    /http_proxy = (http:[^:]+:\d+)/ and $proxy = $1 foreach cat_("$ENV{HOME}/.wgetrc");
+    my $res = curl_download::download('http://www.linux-mandrake.com/mirrorsfull.list', $cachedir, $proxy, sub {});
+    $res and die $res;
+    require timezone;
+    my $tz = ${{timezone::read()}}{timezone};
+    my @mirrors = map { my ($land, $goodness);
+			my ($arch, $url) = m|\Q$class\E([^:]*):(.+)|;
+			$url =~ m|\.\Q$_\E/| and $land = $_ foreach keys %u2l;
+			$url =~ m|\W\Q$_\E/| and $land = $sites2countries{$_} foreach keys %sites2countries;
+			each_index { $_ eq $land and $goodness ||= 100-$::i } (map { if_($tz =~ /^$_$/, @{$t2l{$_}}) } keys %t2l), @$us;
+			if_($arch && MDK::Common::System::compat_arch($arch),
+			    { url => $url, land => $u2l{$land} || _("United States"), goodness => $goodness + rand })
+		    } cat_($mirrorslist);
+    unlink $mirrorslist;
+    return sort { $::b->{goodness} <=> $::a->{goodness} } @mirrors;
+}
+
+sub choose_mirror {
+    interactive_msg('', 
+_("I need to contact MandrakeSoft website to get the mirrors list.
+Please check that your network is currently running.
+
+Is it ok to continue?"), 1) or return '';
+    my $wait = wait_msg(_("Please wait, downloading mirrors addresses from MandrakeSoft website."));
+    my @mirrors;
+    eval { @mirrors = mirrors('/var/cache/urpmi', 'updates') };
+    remove_wait_msg($wait);
+    if ($@) {
+	my $msg = $@;  #- seems that value is bitten before being printed by next func..
+	interactive_msg(_("Error during download"),
+_("There was an error downloading the mirrors list:
+
+%s
+The network, or MandrakeSoft website, are maybe unavailable.
+Please try again later.", $msg));
+	return '';
+    }
+
+    !@mirrors and interactive_msg(_("No mirror"),
+_("I can't find any suitable mirror.
+
+There can be many reasons for this problem; the most frequent is
+the case when the architecture of your processor is not supported
+by Mandrake Linux Official Updates.")), return '';
+
+    my $w = my_gtk->new('rpmdrake');
+    my $tree = Gtk::CTree->new(1, 0);
+    $tree->set_selection_mode('browse');
+    $tree->set_column_auto_resize(0, 1);
+    $tree->set_row_height($tree->style->font->ascent + $tree->style->font->descent + 1);
+
+    gtkadd($w->{window}, 
+	   gtkpack_(new Gtk::VBox(0,5),
+		    0, _("Please choose the desired mirror."),
+		    1, createScrolledWindow($tree),
+		    0, gtkpack(new Gtk::HBox(1, 20),
+			       map {
+				   my $retv = $_->[1];
+				   gtksignal_connect(new Gtk::Button(but($_->[0])), "clicked" => sub {
+						 $retv and $w->{retval} = { sel => ($tree->node_get_pixtext($tree->selection, 0))[0] };
+						 Gtk->main_quit })
+			       } ([ _("Ok"), 1], [ _("Cancel"), 0 ])),
+		   ));
+    $tree->freeze;
+    my %roots;
+    $tree->insert_node($roots{$_->{land}} ||= $tree->insert_node(undef, undef, [ $_->{land}, '', '' ], 5, (undef) x 4, 0, 0),
+		       undef, [ $_->{url}, '', '' ], 5, (undef) x 4, 1, 0) foreach @mirrors;
+    $tree->expand($tree->node_nth(0));
+    $tree->select($tree->node_nth(1));
+    $tree->thaw;
+    $w->{window}->set_usize(400, 300);
+    $w->{rwindow}->show_all;
+    $w->main && member($w->{retval}{sel}, map { $_->{url} } @mirrors) and $w->{retval}{sel};
+}