summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/ChangeLog20
-rw-r--r--perl-install/Xconfigurator.pm12
-rw-r--r--perl-install/install2.pm5
-rw-r--r--perl-install/install_steps_interactive.pm113
-rw-r--r--perl-install/interactive.pm56
-rw-r--r--perl-install/interactive_gtk.pm31
-rw-r--r--perl-install/interactive_newt.pm7
-rw-r--r--perl-install/interactive_stdio.pm5
-rw-r--r--perl-install/log.pm6
-rw-r--r--perl-install/modules.pm2
-rw-r--r--perl-install/pkgs.pm13
-rw-r--r--perl-install/run_program.pm4
-rw-r--r--perl-install/services.pm35
13 files changed, 188 insertions, 121 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index 94ab48012..5ba606264 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -7,9 +7,19 @@
* netconnect.pm (get_net_device): try to fix it..
-2000-09-22 DrakX <install@linux-mandrake.com>
+2000-09-22 Pixel <pixel@mandrakesoft.com>
- * snapshot uploaded
+ * install_steps_interactive.pm (selectKeyboard,
+ choosePartitionsToFormat, chooseCD, installCrypto): use new ask_many_from_list
+ ():
+
+ * interactive.pm (ask_many_from_list): now only ask_many_from_list
+ exists, obsoleting ask_many_from_list_ref and
+ ask_many_from_list_with_help. More flexible and nicer
+ * interactive_newt.pm (ask_many_from_listW): adapted to new
+ calling type
+ * interactive_gtk.pm (ask_many_from_listW): adapted to new calling
+ type, handle 'shadow' and 'icon2f'
2000-09-22 Pixel <pixel@mandrakesoft.com>
@@ -29,10 +39,16 @@
* run_program.pm (rooted): don't redirect the stdout and stderr to
ddebug.log if not $::isInstall
+ * log.pm (l): log on stdout/stderr if !isInstall and !isStandalone
+
* modules.pm (load_raw): redirect stderr to tty5
* install2.pm (main): set variable $::isInstall
+2000-09-22 DrakX <install@linux-mandrake.com>
+
+ * snapshot uploaded
+
2000-09-22 Guillaume Cottenceau <gc@mandrakesoft.com>
* standalone/drakgw: now includes information from netconnect to
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 6ce395a06..b9e008c1b 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -182,8 +182,8 @@ sub cardConfiguration(;$$$) {
updateCardAccordingName($card, $card->{type}) if $card->{type};
add2hash($card, { vendor => "Unknown", board => "Unknown" });
- $card->{memory} = 4096, delete $card->{depth} if $card->{memory} <= 1024 && $card->{driver} eq "i810";
- $card->{memory} = 16384, delete $card->{depth} if $card->{memory} <= 1024 && $card->{chipset} =~ /PERMEDIA/;
+ $card->{memory} = 4096, delete $card->{depth} if $card->{driver} eq 'i810';
+ $card->{memory} = 16384, delete $card->{depth} if $card->{chipset} =~ /PERMEDIA/ && $card->{memory} <= 1024;
#- 3D acceleration configuration for XFree 3.3 using Utah-GLX.
$card->{Utah_glx} = ($card->{identifier} =~ /Matrox.* G[24]00/ || #- 8bpp does not work.
@@ -310,7 +310,7 @@ NOTE THIS IS EXPERIMENTAL SUPPORT AND MAY FREEZE YOUR COMPUTER.", $xf3_ver)) . "
$card->{type} =~ /Intel 810/ and ($card->{flags}{needVideoRam}, $card->{memory}) = ('fakeVideoRam', 16384);
}
- if (!$::isStandalone && $card->{driver} eq "i810") {
+ if (!$::isStandalone && $card->{driver} eq 'i810') {
require modules;
eval { modules::load("agpgart"); };
}
@@ -413,6 +413,9 @@ sub testFinalConfig {
$bad_card ||= $o->{card}{use_xf4}; #- TODO obsoleted to check, when using fbdev of XFree 4.0!
log::l("the graphic card does not like X in framebuffer") if $bad_card;
+ my $verybad_card = $o->{card}{driver} eq 'i810';
+ $verybad_card and return 1;
+
my $mesg = _("Do you want to test the configuration?");
my $def = 1;
if ($bad_card && !$::isStandalone) {
@@ -486,7 +489,7 @@ sub testFinalConfig {
1;
});
- my $background = "/usr/share/pixmaps/backgrounds/mandrake/XFdrake-image-test.jpg";
+ my $background = "/usr/share/pixmaps/backgrounds/linux-mandrake/XFdrake-image-test.jpg";
my $qiv = "/usr/bin/qiv";
-r "} . $prefix . q{/$background" && -x "} . $prefix . q{/$qiv" and
system(($::testing ? "} . $prefix . q{" : "chroot } . $prefix . q{/ ") . "$qiv -y $background");
@@ -1084,6 +1087,7 @@ Current configuration is:
foreach (@window_managers) {
if (`pidof "$_"` > 0) {
if ($in->ask_okcancel('', _("Please relog into %s to activate the changes", ucfirst $_), 1)) {
+ fork and $in->exit;
system("kwmcom logout") if /kwm/;
system("dcop kdesktop default logout") if /kwin/;
system("save-session --kill") if /gnome-session/;
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 68856df90..fa074531b 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -452,6 +452,7 @@ sub main {
$ENV{SHARE_PATH} ||= "/usr/share";
$ENV{PERL_BADLANG} = 1;
+ $::isInstall = 1;
$::beginner = $::expert = $::g_auto_install = 0;
#- c::unlimit_core() unless $::testing;
@@ -620,7 +621,9 @@ sub main {
$o->{interactive} = "newt";
require install_steps_newt;
}
- $o->{meta_class} = 'desktop' if cat__(install_any::getFile("VERSION")) =~ /desktop/i;
+ my $VERSION = cat__(install_any::getFile("VERSION"));
+ $o->{lnx4win} = 1 if $VERSION =~ /lnx4win/i;
+ $o->{meta_class} = 'desktop' if $VERSION =~ /desktop/i;
if ($o->{meta_class} eq 'desktop') {
$o->{installClass} = 'normal';
push @auto, 'selectInstallClass';
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 29ee25505..6e315de27 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -1,4 +1,3 @@
-
package install_steps_interactive; # $Id$
@@ -82,12 +81,18 @@ sub selectKeyboard($) {
delete $o->{keyboard_unsafe};
if ($::expert && ref($o) !~ /newt/) { #- newt is buggy with big windows :-(
- my %langs; $langs{$_} = 1 foreach @{$o->{langs}};
- my @l = sort { $a->[0] cmp $b->[0] } map { [ lang::lang2text($_) || $_, \$langs{$_} ] } lang::list();
- $o->ask_many_from_list_ref('',
- _("You can choose other languages that will be available after install"),
- [ map { $_->[0] } @l ], [ map { $_->[1] } @l ], [ 'All' ], [ \$langs{all} ]) or goto &selectKeyboard;
- $o->{langs} = $langs{all} ? [ 'all' ] : [ grep { $langs{$_} } keys %langs ];
+ $o->{langs} ||= [];
+ my $all = $o->{langs}[0] eq 'all';
+ $o->{langs} = $o->ask_many_from_list('',
+ _("You can choose other languages that will be available after install"),
+ {
+ list => [ lang::list() ],
+ label => sub { lang::lang2text($_) },
+ values => $o->{langs},
+ sort => 1,
+ },
+ { list => ['all'], label => sub { _("All") }, ref => sub { \$all }, shadow => 0 }) or goto &selectKeyboard;
+ $o->{langs} = [ 'all' ] if $all;
}
install_steps::selectKeyboard($o);
}
@@ -277,28 +282,29 @@ sub choosePartitionsToFormat($$) {
} @$fstab;
$_->{toFormat} = 1 foreach grep { $::beginner && isSwap($_) } @$fstab;
- return if $::beginner && 0 == grep { ! $_->{toFormat} } @l;
+ return if @l == 0 || $::beginner && 0 == grep { ! $_->{toFormat} } @l;
+
+ my $name2label = sub {
+ sprintf("%s %s", isSwap($_) ? type2name($_->{type}) : $_->{mntpoint},
+ isLoopback($_) ? $::expert && loopback::file($_) : partition_table_raw::description($_));
+ };
#- keep it temporary until the guy has accepted
- my %toFormat = map { $_ => $_->{toFormat} || $_->{toFormatUnsure} } @l;
-
- my %label;
- $label{$_} = sprintf("%s %s",
- isSwap($_) ? type2name($_->{type}) : $_->{mntpoint},
- isLoopback($_) ?
- $::expert && loopback::file($_) :
- partition_table_raw::description($_)) foreach @l;
-
- $o->ask_many_from_list_ref('', _("Choose the partitions you want to format"),
- [ map { $label{$_} } @l ],
- [ map { \$toFormat{$_} } @l ]) or die "already displayed";
+ my $toFormat = $o->ask_many_from_list('', _("Choose the partitions you want to format"),
+ {
+ list => \@l,
+ label => $name2label,
+ value => sub { $_->{toFormat} || $_->{toFormatUnsure} },
+ }) or die "already displayed";
#- ok now we can really set toFormat
- $_->{toFormat} = $toFormat{$_} foreach @l;
+ $_->{toFormat} = 1 foreach @$toFormat;
- @l = grep { $_->{toFormat} && !isLoopback($_) && !isReiserfs($_) } @l;
- $o->ask_many_from_list_ref('', _("Check bad blocks?"),
- [ map { $label{$_} } @l ],
- [ map { \$_->{toFormatCheck} } @l ]) or goto &choosePartitionsToFormat if $::expert;
+ $o->ask_many_from_list('', _("Check bad blocks?"),
+ {
+ list => [ grep { $_->{toFormat} && !isLoopback($_) && !isReiserfs($_) } @l ],
+ label => $name2label,
+ ref => sub { \$_->{toFormatCheck} },
+ }) or goto &choosePartitionsToFormat if $::expert;
}
@@ -347,7 +353,12 @@ sub choosePackages {
#- avoid reselection of package if individual selection is requested and this is not the first time.
if (1 || $first_time || !$individual) {
my $min_mark = $::beginner ? 10 : $::expert ? 0 : 1;
- my ($size, $level) = pkgs::fakeSetSelectedFromCompssList($o->{compssListLevels}, $packages, $min_mark, 0, $o->{installClass});
+
+ my $b = pkgs::saveSelected($packages);
+ my (undef, $level) = pkgs::setSelectedFromCompssList($o->{compssListLevels}, $packages, $min_mark, 0, $o->{installClass});
+ my $size = pkgs::selectedSize($packages);
+ pkgs::restoreSelected($b);
+
my $max_size = 1 + $size; #- avoid division by zero.
my $size2install = min($availableC, do {
@@ -390,13 +401,27 @@ sub choosePackagesTree {}
sub chooseGroups {
my ($o, $packages, $compssUsers, $compssUsersSorted, $individual) = @_;
- $o->ask_many_from_list_ref('',
- _("Package Group Selection"),
- [ @$compssUsersSorted, _("Miscellaneous") ],
- [ map { \$o->{compssUsersChoice}{$_} } @$compssUsersSorted, "Miscellaneous" ],
- $individual ? ([ _("Individual package selection") ], [ $individual ]) : (),
- ) or goto &chooseGroups;
-
+ my %size;
+ my $base = pkgs::selectedSize($packages);
+ foreach (@$compssUsersSorted) {
+ my $b = pkgs::saveSelected($packages);
+ pkgs::selectPackage($packages, $_) foreach @{$compssUsers->{$_}};
+ $size{$_} = pkgs::selectedSize($packages) - $base;
+ pkgs::restoreSelected($b);
+ }
+ my @groups = (@$compssUsersSorted, $o->{meta_class} eq 'desktop' ? () : __("Miscellaneous"));
+ my $all;
+ $o->ask_many_from_list('', _("Package Group Selection"),
+ { list => \@groups,
+ ref => sub { \$o->{compssUsersChoice}{$_} },
+ label => sub { $size{$_} ? sprintf "$_ (%d%s)", round_down($size{$_} / sqr(1024), 10), _("MB") : translate($_) },
+ },
+ $o->{meta_class} eq 'desktop' ? { list => [ _("All") ], ref => sub { \$all }, shadow => 0 } : (),
+ $individual ? { list => [ _("Individual package selection") ], ref => sub { $individual } } : (),
+ ) or goto &chooseGroups;
+ if ($all) {
+ $o->{compssUsersChoice}{$_} = 1 foreach @$compssUsersSorted, "Miscellaneous";
+ }
unless ($o->{compssUsersChoice}{Miscellaneous}) {
my %l;
$l{@{$compssUsers->{$_}}} = () foreach @$compssUsersSorted;
@@ -439,15 +464,17 @@ sub chooseCD {
}
$o->set_help('chooseCD');
- $o->ask_many_from_list_ref('',
- _("If you have all the CDs in the list below, click Ok.
+ $o->ask_many_from_list('',
+ _("If you have all the CDs in the list below, click Ok.
If you have none of those CDs, click Cancel.
If only some CDs are missing, unselect them, then click Ok."),
- [ map { _("Cd-Rom labeled \"%s\"", $_) } @mediumsDescr ],
- [ map { \$mediumsDescr{$_} } @mediumsDescr ]
- ) or do {
- map { $mediumsDescr{$_} = 0 } @mediumsDescr; #- force unselection of other CDs.
- };
+ {
+ list => \@mediumsDescr,
+ label => sub { _("Cd-Rom labeled \"%s\"", $_) },
+ ref => sub { \$mediumsDescr{$_} },
+ }) or do {
+ map { $mediumsDescr{$_} = 0 } @mediumsDescr; #- force unselection of other CDs.
+ };
$o->set_help('choosePackages');
#- restore true selection of medium (which may have been grouped together)
@@ -547,10 +574,8 @@ USA")) || return;
my $w = $o->wait_message('', _("Contacting the mirror to get the list of available packages"));
crypto::getPackages($o->{prefix}, $o->{packages}, $u->{mirror}); #- make sure $o->{packages} is defined when testing
};
- my %h; $h{$_} = 1 foreach @{$u->{packages} || []};
- $o->ask_many_from_list_ref('', _("Please choose the packages you want to install."),
- \@packages, [ map { \$h{$_} } @packages ]) or return;
- $o->pkg_install(@{$u->{packages} = [ grep { $h{$_} } @packages ]});
+ $u->{packages} = $o->ask_many_from_list('', _("Please choose the packages you want to install."), { list => \@packages, values => $u->{packages} }) or return;
+ $o->pkg_install(@{$u->{packages}});
#- stop interface using ppp only.
install_interactive::downNetwork($o, 'pppOnly');
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 46c4250d1..ecaa8f095 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -181,36 +181,36 @@ sub ask_from_treelistW($$$$;$) {
}
-
-sub ask_many_from_list_refH {
- my ($o, $title, $message, @l) = @_;
- $o->ask_many_from_list_ref($title, $message, map { [ keys %$_ ], [ values %$_ ] } @l);
-}
-sub ask_many_from_list_ref {
- my ($o, $title, $message, @l) = @_;
- $o->ask_many_from_list_with_help_ref($title, [ deref($message) ], map { ($_->[0], [], $_->[1]) } combine(2, @l));
-}
-sub ask_many_from_list_with_help_ref {
- my ($o, $title, $message, @l) = @_;
- my @L = grep { @{$_->[0]} } combine(3, @l) or return 1;
- $o->ask_many_from_list_with_help_refW($title, [ deref($message) ], @L);
-}
-
sub ask_many_from_list {
- my ($o, $title, $message, $l, $def) = @_;
-
- my $val = [ map { my $i = $_; \$i } @$def ];
-
- $o->ask_many_from_list_ref($title, $message, $l, $val) ?
- [ map { $$_ } @$val ] : undef;
-}
-sub ask_many_from_list_with_help {
- my ($o, $title, $message, $l, $help, $def) = @_;
-
- my $val = [ map { my $i = $_; \$i } @$def ];
+ my ($o, $title, $message, @l) = @_;
+ @l = grep { @{$_->{list}} } @l or return '';
+ foreach my $h (@l) {
+ $h->{labels} ||= [ map { $h->{label} ? $h->{label}->($_) : $_ } @{$h->{list}} ];
+
+ if ($h->{sort}) {
+ my @places = sort { $h->{labels}[$b] <=> $h->{labels}[$a] } 0 .. $#{$h->{labels}};
+ $h->{labels} = [ map { $h->{labels}[$_] } @places ];
+ $h->{list} = [ map { $h->{list}[$_] } @places ];
+ }
+ $h->{ref} = [ map {
+ $h->{ref} ? $h->{ref}->($_) : do {
+ my $i =
+ $h->{value} ? $h->{value}->($_) :
+ $h->{values} ? member($_, @{$h->{values}}) : 0;
+ \$i;
+ };
+ } @{$h->{list}} ];
+
+ $h->{help} = $h->{help} ? [ map { $h->{help}->($_) } @{$h->{list}} ] : [];
+ $h->{icons} = $h->{icon2f} ? [ map { $h->{icon2f}->($_) } @{$h->{list}} ] : [];
+ }
+ $o->ask_many_from_listW($title, [ deref($message) ], @l) or return;
- $o->ask_many_from_list_with_help_ref($title, $message, $l, $help, $val) ?
- [ map { $$_ } @$val ] : undef;
+ @l = map {
+ my $h = $_;
+ [ grep_index { ${$h->{ref}[$::i]} } @{$h->{list}} ];
+ } @l;
+ wantarray ? @l : $l[0];
}
sub ask_from_entry {
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index 5335909d9..eae43f1f3 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -24,6 +24,7 @@ sub resume {}
sub exit {
gtkset_mousecursor_normal(); #- for restoring a normal in any case on standalone
+ my_gtk::flush();
c::_exit($_[0]) #- workaround
}
@@ -201,26 +202,34 @@ sub ask_from_treelistW {
$w->main or die "ask_from_list cancel";
}
-sub ask_many_from_list_with_help_refW {
- my ($o, $title, $messages, @L) = @_;
+sub ask_many_from_listW {
+ my ($o, $title, $messages, @l) = @_;
my $w = my_gtk->new('', %$o);
+ $w->sync; # for XPM's creation
+
my $tips = new Gtk::Tooltips;
- my @boxes = map {
+ my @boxes; @boxes = map {
my $l = $_;
my $box = gtkpack(new Gtk::VBox(0,0),
map_index {
my $i = $::i;
+
my $o = Gtk::CheckButton->new($_);
- $tips->set_tip($o, $l->[1][$i]) if $l->[1][$i];
- $o->set_active(${$l->[2][$i]});
- $o->signal_connect(clicked => sub { invbool $l->[2][$i] });
- $o;
- } @{$l->[0]});
- @{$l->[0]} > 11 ? gtkset_usize(createScrolledWindow($box), 0, 250) : $box;
- } @L;
+ $tips->set_tip($o, $l->{help}[$i]) if $l->{help}[$i];
+ $o->set_active(${$l->{ref}[$i]});
+ $o->signal_connect(clicked => sub {
+ my $v = invbool($l->{ref}[$i]);
+ $boxes[$l->{shadow}]->set_sensitive(!$v) if exists $l->{shadow};
+ });
+
+ my $f = $l->{icons}[$i];
+ -e $f ? gtkpack_(new Gtk::HBox(0,0), 0, new Gtk::Pixmap(gtkcreate_xpm($w->{window}, $f)), 1, $o) : $o;
+ } @{$l->{labels}});
+ @{$l->{labels}} > 11 ? gtkset_usize(createScrolledWindow($box), 0, 250) : $box;
+ } @l;
gtkadd($w->{window},
gtkpack_(create_box_with_title($w, @$messages),
- (map {; 1, $_ } @boxes),
+ (map {; 1, $_, 0, '' } @boxes),
0, $w->create_okcancel,
)
);
diff --git a/perl-install/interactive_newt.pm b/perl-install/interactive_newt.pm
index edd26fd11..4c4c0e65e 100644
--- a/perl-install/interactive_newt.pm
+++ b/perl-install/interactive_newt.pm
@@ -79,10 +79,9 @@ sub ask_from_listW {
}
}
-sub ask_many_from_list_with_help_refW {
- my ($o, $title, $messages, @lists) = @_;
- my ($list) = map { $_->[0] } @lists;
- my ($val) = map { $_->[2] } @lists;
+sub ask_many_from_listW {
+ my ($o, $title, $messages, $l) = @_;
+ my ($list, $val) = ($l->{labels}, $l->{ref});
my $height = min(int @$list, 18);
my $sb = Newt::Component::VerticalScrollbar(-1, -1, $height, 9, 10);
diff --git a/perl-install/interactive_stdio.pm b/perl-install/interactive_stdio.pm
index fd104ee4a..284194a11 100644
--- a/perl-install/interactive_stdio.pm
+++ b/perl-install/interactive_stdio.pm
@@ -56,8 +56,9 @@ sub ask_from_listW {
}
}
-sub ask_many_from_list_refW {
- my ($o, $title, $messages, $list, $val) = @_;
+sub ask_many_from_listW {
+ my ($o, $title, $messages, $l) = @_;
+ my ($list, $val) = ($l->{labels}, $l->{ref});
my @defaults;
print map { "$_\n" } @$messages;
my $n = 0; foreach (@$list) {
diff --git a/perl-install/log.pm b/perl-install/log.pm
index 534529494..b862ca06a 100644
--- a/perl-install/log.pm
+++ b/perl-install/log.pm
@@ -21,9 +21,11 @@ sub l {
$logOpen or openLog();
if ($::isStandalone) {
c::syslog(join "", @_);
- } else {
+ } elsif ($::isInstall) {
print LOG "* ", @_, "\n";
print LOG2 "* ", @_, "\n";
+ } else {
+ print @_, "\n";
}
}
sub ld { $logDebugMessages and &l }
@@ -32,7 +34,7 @@ sub w { &l }
sub openLog(;$) {
if ($::isStandalone) {
c::openlog("DrakX");
- } else {
+ } elsif ($::isInstall) {
if ($_[0]) { #- useLocal
open LOG, "> $_[0]";# or die "no log possible :(";
} else {
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 0cb526b7e..bd4f523e4 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -464,7 +464,7 @@ sub load_raw {
run_program::run("packdrake", "-x", $cz, "/tmp", map { "$_->[0].o" } @l);
my @failed = grep {
my $m = "/tmp/$_->[0].o";
- if (-e $m && run_program::run(["insmod_", "insmod"], "-f", $m, @{$_->[1]})) {
+ if (-e $m && run_program::run(["insmod_", "insmod"], '2>', '/dev/tty5', '-f', $m, @{$_->[1]})) {
unlink $m;
$conf{$_->[0]}{loaded} = 1;
'';
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 593e574ef..62107d72c 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -734,14 +734,15 @@ sub setSelectedFromCompssList {
#- usefull to know the size it would take for a given min_level/max_size
#- just saves the selected packages, call setSelectedFromCompssList and restores the selected packages
-sub fakeSetSelectedFromCompssList {
- my ($compssListLevels, $packages, $min_level, $max_size, $install_class) = @_;
+sub saveSelected {
+ my ($packages) = @_;
my @l = values %{$packages->[0]};
my @flags = map { pkgs::packageFlagSelected($_) } @l;
- my (undef, $level) = setSelectedFromCompssList($compssListLevels, $packages, $min_level, $max_size, $install_class);
- my $size = pkgs::selectedSize($packages);
- mapn { pkgs::packageSetFlagSelected(@_) } \@l, \@flags;
- $size, $level;
+ [ $packages, \@l, \@flags ];
+}
+sub restoreSelected {
+ my ($packages, $l, $flags) = @{$_[0]};
+ mapn { pkgs::packageSetFlagSelected(@_) } $l, $flags;
}
diff --git a/perl-install/run_program.pm b/perl-install/run_program.pm
index ad0f4ca95..293910cb8 100644
--- a/perl-install/run_program.pm
+++ b/perl-install/run_program.pm
@@ -32,12 +32,12 @@ sub rooted {
if ($stderr) {
$stderrm =~ s/2//;
open STDERR, "$stderrm $root$stderr" or die "run_program can't output in $root$stderr (mode `$stderrm')";
- } else {
+ } elsif ($::isInstall) {
open STDERR, ">> /tmp/ddebug.log" or open STDOUT, ">> /dev/tty7" or die "run_program can't log, give me access to /tmp/ddebug.log";
}
if ($stdout) {
open STDOUT, "$stdoutm $root$stdout" or die "run_program can't output in $root$stdout (mode `$stdoutm')";
- } else {
+ } elsif ($::isInstall) {
open STDOUT, ">> /tmp/ddebug.log" or open STDOUT, ">> /dev/tty7" or die "run_program can't log, give me access to /tmp/ddebug.log";
}
diff --git a/perl-install/services.pm b/perl-install/services.pm
index f8fb3d6f6..fd1ea51ce 100644
--- a/perl-install/services.pm
+++ b/perl-install/services.pm
@@ -82,40 +82,47 @@ xfs => __("Starts and stops the X Font Server at boot time and shutdown."),
$s;
}
+#- returns:
+#--- the listref of installed services
+#--- the listref of "on" services
sub services {
my ($prefix) = @_;
my $cmd = $prefix ? "chroot $prefix" : "";
my @l = map { [ /(\S+)/, /:on/ ] } sort `LANGUAGE=C $cmd chkconfig --list`;
- [ map { $_->[0] } @l ], [ map { $_->[1] } @l ];
+ [ map { $_->[0] } @l ], [ mapgrep { $_->[1], $_->[0] } @l ];
}
sub ask {
my ($in, $prefix) = @_;
- my ($l, $before) = services($prefix);
- my $after = $in->ask_many_from_list_with_help("drakxservices",
- _("Choose which services should be automatically started at boot time"),
- $l, [ map { description($_, $prefix) } @$l ], $before) or return;
- [ grep_index { $after->[$::i] } @$l ];
+ my ($l, $on_services) = services($prefix);
+ $in->ask_many_from_list("drakxservices",
+ _("Choose which services should be automatically started at boot time"),
+ {
+ list => $l,
+ help => sub { description($_, $prefix) },
+ values => $on_services,
+ sort => 1,
+ });
}
sub doit {
my ($in, $on_services, $prefix) = @_;
- my ($l, $before) = services($prefix);
+ my ($l, $was_on_services) = services($prefix);
- mapn {
- my ($name, $before) = @_;
- my $after = member($name, @$on_services);
+ foreach (@$l) {
+ my $before = member($_, @$was_on_services);
+ my $after = member($_, @$on_services);
if ($before != $after) {
- my $script = "/etc/rc.d/init.d/$name";
- run_program::rooted($prefix, "chkconfig", $after ? "--add" : "--del", $name);
+ my $script = "/etc/rc.d/init.d/$_";
+ run_program::rooted($prefix, "chkconfig", $after ? "--add" : "--del", $_);
if ($after && cat_("$prefix$script") =~ /^#\s+chkconfig:\s+-/m) {
- run_program::rooted($prefix, "chkconfig", "--level", "35", $name, "on");
+ run_program::rooted($prefix, "chkconfig", "--level", "35", $_, "on");
}
if (!$after && $::isStandalone) {
run_program::rooted($prefix, $script, "stop");
}
}
- } $l, $before;
+ }
}
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-01 14:07:27 +0000