summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>1999-07-31 17:49:30 +0000
committerPascal Rigaux <pixel@mandriva.com>1999-07-31 17:49:30 +0000
commit416760cf6e1a2bcd8080388e290fa12e3e74c377 (patch)
tree2b841530dcd292a2559218349f0881c60d410999 /perl-install
parent91419eac51774d733b905ac2d54b3bde60a208df (diff)
downloaddrakx-416760cf6e1a2bcd8080388e290fa12e3e74c377.tar
drakx-416760cf6e1a2bcd8080388e290fa12e3e74c377.tar.gz
drakx-416760cf6e1a2bcd8080388e290fa12e3e74c377.tar.bz2
drakx-416760cf6e1a2bcd8080388e290fa12e3e74c377.tar.xz
drakx-416760cf6e1a2bcd8080388e290fa12e3e74c377.zip
no_comment
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Xconfigurator.pm204
-rw-r--r--perl-install/Xconfigurator_consts.pm6
-rw-r--r--perl-install/common.pm25
-rwxr-xr-xperl-install/install22
-rw-r--r--perl-install/install_any.pm2
-rw-r--r--perl-install/log.pm4
-rw-r--r--perl-install/my_gtk.pm2
-rw-r--r--perl-install/partition_table.pm6
8 files changed, 150 insertions, 101 deletions
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index e8782fc2c..751efeebd 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -66,6 +66,7 @@ sub readCardsDB {
CLOCKCHIP => sub { $card->{clockchip} = $val; $card->{flags}->{noclockprobe} = 1; },
NOCLOCKPROBE => sub { $card->{flags}->{noclockprobe} = 1 },
UNSUPPORTED => sub { $card->{flags}->{unsupported} = 1 },
+ COMMENT => sub {},
}}{$cmd};
$f ? &$f() : log::l("unknown line $lineno ($_)");
@@ -112,23 +113,19 @@ sub rewriteInittab {
open G, "> /etc/inittab-" or die "cannot write in /etc/inittab-: $!";
foreach (<F>) {
- print G /^id:/ ? "id:$runlevel:initdefault:\n" : $_;
+ print G /^(id:)[35](:initdefault:)\s*$/ ? "$1$runlevel$2\n" : $_;
}
}
unlink("/etc/inittab");
rename("/etc/inittab-", "/etc/inittab");
}
-sub findLegalModes {
+sub keepOnlyLegalModes {
my ($card) = @_;
- my $mem = $card->{memory} || 1000000;
+ my $mem = 1024 * ($card->{memory} || return);
- foreach (reverse @resolutions) {
- my ($h, $v) = split 'x';
-
- foreach $_ (@depths) {
- push @{$card->{depth}->{$_}}, [ $h, $v ] if 1024 * $mem >= $h * $v * $_ / 8;
- }
+ while (my ($depth, $res) = each %{$card->{depth}}) {
+ @$res = grep { $mem >= product(@$_, $depth / 8) } @$res;
}
}
@@ -146,7 +143,6 @@ sub cardConfigurationAuto() {
sub cardConfiguration(;$$) {
my ($card, $noauto) = @_;
$card ||= {};
- $noauto = $::expert unless $noauto;
readCardsDB("/usr/X11R6/lib/X11/Cards");
@@ -198,7 +194,8 @@ sub testConfig($) {
local *F;
open F, "$o->{card}->{prog} :9 -probeonly -pn -xf86config $tmpconfig 2>&1 |";
foreach (<F>) {
- #$videomemory = $2 if /(videoram|Video RAM):\s*(\d*)/;
+ $o->{card}->{memory} ||= $2 if /(videoram|Video RAM):\s*(\d*)/;
+
# look for clocks
push @$clocklines, $1 if /clocks: (.*)/ && !/(pixel |num)clocks:/;
@@ -210,8 +207,8 @@ sub testConfig($) {
($resolutions, $clocklines);
}
-sub testFinalConfig($) {
- my ($o) = @_;
+sub testFinalConfig($;$) {
+ my ($o, $auto) = @_;
$o->{monitor}->{hsyncrange} && $o->{monitor}->{vsyncrange} or
$in->ask_warn('', _("Monitor not configured yet")), return;
@@ -222,9 +219,14 @@ sub testFinalConfig($) {
$o->{card}->{depth} or
$in->ask_warn('', _("Resolutions not chosen yet")), return;
+ rename("/etc/X11/XF86Config", "/etc/X11/XF86Config.old") || die "unable to make a backup of XF86Config" unless $::testing;
write_XF86Config($o, $::testing ? $tmpconfig : "/etc/X11/XF86Config");
+ $auto
+ or $in->ask_yesorno(_("Test configuration"), _("Do you want to test configuration?"))
+ or return 1;
+
my $pid; unless ($pid = fork) {
my @l = "X";
@l = ($o->{card}->{prog}, "-xf86config", $tmpconfig) if $::testing;
@@ -252,19 +254,23 @@ sub testFinalConfig($) {
$time-- or Gtk->main_quit;
});
- exit !interactive_gtk->new->ask_yesorno('', [ _("Is this ok?"), $text ], 1);
+ exit (interactive_gtk->new->ask_yesorno('', [ _("Is this ok?"), $text ], 1)
+ ? 0 : 222);
};
my $rc = close F;
+ my $err = $?;
kill 2, $pid;
+ $rc || $err == 222 << 8 or $in->ask_warn('', _("An error occured, try changing some parameters"));
+
$rc;
}
-sub autoResolutions($) {
- my ($o) = @_;
+sub autoResolutions($;$) {
+ my ($o, $nowarning) = @_;
my $card = $o->{card};
- $in->ask_okcancel(_("Automatic resolutions"),
+ $nowarning || $in->ask_okcancel(_("Automatic resolutions"),
_("To find the available resolutions i will try different ones.
Your screen will blink...
You can switch if off if you want, you'll hear a beep when it's over")) or return;
@@ -282,7 +288,7 @@ You can switch if off if you want, you'll hear a beep when it's over")) or retur
delete $card->{depth}->{$_};
} else {
$card->{clocklines} ||= $clocklines unless $card->{flags}->{noclockprobe};
- $card->{depth}->{$_} = [ sort { $b->[0] <=> $a->[0] } @$resolutions ];
+ $card->{depth}->{$_} = [ @$resolutions ];
}
}
@@ -293,12 +299,8 @@ You can switch if off if you want, you'll hear a beep when it's over")) or retur
sub autoDefaultDepth($$) {
my ($card, $resolution_wanted) = @_;
- my $wres_wanted = first(split 'x', $resolution_wanted);
- my $depth = $card->{default_depth};
-
- # unset default_depth if there is no resolution in this depth
- undef $depth if $depth && !$card->{depth}->{$depth};
- my $best = $depth;
+ my ($wres_wanted) = split 'x', $resolution_wanted;
+ my ($best, $depth);
while (my ($d, $r) = each %{$card->{depth}}) {
$depth = $depth ? max($depth, $d) : $d;
@@ -306,64 +308,22 @@ sub autoDefaultDepth($$) {
# try to have $resolution_wanted
$best = $best ? max($best, $d) : $d if $r->[0][0] >= $wres_wanted;
}
- $card->{default_depth} = $best || $depth or die "no valid modes";
+ $best || $depth or die "no valid modes";
}
-
-sub resolutionsConfiguration($;$) {
- my ($o, $option) = @_;
- my $card = $o->{card};
- my $auto = $option eq 'auto';
- my $noauto = $option || $::expert;
-
- # For the mono and vga16 server, no further configuration is required.
- return if member($card->{server}, "Mono", "VGA16");
-
- # some of these guys hate to be poked
- # if we dont know then its at the user's discretion
- #my $manual ||=
- # $card->{server} =~ /^(TGA|Mach32)/ ||
- # $card->{name} =~ /^Riva 128/ ||
- # $card->{chipset} =~ /^(RIVA128|mgag)/ ||
- # $::expert;
- #
- #my $unknown =
- # member($card->{server}, qw(S3 S3V I128 Mach64)) ||
- # member($card->{type},
- # "Matrox Millennium (MGA)",
- # "Matrox Millennium II",
- # "Matrox Millennium II AGP",
- # "Matrox Mystique",
- # "Matrox Mystique",
- # "S3",
- # "S3V",
- # "I128",
- # ) ||
- # $card->{type} =~ /S3 ViRGE/;
- #
- #$unknown and $manual ||= !$in->ask_okcancel('', [ _("I can try to autodetect information about graphic card, but it may freeze :("),
- # _("Do you want to try?") ]);
-
- findLegalModes($card);
-
- if ($auto || (!$noauto && $in->ask_okcancel(_("Automatic resolutions"),
-_("I can try to find the available resolutions (eg: 800x600).
-Alas it can freeze sometimes
-Do you want to try?")))) {
- autoResolutions($o);
- }
-
- autoDefaultDepth($card, $o->{resolution_wanted} || $resolution_wanted);
-
+sub chooseResolutions($$) {
+ my ($card, $chosen_depth) = @_;
my $W = my_gtk->new(_("Resolution"));
my %txt2depth = reverse %depths;
- my $chosen_depth = $card->{default_depth};
my $chosen_w = 9999999; # will be set by the combo callback
my ($r, $depth_combo, %w2depth, %w2h, %w2widget);
my $set_depth = sub { $depth_combo->entry->set_text(translate($depths{$chosen_depth})) };
+ # the set function is usefull to toggle the CheckButton with the callback being ignored
+ my $ignore;
+ my $set = sub { $ignore = 1; $_[0]->set_active(1); $ignore = 0; };
while (my ($depth, $res) = each %{$card->{depth}}) {
foreach (@$res) {
@@ -375,6 +335,7 @@ Do you want to try?")))) {
my $V = $w . "x" . $h;
$w2widget{$w} = $r = new Gtk::RadioButton($r ? ($V, $r) : $V);
$r->signal_connect("clicked" => sub {
+ $ignore and return;
$chosen_w = $w;
unless (member($chosen_depth, @{$w2depth{$w}})) {
$chosen_depth = max(@{$w2depth{$w}});
@@ -400,14 +361,82 @@ Do you want to try?")))) {
$depth_combo->entry->signal_connect(changed => sub {
$chosen_depth = $txt2depth{untranslate($depth_combo->entry->get_text, keys %txt2depth)};
my $w = $card->{depth}->{$chosen_depth}->[0][0];
- $chosen_w > $w and $w2widget{$chosen_w = $w}->set_active(1);
+ $chosen_w > $w and &$set($w2widget{$chosen_w = $w});
});
&$set_depth();
- my $rc = $W->main;
+
+ $W->main or return;
+
+ ($chosen_depth, $chosen_w);
+}
+
+
+sub resolutionsConfiguration($$) {
+ my ($o, $option) = @_;
+ my $card = $o->{card};
+ my $auto = $option eq 'auto';
+ my $nowarning = $auto || $option eq 'nowarning';
+ my $noauto = $option eq 'noauto';
+
+ unless ($card->{depth}) {
+ $card->{depth}->{$_} = [ map { [ split "x" ] } @resolutions ]
+ foreach @depths;
+ }
+
+ # For the mono and vga16 server, no further configuration is required.
+ return if member($card->{server}, "Mono", "VGA16");
+
+ # some of these guys hate to be poked
+ # if we dont know then its at the user's discretion
+ #my $manual ||=
+ # $card->{server} =~ /^(TGA|Mach32)/ ||
+ # $card->{name} =~ /^Riva 128/ ||
+ # $card->{chipset} =~ /^(RIVA128|mgag)/ ||
+ # $::expert;
+ #
+ #my $unknown =
+ # member($card->{server}, qw(S3 S3V I128 Mach64)) ||
+ # member($card->{type},
+ # "Matrox Millennium (MGA)",
+ # "Matrox Millennium II",
+ # "Matrox Millennium II AGP",
+ # "Matrox Mystique",
+ # "Matrox Mystique",
+ # "S3",
+ # "S3V",
+ # "I128",
+ # ) ||
+ # $card->{type} =~ /S3 ViRGE/;
+ #
+ #$unknown and $manual ||= !$in->ask_okcancel('', [ _("I can try to autodetect information about graphic card, but it may freeze :("),
+ # _("Do you want to try?") ]);
- $card->{default_depth} = $chosen_depth;
- $card->{depth}->{$chosen_depth} = [ grep { $_->[0] <= $chosen_w } @{$card->{depth}->{$chosen_depth}} ];
- $rc;
+ if ($nowarning || (!$noauto && $in->ask_okcancel(_("Automatic resolutions"),
+_("I can try to find the available resolutions (eg: 800x600).
+Alas it can freeze sometimes
+Do you want to try?")))) {
+ autoResolutions($o, $nowarning);
+ }
+
+ # sort resolutions in each depth
+ @$_ = sort { $b->[0] <=> $a->[0] } @$_ foreach values %{$card->{depth}};
+
+ # remove unusable resolutions (based on the video memory size)
+ keepOnlyLegalModes($card);
+
+ my $res = $o->{resolution_wanted} || $resolution_wanted;
+ my $depth = $card->{default_depth} || autoDefaultDepth($card, $res);
+
+ $auto or ($depth, $res) = chooseResolutions($card, $depth) or return;
+
+ # needed in auto mode when all has been provided by the user
+ $card->{depth}->{$depth} or die "you fixed an unusable depth";
+
+ # remove all biggest resolution (keep the small ones for ctl-alt-+)
+ # otherwise there'll be a virtual screen :(
+ $card->{depth}->{$depth} = [ grep { $_->[0] <= $res } @{$card->{depth}->{$depth}} ];
+ $card->{default_depth} = $depth;
+ 1;
}
@@ -567,23 +596,23 @@ sub main {
XF86check_link();
- $o->{card} = cardConfiguration($o->{card});
+ $o->{card} = cardConfiguration($o->{card}, $::noauto);
$o->{monitor} = monitorConfiguration($o->{monitor});
- my $ok = resolutionsConfiguration($o);
+ my $ok = resolutionsConfiguration($o, $::auto && 'auto' || $::noauto && 'noauto' || '');
- $ok = testFinalConfig($o) if $ok && $in->ask_yesorno(_("Test configuration"), _("Do you want to test configuration?"));
+ $ok &&= testFinalConfig($o, $::auto);
my $quit;
until ($ok || $quit) {
my %c = my @c = (
__("Change Monitor") => sub { $o->{monitor} = monitorConfiguration() },
- __("Change Graphic card") => sub { $o->{card} = cardConfiguration(0, 1) },
+ __("Change Graphic card") => sub { $o->{card} = cardConfiguration('', 'noauto') },
__("Change Resolution") => sub { resolutionsConfiguration($o, 'noauto') },
- __("Automaticall resolutions search") => sub { resolutionsConfiguration($o, 'auto') },
- __("Test again") => sub { $ok = testFinalConfig($o) },
+ __("Automaticall resolutions search") => sub { resolutionsConfiguration($o, 'nowarning') },
+ __("Test again") => sub { $ok = testFinalConfig($o, 1) },
__("Quit") => sub { $quit = 1 },
);
&{$c{$in->ask_from_list_('',
@@ -591,16 +620,17 @@ sub main {
[ grep { !ref } @c ])}};
}
- if ($ok && !$::expert) {
- my $run5 = $in->ask_yesorno(_("X at startup"),
+ if ($ok) {
+ my $run = $o->{xdm} || $::auto || $in->ask_yesorno(_("X at startup"),
_("I can set up your computer to automatically start X upon booting.
Would you like X to start when you reboot?"));
- rewriteInittab($run5 ? 5 : 3) unless $::testing;
+
+ rewriteInittab($run ? 5 : 3) unless $::testing;
$in->ask_warn(_("X successfully configured"),
_("Configuration file has been written. Take a look at it before running 'startx'.
Within the server press ctrl, alt and '+' simultaneously to cycle video resolutions.
Pressing ctrl, alt and backspace simultaneously immediately exits the server
-For further configuration, refer to /usr/X11R6/lib/X11/doc/README.Config."));
+For further configuration, refer to /usr/X11R6/lib/X11/doc/README.Config.")) unless $::auto;
}
}
diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm
index ae8f39d9d..272138411 100644
--- a/perl-install/Xconfigurator_consts.pm
+++ b/perl-install/Xconfigurator_consts.pm
@@ -1,12 +1,8 @@
use common qw(:common);
-%keymap_translate = (
- uk => "gb",
-);
-
%depths = (
8 => __("256 colors"),
- 15 => __("32 thousand colors"),
+# 15 => __("32 thousand colors"),
16 => __("65 thousand colors"),
24 => __("16 millions of colors"),
32 => __("4 billions of colors"),
diff --git a/perl-install/common.pm b/perl-install/common.pm
index c6d96682c..2fee51d59 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -6,9 +6,9 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- common => [ qw(_ __ min max sum bool ikeys member divide is_empty_array_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate) ],
+ common => [ qw(_ __ min max sum product bool ikeys member divide is_empty_array_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate) ],
functional => [ qw(fold_left) ],
- file => [ qw(dirname basename touch all glob_ cat_ chop_ mode) ],
+ file => [ qw(dirname basename touch all glob_ cat_ chop_ mode getVarsFromSh) ],
system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_) ],
constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
);
@@ -26,6 +26,7 @@ sub __ { $_[0] }
sub min { fold_left(sub { $a < $b ? $a : $b }, @_) }
sub max { fold_left(sub { $a > $b ? $a : $b }, @_) }
sub sum { fold_left(sub { $a + $b }, @_) }
+sub product { fold_left(sub { $a * $b }, @_) }
sub first { $_[0] }
sub second { $_[1] }
sub top { $_[$#_] }
@@ -124,3 +125,23 @@ sub untranslate($@) {
foreach (@_) { translate($_) eq $s and return $_ }
die "untranslate failed";
}
+
+sub getVarsFromSh($) {
+ my %l;
+ local *F;
+ open F, $_[0] or return;
+ foreach (<F>) {
+ my ($v, $val, $val2) =
+ /^\s* # leading space
+ (\w+) = # variable
+ (
+ "([^"]*)" # double-quoted text "
+ | '([^']*)' # single-quoted text '
+ | [^'"\s]+ # normal text '
+ )
+ \s*$ # end of line
+ /x or next;
+ $l{$v} = $val2 || $val;
+ }
+ %l;
+}
diff --git a/perl-install/install2 b/perl-install/install2
index e299e423f..5076029b0 100755
--- a/perl-install/install2
+++ b/perl-install/install2
@@ -1,7 +1,7 @@
#!/usr/bin/perl
# DiskDrake
-# Copyright (C) 1999 MandrakeSoft
+# Copyright (C) 1999 MandrakeSoft (pixel@linux-mandrake.com)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 938323350..dd9bcd4de 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -86,7 +86,7 @@ sub spawnShell {
}
sub mouse_detect() {
- my ($type, $dev) = split("\n", `mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
+ my ($type, $dev) = split("\n", `./mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
$type, $dev;
}
diff --git a/perl-install/log.pm b/perl-install/log.pm
index 1ccbbf315..00148127a 100644
--- a/perl-install/log.pm
+++ b/perl-install/log.pm
@@ -19,7 +19,9 @@ sub ld { $logDebugMessages and &l }
sub w { &l }
sub openLog(;$) {
- if ($_[0]) { # useLocal
+ if ($::isStandalone) {
+ open LOG, ">&STDERR";
+ } elsif ($_[0]) { # useLocal
open LOG, "> $_[0]";# or die "no log possible :(";
} else {
open LOG, "> /dev/tty3" or open LOG, ">> /tmp/install.log";# or die "no log possible :(";
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index e78cd2fda..dcf0458ee 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -292,7 +292,7 @@ sub _ask_from_list($$$$) {
$def = $i if $l->[$i] eq $def;
my $w = new Gtk::ListItem($l->[$i]);
my $id = $w->signal_connect(key_press_event => sub {
- my ($w, $e)= @_;
+ my ($w, $e) = @_;
my $c = chr $e->{keyval};
Gtk->timeout_remove($timeout) if $timeout; $timeout = '';
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index 49058e9ed..fbd5a57df 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -362,14 +362,14 @@ sub load($$;$) {
my ($hd, $file, $force) = @_;
local *F;
- open F, $file or die _("Error reading file $file");
+ open F, $file or die _("Error reading file %s", $file);
my $h;
{
no strict 'vars';
$h = eval join '', <F>;
}
- $@ and die _("Restoring from file $file failed: $@");
+ $@ and die _("Restoring from file %s failed: %s", $file, $@);
ref $h eq 'HASH' or die _("Bad backup file");
@@ -391,5 +391,5 @@ sub save($$) {
local *F;
open F, ">$file"
and print F Dumper(\%h)
- or die _("Error writing to file $file");
+ or die _("Error writing to file %s", $file);
}