summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>1999-09-09 09:02:47 +0000
committerPascal Rigaux <pixel@mandriva.com>1999-09-09 09:02:47 +0000
commit1d3ac921d66022bb6e19a96dce95472cc31f0987 (patch)
tree4da18678cee71134f6cec6004f0b41afe6d25145 /perl-install
parentdb4013c2a40eaeb3752cc69623037e4bb274693b (diff)
downloaddrakx-backup-do-not-use-1d3ac921d66022bb6e19a96dce95472cc31f0987.tar
drakx-backup-do-not-use-1d3ac921d66022bb6e19a96dce95472cc31f0987.tar.gz
drakx-backup-do-not-use-1d3ac921d66022bb6e19a96dce95472cc31f0987.tar.bz2
drakx-backup-do-not-use-1d3ac921d66022bb6e19a96dce95472cc31f0987.tar.xz
drakx-backup-do-not-use-1d3ac921d66022bb6e19a96dce95472cc31f0987.zip
no_comment
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile7
-rw-r--r--perl-install/Xconfig.pm2
-rw-r--r--perl-install/Xconfigurator.pm102
-rw-r--r--perl-install/Xconfigurator_consts.pm4
-rw-r--r--perl-install/common.pm6
-rw-r--r--perl-install/detect_devices.pm18
-rw-r--r--perl-install/devices.pm10
-rw-r--r--perl-install/fs.pm26
-rw-r--r--perl-install/fsedit.pm56
-rw-r--r--perl-install/install2.pm124
-rw-r--r--perl-install/install_any.pm84
-rw-r--r--perl-install/install_steps.pm15
-rw-r--r--perl-install/install_steps_interactive.pm12
-rw-r--r--perl-install/interactive.pm49
-rw-r--r--perl-install/interactive_gtk.pm26
-rw-r--r--perl-install/keyboard.pm20
-rw-r--r--perl-install/lang.pm66
-rw-r--r--perl-install/log.pm4
-rw-r--r--perl-install/modules.pm133
-rw-r--r--perl-install/my_gtk.pm44
-rw-r--r--perl-install/network.pm12
-rw-r--r--perl-install/partition_table.pm64
-rw-r--r--perl-install/partition_table_raw.pm6
-rw-r--r--perl-install/pkgs.pm12
-rw-r--r--perl-install/resize_fat/any.pm16
-rw-r--r--perl-install/resize_fat/boot_sector.pm58
-rw-r--r--perl-install/resize_fat/dir_entry.pm8
-rw-r--r--perl-install/resize_fat/directory.pm16
-rw-r--r--perl-install/resize_fat/fat.pm26
-rw-r--r--perl-install/resize_fat/info_sector.pm6
-rw-r--r--perl-install/resize_fat/main.pm32
-rw-r--r--perl-install/share/install.rc56
-rw-r--r--perl-install/swap.pm8
-rw-r--r--perl-install/unused/cdrom.pm4
-rw-r--r--perl-install/unused/scsi.pm6
35 files changed, 487 insertions, 651 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile
index f9a160426..6b3f998c6 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -78,8 +78,9 @@ install_pms: all
for i in $(PMS); do \
dest=$(DESTREP4PMS)/`dirname $$i`; \
install -d $$dest; \
- perl -ne 'print unless (/^=head/ .. /^=cut/) || /^\s*#-/ || /use (diagnostics|vars|strict)/' $$i > $(DESTREP4PMS)/$$i; \
+ perl -ne 'print unless (/^=head/ .. /^=cut/) || /#-.*/' $$i > $(DESTREP4PMS)/$$i; \
done
+# || /use (diagnostics|vars|strict)/
rm $(DESTREP4PMS)/c/c.xs.pm
mv -f $(DESTREP4PMS)/c/c.pm $(DESTREP4PMS)
@@ -134,7 +135,9 @@ get_needed_files: $(SO_FILES)
install -d $(DEST)/usr/X11R6/lib/X11/fonts/75dpi
install -d $(DEST)/usr/X11R6/lib/X11/fonts/misc
cd /usr/X11R6/lib/X11/fonts/75dpi ; cp -a fonts.* helvR* $(DEST)/usr/X11R6/lib/X11/fonts/75dpi
- cd /usr/X11R6/lib/X11/fonts/misc ; cp -a fonts.* cursor.pcf.gz 6x13.pcf.gz $(DEST)/usr/X11R6/lib/X11/fonts/misc
+ cd /usr/X11R6/lib/X11/fonts/misc ; cp -a fonts.* k14.pcf.gz cursor.pcf.gz 6x13.pcf.gz $(DEST)/usr/X11R6/lib/X11/fonts/misc
+
+ for i in ru ja; do install -d $(DEST)/usr/share/locale/$$i ; cp -f `find /usr/share/locale/$$i/* -prune -type f` $(DEST)/usr/share/locale/$$i ; done
perl -I. -Ic -Ic/blib/arch -Mkeyboard -e 'foreach (keyboard::xmodmaps()) { `cp /usr/share/xmodmap/xmodmap.$$_ $(DEST)/usr/share/xmodmap` }'
diff --git a/perl-install/Xconfig.pm b/perl-install/Xconfig.pm
index edbdc2c01..2e93b5679 100644
--- a/perl-install/Xconfig.pm
+++ b/perl-install/Xconfig.pm
@@ -35,7 +35,7 @@ sub getinfoFromXF86Config {
my $o = shift || {};
my (%c, $depth);
- $o->{card}{server} ||= $1 if readlink("/etc/X11/X") =~ /XF86_ (\w+)$/x; # /x for perl2fcalls
+ $o->{card}{server} ||= $1 if readlink("/etc/X11/X") =~ /XF86_ (\w+)$/x; #- /x for perl2fcalls
local *F;
open F, "/etc/X11/XF86Config" or return {};
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 84ff9b803..1879e45b2 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -78,7 +78,7 @@ sub readCardsDB {
push @{$cards{S3}{lines}}, $s3_comment;
push @{$cards{'CL-GD'}{lines}}, $cirrus_comment;
- # this entry is broken in X11R6 cards db
+ #- this entry is broken in X11R6 cards db
$cards{I128}{flags}{noclockprobe} = 1;
}
@@ -150,8 +150,8 @@ sub cardConfiguration(;$$) {
readCardsDB("$prefix/usr/X11R6/lib/X11/Cards");
- add2hash($card, $cards{$card->{type}}) if $card->{type}; # try to get info from given type
- $card->{type} = undef unless $card->{server}; # bad type as we can't find the server
+ add2hash($card, $cards{$card->{type}}) if $card->{type}; #- try to get info from given type
+ $card->{type} = undef unless $card->{server}; #- bad type as we can't find the server
add2hash($card, cardConfigurationAuto()) unless $card->{server} || $noauto;
add2hash($card, { type => $in->ask_from_list('', _("Choose a graphic card"), [keys %cards]) }) unless $card->{type} || $card->{server};
@@ -245,8 +245,8 @@ sub testFinalConfig($;$) {
}
do { sleep 1; } until (c::Xtest(':0'));
- # create a link from the non-prefixed /tmp/.X11-unix/X9 to the prefixed one
- # that way, you can talk to :9 without doing a chroot
+ #- create a link from the non-prefixed /tmp/.X11-unix/X9 to the prefixed one
+ #- that way, you can talk to :9 without doing a chroot
unlink "/tmp/.X11-unix/X9" if $prefix;
symlink "$prefix/tmp/.X11-unix/X9", "/tmp/.X11-unix/X9" if $prefix;
@@ -291,10 +291,10 @@ _("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;
- # swith to virtual console 1 (hopefully not X :)
+ #- swith to virtual console 1 (hopefully not X :)
my $vt = setVirtual(1);
- # Configure the modes order.
+ #- Configure the modes order.
my ($ok, $best);
foreach (reverse @depths) {
local $card->{default_depth} = $_;
@@ -308,9 +308,9 @@ You can switch if off if you want, you'll hear a beep when it's over")) or retur
}
}
- # restore the virtual console
+ #- restore the virtual console
setVirtual($vt);
- print "\a"; # beeeep!
+ print "\a"; #- beeeep!
}
sub autoDefaultDepth($$) {
@@ -332,12 +332,12 @@ sub chooseResolutions($$) {
my $W = my_gtk->new(_("Resolution"));
my %txt2depth = reverse %depths;
- my $chosen_w = 9999999; # will be set by the combo callback
+ 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
+ #- 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; };
@@ -394,33 +394,33 @@ sub resolutionsConfiguration($$) {
my $nowarning = $auto || $option eq 'nowarning';
my $noauto = $option eq 'noauto';
- # For the mono and vga16 server, no further configuration is required.
+ #- 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?") ]);
+ #- 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?") ]);
unless ($card->{depth}) {
$card->{depth}{$_} = [ map { [ split "x" ] } @resolutions ]
@@ -434,14 +434,14 @@ Do you want to try?")))) {
}
}
- # sort resolutions in each depth
+ #- sort resolutions in each depth
foreach (values %{$card->{depth}}) {
my $i;
@$_ = grep { first($i != $_->[0], $i = $_->[0]) }
sort { $b->[0] <=> $a->[0] } @$_;
}
- # remove unusable resolutions (based on the video memory size)
+ #- remove unusable resolutions (based on the video memory size)
keepOnlyLegalModes($card);
my $res = $o->{resolution_wanted} || $resolution_wanted;
@@ -449,18 +449,18 @@ Do you want to try?")))) {
$auto or ($depth, $res) = chooseResolutions($card, $depth) or return;
- # needed in auto mode when all has been provided by the user
+ #- 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 :(
+ #- 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;
}
-# * Create the XF86Config file.
+#- Create the XF86Config file.
sub write_XF86Config {
my ($o, $file) = @_;
my $O;
@@ -470,7 +470,7 @@ sub write_XF86Config {
print F $XF86firstchunk_text;
- # Write keyboard section.
+ #- Write keyboard section.
$O = $o->{keyboard};
print F $keyboardsection_start;
@@ -479,12 +479,12 @@ sub write_XF86Config {
print F qq( XkbLayout "$O->{xkb_keymap}"\n);
print F $keyboardsection_end;
- # Write pointer section.
+ #- Write pointer section.
$O = $o->{mouse};
print F $pointersection_text1;
print F qq( Protocol "$O->{XMOUSETYPE}"\n);
print F qq( Device "$O->{device}"\n);
- # this will enable the "wheel" or "knob" functionality if the mouse supports it
+ #- this will enable the "wheel" or "knob" functionality if the mouse supports it
print F " ZAxisMapping 4 5\n" if
member($O->{XMOUSETYPE}, qw(IntelliMouse IMPS/2 ThinkingMousePS/2 NetScrollPS/2 NetMousePS/2 MouseManPlusPS/2));
@@ -500,7 +500,7 @@ sub write_XF86Config {
print F " ClearRTS\n\n" if $O->{cleardtrrts};
print F "EndSection\n\n\n";
- # Write monitor section.
+ #- Write monitor section.
$O = $o->{monitor};
print F $monitorsection_text1;
print F qq( Identifier "$O->{type}"\n);
@@ -519,7 +519,7 @@ sub write_XF86Config {
$modelines_text);
print F "EndSection\n\n\n";
- # Write Device section.
+ #- Write Device section.
$O = $o->{card};
print F $devicesection_text;
print F qq(Section "Device"\n);
@@ -543,7 +543,7 @@ sub write_XF86Config {
}
print F "EndSection\n\n\n";
- # Write Screen sections.
+ #- Write Screen sections.
print F $screensection_text1;
my $screen = sub {
@@ -568,7 +568,7 @@ Section "Screen"
print F "EndSection\n";
};
- # SVGA screen section.
+ #- SVGA screen section.
print F qq(
# The Colour SVGA server
);
@@ -598,7 +598,7 @@ sub XF86check_link {
my $l = "$prefix/usr/X11R6/lib/X11/XF86Config";
- if (-e $l && (stat($f))[1] != (stat($l))[1]) { # compare the inode, must be the sames
+ if (-e $l && (stat($f))[1] != (stat($l))[1]) { #- compare the inode, must be the sames
-e $l and unlink($l) || die "can't remove bad $l";
symlink "../../../../etc/X11/XF86Config", $l;
}
@@ -621,7 +621,7 @@ sub show_info {
$in->ask_warn('', $info);
}
-# * Program entry point.
+#- Program entry point.
sub main {
my $o;
($prefix, $o, $in, $install) = @_;
diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm
index 258f7c882..1f7529164 100644
--- a/perl-install/Xconfigurator_consts.pm
+++ b/perl-install/Xconfigurator_consts.pm
@@ -2,7 +2,7 @@ use common qw(:common);
%depths = (
8 => __("256 colors"),
-# 15 => __("32 thousand colors"),
+#- 15 => __("32 thousand colors"),
16 => __("65 thousand colors"),
24 => __("16 million colors"),
32 => __("4 billion colors"),
@@ -41,7 +41,7 @@ $resolution_wanted = "1024x768";
__("Monitor that can do 1600x1200 at 76 Hz") => [ '1600x1200@76', "31.5-94.0" , "50-160" ],
);
-# * Screen/video card configuration.
+#- * Screen/video card configuration.
%ramdacs = (
__("No RAMDAC Setting (recommended)") => '',
__("AT&T 20C490 (S3 and AGX servers, ARK driver)"), => 'att20c490',
diff --git a/perl-install/common.pm b/perl-install/common.pm
index 084080959..4b88b85ed 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -29,7 +29,7 @@ sub fold_left(&@) {
}
sub _ { my $s = shift @_; sprintf translate($s), @_ }
-#delete $main::{'_'};
+#-delete $main::{'_'};
sub __ { $_[0] }
sub min { fold_left { $a < $b ? $a : $b } @_ }
sub max { fold_left { $a > $b ? $a : $b } @_ }
@@ -85,7 +85,7 @@ sub map_index(&@) {
@l;
}
-#pseudo-array-hash :)
+#- pseudo-array-hash :)
sub map_tab_hash(&$@) {
my ($f, $fields, @tab_hash) = @_;
my %hash;
@@ -135,7 +135,7 @@ sub add_f4before_leaving {
}
-# ! the functions are not called in the order wanted, in case of multiple before_leaving :(
+#- ! the functions are not called in the order wanted, in case of multiple before_leaving :(
sub before_leaving(&) {
my ($f) = @_;
my $b = bless {}, 'common::before_leaving';
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index c8c14736b..5b6f79e41 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -15,12 +15,12 @@ my $CSADeviceAvailable;
1;
sub get {
- # Detect the default BIOS boot harddrive is kind of tricky. We may have IDE,
- # SCSI and RAID devices on the same machine. From what I see so far, the default
- # BIOS boot harddrive will be
- # 1. The first IDE device if IDE exists. Or
- # 2. The first SCSI device if SCSI exists. Or
- # 3. The first RAID device if RAID exists.
+ #- Detect the default BIOS boot harddrive is kind of tricky. We may have IDE,
+ #- SCSI and RAID devices on the same machine. From what I see so far, the default
+ #- BIOS boot harddrive will be
+ #- 1. The first IDE device if IDE exists. Or
+ #- 2. The first SCSI device if SCSI exists. Or
+ #- 3. The first RAID device if RAID exists.
map { &{$_->[0]}() ? &{$_->[1]}() : () }
[ \&hasIDE, \&getIDE ],
@@ -89,7 +89,7 @@ sub getSCSI() {
sub getIDE() {
my @idi;
- # Great. 2.2 kernel, things are much easier and less error prone.
+ #- Great. 2.2 kernel, things are much easier and less error prone.
foreach my $d (glob_('/proc/ide/hd*')) {
my ($t) = chop_(cat_("$d/media"));
my $type = $ {{disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd'}}{$t} or next;
@@ -119,8 +119,8 @@ sub getCompaqSmartArray() {
sub getDAC960() {
my @idi;
- # We are looking for lines of this format:DAC960#0:
- # /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012
+ #- We are looking for lines of this format:DAC960#0:
+ #- /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012
foreach (syslog()) {
my ($devicename, $info) = m|/dev/rd/(.*?): (.*?),| or next;
push @idi, { info => $info, type => 'hd', devicename => $devicename };
diff --git a/perl-install/devices.pm b/perl-install/devices.pm
index af5dd3ab1..f29ac194b 100644
--- a/perl-install/devices.pm
+++ b/perl-install/devices.pm
@@ -17,15 +17,15 @@ sub size($) {
my $valid_offset = sub { sysseek(F, $_[0], 0) && sysread(F, my $a, 1) };
- # first try getting the size nicely
+ #- first try getting the size nicely
my $size = 0;
ioctl(F, c::BLKGETSIZE(), $size) and return unpack("i", $size) * $common::SECTORSIZE;
- # sad it didn't work, well searching the size using the dichotomy algorithm!
+ #- sad it didn't work, well searching the size using the dichotomy algorithm!
my $low = 0;
my ($high, $mid);
- # first find n where 2^n < size <= 2^n+1
+ #- first find n where 2^n < size <= 2^n+1
for ($high = 1; $high > 0 && &$valid_offset($high); $high *= 2) { $low = $high; }
while ($low < $high - 1) {
@@ -46,7 +46,7 @@ sub make($) {
$file = "$prefix/dev/$_";
-e $file or $file = "$prefix/tmp/$_";
}
- -e $file and return $file; # assume nobody takes fun at creating files named as device
+ -e $file and return $file; #- assume nobody takes fun at creating files named as device
if (/^sd(.)(\d{0,2})/) {
$type = c::S_IFBLK();
@@ -100,7 +100,7 @@ sub make($) {
}}{$_} or die "unknown device $_" };
}
- # make a directory for this inode if needed.
+ #- make a directory for this inode if needed.
mkdir dirname($file), 0755;
syscall_('mknod', $file, $type | 0600, makedev($major, $minor)) or die "mknod failed (dev:$_): $!";
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index b891f5f10..45045e508 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -63,7 +63,7 @@ sub format_ext2($;$) {
my ($dev, $bad_blocks) = @_;
my @options;
- $dev =~ m,(rd|ida)/, and push @options, qw(-b 4096 -R stride=16); # For RAID only.
+ $dev =~ m,(rd|ida)/, and push @options, qw(-b 4096 -R stride=16); #- For RAID only.
$bad_blocks and push @options, "-c";
run_program::run("mke2fs", devices::make($dev), @options) or die _("%s formatting of %s failed", "ext2", $dev);
@@ -116,24 +116,24 @@ sub mount($$$;$) {
if ($fs eq 'vfat') {
$mount_opt = "check=relaxed";
- eval { modules::load('vfat') }; # try using vfat
- eval { modules::load('msdos') } if $@; # otherwise msdos...
+ eval { modules::load('vfat') }; #- try using vfat
+ eval { modules::load('msdos') } if $@; #- otherwise msdos...
}
log::l("calling mount($dev, $where, $fs, $flag, $mount_opt)");
syscall_('mount', $dev, $where, $fs, $flag, $mount_opt) or die _("mount failed: ") . "$!";
}
local *F;
- open F, ">>/etc/mtab" or return; # fail silently, must be read-only /etc
+ open F, ">>/etc/mtab" or return; #- fail silently, must be read-only /etc
print F "$dev $where $fs defaults 0 0\n";
}
-# takes the mount point to umount (can also be the device)
+#- takes the mount point to umount (can also be the device)
sub umount($) {
my ($mntpoint) = @_;
syscall_('umount', $mntpoint) or die _("error unmounting %s: %s", $mntpoint, "$!");
- my @mtab = cat_('/etc/mtab'); # don't care about error, if we can't read, we won't manage to write... (and mess mtab)
+ my @mtab = cat_('/etc/mtab'); #- don't care about error, if we can't read, we won't manage to write... (and mess mtab)
local *F;
open F, ">/etc/mtab" or return;
foreach (@mtab) { print F $_ unless /(^|\s)$mntpoint\s/; }
@@ -150,7 +150,7 @@ sub mount_part($;$) {
$part->{mntpoint} or die "missing mount point";
mount(devices::make($part->{device}), ($prefix || '') . $part->{mntpoint}, type2fs($part->{type}), 0);
}
- $part->{isMounted} = $part->{isFormatted} = 1; # assume that if mount works, partition is formatted
+ $part->{isMounted} = $part->{isFormatted} = 1; #- assume that if mount works, partition is formatted
}
sub umount_part($;$) {
@@ -169,7 +169,7 @@ sub mount_all($;$) {
log::l("mounting all filesystems");
- # order mount by alphabetical ordre, that way / < /home < /home/httpd...
+ #- order mount by alphabetical ordre, that way / < /home < /home/httpd...
foreach (sort { ($a->{mntpoint} || '') cmp ($b->{mntpoint} || '') } @$fstab) {
mount_part($_, $prefix) if ($_->{mntpoint} || isSwap($_));
}
@@ -185,7 +185,7 @@ sub umount_all($;$) {
}
}
-# do some stuff before calling write_fstab
+#- do some stuff before calling write_fstab
sub write($$) {
my ($prefix, $fstab) = @_;
my @cd_drives = detect_devices::cdroms();
@@ -194,8 +194,8 @@ sub write($$) {
unshift @cd_drives, grep { $_->{type} eq 'iso9660' } read_fstab("/proc/mounts");
log::l("found cdrom drive(s) " . join(', ', map { $_->{device} } @cd_drives));
- # cd-rom rooted installs have the cdrom mounted on /dev/root which
- # is not what we want to symlink to /dev/cdrom.
+ #- cd-rom rooted installs have the cdrom mounted on /dev/root which
+ #- is not what we want to symlink to /dev/cdrom.
my $cddev = first(grep { $_ ne 'root' } map { $_->{device} } @cd_drives);
log::l("resetting /etc/mtab");
@@ -234,7 +234,7 @@ sub write_fstab($;$$) {
push @to_add, [ split ' ', 'none /dev/pts devpts mode=0620 0 0' ];
}
- # get the list of devices and mntpoint
+ #- get the list of devices and mntpoint
my @new = grep { $_ ne 'none' } map { @$_[0,1] } @to_add;
my %new; @new{@new} = undef;
@@ -245,7 +245,7 @@ sub write_fstab($;$$) {
open F, "> $prefix/etc/fstab" or die "error writing $prefix/etc/fstab";
foreach (@current) {
my ($a, $b) = split;
- # if we find one line of fstab containing either the same device or mntpoint, do not write it
+ #- if we find one line of fstab containing either the same device or mntpoint, do not write it
exists $new{$a} || exists $new{$b} and next;
print F $_;
}
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index fc555c056..055a1d3b8 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -76,9 +76,9 @@ sub suggest_part($$$;$) {
$best = $second if
$best->{mntpoint} eq '/boot' &&
- $part->{start} + $best->{minsize} > 1024 * partition_table::cylinder_size($hd); # if the empty slot is beyond the 1024th cylinder, no use having /boot
+ $part->{start} + $best->{minsize} > 1024 * partition_table::cylinder_size($hd); #- if the empty slot is beyond the 1024th cylinder, no use having /boot
- defined $best or return; # sorry no suggestion :(
+ defined $best or return; #- sorry no suggestion :(
$part->{mntpoint} = $best->{mntpoint};
$part->{type} = $best->{type};
@@ -87,24 +87,24 @@ sub suggest_part($$$;$) {
}
-#sub partitionDrives {
-#
-# my $cmd = "/sbin/fdisk";
-# -x $cmd or $cmd = "/usr/bin/fdisk";
-#
-# my $drives = findDrivesPresent() or die "You don't have any hard drives available! You probably forgot to configure a SCSI controller.";
-#
-# foreach (@$drives) {
-# my $text = "/dev/" . $_->{device};
-# $text .= " - SCSI ID " . $_->{id} if $_->{device} =~ /^sd/;
-# $text .= " - Model " . $_->{info};
-# $text .= " array" if $_->{device} =~ /^c.d/;
-#
-# # truncate at 50 columns for now
-# $text = substr $text, 0, 50;
-# }
-# #TODO TODO
-#}
+#-sub partitionDrives {
+#-
+#- my $cmd = "/sbin/fdisk";
+#- -x $cmd or $cmd = "/usr/bin/fdisk";
+#-
+#- my $drives = findDrivesPresent() or die "You don't have any hard drives available! You probably forgot to configure a SCSI controller.";
+#-
+#- foreach (@$drives) {
+#- my $text = "/dev/" . $_->{device};
+#- $text .= " - SCSI ID " . $_->{id} if $_->{device} =~ /^sd/;
+#- $text .= " - Model " . $_->{info};
+#- $text .= " array" if $_->{device} =~ /^c.d/;
+#-
+#- #- truncate at 50 columns for now
+#- $text = substr $text, 0, 50;
+#- }
+#- #-TODO TODO
+#-}
sub has_mntpoint($$) {
@@ -112,8 +112,8 @@ sub has_mntpoint($$) {
scalar grep { $mntpoint eq $_->{mntpoint} } get_fstab(@$hds);
}
-# do this before modifying $part->{mntpoint}
-# $part->{mntpoint} should not be used here, use $mntpoint instead
+#- do this before modifying $part->{mntpoint}
+#- $part->{mntpoint} should not be used here, use $mntpoint instead
sub check_mntpoint {
my ($mntpoint, $hd, $part, $hds) = @_;
@@ -121,7 +121,7 @@ sub check_mntpoint {
local $_ = $mntpoint;
m|^/| or die _("Mount points must begin with a leading /");
-# m|(.)/$| and die "The mount point $_ is illegal.\nMount points may not end with a /";
+#- m|(.)/$| and die "The mount point $_ is illegal.\nMount points may not end with a /";
has_mntpoint($mntpoint, $hds) and die _("There is already a partition with mount point %s", $mntpoint);
@@ -152,10 +152,10 @@ sub removeFromList($$$) {
if ($start == $list->[$i]) {
$end > $list->[$i + 1] and die $err;
if ($end == $list->[$i + 1]) {
- # the free block is just the same size, removing it
+ #- the free block is just the same size, removing it
splice(@$list, 0, 2);
} else {
- # the free block now start just after this block
+ #- the free block now start just after this block
$list->[$i] = $end;
}
} else {
@@ -163,7 +163,7 @@ sub removeFromList($$$) {
if ($end < $list->[$i + 1]) {
splice(@$list, $i + 2, 0, $end, $list->[$i + 1]);
}
- $list->[$i + 1] = $start; # shorten the free block
+ $list->[$i + 1] = $start; #- shorten the free block
}
return;
}
@@ -172,7 +172,7 @@ sub removeFromList($$$) {
sub allocatePartitions($$) {
my ($hds, $to_add) = @_;
- my %free_sectors = map { $_->{device} => [1, $_->{totalsectors} ] } @$hds; # first sector is always occupied by the MBR
+ my %free_sectors = map { $_->{device} => [1, $_->{totalsectors} ] } @$hds; #- first sector is always occupied by the MBR
my $remove = sub { removeFromList($_[0]{start}, $_[0]->{start} + $_[0]->{size}, $free_sectors{$_[0]->{rootDevice}}) };
my $success = 0;
@@ -239,7 +239,7 @@ sub move {
$part2->{size} += partition_table::cylinder_size($hd2) - 1;
partition_table::remove($hd, $part);
{
- local ($part2->{notFormatted}, $part2->{isFormatted}); # do not allow partition::add to change this
+ local ($part2->{notFormatted}, $part2->{isFormatted}); #- do not allow partition::add to change this
partition_table::add($hd2, $part2);
}
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index abcae4402..f3850252b 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -183,7 +183,7 @@ my @installSteps = (
configureMouse => [ __("Configure mouse"), 1, 1, "formatPartitions" ],
configureNetwork => [ __("Configure networking"), 1, 1, "formatPartitions" ],
configureTimezone => [ __("Configure timezone"), 1, 1, "doInstallStep" ],
-# configureServices => [ __("Configure services"), 0, 0 ],
+#- configureServices => [ __("Configure services"), 0, 0 ],
configurePrinter => [ __("Configure printer"), 1, 0, "doInstallStep" ],
setRootPassword => [ __("Set root password"), 1, 1, "formatPartitions" ],
addUser => [ __("Add a user"), 1, 1, "doInstallStep" ],
@@ -204,18 +204,18 @@ for (my $i = 0; $i < @installSteps; $i += 2) {
push @orderedInstallSteps, $installSteps[$i];
}
-#TOSEE bug with
-#%installSteps =
-# map_tab_hash {
-# my ($i, $h) = @_;
-# $h->{help} = $stepsHelp{$installSteps[$i]} || __("Help");
-# $h->{next} = $installSteps[$i + 2];
-# $h->{onError} = $installSteps[$i + 2 * $h->{onError}];
-## $h->{toBeDone} = []; SEMBLE FIXE les PBS
-## $h->{entered} = 0;
-# push @orderedInstallSteps, $installSteps[$i];
-# } \@installStepsFields, @installSteps;
-#print Dumper(\%installSteps);
+#-TOSEE bug with
+#-%installSteps =
+#- map_tab_hash {
+#- my ($i, $h) = @_;
+#- $h->{help} = $stepsHelp{$installSteps[$i]} || __("Help");
+#- $h->{next} = $installSteps[$i + 2];
+#- $h->{onError} = $installSteps[$i + 2 * $h->{onError}];
+#-#- $h->{toBeDone} = []; SEMBLE FIXE les PBS
+#-#- $h->{entered} = 0;
+#- push @orderedInstallSteps, $installSteps[$i];
+#- } \@installStepsFields, @installSteps;
+#-print Dumper(\%installSteps);
$installSteps{first} = $installSteps[0];
@@ -227,7 +227,7 @@ my @install_classes = (__("beginner"), __("developer"), __("server"), __("expert
#-#####################################################################################
#-Default value
#-#####################################################################################
-# partition layout
+#- partition layout
my %suggestedPartitions = (
beginner => [
{ mntpoint => "/boot", size => 16 << 11, type => 0x83 },
@@ -264,28 +264,28 @@ my %suggestedPartitions = (
$o = $::o = {
bootloader => { onmbr => 1, linear => 0 },
autoSCSI => 0,
- mkbootdisk => 1, # no mkbootdisk if 0 or undef, find a floppy with 1
-# packages => [ qw() ],
+ mkbootdisk => 1, #- no mkbootdisk if 0 or undef, find a floppy with 1
+#- packages => [ qw() ],
partitioning => { clearall => $::testing, eraseBadPartitions => 0, auto_allocate => 0, autoformat => 0 },
-# partitions => [
-# { mntpoint => "/boot", size => 16 << 11, type => 0x83 },
-# { mntpoint => "/", size => 256 << 11, type => 0x83 },
-# { mntpoint => "/usr", size => 512 << 11, type => 0x83, growable => 1 },
-# { mntpoint => "/var", size => 256 << 11, type => 0x83 },
-# { mntpoint => "/home", size => 512 << 11, type => 0x83, growable => 1 },
-# { mntpoint => "swap", size => 64 << 11, type => 0x82 }
-# { mntpoint => "/boot", size => 16 << 11, type => 0x83 },
-# { mntpoint => "/", size => 300 << 11, type => 0x83 },
-# { mntpoint => "swap", size => 64 << 11, type => 0x82 },
-# { mntpoint => "/usr", size => 400 << 11, type => 0x83, growable => 1 },
-# ],
+#- partitions => [
+#- { mntpoint => "/boot", size => 16 << 11, type => 0x83 },
+#- { mntpoint => "/", size => 256 << 11, type => 0x83 },
+#- { mntpoint => "/usr", size => 512 << 11, type => 0x83, growable => 1 },
+#- { mntpoint => "/var", size => 256 << 11, type => 0x83 },
+#- { mntpoint => "/home", size => 512 << 11, type => 0x83, growable => 1 },
+#- { mntpoint => "swap", size => 64 << 11, type => 0x82 }
+#- { mntpoint => "/boot", size => 16 << 11, type => 0x83 },
+#- { mntpoint => "/", size => 300 << 11, type => 0x83 },
+#- { mntpoint => "swap", size => 64 << 11, type => 0x82 },
+#- { mntpoint => "/usr", size => 400 << 11, type => 0x83, growable => 1 },
+#- ],
shells => [ map { "/bin/$_" } qw(bash tcsh zsh ash ksh) ],
lang => 'en',
isUpgrade => 0,
installClass => "beginner",
timezone => {
-# timezone => "Europe/Paris",
+#- timezone => "Europe/Paris",
GMT => 1,
},
printer => {
@@ -315,27 +315,27 @@ $o = $::o = {
SMBPASSWD => "passowrd",
SMBWORKGROUP => "AS3",
},
-# superuser => { password => 'a', shell => '/bin/bash', realname => 'God' },
-# user => { name => 'foo', password => 'bar', home => '/home/foo', shell => '/bin/bash', realname => 'really, it is foo' },
+#- superuser => { password => 'a', shell => '/bin/bash', realname => 'God' },
+#- user => { name => 'foo', password => 'bar', home => '/home/foo', shell => '/bin/bash', realname => 'really, it is foo' },
-# keyboard => 'de',
-# display => "192.168.1.9:0",
+#- keyboard => 'de',
+#- display => "192.168.1.9:0",
steps => \%installSteps,
orderedSteps => \@orderedInstallSteps,
base => [ qw(basesystem initscripts console-tools mkbootdisk anacron rhs-hwdiag utempter ldconfig chkconfig ntsysv mktemp setup filesystem SysVinit bdflush crontabs dev e2fsprogs etcskel fileutils findutils getty_ps grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm sash sed setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time timeconfig tmpwatch util-linux vim-minimal vixie-cron which cpio) ],
-# for the list of fields available for user and superuser, see @etc_pass_fields in install_steps.pm
-# intf => [ { DEVICE => "eth0", IPADDR => '1.2.3.4', NETMASK => '255.255.255.128' } ],
-
-#step : the current one
-#prefix
-#mouse
-#keyboard
-#netc
-#autoSCSI drives hds fstab
-#methods
-#packages compss
-#printer haveone entry(cf printer.pm)
+#- for the list of fields available for user and superuser, see @etc_pass_fields in install_steps.pm
+#- intf => [ { DEVICE => "eth0", IPADDR => '1.2.3.4', NETMASK => '255.255.255.128' } ],
+
+#-step : the current one
+#-prefix
+#-mouse
+#-keyboard
+#-netc
+#-autoSCSI drives hds fstab
+#-methods
+#-packages compss
+#-printer haveone entry(cf printer.pm)
};
@@ -363,7 +363,7 @@ sub selectKeyboard {
return if $::beginner && !$clicked;
$o->selectKeyboard;
- #if we go back to the selectKeyboard, you must rewrite
+ #- if we go back to the selectKeyboard, you must rewrite
addToBeDone {
keyboard::write($o->{prefix}, $o->{keyboard}) unless $o->{isUpgrade};
} 'doInstallStep';
@@ -397,7 +397,7 @@ sub setupSCSI {
}
#------------------------------------------------------------------------------
-#PADTODO
+#-PADTODO
sub partitionDisks {
$o->{drives} = [ detect_devices::hds() ];
$o->{hds} = catch_cdie { fsedit::hds($o->{drives}, $o->{partitioning}) }
@@ -409,9 +409,9 @@ I'll try to go on blanking bad partitions"));
};
unless (@{$o->{hds}} > 0) {
- $o->setupSCSI if $o->{autoSCSI}; # ask for an unautodetected scsi card
+ $o->setupSCSI if $o->{autoSCSI}; #- ask for an unautodetected scsi card
}
- unless (@{$o->{hds}} > 0) { # no way
+ unless (@{$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");
}
@@ -431,7 +431,7 @@ I'll try to go on blanking bad partitions"));
}
-#PADTODO
+#-PADTODO
sub formatPartitions {
$o->choosePartitionsToFormat($o->{fstab});
@@ -444,7 +444,7 @@ sub formatPartitions {
}
#------------------------------------------------------------------------------
-#PADTODO
+#-PADTODO
sub choosePackages {
install_any::setPackages($o);
$o->choosePackages($o->{packages}, $o->{compss});
@@ -452,7 +452,7 @@ sub choosePackages {
}
#------------------------------------------------------------------------------
-#PADTODO
+#-PADTODO
sub doInstallStep {
$o->beforeInstallPackages;
$o->installPackages($o->{packages});
@@ -467,7 +467,7 @@ sub configureNetwork {
$o->configureNetwork($entered == 1 && !$clicked)
}
#------------------------------------------------------------------------------
-#PADTODO
+#-PADTODO
sub configureTimezone {
my ($clicked) = $_[0];
my $f = "$o->{prefix}/etc/sysconfig/clock";
@@ -486,12 +486,12 @@ sub addUser {
$o->addUser;
addToBeDone {
- run_program::rooted($o->{prefix}, "pwconv") or log::l("pwconv failed"); # use shadow passwords
+ run_program::rooted($o->{prefix}, "pwconv") or log::l("pwconv failed"); #- use shadow passwords
} 'doInstallStep';
}
#------------------------------------------------------------------------------
-#PADTODO
+#-PADTODO
sub createBootdisk {
fs::write($o->{prefix}, $o->{fstab}) unless $o->{isUpgrade};
modules::write_conf("$o->{prefix}/etc/conf.modules", 'append');
@@ -517,7 +517,7 @@ sub exitInstall { $o->exitInstall }
sub main {
$SIG{__DIE__} = sub { chomp $_[0]; log::l("ERROR: $_[0]") };
- # if this fails, it's okay -- it might help with free space though
+ #- if this fails, it's okay -- it might help with free space though
unlink "/sbin/install" unless $::testing;
unlink "/sbin/insmod" unless $::testing;
@@ -529,15 +529,15 @@ sub main {
$o->{prefix} = $::testing ? "/tmp/test-perl-install" : "/mnt";
mkdir $o->{prefix}, 0755;
- # make sure we don't pick up any gunk from the outside world
+ #- make sure we don't pick up any gunk from the outside world
$ENV{PATH} = "/usr/bin:/bin:/sbin:/usr/sbin:/usr/X11R6/bin:$o->{prefix}/sbin:$o->{prefix}/bin:$o->{prefix}/usr/sbin:$o->{prefix}/usr/bin:$o->{prefix}/usr/X11R6/bin";
$ENV{LD_LIBRARY_PATH} = "";
- #really needed ??
+ #-really needed ??
spawnSync();
eval { spawnShell() };
- # needed very early for install_steps_graphical
+ #- needed very early for install_steps_graphical
$o->{mouse} = install_any::mouse_detect() unless $::testing || $o->{mouse};
$o = install_steps_graphical->new($o);
@@ -574,7 +574,7 @@ sub main {
}
- #the main cycle
+ #-the main cycle
my $clicked = 0;
MAIN: for ($o->{step} = $o->{steps}{first};; $o->{step} = getNextStep()) {
$o->enteringStep($o->{step});
@@ -604,10 +604,10 @@ sub main {
sub killCardServices {
my $pid = chop_(cat_("/tmp/cardmgr.pid"));
- $pid and kill(15, $pid); # send SIGTERM
+ $pid and kill(15, $pid); #- send SIGTERM
}
#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
-1; #
+1;
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 5cec2da8a..0b9989377 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -125,87 +125,3 @@ sub addToBeDone(&$) {
push @{$::o->{steps}{$step}{toBeDone}}, $f;
}
-
-sub upgrFindInstall {
-# int rc;
-#
-# if (!$::o->{table}.parts) {
-# rc = findAllPartitions(NULL, &$::o->{table});
-# if (rc) return rc;
-# }
-#
-# umountFilesystems(&$::o->{fstab});
-#
-# # rootpath upgrade support
-# if (strcmp($::o->{rootPath} ,"/mnt"))
-# return INST_OKAY;
-#
-# # this also turns on swap for us
-# rc = readMountTable($::o->{table}, &$::o->{fstab});
-# if (rc) return rc;
-#
-# if (!testing) {
-# mountFilesystems(&$::o->{fstab});
-#
-# if ($::o->{method}->prepareMedia) {
-# rc = $::o->{method}->prepareMedia($::o->{method}, &$::o->{fstab});
-# if (rc) {
-# umountFilesystems(&$::o->{fstab});
-# return rc;
-# }
-# }
-# }
-#
-# return 0;
-}
-
-sub upgrChoosePackages {
-# static int firstTime = 1;
-# char * rpmconvertbin;
-# int rc;
-# char * path;
-# char * argv[] = { NULL, NULL };
-# char buf[128];
-#
-# if (testing)
-# path = "/";
-# else
-# path = $::o->{rootPath};
-#
-# if (firstTime) {
-# snprintf(buf, sizeof(buf), "%s%s", $::o->{rootPath},
-# "/var/lib/rpm/packages.rpm");
-# if (access(buf, R_OK)) {
-# snprintf(buf, sizeof(buf), "%s%s", $::o->{rootPath},
-# "/var/lib/rpm/packages");
-# if (access(buf, R_OK)) {
-# errorWindow("No RPM database exists!");
-# return INST_ERROR;
-# }
-#
-# if ($::o->{method}->getFile($::o->{method}, "rpmconvert",
-# &rpmconvertbin)) {
-# return INST_ERROR;
-# }
-#
-# symlink("/mnt/var", "/var");
-# winStatus(35, 3, _("Upgrade"), _("Converting RPM database..."));
-# chmod(rpmconvertbin, 0755);
-# argv[0] = rpmconvertbin;
-# rc = runProgram(RUN_LOG, rpmconvertbin, argv);
-# if ($::o->{method}->rmFiles)
-# unlink(rpmconvertbin);
-#
-# newtPopWindow();
-# if (rc) return INST_ERROR;
-# }
-# winStatus(35, 3, "Upgrade", _("Finding packages to upgrade..."));
-# rc = ugFindUpgradePackages(&$::o->{packages}, path);
-# newtPopWindow();
-# if (rc) return rc;
-# firstTime = 0;
-# psVerifyDependencies(&$::o->{packages}, 1);
-# }
-#
-# return psSelectPackages(&$::o->{packages}, &$::o->{compss}, NULL, 0, 1);
-}
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 6cd107081..cf3df79dc 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -52,17 +52,14 @@ sub enteringStep($$) {
my @l = ref $needs ? @$needs : $needs;
$reachable = min(map { $o->{steps}{$_}{done} || 0 } @l);
}
- $o->{steps}{$s}{reachable} = 1, $o->step_set_reachable($s) if $reachable;
+ $o->{steps}{$s}{reachable} = 1 if $reachable;
}
}
sub leavingStep($$) {
my ($o, $step) = @_;
log::l("step `$step' finished");
- unless ($o->{steps}{$step}{redoable}) {
- $o->{steps}{$step}{reachable} = 0;
- $o->step_set_unreachable($step);
- }
+ $o->{steps}{$step}{reachable} = $o->{steps}{$step}{redoable};
while (my $f = shift @{$o->{steps}{$step}{toBeDone} || []}) {
eval { &$f() };
@@ -149,7 +146,7 @@ sub installPackages($$) {
sub afterInstallPackages($) {
my ($o) = @_;
- # why not? cuz weather is nice today :-) [pixel]
+ #- why not? cuz weather is nice today :-) [pixel]
sync(); sync();
# configPCMCIA($o->{rootPath}, $o->{pcmcia});
@@ -175,7 +172,7 @@ sub configureNetwork($) {
network::add2hosts("$etc/hosts", $o->{netc}{HOSTNAME}, map { $_->{IPADDR} } @{$o->{intf}});
network::sethostname($o->{netc}) unless $::testing;
network::addDefaultRoute($o->{netc}) unless $::testing;
- #res_init(); # reinit the resolver so DNS changes take affect
+ #-res_init(); # reinit the resolver so DNS changes take affect
}
#------------------------------------------------------------------------------
@@ -265,7 +262,7 @@ sub createBootdisk($) {
my @l = detect_devices::floppies();
$dev = shift @l || die _("no floppy available")
- if $dev eq "1"; # special case meaning autochoose
+ if $dev eq "1"; #- special case meaning autochoose
return if $::testing;
@@ -291,4 +288,4 @@ sub exitInstall {}
#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
-1; #
+1;
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index b2b42036c..70090a875 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -266,7 +266,7 @@ name and directory should be used for this queue?"),
}
eval { modules::unload("lp") };
-# @port =("lp0", "lp1", "lp2");
+#- @port =("lp0", "lp1", "lp2");
$o->{printer}{DEVICE} = $port[0] if $port[0];
@@ -275,7 +275,7 @@ name and directory should be used for this queue?"),
[_("Printer Device:")],
[{val => \$o->{printer}{DEVICE}, list => \@port }],
);
- #TAKE A GOODDEFAULT TODO
+ #-TAKE A GOODDEFAULT TODO
} elsif ($o->{printer}{TYPE} eq "REMOTE") {
return if !$o->ask_from_entries_ref(_("Remote lpd Printer Options"),
@@ -348,7 +348,7 @@ wish to access and any applicable user name and password."),
my %db_entry = %{$printer::thedb{$o->{printer}{DBENTRY}}};
- #paper size conf
+ #-paper size conf
$o->{printer}{PAPERSIZE} =
$o->ask_from_list_(_("Paper Size"),
_("Paper Size"),
@@ -356,7 +356,7 @@ wish to access and any applicable user name and password."),
$o->{printer}{PAPERSIZE}
);
- #resolution size conf
+ #-resolution size conf
my @list_res = @{$db_entry{RESOLUTION}};
my @res = map { "${$_}{XDPI}x${$_}{YDPI}" } @list_res;
if (@list_res) {
@@ -375,7 +375,7 @@ wish to access and any applicable user name and password."),
$o->{printer}{CRLF});
- #color_depth
+ #-color_depth
if ($db_entry{BITSPERPIXEL}) {
my @list_col = @{$db_entry{BITSPERPIXEL}};
my @col = map { "$_->{DEPTH} $_->{DESCR}" } @list_col;
@@ -606,4 +606,4 @@ sub setup_thiskind {
#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
-1; #
+1;
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 69fb31f97..9e3d8b6a3 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -8,24 +8,24 @@ use strict;
#-######################################################################################
use common qw(:common :functional);
-# heritate from this class and you'll get all made interactivity for same steps.
-# for this you need to provide
-# - ask_from_listW(o, title, messages, arrayref, default) returns one string of arrayref
-# - ask_many_from_listW(o, title, messages, arrayref, arrayref2) returns many strings of arrayref
-#
-# where
-# - o is the object
-# - title is a string
-# - messages is an refarray of strings
-# - default is an optional string (default is in arrayref)
-# - arrayref is an arrayref of strings
-# - arrayref2 contains booleans telling the default state,
-#
-# ask_from_list and ask_from_list_ are wrappers around ask_from_biglist and ask_from_smalllist
-#
-# ask_from_list_ just translate arrayref before calling ask_from_list and untranslate the result
-#
-# ask_from_listW should handle differently small lists and big ones.
+#- heritate from this class and you'll get all made interactivity for same steps.
+#- for this you need to provide
+#- - ask_from_listW(o, title, messages, arrayref, default) returns one string of arrayref
+#- - ask_many_from_listW(o, title, messages, arrayref, arrayref2) returns many strings of arrayref
+#-
+#- where
+#- - o is the object
+#- - title is a string
+#- - messages is an refarray of strings
+#- - default is an optional string (default is in arrayref)
+#- - arrayref is an arrayref of strings
+#- - arrayref2 contains booleans telling the default state,
+#-
+#- ask_from_list and ask_from_list_ are wrappers around ask_from_biglist and ask_from_smalllist
+#-
+#- ask_from_list_ just translate arrayref before calling ask_from_list and untranslate the result
+#-
+#- ask_from_listW should handle differently small lists and big ones.
@@ -119,9 +119,9 @@ sub ask_from_entries($$$$;$%) {
map { $$_ } @$val :
undef;
}
-# can get a hash of callback: focus_out changed and complete
-# moreove if you pass a hash with a field list -> combo
-# if you pass a hash with a field hidden -> emulate stty -echo
+#- can get a hash of callback: focus_out changed and complete
+#- moreove if you pass a hash with a field list -> combo
+#- if you pass a hash with a field hidden -> emulate stty -echo
sub ask_from_entries_ref($$$$;$%) {
my ($o, $title, $message, $l, $val, %callback) = @_;
@@ -146,14 +146,15 @@ sub wait_message($$$) {
my $w = $o->wait_messageW($title, [ _("Please wait"), @$message ]);
my $b = before_leaving { $o->wait_message_endW($w) };
- # enable access through set
+ #- enable access through set
common::add_f4before_leaving(sub { $o->wait_message_nextW($_[1], $w) }, $b, 'set');
$b;
}
sub kill {
my ($o) = @_;
- while ($o->{before_killing} && @interactive::objects > $o->{before_killing}) {
+ $o->{before_killing} ||= 0;
+ while (@interactive::objects > $o->{before_killing}) {
my $w = pop @interactive::objects;
$w->destroy;
}
@@ -163,4 +164,4 @@ sub kill {
#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
-1; #
+1;
diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm
index 1afb5b420..ad4aa36ba 100644
--- a/perl-install/interactive_gtk.pm
+++ b/perl-install/interactive_gtk.pm
@@ -12,12 +12,12 @@ use my_gtk qw(:helpers :wrappers);
1;
-## redefine ask_warn
-#sub ask_warn {
-# my $o = shift;
-# local $my_gtk::grab = 1;
-# $o->SUPER::ask_warn(@_);
-#}
+#-#- redefine ask_warn
+#-sub ask_warn {
+#- my $o = shift;
+#- local $my_gtk::grab = 1;
+#- $o->SUPER::ask_warn(@_);
+#-}
sub ask_from_entryW {
my ($o, $title, $messages, $def) = @_;
@@ -77,10 +77,10 @@ sub ask_many_from_list_refW($$$$$) {
sub ask_from_entries_refW {
my ($o, $title, $messages, $l, $val, %hcallback) = @_;
my $num_fields = @{$l};
- my $ignore = 0; #to handle recursivity
+ my $ignore = 0; #-to handle recursivity
my $w = my_gtk->new($title, %$o);
- #the widgets
+ #-the widgets
my @entries = map {
if ($_->{type} eq "list") {
my $depth_combo = new Gtk::Combo;
@@ -113,10 +113,10 @@ sub ask_from_entries_refW {
for (my $i = 0; $i < $num_fields; $i++) {
- my $ind = $i; #cos lexical bindings pb !!
+ my $ind = $i; #-cos lexical bindings pb !!
my $entry = comb_entry($entries[$i], $val->[$i]);
my $changed_callback = sub {
- return if $ignore; #handle recursive deadlock
+ return if $ignore; #-handle recursive deadlock
&{$updates[$ind]};
if ($hcallback{changed}) {
&{$hcallback{changed}}($ind);
@@ -151,8 +151,8 @@ sub ask_from_entries_refW {
my $c = chr $e->{keyval};
if ($c eq "\x8d")
{
- #don't know why it works, i believe that
- #i must say before &$go_to_next, but with it doen't work HACK!
+ #-don't know why it works, i believe that
+ #-i must say before &$go_to_next, but with it doen't work HACK!
$w->signal_emit_stop("key_press_event");
}
;
@@ -175,7 +175,7 @@ sub ask_from_entries_refW {
if ($hcallback{complete}) {
my $callback = sub {
my ($error, $focus) = &{$hcallback{complete}};
- #update all the value
+ #-update all the value
$ignore = 1;
foreach (@updates_inv) { &{$_};}
$ignore = 0;
diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm
index 8bd75bbf3..baad33b74 100644
--- a/perl-install/keyboard.pm
+++ b/perl-install/keyboard.pm
@@ -23,10 +23,10 @@ my %lang2keyboard =
"en" => "us",
);
-# [1] = name for loadkeys, [2] = extension for Xmodmap
+#- [1] = name for loadkeys, [2] = extension for Xmodmap
my %keyboards = (
-# armenian xmodmap have to be checked...
-# "am" => [ __("Armenian"), "am-armscii8", "am" ],
+#- armenian xmodmap have to be checked...
+#- "am" => [ __("Armenian"), "am-armscii8", "am" ],
"be" => [ __("Belgian"), "be-latin1", "be" ],
"bg" => [ __("Bulgarian"), "bg", "bg" ],
"cz" => [ __("Czech"), "cz-latin2", "cz" ],
@@ -35,9 +35,9 @@ my %keyboards = (
"dvorak" => [ __("Dvorak"), "dvorak", "dvorak" ],
"fi" => [ __("Finnish"), "fi-latin1", "fi" ],
"fr" => [ __("French"), "fr-latin1", "fr" ],
-# georgian keyboards have to be written...
-#"ge_ru"=>[__("Georgian (\"Russian\" layout)","ge_ru-georgian_academy","ge_ru"],
-#"ge_la"=>[__("Georgian ("\Latin\" layout)","ge_la-georgian_academy","ge_ru"],
+#- georgian keyboards have to be written...
+#-"ge_ru"=>[__("Georgian (\"Russian\" layout)","ge_ru-georgian_academy","ge_ru"],
+#-"ge_la"=>[__("Georgian ("\Latin\" layout)","ge_la-georgian_academy","ge_ru"],
"gr" => [ __("Greek"), "gr-8859_7", "gr" ],
"hu" => [ __("Hungarian"), "hu-latin2", "hu" ],
"il" => [ __("Israelian"), "il-8859_8", "il" ],
@@ -55,8 +55,8 @@ my %keyboards = (
"sg" => [ __("Swiss (german layout)"), "sg-latin1", "sg" ],
"si" => [ __("Slovenian"), "si-latin1", "si" ],
"sk" => [ __("Slovakian"), "sk-latin2", "sk" ],
-# the xmodmap.th has to be fixed to use tis620 keymaps
-# "th" => [ __("Thai keyboard"), "th", "th" ],
+#- the xmodmap.th has to be fixed to use tis620 keymaps
+#- "th" => [ __("Thai keyboard"), "th", "th" ],
"tr_f" => [ __("Turkish (traditional \"F\" model)"), "tr_f-latin5", "tr_f" ],
"tr_q" => [ __("Turkish (modern \"Q\" model)"), "tr_q-latin5", "tr_q" ],
"uk" => [ __("UK keyboard"), "uk-latin1", "uk" ],
@@ -144,7 +144,7 @@ sub read($) {
foreach (<F>) {
($_) = /^KEYTABLE=(.*)/ or log::l("unrecognized entry in keyboard configuration file ($_)"), next;
s/^\s*"(.*)"\s*$/$1/;
- s/\.[^.]*//; # remove extension
+ s/\.[^.]*//; #- remove extension
return basename($_);
}
die "empty keyboard configuration file";
@@ -153,4 +153,4 @@ sub read($) {
#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
-1; #
+1;
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
index b28fd081f..fa353a776 100644
--- a/perl-install/lang.pm
+++ b/perl-install/lang.pm
@@ -13,9 +13,9 @@ use log;
#-######################################################################################
#- Globals
#-######################################################################################
-# key (to be used in $LC_ALL), [0] = english name, [1] = charset encoding,
-# [2] = value for $LANG, [3] = value for LANGUAGE (a list of possible
-# languages, carefully choosen)
+#- key (to be used in $LC_ALL), [0] = english name, [1] = charset encoding,
+#- [2] = value for $LANG, [3] = value for LANGUAGE (a list of possible
+#- languages, carefully choosen)
my %languages = (
'en' => [ 'English', undef, 'en', 'en_US' ],
'fr_FR' => [ 'French (France)', 'iso-8859-1', 'fr', 'fr_FR' ],
@@ -56,16 +56,16 @@ my %charsets = (
"iso-8859-5" => [ "iso05.f16", "iso05",
"*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
"*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-5" ],
-# arabic needs special console driver for text mode [acon]
-# (and gtk support isn't done yet)
+#- arabic needs special console driver for text mode [acon]
+#- (and gtk support isn't done yet)
"iso-8859-6" => [ "iso06.f16", "iso06",
"*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
"*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-6" ],
"iso-8859-7" => [ "iso07.f16", "iso07",
"*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
"*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-7" ],
-# hebrew needs special console driver for text mode (none yet)
-# (and gtk support isn't done yet)
+#- hebrew needs special console driver for text mode (none yet)
+#- (and gtk support isn't done yet)
"iso-8859-8" => [ "iso08.f16", "iso08",
"*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
"*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-8" ],
@@ -75,7 +75,7 @@ my %charsets = (
"iso-8859-15" => [ "lat0-sun16.psf", "iso15",
"*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
"*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-15" ],
-# japanese needs special console driver for text mode [kon2]
+#- japanese needs special console driver for text mode [kon2]
"jisx0208" => [ "????", "????",
"-misc-fixed-medium-r-normal--14-130-75-75-c-70-jisx0201.1976-0"
],
@@ -150,32 +150,32 @@ sub write {
}
}
-#sub load_font {
-# my ($charset) = @_;
-# my $fontFile = "lat0-sun16";
-#
-# if (my $c = $charsets{$charset}) {
-# log::l("loading $charset font");
-# $fontFile = $c->[0];
-# }
-#
-# # text mode font
-# log::l("loading font /usr/share/consolefonts/$fontFile");
-# #c::loadFont("/tmp/$fontFile") or log::l("error in loadFont: one of PIO_FONT PIO_UNIMAPCLR PIO_UNIMAP PIO_UNISCRNMAP failed: $!");
-# #print STDERR "\033(K";
-#
-#}
-
-sub get_x_fontset {
- my ($lang) = @_;
- my $def = "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1";
-
- my $l = $languages{$lang} or return $def;
- my $c = $charsets{$l->[1]} or return $def;
- $c->[2];
-}
+#-sub load_font {
+#- my ($charset) = @_;
+#- my $fontFile = "lat0-sun16";
+#-
+#- if (my $c = $charsets{$charset}) {
+#- log::l("loading $charset font");
+#- $fontFile = $c->[0];
+#- }
+#-
+#- # text mode font
+#- log::l("loading font /usr/share/consolefonts/$fontFile");
+#- #c::loadFont("/tmp/$fontFile") or log::l("error in loadFont: one of PIO_FONT PIO_UNIMAPCLR PIO_UNIMAP PIO_UNISCRNMAP failed: $!");
+#- #print STDERR "\033(K";
+#-
+#-}
+
+#-sub get_x_fontset {
+#- my ($lang) = @_;
+#- my $def = "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1";
+#-
+#- my $l = $languages{$lang} or return $def;
+#- my $c = $charsets{$l->[1]} or return $def;
+#- $c->[2];
+#-}
#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
-1; #
+1;
diff --git a/perl-install/log.pm b/perl-install/log.pm
index 3f119b365..b1428408d 100644
--- a/perl-install/log.pm
+++ b/perl-install/log.pm
@@ -27,7 +27,7 @@ sub w { &l }
sub openLog(;$) {
if ($::isStandalone) {
open LOG, ">&STDERR";
- } elsif ($_[0]) { # useLocal
+ } 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 :(";
@@ -44,4 +44,4 @@ sub closeLog() { close LOG; close LOG2; }
#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
-1; #
+1;
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 46ff2b068..d0c38d49c 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -15,91 +15,30 @@ my $scsi = 0;
my %deps = ();
-my @neOptions = (
- [ "io=", "Base IO port:", "0x300:0x280:0x320:0x340:0x360" ],
- [ "irq=", "IRQ level:", "" ],
-);
-
-my @de4x5Options = (
- [ "io=", "Base IO port:", "0x0b" ],
-);
-
-my @cdu31aOptions = (
- [ "cdu31a_port=", "Base IO port:", "" ],
- [ "cdu31a_irq=", "IRQ level:", "" ],
-);
-
-#
-#my %knownAliases = (
-# eth => { type => 'net', minor => 'ethernet' },
-# scsi_hostadapter => { type => 'scsi' },
-#);
-#
-#my @neOptions = (
-# [ "io=", __("Base IO port:"), "0x300", "0x280", "0x320", "0x340", "0x360" ],
-# [ "irq=", __("IRQ level:"), "" ],
-#);
-#
-#my @de4x5Options = (
-# [ "io=", __("Base IO port:"), "0x0b" ],
-#);
-#
-#my @cdu31aOptions = (
-# [ "cdu31a_port=", __("Base IO port:"), "" ],
-# [ "cdu31a_irq=", __("IRQ level:"), "" ],
-#);
-#
-#my @cm206Options = (
-# [ "cm206=", __("IO base, IRQ:"), "" ],
-#);
-#
-#my @mcdOptions = (
-# [ "mcd=", __("Base IO port:"), "" ],
-#);
-#
-#my @optcdOptions = (
-# [ "optcd=", __("Base IO port:"), "" ],
-#);
-#
-#my @fdomainOptions = (
-# [ "setup_called=", __("Use other options"), "1" ],
-# [ "port_base=", __("Base IO port:"), "0xd800" ],
-# [ "interrupt_level=", __("Interrupt level (IRQ):"), "10" ],
-#);
-#
-#my @sbpcdOptions = (
-# [ "sbpcd=", __("IO base, IRQ, label:"), "" ],
-#);
-#
-#my @parportPcOptions = (
-# [ "io=", __("Base IO port:"), "0x378" ],
-# [ "irq=", __("IRQ level:"), "7" ],
-#);
-#
-#my @modules_fields = qw(shouldAutoprobe options flags defaultOptions);
-#my %modules = (
-# "8390" => [ 1 ],
-# "cdu31a" => [ 0, \@cdu31aOptions ],
-# "cm206" => [ 0, \@cm206Options ],
-# "de4x5" => [ 1, \@de4x5Options, 'AUTOPROBE', "io=0" ],
-# "ds" => [ 1, undef, 0, '' ],
-# "fdomain" => [ 1, \@fdomainOptions, 0, '' ],
-# "i82365" => [ 1, undef, 0, '' ],
-# "isofs" => [ 1, undef, 0, '' ],
-# "loop" => [ 1, undef, 0, '' ],
-# "lp" => [ 1, undef, 0, '' ],
-# "parport" => [ 1, undef, 0, '' ],
-# "parport_pc" => [ 1, \@parportPcOptions, 0, "irq=7" ],
-# "mcd" => [ 0, \@mcdOptions, 0, '' ],
-# "ne" => [ 0, \@neOptions, 'FAKEAUTOPROBE', "io=0x300" ],
-# "nfs" => [ 1, undef, 0, '' ],
-# "optcd" => [ 0, \@optcdOptions, 0, '' ],
-# "pcmcia_core" => [ 1, undef, 0, '' ],
-# "sbpcd" => [ 1, \@sbpcdOptions, 0, '' ],
-# "smbfs" => [ 1, undef, 0, '' ],
-# "tcic" => [ 1, undef, 0, '' ],
-# "vfat" => [ 1, undef, 0, '' ],
-#);
+#-my @modules_fields = qw(shouldAutoprobe options flags defaultOptions);
+#-my %modules = (
+#- "8390" => [ 1 ],
+#- "cdu31a" => [ 0, \@cdu31aOptions ],
+#- "cm206" => [ 0, \@cm206Options ],
+#- "de4x5" => [ 1, \@de4x5Options, 'AUTOPROBE', "io=0" ],
+#- "ds" => [ 1, undef, 0, '' ],
+#- "fdomain" => [ 1, \@fdomainOptions, 0, '' ],
+#- "i82365" => [ 1, undef, 0, '' ],
+#- "isofs" => [ 1, undef, 0, '' ],
+#- "loop" => [ 1, undef, 0, '' ],
+#- "lp" => [ 1, undef, 0, '' ],
+#- "parport" => [ 1, undef, 0, '' ],
+#- "parport_pc" => [ 1, \@parportPcOptions, 0, "irq=7" ],
+#- "mcd" => [ 0, \@mcdOptions, 0, '' ],
+#- "ne" => [ 0, \@neOptions, 'FAKEAUTOPROBE', "io=0x300" ],
+#- "nfs" => [ 1, undef, 0, '' ],
+#- "optcd" => [ 0, \@optcdOptions, 0, '' ],
+#- "pcmcia_core" => [ 1, undef, 0, '' ],
+#- "sbpcd" => [ 1, \@sbpcdOptions, 0, '' ],
+#- "smbfs" => [ 1, undef, 0, '' ],
+#- "tcic" => [ 1, undef, 0, '' ],
+#- "vfat" => [ 1, undef, 0, '' ],
+#-);
my @drivers_by_category = (
[ \&detect_devices::hasEthernet, 'net', 'ethernet', {
"3c509" => "3com 3c509",
@@ -274,7 +213,7 @@ sub load_raw($@) {
run_program::run("insmod", $name, @options) or die("insmod $name failed");
- # this is a hack to make plip go
+ #- this is a hack to make plip go
if ($name eq "parport_pc") {
foreach (@options) {
/^irq=(\d+)/ or next;
@@ -315,7 +254,7 @@ sub read_conf($;$) {
$$scsi = max($$scsi, $1 || 0) if /^\s*alias\s+scsi_hostadapter (\d*)/x && $scsi;
} if /^\s*(\S+)\s+(\S+)\s+(.*?)\s*$/;
}
- # cheating here: not handling aliases of aliases
+ #- cheating here: not handling aliases of aliases
while (my ($k, $v) = each %c) {
$$scsi ||= $v->{scsi_hostadapter} if $scsi;
if (my $a = $v->{alias}) {
@@ -372,15 +311,15 @@ sub load_thiskind($;&) {
}
}
-# This assumes only one of each driver type is loaded
-sub removeDeviceDriver {
-# my ($type) = @_;
-#
-# my @m = grep { $loaded{$_}{type} eq $type } keys %loaded;
-# @m or return 0;
-# @m > 1 and log::l("removeDeviceDriver assume only one of each driver type is loaded, which is not the case (" . join(' ', @m) . ")");
-# removeModule($m[0]);
-# 1;
-}
+#-#- This assumes only one of each driver type is loaded
+#-sub removeDeviceDriver {
+#- my ($type) = @_;
+#-
+#- my @m = grep { $loaded{$_}{type} eq $type } keys %loaded;
+#- @m or return 0;
+#- @m > 1 and log::l("removeDeviceDriver assume only one of each driver type is loaded, which is not the case (" . join(' ', @m) . ")");
+#- removeModule($m[0]);
+#- 1;
+#-}
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 7ebbd0fda..33f753638 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -17,14 +17,14 @@ use Gtk;
use c;
use common qw(:common :functional);
-my $forgetTime = 1000; # in milli-seconds
+my $forgetTime = 1000; #- in milli-seconds
$border = 5;
1;
-################################################################################
-# OO stuff
-################################################################################
+#-###############################################################################
+#- OO stuff
+#-###############################################################################
sub new {
my ($type, $title, %opts) = @_;
@@ -169,11 +169,11 @@ sub gtkset_default_fontset($) {
}
-################################################################################
-# createXXX functions
+#-###############################################################################
+#- createXXX functions
-# these functions return a widget
-################################################################################
+#- these functions return a widget
+#-###############################################################################
sub create_okcancel($;$$) {
my ($w, $ok, $cancel) = @_;
@@ -316,11 +316,11 @@ sub _create_window($$) {
-################################################################################
-# ask_XXX
+#-###############################################################################
+#- ask_XXX
-# just give a title and some args, and it will return the value given by the user
-################################################################################
+#- just give a title and some args, and it will return the value given by the user
+#-###############################################################################
sub ask_warn { my $w = my_gtk->new(shift @_); $w->_ask_warn(@_); main($w); }
sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Yes"), _("No")); main($w); }
@@ -394,7 +394,7 @@ sub _ask_from_list($$$$) {
gtkpack($o->create_box_with_title(@$messages),
@$l > 15 ? gtkset_usize(createScrolledWindow($list), 200, 280) : $list));
- $o->sync; # otherwise the moveto is not done
+ $o->sync; #- otherwise the moveto is not done
map_index {
$list->append($_);
&$select($::i) if $def && $_ eq $def;
@@ -434,16 +434,16 @@ sub _ask_file($$) {
$f->hide_fileop_buttons;
}
-################################################################################
-# rubbish
-################################################################################
+#-###############################################################################
+#- rubbish
+#-###############################################################################
-#sub label_align($$) {
-# my $w = shift;
-# local $_ = shift;
-# $w->set_alignment(!/W/i, !/N/i);
-# $w
-#}
+#-sub label_align($$) {
+#- my $w = shift;
+#- local $_ = shift;
+#- $w->set_alignment(!/W/i, !/N/i);
+#- $w
+#-}
#-sub _ask_from_list($$$$) {
#- my ($o, $messages, $l, $def) = @_;
diff --git a/perl-install/network.pm b/perl-install/network.pm
index cc5c74fa6..7529261bd 100644
--- a/perl-install/network.pm
+++ b/perl-install/network.pm
@@ -48,7 +48,7 @@ sub write_conf {
sub write_resolv_conf {
my ($file, $netc) = @_;
- # We always write these, even if they were autoconfigured. Otherwise, the reverse name lookup in the install doesn't work.
+ #- We always write these, even if they were autoconfigured. Otherwise, the reverse name lookup in the install doesn't work.
unless ($netc->{DOMAINNAME} || dnsServers($netc)) {
unlink($file);
log::l("neither domain name nor dns server are configured");
@@ -62,7 +62,7 @@ sub write_resolv_conf {
print F "nameserver $_\n" foreach dnsServers($netc);
print F "#$_" foreach @l;
- #res_init(); # reinit the resolver so DNS changes take affect
+ #-res_init(); # reinit the resolver so DNS changes take affect
1;
}
@@ -158,13 +158,13 @@ sub netmask {
return "255.255.255.0" unless is_ip($ip);
$ip =~ $ip_regexp;
if ($1 >= 1 && $1 < 127) {
- return "255.0.0.0"; #1.0.0.0 to 127.0.0.0
+ return "255.0.0.0"; #-1.0.0.0 to 127.0.0.0
} elsif ($1 >= 128 && $1 <= 191 ){
- return "255.255.0.0"; #128.0.0.0 to 191.255.0.0
+ return "255.255.0.0"; #-128.0.0.0 to 191.255.0.0
} elsif ($1 >= 192 && $1 <= 223) {
return "255.255.255.0";
} else {
- return "255.255.255.255"; #experimental classes
+ return "255.255.255.255"; #-experimental classes
}
}
@@ -198,4 +198,4 @@ sub gateway {
#-######################################################################################
#- Wonderful perl :(
#-######################################################################################
-1; #
+1;
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index 800a65c60..65b084f21 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -29,7 +29,7 @@ my %types = (
4 => "DOS 16-bit <32M",
5 => "Extended",
6 => "DOS FAT16",
- 7 => "OS/2 HPFS", # or QNX?
+ 7 => "OS/2 HPFS", #- or QNX?
8 => "AIX",
9 => "AIX bootable",
10 => "OS/2 Boot Manager",
@@ -39,28 +39,28 @@ my %types = (
0x12 => "Compaq setup",
0x40 => "Venix 80286",
0x51 => "Novell?",
- 0x52 => "Microport", # or CPM?
- 0x63 => "GNU HURD", # or System V/386?
+ 0x52 => "Microport", #- or CPM?
+ 0x63 => "GNU HURD", #- or System V/386?
0x64 => "Novell Netware 286",
0x65 => "Novell Netware 386",
0x75 => "PC/IX",
- 0x80 => "Old MINIX", # Minix 1.4a and earlier
+ 0x80 => "Old MINIX", #- Minix 1.4a and earlier
- 0x81 => "Linux/MINIX", # Minix 1.4b and later
+ 0x81 => "Linux/MINIX", #- Minix 1.4b and later
0x82 => "Linux swap",
0x83 => "Linux native",
0x93 => "Amoeba",
- 0x94 => "Amoeba BBT", # (bad block table)
+ 0x94 => "Amoeba BBT", #- (bad block table)
0xa5 => "BSD/386",
0xb7 => "BSDI fs",
0xb8 => "BSDI swap",
0xc7 => "Syrinx",
- 0xdb => "CP/M", # or Concurrent DOS?
+ 0xdb => "CP/M", #- or Concurrent DOS?
0xe1 => "DOS access",
0xe3 => "DOS R/O",
0xf2 => "DOS secondary",
- 0xff => "BBT" # (bad track table)
+ 0xff => "BBT" #- (bad track table)
);
my %type2fs = (
@@ -74,7 +74,7 @@ my %type2fs = (
0x0e => 'vfat',
0x82 => 'swap',
0x83 => 'ext2',
- nfs => 'nfs', # hack
+ nfs => 'nfs', #- hack
);
my %types_rev = reverse %types;
my %fs2type = reverse %type2fs;
@@ -94,7 +94,7 @@ sub isSwap($) { $type2fs{$_[0]{type}} eq 'swap' }
sub isExt2($) { $type2fs{$_[0]{type}} eq 'ext2' }
sub isDos($) { $ {{ 1=>1, 4=>1, 6=>1 }}{$_[0]{type}} }
sub isWin($) { $ {{ 0xb=>1, 0xc=>1, 0xe=>1 }}{$_[0]{type}} }
-sub isNfs($) { $_[0]{type} eq 'nfs' } # small hack
+sub isNfs($) { $_[0]{type} eq 'nfs' } #- small hack
sub isPrimary($$) {
my ($part, $hd) = @_;
@@ -160,10 +160,10 @@ sub assign_device_numbers($) {
$_->{device} = $hd->{prefix} . $i++ foreach @{$hd->{primary}{raw}},
map { $_->{normal} } @{$hd->{extended} || []};
- # try to figure what the windobe drive letter could be!
+ #- try to figure what the windobe drive letter could be!
#
- # first verify there's at least one primary dos partition, otherwise it
- # means it is a secondary disk and all will be false :(
+ #- first verify there's at least one primary dos partition, otherwise it
+ #- means it is a secondary disk and all will be false :(
my ($c, @others) = grep { isDos($_) || isWin($_) } @{$hd->{primary}{normal}};
$c or return;
@@ -206,10 +206,10 @@ sub adjust_main_extended($) {
$l->{size} = $hd->{primary}{extended}{size} = $end - $start;
}
unless (@{$hd->{extended} || []} || !$hd->{primary}{extended}) {
- %{$hd->{primary}{extended}} = (); # modify the raw entry
+ %{$hd->{primary}{extended}} = (); #- modify the raw entry
delete $hd->{primary}{extended};
}
- verifyParts($hd); # verify everything is all right
+ verifyParts($hd); #- verify everything is all right
}
@@ -265,7 +265,7 @@ sub read_extended($$) {
@{$pt->{normal}} <= 1 or die "more than one normal partition in extended partition";
@{$pt->{normal}} >= 1 or die "no normal partition in extended partition";
$pt->{normal} = $pt->{normal}[0];
- # in case of extended partitions, the start sector is local to the partition or to the first extended_part!
+ #- in case of extended partitions, the start sector is local to the partition or to the first extended_part!
$pt->{normal}{start} += $pt->{start};
verifyInside($pt->{normal}, $extended) or die "partition $pt->{normal}{device} is not inside its extended partition";
@@ -281,7 +281,7 @@ sub read_extended($$) {
sub write($) {
my ($hd) = @_;
- # set first primary partition active if no primary partitions are marked as active.
+ #- set first primary partition active if no primary partitions are marked as active.
for ($hd->{primary}{raw}) {
(grep { $_->{local_start} = $_->{start}; $_->{active} ||= 0 } @$_) or $_->[0]{active} = 0x80;
}
@@ -296,7 +296,7 @@ sub write($) {
}
$hd->{isDirty} = 0;
- # now sync disk and re-read the partition table
+ #- now sync disk and re-read the partition table
if ($hd->{needKernelReread}) {
sync();
partition_table_raw::kernel_read($hd);
@@ -317,21 +317,21 @@ sub remove($$) {
my ($hd, $part) = @_;
my $i;
- # first search it in the primary partitions
+ #- first search it in the primary partitions
$i = 0; foreach (@{$hd->{primary}{normal}}) {
if ($_ eq $part) {
splice(@{$hd->{primary}{normal}}, $i, 1);
- %$_ = (); # blank it
+ %$_ = (); #- blank it
return $hd->{isDirty} = $hd->{needKernelReread} = 1;
}
$i++;
}
- # otherwise search it in extended partitions
+ #- otherwise search it in extended partitions
foreach (@{$hd->{extended}}) {
$_->{normal} eq $part or next;
- delete $_->{normal}; # remove it
+ delete $_->{normal}; #- remove it
remove_empty_extended($hd);
return $hd->{isDirty} = $hd->{needKernelReread} = 1;
@@ -344,12 +344,12 @@ sub add_primary($$) {
my ($hd, $part) = @_;
{
- local $hd->{primary}{normal}; # save it to fake an addition of $part, that way add_primary do not modify $hd if it fails
+ local $hd->{primary}{normal}; #- save it to fake an addition of $part, that way add_primary do not modify $hd if it fails
push @{$hd->{primary}{normal}}, $part;
- adjust_main_extended($hd); # verify
+ adjust_main_extended($hd); #- verify
raw_add($hd->{primary}{raw}, $part);
}
- push @{$hd->{primary}{normal}}, $part; # really do it
+ push @{$hd->{primary}{normal}}, $part; #- really do it
}
sub add_extended($$) {
@@ -363,7 +363,7 @@ sub add_extended($$) {
my $start = min($e->{start}, $part->{start});
$end = max($end, $part->{start} + $part->{size}) - $start;
- { # faking a resizing of the main extended partition to test for problems
+ { #- faking a resizing of the main extended partition to test for problems
local $e->{start} = $start;
local $e->{size} = $end - $start;
eval { verifyPrimary($hd->{primary}) };
@@ -386,7 +386,7 @@ The only solution is to move your primary partitions to have the hole next to th
} else {
my ($ext, $ext_size) = is_empty_array_ref($hd->{extended}) ?
- ($hd->{primary}, -1) : # -1 size will be computed by adjust_main_extended
+ ($hd->{primary}, -1) : #- -1 size will be computed by adjust_main_extended
(top(@{$hd->{extended}}), $part->{size});
my %ext = ( type => 5, start => $part->{start}, size => $ext_size );
@@ -394,7 +394,7 @@ The only solution is to move your primary partitions to have the hole next to th
$ext->{extended} = \%ext;
push @{$hd->{extended}}, { %ext, raw => [ $part, {}, {}, {} ], normal => $part };
}
- $part->{start}++; $part->{size}--; # let it start after the extended partition sector
+ $part->{start}++; $part->{size}--; #- let it start after the extended partition sector
adjustStartAndEnd($hd, $part);
adjust_main_extended($hd);
@@ -407,7 +407,7 @@ sub add($$;$) {
$part->{isFormatted} = 0;
$part->{rootDevice} = $hd->{device};
$hd->{isDirty} = $hd->{needKernelReread} = 1;
- $part->{start} ||= 1; # starting at sector 0 is not allowed
+ $part->{start} ||= 1; #- starting at sector 0 is not allowed
adjustStartAndEnd($hd, $part);
my $e = $hd->{primary}{extended};
@@ -417,10 +417,10 @@ sub add($$;$) {
eval { add_primary($hd, $part) };
return unless $@;
}
- eval { add_extended($hd, $part) }; # try adding extended
+ eval { add_extended($hd, $part) }; #- try adding extended
if (my $err = $@) {
eval { add_primary($hd, $part) };
- die $@ if $@; # send the add extended error which should be better
+ die $@ if $@; #- send the add extended error which should be better
}
}
@@ -471,7 +471,7 @@ sub load($$;$) {
$h{totalsectors} == $hd->{totalsectors} or $force or cdie("Bad totalsectors");
- # unsure we don't modify totalsectors
+ #- unsure we don't modify totalsectors
local $hd->{totalsectors};
@{$hd}{@fields2save} = @$h;
diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm
index ff54ef765..c97a8a094 100644
--- a/perl-install/partition_table_raw.pm
+++ b/perl-install/partition_table_raw.pm
@@ -26,7 +26,7 @@ sub compute_CHS($$) {
sub CHS2rawCHS($$$) {
my ($c, $h, $s) = @_;
- $c = min($c, 1023); # no way to have a #cylinder >= 1024
+ $c = min($c, 1023); #- no way to have a #cylinder >= 1024
($c & 0xff, $h, $s | ($c >> 2 & 0xc0));
}
@@ -73,7 +73,7 @@ sub read($$) {
\%h;
} (1..$nb_primary);
- # check magic number
+ #- check magic number
sysread F, $tmp, length $magic or die "error reading magic number";
$tmp eq $magic or die "bad magic number";
@@ -92,7 +92,7 @@ sub write($$$) {
foreach (@$pt) {
compute_CHS($hd, $_);
local $_->{start} = $_->{local_start} || 0;
- $_->{active} ||= 0; $_->{type} ||= 0; $_->{size} ||= 0; # for no warning
+ $_->{active} ||= 0; $_->{type} ||= 0; $_->{size} ||= 0; #- for no warning
syswrite F, pack($format, @$_{@fields}), psizeof($format) or return 0;
}
syswrite F, $magic, length $magic or return 0;
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 0f50ed3a5..edb6f441c 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -24,11 +24,11 @@ sub Package {
sub select($$;$) {
my ($packages, $p, $base) = @_;
$p->{base} ||= $base;
- $p->{selected} = -1; # selected by user
+ $p->{selected} = -1; #- selected by user
my @l = @{$p->{deps} || die "missing deps file"};
while (@l) {
my $n = shift @l;
- $n =~ /|/ and $n = first(split '\|', $n); #TODO better handling of choice
+ $n =~ /|/ and $n = first(split '\|', $n); #-TODO better handling of choice
my $i = Package($packages, $n) or next;
$i->{base} ||= $base;
$i->{deps} or log::l("missing deps for $n");
@@ -42,11 +42,11 @@ sub unselect($$) {
my $set = set_new($p->{name});
my $l = $set->{list};
- # get the list of provided packages
+ #- get the list of provided packages
foreach my $q (@$l) {
my $i = Package($packages, $q);
$i->{selected} && !$i->{base} or next;
- $i->{selected} = 1; # that way, its counter will be zero the first time
+ $i->{selected} = 1; #- that way, its counter will be zero the first time
set_add($set, @{$i->{provides} || []});
}
@@ -60,7 +60,7 @@ sub unselect($$) {
}
}
- # garbage collect for circular dependencies
+ #- garbage collect for circular dependencies
my $changed = 1;
while ($changed) {
$changed = 0;
@@ -280,7 +280,7 @@ sub install {
log::ld("starting installation: ", $nb, " packages, ", $total, " bytes");
- # !! do not translate these messages, they are used when catched (cf install_steps_graphical)
+ #- !! do not translate these messages, they are used when catched (cf install_steps_graphical)
my $callbackOpen = sub {
my $fd = install_any::getFile($_[0]) or log::l("bad file $_[0]");
$fd ? fileno $fd : -1;
diff --git a/perl-install/resize_fat/any.pm b/perl-install/resize_fat/any.pm
index e4747dc87..26c98f886 100644
--- a/perl-install/resize_fat/any.pm
+++ b/perl-install/resize_fat/any.pm
@@ -18,7 +18,7 @@ $DIRECTORY = 2;
1;
-# returns the number of clusters for a given filesystem type
+#- returns the number of clusters for a given filesystem type
sub min_cluster_count($) {
my ($fs) = @_;
(1 << $ {{ FAT16 => 12, FAT32 => 12 }}{$fs->{fs_type}}) - 12;
@@ -30,20 +30,20 @@ sub max_cluster_count($) {
-# calculates the minimum size of a partition, in physical sectors
+#- calculates the minimum size of a partition, in physical sectors
sub min_size($) {
my ($fs) = @_;
my $count = $fs->{clusters}{count};
- # directories are both in `used' and `dirs', so are counted twice
- # It's done on purpose since we're moving all directories. So at the worse
- # moment, 2 directories are there, but that way nothing wrong can happen :)
+ #- directories are both in `used' and `dirs', so are counted twice
+ #- It's done on purpose since we're moving all directories. So at the worse
+ #- moment, 2 directories are there, but that way nothing wrong can happen :)
my $min_cluster_count = max(2 + $count->{used} + $count->{bad} + $count->{dirs}, min_cluster_count($fs));
$min_cluster_count * divide($fs->{cluster_size}, $SECTORSIZE) +
divide($fs->{cluster_offset}, $SECTORSIZE);
}
-# calculates the maximum size of a partition, in physical sectors
+#- calculates the maximum size of a partition, in physical sectors
sub max_size($) {
my ($fs) = @_;
@@ -53,8 +53,8 @@ sub max_size($) {
divide($fs->{cluster_offset}, $SECTORSIZE);
}
-# fills in $fs->{fat_flag_map}.
-# Each FAT entry is flagged as either FREE, FILE or DIRECTORY.
+#- fills in $fs->{fat_flag_map}.
+#- Each FAT entry is flagged as either FREE, FILE or DIRECTORY.
sub flag_clusters {
my ($fs) = @_;
my ($cluster, $entry, $type);
diff --git a/perl-install/resize_fat/boot_sector.pm b/perl-install/resize_fat/boot_sector.pm
index cd8f52cac..6da81e420 100644
--- a/perl-install/resize_fat/boot_sector.pm
+++ b/perl-install/resize_fat/boot_sector.pm
@@ -11,41 +11,41 @@ use resize_fat::directory;
my $format = "a3 a8 S C S C S S C S S S I I I S S I S S a458 S";
my @fields = (
- 'boot_jump', # boot strap short or near jump
- 'system_id', # Name - can be used to special case partition manager volumes
- 'sector_size', # bytes per logical sector
- 'cluster_size_in_sectors', # sectors/cluster
- 'nb_reserved', # reserved sectors
- 'nb_fats', # number of FATs
- 'nb_root_dir_entries', # number of root directory entries
- 'small_nb_sectors', # number of sectors: big_nb_sectors supersedes
- 'media', # media code
- 'fat16_fat_length', # sectors/FAT for FAT12/16
+ 'boot_jump', #- boot strap short or near jump
+ 'system_id', #- Name - can be used to special case partition manager volumes
+ 'sector_size', #- bytes per logical sector
+ 'cluster_size_in_sectors', #- sectors/cluster
+ 'nb_reserved', #- reserved sectors
+ 'nb_fats', #- number of FATs
+ 'nb_root_dir_entries', #- number of root directory entries
+ 'small_nb_sectors', #- number of sectors: big_nb_sectors supersedes
+ 'media', #- media code
+ 'fat16_fat_length', #- sectors/FAT for FAT12/16
'sectors_per_track',
'nb_heads',
- 'nb_hidden', # (unused)
- 'big_nb_sectors', # number of sectors (if small_nb_sectors == 0)
-
-# FAT32-only entries
- 'fat32_fat_length', # size of FAT in sectors
- 'fat32_flags', # bit8: fat mirroring,
- # low4: active fat
- 'fat32_version', # minor * 256 + major
+ 'nb_hidden', #- (unused)
+ 'big_nb_sectors', #- number of sectors (if small_nb_sectors == 0)
+
+#- FAT32-only entries
+ 'fat32_fat_length', #- size of FAT in sectors
+ 'fat32_flags', #- bit8: fat mirroring,
+ #- low4: active fat
+ 'fat32_version', #- minor * 256 + major
'fat32_root_dir_cluster',
'info_offset_in_sectors',
'fat32_backup_sector',
-# Common again...
- 'boot_code', # Boot code (or message)
- 'boot_sign', # 0xAA55
+#- Common again...
+ 'boot_code', #- Boot code (or message)
+ 'boot_sign', #- 0xAA55
);
1;
-# trimfs_init_boot_sector() - reads in the boot sector - gets important info out
-# of boot sector, and puts in main structure - performs sanity checks - returns 1
-# on success, 0 on failureparameters: filesystem an empty structure to fill.
+#- trimfs_init_boot_sector() - reads in the boot sector - gets important info out
+#- of boot sector, and puts in main structure - performs sanity checks - returns 1
+#- on success, 0 on failureparameters: filesystem an empty structure to fill.
sub read($) {
my ($fs) = @_;
@@ -60,11 +60,11 @@ sub read($) {
$fs->{nb_sectors} < 32 and die "Too few sectors for viable file system\n";
if ($fs->{fat16_fat_length}) {
- # asserting FAT16, will be verified later on
+ #- asserting FAT16, will be verified later on
$fs->{fs_type} = 'FAT16';
$fs->{fs_type_size} = 16;
$fs->{fat_length} = $fs->{fat16_fat_length};
- $resize_fat::bad_cluster_value = 0xfff7; # 2**16 - 1
+ $resize_fat::bad_cluster_value = 0xfff7; #- 2**16 - 1
} else {
$resize_fat::isFAT32 = 1;
$fs->{fs_type} = 'FAT32';
@@ -84,12 +84,12 @@ sub read($) {
$fs->{nb_fat_entries} = divide($fs->{fat_size}, $fs->{fs_type_size} / 8);
- # - 2 because clusters 0 & 1 doesn't exist
+ #- - 2 because clusters 0 & 1 doesn't exist
$fs->{nb_clusters} = divide($fs->{nb_sectors} * $fs->{sector_size} - $fs->{cluster_offset}, $fs->{cluster_size}) - 2;
$fs->{dir_entries_per_cluster} = divide($fs->{cluster_size}, psizeof($format));
-# $fs->{nb_clusters} >= resize_fat::any::min_cluster_count($fs) or die "error: not enough sectors for a $fs->{fs_type}\n";
+#- $fs->{nb_clusters} >= resize_fat::any::min_cluster_count($fs) or die "error: not enough sectors for a $fs->{fs_type}\n";
$fs->{nb_clusters} < resize_fat::any::max_cluster_count($fs) or die "error: too many sectors for a $fs->{fs_type}\n";
}
@@ -100,7 +100,7 @@ sub write($) {
eval { resize_fat::io::write($fs, 0, $SECTORSIZE, $boot) }; $@ and die "writing the boot sector failed on device $fs->{fs_name}";
if ($resize_fat::isFAT32) {
- # write backup
+ #- write backup
eval { resize_fat::io::write($fs, $fs->{fat32_backup_sector} * $SECTORSIZE, $SECTORSIZE, $boot) };
$@ and die "writing the backup boot sector (#$fs->{fat32_backup_sector}) failed on device $fs->{fs_name}";
}
diff --git a/perl-install/resize_fat/dir_entry.pm b/perl-install/resize_fat/dir_entry.pm
index fa5ebb344..47f326735 100644
--- a/perl-install/resize_fat/dir_entry.pm
+++ b/perl-install/resize_fat/dir_entry.pm
@@ -46,7 +46,7 @@ sub is_special_entry($) {
my ($entry) = @_;
my ($c) = unpack "C", $entry->{name};
- # skip empty slots, deleted files, and 0xF6?? (taken from kernel)
+ #- skip empty slots, deleted files, and 0xF6?? (taken from kernel)
$c == 0 || $c == $DELETED_FLAG || $c == 0xF6 and return 1;
$entry->{attributes} == $VFAT_ATTR and return 1;
@@ -54,7 +54,7 @@ sub is_special_entry($) {
}
-# return true if entry has been modified
+#- return true if entry has been modified
sub remap {
my ($fat_remap, $entry) = @_;
@@ -63,9 +63,9 @@ sub remap {
my $cluster = get_cluster($entry);
my $new_cluster = $fat_remap->[$cluster];
- #print "remapping cluster ", get_first_cluster($fs, $entry), " to $new_cluster";
+ #-print "remapping cluster ", get_first_cluster($fs, $entry), " to $new_cluster";
- $new_cluster == $cluster and return; # no need to modify
+ $new_cluster == $cluster and return; #- no need to modify
set_cluster($entry, $new_cluster);
1;
diff --git a/perl-install/resize_fat/directory.pm b/perl-install/resize_fat/directory.pm
index 00ae6a870..3b779e2de 100644
--- a/perl-install/resize_fat/directory.pm
+++ b/perl-install/resize_fat/directory.pm
@@ -14,11 +14,11 @@ my @fields = (
'extension',
'attributes',
'is_upper_case_name',
- 'creation_time_low', # milliseconds
+ 'creation_time_low', #- milliseconds
'creation_time_high',
'creation_date',
'access_date',
- 'first_cluster_high', # for FAT32
+ 'first_cluster_high', #- for FAT32
'time',
'date',
'first_cluster',
@@ -29,15 +29,15 @@ my @fields = (
sub entry_size { psizeof($format) }
-# call `f' for each entry of the directory
-# if f return true, then modification in the entry are taken back
+#- call `f' for each entry of the directory
+#- if f return true, then modification in the entry are taken back
sub traverse($$$) {
my ($fs, $directory, $f) = @_;
for (my $i = 0;; $i++) {
my $raw = \substr($directory, $i * psizeof($format), psizeof($format));
- # empty entry means end of directory
+ #- empty entry means end of directory
$$raw =~ /^\0*$/ and return $directory;
my $entry; @{$entry}{@fields} = unpack $format, $$raw;
@@ -59,7 +59,7 @@ sub traverse_all($$) {
resize_fat::dir_entry::is_directory($entry)
and traverse($fs, resize_fat::io::read_file($fs, resize_fat::dir_entry::get_cluster($entry)), $traverse_all);
- undef; # no need to write back (cf traverse)
+ undef; #- no need to write back (cf traverse)
};
my $directory = $resize_fat::isFAT32 ?
@@ -69,8 +69,8 @@ sub traverse_all($$) {
}
-# function used by construct_dir_tree to translate the `cluster' fields in each
-# directory entry
+#- function used by construct_dir_tree to translate the `cluster' fields in each
+#- directory entry
sub remap {
my ($fs, $directory) = @_;
diff --git a/perl-install/resize_fat/fat.pm b/perl-install/resize_fat/fat.pm
index 87ce2af71..5c0b259b4 100644
--- a/perl-install/resize_fat/fat.pm
+++ b/perl-install/resize_fat/fat.pm
@@ -42,10 +42,10 @@ sub write($) {
-# allocates where all the clusters will be moved to. Clusters before cut_point
-# remain in the same position, however cluster that are part of a directory are
-# moved regardless (this is a mechanism to prevent data loss) (cut_point is the
-# first cluster that won't occur in the new fs)
+#- allocates where all the clusters will be moved to. Clusters before cut_point
+#- remain in the same position, however cluster that are part of a directory are
+#- moved regardless (this is a mechanism to prevent data loss) (cut_point is the
+#- first cluster that won't occur in the new fs)
sub allocate_remap {
my ($fs, $cut_point) = @_;
my ($cluster, $new_cluster);
@@ -53,8 +53,8 @@ sub allocate_remap {
my $get_new = sub {
$new_cluster = get_free($fs);
0 < $new_cluster && $new_cluster < $cut_point or die "no free clusters";
- set_eof($fs, $new_cluster); # mark as used
- #log::ld("resize_fat: [$cluster,", &next($fs, $cluster), "...]->$new_cluster...");
+ set_eof($fs, $new_cluster); #- mark as used
+ #-log::ld("resize_fat: [$cluster,", &next($fs, $cluster), "...]->$new_cluster...");
};
$fs->{fat_remap}[0] = 0;
@@ -75,7 +75,7 @@ sub allocate_remap {
}
-# updates the fat for the resized filesystem
+#- updates the fat for the resized filesystem
sub update {
my ($fs) = @_;
@@ -95,9 +95,9 @@ sub update {
}
-# - compares the two FATs (one's a backup that should match) - skips first entry
-# - its just a signature (already checked above) NOTE: checks for cross-linking
-# are done in count.c
+#- - compares the two FATs (one's a backup that should match) - skips first entry
+#- - its just a signature (already checked above) NOTE: checks for cross-linking
+#- are done in count.c
sub check($) {
my ($fs) = @_;
foreach (@{$fs->{fats}}) {
@@ -140,7 +140,7 @@ sub get_free($) {
die "no free clusters";
}
-# returns true if <cluster> represents an EOF marker
+#- returns true if <cluster> represents an EOF marker
sub is_eof($) {
my ($cluster) = @_;
$cluster >= $resize_fat::bad_cluster_value;
@@ -150,13 +150,13 @@ sub set_eof($$) {
set_next($fs, $cluster, $resize_fat::bad_cluster_value + 1);
}
-# returns true if <cluster> is empty. Note that this includes bad clusters.
+#- returns true if <cluster> is empty. Note that this includes bad clusters.
sub is_empty($) {
my ($cluster) = @_;
$cluster == 0 || $cluster == $resize_fat::bad_cluster_value;
}
-# returns true if <cluster> is available.
+#- returns true if <cluster> is available.
sub is_available($) {
my ($cluster) = @_;
$cluster == 0;
diff --git a/perl-install/resize_fat/info_sector.pm b/perl-install/resize_fat/info_sector.pm
index 2eacf58ca..3a6f7cfed 100644
--- a/perl-install/resize_fat/info_sector.pm
+++ b/perl-install/resize_fat/info_sector.pm
@@ -9,9 +9,9 @@ use resize_fat::io;
my $format = "a484 I I I a16";
my @fields = (
'unused',
- 'signature', # should be 0x61417272
- 'free_clusters', # -1 for unknown
- 'next_cluster', # most recently allocated cluster
+ 'signature', #- should be 0x61417272
+ 'free_clusters', #- -1 for unknown
+ 'next_cluster', #- most recently allocated cluster
'unused2',
);
diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm
index 55cc34d7b..692ade0cb 100644
--- a/perl-install/resize_fat/main.pm
+++ b/perl-install/resize_fat/main.pm
@@ -36,7 +36,7 @@ use resize_fat::any;
1;
-# - reads in the boot sector/partition info., and tries to make some sense of it
+#- - reads in the boot sector/partition info., and tries to make some sense of it
sub new($$$) {
my ($type, $device, $fs_name) = @_;
my $fs = { device => $device, fs_name => $fs_name } ;
@@ -51,9 +51,9 @@ sub new($$$) {
bless $fs, $type;
}
-# copy all clusters >= <start_cluster> to a new place on the partition, less
-# than <start_cluster>. Only copies files, not directories.
-# (use of buffer needed because the seeks slow like hell the hard drive)
+#- copy all clusters >= <start_cluster> to a new place on the partition, less
+#- than <start_cluster>. Only copies files, not directories.
+#- (use of buffer needed because the seeks slow like hell the hard drive)
sub copy_clusters {
my ($fs, $cluster) = @_;
my @buffer;
@@ -71,13 +71,13 @@ sub copy_clusters {
&$flush();
}
-# Constructs the new directory tree to match the new file locations.
+#- Constructs the new directory tree to match the new file locations.
sub construct_dir_tree {
my ($fs) = @_;
if ($resize_fat::isFAT32) {
- # fat32's root must remain in the first 64k clusters
- # so don't set it as DIRECTORY, it will be specially handled
+ #- fat32's root must remain in the first 64k clusters
+ #- so don't set it as DIRECTORY, it will be specially handled
$fs->{fat_flag_map}[$fs->{fat32_root_dir_cluster}] = $resize_fat::any::FREE;
}
@@ -91,12 +91,12 @@ sub construct_dir_tree {
sync();
- # until now, only free clusters have been written. it's a null operation if we stop here.
- # it means no corruption :)
+ #- until now, only free clusters have been written. it's a null operation if we stop here.
+ #- it means no corruption :)
#
- # now we must be as fast as possible!
+ #- now we must be as fast as possible!
- # remapping non movable root directory
+ #- remapping non movable root directory
if ($resize_fat::isFAT32) {
my $cluster = $fs->{fat32_root_dir_cluster};
@@ -112,10 +112,10 @@ sub construct_dir_tree {
sub min_size($) { &resize_fat::any::min_size }
sub max_size($) { &resize_fat::any::max_size }
-# resize
-# - size is in sectors
-# - checks boundaries before starting
-# - copies all data beyond new_cluster_count behind the frontier
+#- resize
+#- - size is in sectors
+#- - checks boundaries before starting
+#- - copies all data beyond new_cluster_count behind the frontier
sub resize {
my ($fs, $size) = @_;
@@ -158,7 +158,7 @@ sub resize {
resize_fat::boot_sector::write($fs);
- $resize_fat::isFAT32 and eval { resize_fat::info_sector::write($fs) }; # doesn't matter if this fails - its pretty useless!
+ $resize_fat::isFAT32 and eval { resize_fat::info_sector::write($fs) }; #- doesn't matter if this fails - its pretty useless!
sync();
log::l("resize_fat: done");
diff --git a/perl-install/share/install.rc b/perl-install/share/install.rc
index 585595df4..f16dc101a 100644
--- a/perl-install/share/install.rc
+++ b/perl-install/share/install.rc
@@ -1,54 +1,34 @@
style "default-font"
{
- fontset = "-*-helvetica-medium-r-normal--*-*-*-*-*-*-*-*,\
- -*-arial-medium-r-normal--*-*-*-*-*-*-*-*,\
- -*-*helvetica*-medium-r-normal--*-*-*-*-*-*-*-*,\
- -*-*arial*-medium-r-normal--*-*-*-*-*-*-*-*,\
- -*-tahoma-medium-r-normal--*-*-*-*-*-*-*-*,\
- -ricoh-*-medium-r-normal--*-*-*-*-*-*-jisx0208.1983-0,\
- -misc-fixed-medium-r-normal--*-*-*-*-*-*-jisx0208.1983-0,\
- -*-*-medium-r-normal--*-*-*-*-*-*-jisx0208.1983-0,\
- -*-*-medium-r-normal--*-*-*-*-*-*-jisx0201.1976-0,\
- -*-*-medium-r-normal--*-*-*-*-*-*-georgian-academy,\
- -*-*-medium-r-normal--*-*-*-*-*-*-georgian-rs,\
- -*-*-medium-*-*--*-*-*-*-*-*-ksc5601.1987-*,\
- -*-*-medium-r-normal-*-*-*-*-*-*-*-mulelao-1,\
- -*-*-medium-r-normal-*-*-*-*-*-*-*-ibm-cp1133,\
- -*-*-medium-r-normal-*-*-*-*-*-*-*-iso10646-1,\
- -taipei-*-medium-r-normal--*-*-*-*-*-*-big5-0"
-# fontset = "-adobe-helvetica-medium-r-normal-*-*-100-*-*-p-*-iso8859-1"
+ fontset = "\
+-*-helvetica-medium-r-normal-*-*-100-*-*-*-*-*-*,\
+-*-arial-medium-r-normal-*-*-*-*-*-*-*-*-*,\
+-*-*helvetica*-medium-r-normal-*-*-*-*-*-*-*-*-*,\
+-*-*arial*-medium-r-normal-*-*-*-*-*-*-*-*-*,\
+-*-tahoma-medium-r-normal-*-*-*-*-*-*-*-*-*,\
+-*-*-medium-r-normal-*-*-*-*-*-*-*-jisx0208.1990-0,\
+-*-*-medium-r-normal-*-*-*-*-*-*-*-jisx0208.1983-0,\
+-*-*-medium-r-normal-*-*-*-*-*-*-*-jisx0201.1976-0,\
+-*-*-medium-r-normal-*-*-*-*-*-*-*-georgian-academy,\
+-*-*-medium-r-normal-*-*-*-*-*-*-*-georgian-rs,\
+-*-*-medium-*-*-*-*-*-*-*-*-*-ksc5601.1987-*,\
+-*-*-medium-r-normal-*-*-*-*-*-*-*-mulelao-1,\
+-*-*-medium-r-normal-*-*-*-*-*-*-*-ibm-cp1133,\
+-*-*-medium-r-normal-*-*-*-*-*-*-*-iso10646-1,\
+-taipei-*-medium-r-normal-*-*-*-*-*-*-*-big5-0"
}
style "steps"
{
bg[NORMAL] = { 0, 0, 0 }
fg[NORMAL] = { 1.0, 1.0, 1.0 }
-# fontset = "-adobe-helvetica-medium-r-normal-*-*-80-*-*-p-*-iso8859-1"
+
+ fontset = "-*-helvetica-medium-r-normal-*-*-80-*-*-*-*-*-*"
}
style "logo"
{
bg[NORMAL] = { 1.0, 1.0, 1.0 }
- fg[NORMAL] = { 1.0, 1.0, 1.0 }
- text[NORMAL] = { 1.0, 1.0, 1.0 }
- fg[ACTIVE] = { 1.0, 1.0, 1.0 }
- text[ACTIVE] = { 1.0, 1.0, 1.0 }
- fg[PRELIGHT] = { 1.0, 1.0, 1.0 }
- text[PRELIGHT] = { 1.0, 1.0, 1.0 }
- fg[SELECTED] = { 1.0, 1.0, 1.0 }
- text[SELECTED] = { 1.0, 1.0, 1.0 }
- fg[INSENSITIVE] = { 1.0, 1.0, 1.0 }
- text[INSENSITIVE] = { 1.0, 1.0, 1.0 }
- bg[NORMAL] = { 1.0, 1.0, 1.0 }
- base[NORMAL] = { 1.0, 1.0, 1.0 }
- bg[ACTIVE] = { 1.0, 1.0, 1.0 }
- base[ACTIVE] = { 1.0, 1.0, 1.0 }
- bg[PRELIGHT] = { 1.0, 1.0, 1.0 }
- base[PRELIGHT] = { 1.0, 1.0, 1.0 }
- bg[SELECTED] = { 1.0, 1.0, 1.0 }
- base[SELECTED] = { 1.0, 1.0, 1.0 }
- bg[INSENSITIVE] = { 1.0, 1.0, 1.0 }
- base[INSENSITIVE] = { 1.0, 1.0, 1.0 }
}
widget "*" style "default-font"
diff --git a/perl-install/swap.pm b/perl-install/swap.pm
index 879794ca9..bf8f608ed 100644
--- a/perl-install/swap.pm
+++ b/perl-install/swap.pm
@@ -21,9 +21,9 @@ my $signature_page = "\0" x $pagesize;
my $V0_MAX_PAGES = 8 * $pagesize - 10;
my $V1_OLD_MAX_PAGES = int 0x7fffffff / $pagesize - 1;
-my $V1_MAX_PAGES = $V1_OLD_MAX_PAGES; # (1 << 24) - 1;
+my $V1_MAX_PAGES = $V1_OLD_MAX_PAGES; #- (1 << 24) - 1;
my $MAX_BADPAGES = int ($pagesize - 1024 - 128 * $common::sizeof_int - 10) / $common::sizeof_int;
-my $signature_format_v1 = "x1024 I I I I125"; # bootbits, version, last_page, nr_badpages, padding
+my $signature_format_v1 = "x1024 I I I I125"; #- bootbits, version, last_page, nr_badpages, padding
1;
@@ -52,7 +52,7 @@ sub check_blocks {
vec($signature_page, $i, 1) = bool($last_read_ok) if $version == 0;
}
- # TODO: add interface
+ #- TODO: add interface
$badpages and log::l("$badpages bad pages\n");
return $badpages;
@@ -114,7 +114,7 @@ sub make($;$) {
syswrite(F, substr($signature_page, $offset)) or die "unable to write signature page: $!";
- # A subsequent swapon() will fail if the signature is not actually on disk. (This is a kernel bug.)
+ #- A subsequent swapon() will fail if the signature is not actually on disk. (This is a kernel bug.)
syscall_('fsync', fileno(F)) or die "fsync failed: $!";
close F;
}
diff --git a/perl-install/unused/cdrom.pm b/perl-install/unused/cdrom.pm
index 46bb4fc3f..6ba5f5152 100644
--- a/perl-install/unused/cdrom.pm
+++ b/perl-install/unused/cdrom.pm
@@ -30,11 +30,11 @@ sub findSCSIcdrom {
sub setupCDdevice {
my ($cddev, $dl) = @_;
- #TODO
+ #-TODO
}
sub removeCDmodule {
- # this wil fail silently if no CD module has been loaded
+ #- this wil fail silently if no CD module has been loaded
removeDeviceDriver('cdrom');
1;
}
diff --git a/perl-install/unused/scsi.pm b/perl-install/unused/scsi.pm
index 77fe8fe44..1b185a8ad 100644
--- a/perl-install/unused/scsi.pm
+++ b/perl-install/unused/scsi.pm
@@ -58,7 +58,7 @@ sub ideGetDevices {
-r "/proc/ide" or die "sorry, /proc/ide not available, seems like you have a pre-2.2 kernel\n => not handled yet :(";
- # Great. 2.2 kernel, things are much easier and less error prone.
+ #- Great. 2.2 kernel, things are much easier and less error prone.
foreach my $d (glob_('/proc/ide/hd*')) {
my ($t) = chop_(cat_("$d/media"));
my $type = $ {{disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd'}}{$t} or next;
@@ -93,8 +93,8 @@ sub dac960GetDevices {
local *F;
open F, $file or die "Failed to open $file: $!";
- # We are looking for lines of this format:DAC960#0:
- # /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012
+ #- We are looking for lines of this format:DAC960#0:
+ #- /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012
foreach (<F>) {
my ($devicename, $info) = m|/dev/rd/(.*?): (.*?),| or next;
push @idi, { info => $info, type => 'hd', devicename => $devicename };