From 71412b3a34bbb1b5056ace130334917bfa6076be Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Wed, 15 Sep 1999 17:31:22 +0000 Subject: no_comment --- perl-install/Makefile | 3 ++- perl-install/Xconfigurator.pm | 9 ++++++--- perl-install/Xconfigurator_consts.pm | 1 + perl-install/common.pm | 5 +++-- perl-install/fsedit.pm | 4 ++-- perl-install/ftp.pm | 4 ++-- perl-install/install2.pm | 20 +++++++++++--------- perl-install/install_any.pm | 6 +++--- perl-install/interactive.pm | 4 ++-- perl-install/my_gtk.pm | 2 +- perl-install/partition_table.pm | 3 ++- 11 files changed, 35 insertions(+), 26 deletions(-) (limited to 'perl-install') 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 @@ -27,6 +27,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" ], 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}} } -- cgit v1.2.1