aboutsummaryrefslogtreecommitdiffstats
path: root/rpmdrake.pm
diff options
context:
space:
mode:
authorGuillaume Cottenceau <gc@mandriva.com>2002-08-01 17:35:43 +0000
committerGuillaume Cottenceau <gc@mandriva.com>2002-08-01 17:35:43 +0000
commit36c3056b46649d0f28dd3b49f61ad08e8049548a (patch)
tree5d5a8e8b6880e3acdbf7349ccf62c4860fc6332c /rpmdrake.pm
parent814cacf5edc5ad3642157a23d6d8cff249644d3a (diff)
downloadrpmdrake-36c3056b46649d0f28dd3b49f61ad08e8049548a.tar
rpmdrake-36c3056b46649d0f28dd3b49f61ad08e8049548a.tar.gz
rpmdrake-36c3056b46649d0f28dd3b49f61ad08e8049548a.tar.bz2
rpmdrake-36c3056b46649d0f28dd3b49f61ad08e8049548a.tar.xz
rpmdrake-36c3056b46649d0f28dd3b49f61ad08e8049548a.zip
Initial revisionV2_0topic/RPMDRAKE
Diffstat (limited to 'rpmdrake.pm')
-rw-r--r--rpmdrake.pm284
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};
+}