summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>1999-09-15 17:31:22 +0000
committerPascal Rigaux <pixel@mandriva.com>1999-09-15 17:31:22 +0000
commit71412b3a34bbb1b5056ace130334917bfa6076be (patch)
tree5af9cdef0ea08f9bb81e1026fc1e27be7990bfb3 /perl-install
parentfec9449e69b0705b7ef85d9617d36e56f66628a4 (diff)
downloaddrakx-71412b3a34bbb1b5056ace130334917bfa6076be.tar
drakx-71412b3a34bbb1b5056ace130334917bfa6076be.tar.gz
drakx-71412b3a34bbb1b5056ace130334917bfa6076be.tar.bz2
drakx-71412b3a34bbb1b5056ace130334917bfa6076be.tar.xz
drakx-71412b3a34bbb1b5056ace130334917bfa6076be.zip
no_comment
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile3
-rw-r--r--perl-install/Xconfigurator.pm9
-rw-r--r--perl-install/Xconfigurator_consts.pm1
-rw-r--r--perl-install/common.pm5
-rw-r--r--perl-install/fsedit.pm4
-rw-r--r--perl-install/ftp.pm4
-rw-r--r--perl-install/install2.pm20
-rw-r--r--perl-install/install_any.pm6
-rw-r--r--perl-install/interactive.pm4
-rw-r--r--perl-install/my_gtk.pm2
-rw-r--r--perl-install/partition_table.pm3
11 files changed, 35 insertions, 26 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile
index 4ae205f52..dcb0ff56b 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -61,7 +61,8 @@ $(DIRS):
test_pms: verify_c
./perl2fcalls -excludec install2
- (for i in $(PMS); do perl -cw -I. -Ic -Ic/blib/arch $$i || exit 1 ; done)
+ perl -cw -I. -Ic -Ic/blib/arch install2
+ perl -cw -I. -Ic -Ic/blib/arch install_steps_graphical.pm
verify_c:
./verify_c $(PMS)
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 9eec42f88..acd1c17f0 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -252,7 +252,7 @@ sub testFinalConfig($;$) {
symlink "$prefix/tmp/.X11-unix/X9", "/tmp/.X11-unix/X9" if $prefix;
local *F;
- open F, "|perl" or die;
+ open F, "|perl" or die '';
print F "use lib qw(", join(' ', @INC), ");\n";
print F q{
use interactive_gtk;
@@ -426,7 +426,7 @@ sub resolutionsConfiguration($$) {
#-$unknown and $manual ||= !$in->ask_okcancel('', [ _("I can try to autodetect information about graphic card, but it may freeze :("),
#- _("Do you want to try?") ]);
- unless ($card->{depth}) {
+ if (is_empty_hash_ref($card->{depth})) {
$card->{depth}{$_} = [ map { [ split "x" ] } @resolutions ]
foreach @depths;
@@ -435,6 +435,9 @@ _("I can try to find the available resolutions (eg: 800x600).
Alas it can freeze sometimes
Do you want to try?")))) {
autoResolutions($o, $nowarning);
+ is_empty_hash_ref($card->{depth}) and $in->ask_warn('',
+_("No valid modes found
+Try with another video card or monitor")), return;
}
}
@@ -449,7 +452,7 @@ Do you want to try?")))) {
keepOnlyLegalModes($card);
my $res = $o->{resolution_wanted} || $resolution_wanted;
- my $depth = $card->{default_depth} || autoDefaultDepth($card, $res);
+ my $depth = eval { $card->{default_depth} || autoDefaultDepth($card, $res) };
$auto or ($depth, $res) = chooseResolutions($card, $depth) or return;
diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm
index 97280f36d..3bc757382 100644
--- a/perl-install/Xconfigurator_consts.pm
+++ b/perl-install/Xconfigurator_consts.pm
@@ -28,6 +28,7 @@ $resolution_wanted = "1024x768";
%standard_monitors = (
__("Standard VGA, 640x480 at 60 Hz") => [ '640x480@60', "31.5" , "60" ],
+ __("Standard VGA, 640x480 at 60 Hz") => [ '640x480@60', "31.5" , "60" ],
__("Super VGA, 800x600 at 56 Hz") => [ '800x600@56', "31.5-35.1" , "55-60" ],
__("8514 Compatible, 1024x768 at 87 Hz interlaced (no 800x600)") => [ '8514 compatible', "31.5,35.5" , "60,70,87" ],
__("Super VGA, 1024x768 at 87 Hz interlaced, 800x600 at 56 Hz") => [ '1024x768@87i', "31.5,35.15,35.5" , "55-90" ],
diff --git a/perl-install/common.pm b/perl-install/common.pm
index baef6befa..e2a135cdc 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- common => [ qw(__ min max sum sign product bool listlength bool2text to_int ikeys member divide is_empty_array_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate warp_text) ],
+ common => [ qw(__ min max sum sign product bool listlength bool2text to_int ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash set_new set_add round_up round_down first second top uniq translate untranslate warp_text) ],
functional => [ qw(fold_left map_index map_tab_hash mapn mapn_ difference2 before_leaving catch_cdie cdie) ],
file => [ qw(dirname basename touch all glob_ cat_ chop_ mode) ],
system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh setVarsInSh) ],
@@ -62,6 +62,7 @@ sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d }
sub round_up { my ($i, $r) = @_; $i += $r - ($i + $r - 1) % $r - 1; }
sub round_down { my ($i, $r) = @_; $i -= $i % $r; }
sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
+sub is_empty_hash_ref { my $a = shift; !defined $a || keys(%$a) == 0 }
sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
sub intersection { my (%l, @m); @l{@{shift @_}} = (); foreach (@_) { @m = grep { exists $l{$_} } @$_; %l = (); @l{@m} = (); } keys %l }
@@ -136,7 +137,7 @@ sub add_f4before_leaving {
my $list = *common::before_leaving::list;
$list->{$b}{$name} = $f;
*N = sub {
- my $f = $list->{$_[0]}{$name} or die;
+ my $f = $list->{$_[0]}{$name} or die '';
$name eq 'DESTROY' and delete $list->{$_[0]};
goto $f;
} unless defined &{*N};
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index 61a0f2dff..9ff3a0c01 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -251,7 +251,7 @@ sub move {
return if $part2->{notFormatted} && !$part2->{isFormatted} || $::testing;
local (*F, *G);
- sysopen F, $hd->{file}, 0 or die;
+ sysopen F, $hd->{file}, 0 or die '';
sysopen G, $hd2->{file}, 2 or die _("Error opening %s for writing: %s", $hd2->{file}, "$!");
my $base = $part->{start};
@@ -273,7 +273,7 @@ sub move {
c::lseek_sector(fileno(G), $base2, 0) or die "seeking to sector $base2 failed on drive $hd2->{device}";
my $buf;
- sysread F, $buf, $SECTORSIZE * abs($_[0]) or die;
+ sysread F, $buf, $SECTORSIZE * abs($_[0]) or die '';
syswrite G, $buf;
};
diff --git a/perl-install/ftp.pm b/perl-install/ftp.pm
index c33a53e55..6e1002840 100644
--- a/perl-install/ftp.pm
+++ b/perl-install/ftp.pm
@@ -39,8 +39,8 @@ sub new {
$host = join ".", unpack "C4", (gethostbyname $host)[4];
}
- my $ftp = Net::FTP->new($host, %options) or die;
- $ftp->login($ENV{LOGIN}, $ENV{PASSWORD}) or die;
+ my $ftp = Net::FTP->new($host, %options) or die '';
+ $ftp->login($ENV{LOGIN}, $ENV{PASSWORD}) or die '';
$ftp->binary;
$ftp;
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index cd45e7763..5d864a3f0 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -382,19 +382,21 @@ sub setupSCSI {
#------------------------------------------------------------------------------
sub partitionDisks {
- $o->{drives} = [ detect_devices::hds() ];
- $o->{hds} = catch_cdie { fsedit::hds($o->{drives}, $o->{partitioning}) }
- sub {
- $o->ask_warn(_("Error"),
+ unless ($o->{hds}) {
+ $o->{drives} = [ detect_devices::hds() ];
+ $o->{hds} = catch_cdie { fsedit::hds($o->{drives}, $o->{partitioning}) }
+ sub {
+ $o->ask_warn(_("Error"),
_("I can't read your partition table, it's too corrupted for me :(
I'll try to go on blanking bad partitions"));
- 1;
- };
+ 1;
+ };
- unless (@{$o->{hds}} > 0) {
- $o->setupSCSI if $o->{autoSCSI}; #- ask for an unautodetected scsi card
+ unless (@{$o->{hds}} > 0) {
+ $o->setupSCSI if $o->{autoSCSI}; #- ask for an unautodetected scsi card
+ }
}
- unless (@{$o->{hds}} > 0) { #- no way
+ if (@{$o->{hds}} == 0) { #- no way
die _("An error has occurred - no valid devices were found on which to create new filesystems. Please check your hardware for the cause of this problem");
}
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 6485aa759..2cab51528 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -75,9 +75,9 @@ sub spawnShell {
local *F;
sysopen F, "/dev/tty2", 2 or die "cannot open /dev/tty2 -- no shell will be provided";
- open STDIN, "<&F" or die;
- open STDOUT, ">&F" or die;
- open STDERR, ">&F" or die;
+ open STDIN, "<&F" or die '';
+ open STDOUT, ">&F" or die '';
+ open STDERR, ">&F" or die '';
close F;
c::setsid();
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 3b296a982..4ffb44d71 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -59,14 +59,14 @@ sub ask_okcancel($$$;$) {
sub ask_from_list_ {
my ($o, $title, $message, $l, $def) = @_;
- @$l == 0 and die;
+ @$l == 0 and die '';
@$l == 1 and return $l->[0];
goto &ask_from_list2_;
}
sub ask_from_list {
my ($o, $title, $message, $l, $def) = @_;
- @$l == 0 and die;
+ @$l == 0 and die '';
@$l == 1 and return $l->[0];
goto &ask_from_list2;
}
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 33f753638..f3228358f 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -163,7 +163,7 @@ sub gtkset_default_fontset($) {
my ($fontset) = @_;
my $style = Gtk::Widget->get_default_style;
- my $f = Gtk::Gdk::Font->fontset_load($fontset) or die;
+ my $f = Gtk::Gdk::Font->fontset_load($fontset) or die '';
$style->font($f);
Gtk::Widget->set_default_style($style);
}
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index 94c17b815..b16f9dd38 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -36,6 +36,7 @@ my %types = (
0xb => "Win98 FAT32 0xb",
0xc => "Win98 FAT32",
0xe => "Win98 FAT32 0xd",
+ 0xf => "Win95 Ext'd (LBA)",
0x12 => "Compaq setup",
0x40 => "Venix 80286",
0x51 => "Novell?",
@@ -89,7 +90,7 @@ sub type2fs($) { $type2fs{$_[0]} }
sub name2type($) { $types_rev{$_[0]} }
sub fs2type($) { $fs2type{$_[0]} }
-sub isExtended($) { $_[0]{type} == 5 }
+sub isExtended($) { $_[0]{type} == 5 || $_[0]{type} == 0xf }
sub isSwap($) { $type2fs{$_[0]{type}} eq 'swap' }
sub isExt2($) { $type2fs{$_[0]{type}} eq 'ext2' }
sub isDos($) { $ {{ 1=>1, 4=>1, 6=>1 }}{$_[0]{type}} }