diff options
| author | Pascal Rigaux <pixel@mandriva.com> | 2003-04-17 11:34:32 +0000 |
|---|---|---|
| committer | Pascal Rigaux <pixel@mandriva.com> | 2003-04-17 11:34:32 +0000 |
| commit | 4781e491c32fdfe0dbe3cf97a8aca90040a9406b (patch) | |
| tree | ca4f166763cc8be7bc01e943dcbf5a058758060d | |
| parent | 5458ef92ec80fab427e4d69b5cdd22bb76b261d8 (diff) | |
| download | drakx-4781e491c32fdfe0dbe3cf97a8aca90040a9406b.tar drakx-4781e491c32fdfe0dbe3cf97a8aca90040a9406b.tar.gz drakx-4781e491c32fdfe0dbe3cf97a8aca90040a9406b.tar.bz2 drakx-4781e491c32fdfe0dbe3cf97a8aca90040a9406b.tar.xz drakx-4781e491c32fdfe0dbe3cf97a8aca90040a9406b.zip | |
new perl_checker compliance
50 files changed, 351 insertions, 337 deletions
diff --git a/perl-install/Xconfig/main.pm b/perl-install/Xconfig/main.pm index 6aa5376a7..38b0c0e64 100644 --- a/perl-install/Xconfig/main.pm +++ b/perl-install/Xconfig/main.pm @@ -69,7 +69,7 @@ sub configure_everything { } sub configure_chooser_raw { - my ($in, $raw_X, $do_pkgs, $options, $X, $modified) = @_; + my ($in, $raw_X, $do_pkgs, $options, $X, $b_modified) = @_; my %texts; @@ -87,7 +87,7 @@ sub configure_chooser_raw { if ($val) { $X->{$field} = $val; $X->{"modified_$field"} = 1; - $modified = 1; + $b_modified = 1; $update_texts->(); if (member($field, 'card', 'monitor')) { @@ -122,7 +122,7 @@ sub configure_chooser_raw { $X->{various} = 'done'; } }, ]); - $ok, $modified; + $ok, $b_modified; } sub configure_chooser { @@ -135,7 +135,7 @@ sub configure_chooser { }; my ($ok, $modified) = configure_chooser_raw($in, $raw_X, $do_pkgs, $options, $X); - $modified and may_write($in, $raw_X, $X, $ok) or return; + $modified && may_write($in, $raw_X, $X, $ok) or return; 'config_changed'; } diff --git a/perl-install/Xconfig/monitor.pm b/perl-install/Xconfig/monitor.pm index 372086fe9..1df15ecd5 100644 --- a/perl-install/Xconfig/monitor.pm +++ b/perl-install/Xconfig/monitor.pm @@ -42,10 +42,10 @@ sub from_raw_X { } sub configure { - my ($in, $raw_X, $auto) = @_; + my ($in, $raw_X, $b_auto) = @_; my $monitor = from_raw_X($raw_X); - choose($in, $monitor, $auto) or return; + choose($in, $monitor, $b_auto) or return; $raw_X->set_monitors($monitor); $monitor; } @@ -67,12 +67,12 @@ sub configure_auto_install { } sub choose { - my ($in, $monitor, $auto) = @_; + my ($in, $monitor, $b_auto) = @_; my $monitors = monitors(); my $ok = configure_automatic($monitor, $monitors); - if ($auto) { + if ($b_auto) { log::l("Xconfig::monitor: auto failed") if !$ok; return $ok; } diff --git a/perl-install/Xconfig/parse.pm b/perl-install/Xconfig/parse.pm index a2e662009..ea1054835 100644 --- a/perl-install/Xconfig/parse.pm +++ b/perl-install/Xconfig/parse.pm @@ -30,10 +30,10 @@ sub read_XF86Config_from_string { #- raw reading/saving #-############################################################################### sub raw_from_file { #- internal - my ($file, $lines) = @_; + my ($file, $o_lines) = @_; my $raw_X = []; - $lines ||= [ cat_($file) ]; + my $lines = $o_lines || [ cat_($file) ]; my $line; my ($comment, $obj, @objs); @@ -109,7 +109,7 @@ sub raw_from_file { #- internal } sub raw_to_string { - my ($e, $want_spacing) = @_; + my ($e, $b_want_spacing) = @_; my $s = do { if ($e->{l}) { my $inside = join('', map_index { raw_to_string($_, $::i) } @{$e->{l}}); @@ -121,7 +121,7 @@ sub raw_to_string { (defined $e->{val} ? ($e->{Option} && $e->{val} !~ /^"/ ? qq( "$e->{val}") : qq( $e->{val})) : ''); } }; - ($e->{pre_comment} ? ($want_spacing ? "\n" : '') . $e->{pre_comment} : '') . $s . ($e->{comment_on_line} || '') . "\n" . ($e->{post_comment} || ''); + ($e->{pre_comment} ? ($b_want_spacing ? "\n" : '') . $e->{pre_comment} : '') . $s . ($e->{comment_on_line} || '') . "\n" . ($e->{post_comment} || ''); } #-############################################################################### diff --git a/perl-install/Xconfig/resolution_and_depth.pm b/perl-install/Xconfig/resolution_and_depth.pm index 45608e1f5..81559dee7 100644 --- a/perl-install/Xconfig/resolution_and_depth.pm +++ b/perl-install/Xconfig/resolution_and_depth.pm @@ -169,11 +169,11 @@ sub choices { } sub configure { - my ($in, $raw_X, $card, $monitor, $auto) = @_; + my ($in, $raw_X, $card, $monitor, $b_auto) = @_; my ($default_resolution, @resolutions) = choices($raw_X, $raw_X->get_resolution, $card, $monitor); - if ($auto) { + if ($b_auto) { #- use $default_resolution } elsif ($in->isa('interactive::gtk')) { $default_resolution = choose_gtk($in, $card, $default_resolution, @resolutions) or return; diff --git a/perl-install/Xconfig/various.pm b/perl-install/Xconfig/various.pm index 3b1b145cf..d277937c5 100644 --- a/perl-install/Xconfig/various.pm +++ b/perl-install/Xconfig/various.pm @@ -44,10 +44,10 @@ sub info { } sub various { - my ($in, $card, $options, $auto) = @_; + my ($in, $card, $options, $b_auto) = @_; - tvout($in, $card, $options) if !$auto; - choose_xdm($in, $auto); + tvout($in, $card, $options) if !$b_auto; + choose_xdm($in, $b_auto); 1; } @@ -63,10 +63,10 @@ sub runlevel { } sub choose_xdm { - my ($in, $auto) = @_; + my ($in, $b_auto) = @_; my $xdm = $::isStandalone ? runlevel() == 5 : 1; - if (!$auto || $::isStandalone) { + if (!$b_auto || $::isStandalone) { $xdm = $in->ask_yesorno_({ title => N("Graphical interface at startup"), messages => diff --git a/perl-install/Xconfig/xfreeX.pm b/perl-install/Xconfig/xfreeX.pm index 5ffe2c0b3..e8d5f33f4 100644 --- a/perl-install/Xconfig/xfreeX.pm +++ b/perl-install/Xconfig/xfreeX.pm @@ -259,8 +259,8 @@ sub raw_export_section { } sub raw_import_section { - my ($section, $h, $fields) = @_; - foreach ($fields ? grep { exists $h->{$_} } @$fields : keys %$h) { + my ($section, $h, $o_fields) = @_; + foreach ($o_fields ? grep { exists $h->{$_} } @$o_fields : keys %$h) { my @l = map { ref($_) eq 'HASH' ? $_ : { val => $_ } } deref_array($h->{$_}); $section->{$_} = (ref($h->{$_}) eq 'ARRAY' ? \@l : $l[0]); } @@ -282,17 +282,17 @@ sub add_Section { $h; } sub remove_Section { - my ($raw_X, $Section, $when) = @_; - @$raw_X = grep { $_->{name} ne $Section || $when && $when->($_->{l}) } @$raw_X; + my ($raw_X, $Section, $o_when) = @_; + @$raw_X = grep { $_->{name} ne $Section || $o_when && $o_when->($_->{l}) } @$raw_X; $raw_X; } sub get_Sections { - my ($raw_X, $Section, $when) = @_; - map { if_($_->{name} eq $Section && (!$when || $when->($_->{l})), $_->{l}) } @$raw_X; + my ($raw_X, $Section, $o_when) = @_; + map { if_($_->{name} eq $Section && (!$o_when || $o_when->($_->{l})), $_->{l}) } @$raw_X; } sub get_Section { - my ($raw_X, $Section, $when) = @_; - my @l = get_Sections($raw_X, $Section, $when); + my ($raw_X, $Section, $o_when) = @_; + my @l = get_Sections($raw_X, $Section, $o_when); @l > 1 and log::l("Xconfig: found more than one Section $Section"); $l[0]; } diff --git a/perl-install/any.pm b/perl-install/any.pm index 39b10df6b..423bf990c 100644 --- a/perl-install/any.pm +++ b/perl-install/any.pm @@ -81,7 +81,7 @@ sub hdInstallPath() { } sub kernelVersion { - my $kernel = readlink "$::prefix/boot/vmlinuz" || first(all("$::prefix/boot")); + my $kernel = readlink("$::prefix/boot/vmlinuz") || first(all("$::prefix/boot")); first($kernel =~ /vmlinuz-(.*)/); } @@ -501,19 +501,19 @@ sub shells { } sub inspect { - my ($part, $prefix, $rw) = @_; + my ($part, $o_prefix, $b_rw) = @_; isMountableRW($part) or return; my $dir = $::isInstall ? "/tmp/inspect_tmp_dir" : "/root/.inspect_tmp_dir"; if ($part->{isMounted}) { - $dir = ($prefix || '') . $part->{mntpoint}; + $dir = ($o_prefix || '') . $part->{mntpoint}; } elsif ($part->{notFormatted} && !$part->{isFormatted}) { $dir = ''; } else { mkdir $dir, 0700; - eval { fs::mount($part->{device}, $dir, type2fs($part), !$rw) }; + eval { fs::mount($part->{device}, $dir, type2fs($part), !$b_rw) }; $@ and return; } my $h = before_leaving { @@ -565,7 +565,7 @@ sub ask_users { cancel => N("Accept user"), callbacks => { focus_out => sub { - if ($_[0] eq 0) { + if ($_[0] eq '0') { $u->{name} ||= lc first($u->{realname} =~ /([\w-]+)/); } }, diff --git a/perl-install/bootloader.pm b/perl-install/bootloader.pm index 9a110ebfa..97fd85ba4 100644 --- a/perl-install/bootloader.pm +++ b/perl-install/bootloader.pm @@ -300,8 +300,8 @@ sub remove_append_simple { }); } sub set_append { - my ($b, $key, $val) = @_; my $has_val = @_ > 2; + my ($b, $key, $val) = @_; modify_append($b, sub { my ($simple, $dict) = @_; @@ -400,12 +400,12 @@ sub sanitize_ver { $string =~ m|([^-]+)-([^-]+)(-([^-]+))?(-([^-]*))?|; $ehad = $1; $chtaim = $2; $chaloch = $3; $arba = $4; $hamesh = $5; $chech = $6; - if ($chtaim =~ m|mdk| and $chech =~ m|mdk(${mdksub})|) { #new mdk with mdksub + if ($chtaim =~ m|mdk| && $chech =~ m|mdk(${mdksub})|) { #new mdk with mdksub my $s = $1; $chtaim =~ m|^(\d+)\.(\d+)\.(\d+)\.(\d+)mdk|; $return = "$1$2$3-$4$s"; - } elsif ($chaloch =~ m|mdk| and $chtaim =~ /pre\d+/ - and $arba =~ m|(\d+)mdk(${mdksub})?|) { #new mdk with mdksub + } elsif ($chaloch =~ m|mdk| && $chtaim =~ /pre\d+/ + && $arba =~ m|(\d+)mdk(${mdksub})?|) { #new mdk with mdksub my $r = $1; my $s = $2 ? $2 : ""; $chtaim =~ m|^(\d+)\.(\d+)\.(\d+)pre(\d+)|; @@ -421,7 +421,7 @@ sub sanitize_ver { my $s = $1; $chtaim =~ m|^(\d+)\.(\d+)\.(\d+)|; $return = "$1$2$3-$s"; - } elsif (not defined($chaloch)) { #linus/marcelo vanilla + } elsif (!defined($chaloch)) { #linus/marcelo vanilla $chtaim =~ m|^(\d+)\.(\d+)\.(\d+)$|; $return = "$1$2$3"; } else { #a pre ac vanilla or whatever with EXTRAVERSION @@ -499,8 +499,8 @@ wait %d seconds for default boot. #- add a restore entry if installation is done from disk, in order to allow redoing it. if (my $hd_install_path = any::hdInstallPath()) { - if (-e "/tmp/image/boot/vmlinuz" && -e "/tmp/image/boot/all.rdz" and - my ($cmdline) = cat_("/tmp/image/boot/grub/menu.lst") =~ /kernel \S+\/boot\/vmlinuz (.*)$/m) { + if (-e "/tmp/image/boot/vmlinuz" && -e "/tmp/image/boot/all.rdz" && + (my ($cmdline) = cat_("/tmp/image/boot/grub/menu.lst") =~ m|kernel \S+/boot/vmlinuz (.*)$|m)) { log::l("copying kernel and stage1 install to $::prefix/boot/restore"); eval { mkdir "$::prefix/boot/restore"; cp_af("/tmp/image/boot/vmlinuz", "$::prefix/boot/restore/vmlinuz"); @@ -1073,10 +1073,10 @@ N_("Welcome to GRUB the operating system chooser!"), N_("Use the %c and %c keys for selecting which entry is highlighted."), #-PO: these messages will be displayed at boot time in the BIOS, use only ASCII (7bit) #-PO: and keep them smaller than 79 chars long -N_("Press enter to boot the selected OS, \'e\' to edit the"), +N_("Press enter to boot the selected OS, 'e' to edit the"), #-PO: these messages will be displayed at boot time in the BIOS, use only ASCII (7bit) #-PO: and keep them smaller than 79 chars long -N_("commands before booting, or \'c\' for a command-line."), +N_("commands before booting, or 'c' for a command-line."), #-PO: these messages will be displayed at boot time in the BIOS, use only ASCII (7bit) #-PO: and keep them smaller than 79 chars long N_("The highlighted entry will be booted automatically in %d seconds."), diff --git a/perl-install/common.pm b/perl-install/common.pm index 8dbf403b4..72a40bd32 100644 --- a/perl-install/common.pm +++ b/perl-install/common.pm @@ -106,8 +106,8 @@ sub removeXiBSuffix { $_; } sub formatXiB { - my ($newnb, $newbase) = @_; - $newbase ||= 1; + my ($newnb, $o_newbase) = @_; + my $newbase = $o_newbase || 1; my ($nb, $base); my $decr = sub { ($nb, $base) = ($newnb, $newbase); diff --git a/perl-install/crypto.pm b/perl-install/crypto.pm index 927a7de15..76821f38c 100644 --- a/perl-install/crypto.pm +++ b/perl-install/crypto.pm @@ -108,8 +108,8 @@ sub dir { $mirrors{$_[0]}[1] . ($::corporate && '/corporate' || '') . '/' . vers sub ftp($) { ftp::new($_[0], dir($_[0])) } sub getFile { - my ($file, $host) = @_; - $host ||= $crypto::host; + my ($file, $o_host) = @_; + my $host = $o_host || $crypto::host; my $dir = dir($host) . ($file =~ /\.rpm$/ && "/RPMS"); log::l("getting crypto file $file on directory $dir with login $mirrors{$host}[2]"); my ($ftp, $retr) = ftp::new($host, $dir, diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index fbac2e4d9..49a0890ea 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -386,8 +386,8 @@ sub getTVcards { } sub getSerialModem { - my ($modem, $mouse) = @_; - $mouse ||= {}; + my ($modem, $o_mouse) = @_; + my $mouse = $o_mouse || {}; $mouse->{device} = readlink "/dev/mouse"; my $serdev = arch() =~ /ppc/ ? "macserial" : "serial"; eval { modules::load($serdev) }; diff --git a/perl-install/devices.pm b/perl-install/devices.pm index a6916bfdc..7c57f43a0 100644 --- a/perl-install/devices.pm +++ b/perl-install/devices.pm @@ -47,14 +47,14 @@ sub find_free_loop { die "no free loop found"; } sub set_loop { - my ($file, $encrypt_key, $encryption) = @_; + my ($file, $o_encrypt_key, $o_encryption) = @_; my $dev = find_free_loop(); - if ($encrypt_key && $encryption) { - my $cmd = "losetup -p 0 -e $encryption $dev $file"; + if ($o_encrypt_key && $o_encryption) { + my $cmd = "losetup -p 0 -e $o_encryption $dev $file"; log::l("calling $cmd"); open(my $F, "|$cmd"); - print $F $encrypt_key; + print $F $o_encrypt_key; close $F or die "losetup failed"; } else { run_program::run("losetup", $dev, $file) or return; diff --git a/perl-install/diskdrake/hd_gtk.pm b/perl-install/diskdrake/hd_gtk.pm index 5a3c2ea3a..2071b3e4a 100644 --- a/perl-install/diskdrake/hd_gtk.pm +++ b/perl-install/diskdrake/hd_gtk.pm @@ -98,7 +98,7 @@ sub main { if $::isStandalone; $in->ask_warn('', N("If you plan to use aboot, be carefull to leave a free space (2048 sectors is enough) -at the beginning of the disk")) if arch() eq 'alpha' and !$::isEmbedded; +at the beginning of the disk")) if arch() eq 'alpha' && !$::isEmbedded; $w->main; } @@ -106,7 +106,7 @@ at the beginning of the disk")) if arch() eq 'alpha' and !$::isEmbedded; sub try { my ($name, @args) = @_; my $f = $diskdrake::interactive::{$name} or die "unknown function $name"; - try_($name, \&{$f}, @args); + try_($name, \&$f, @args); } sub try_ { my ($name, $f, @args) = @_; diff --git a/perl-install/diskdrake/interactive.pm b/perl-install/diskdrake/interactive.pm index 882368416..f32c872c7 100644 --- a/perl-install/diskdrake/interactive.pm +++ b/perl-install/diskdrake/interactive.pm @@ -1084,7 +1084,7 @@ sub need_migration { } sub migrate_files { - my ($in, $_hd, $part, $_all_hds) = @_; + my ($in, $_hd, $part) = @_; my $wait = $in->wait_message('', N("Moving files to the new partition")); my $handle = any::inspect($part, '', 'rw'); diff --git a/perl-install/diskdrake/smbnfs_gtk.pm b/perl-install/diskdrake/smbnfs_gtk.pm index 721a52309..51152d991 100644 --- a/perl-install/diskdrake/smbnfs_gtk.pm +++ b/perl-install/diskdrake/smbnfs_gtk.pm @@ -36,7 +36,7 @@ sub main { sub try { my ($kind, $name, @args) = @_; my $f = $diskdrake::interactive::{$name} or die "unknown function $name"; - try_($kind, $name, \&{$f}, @args); + try_($kind, $name, \&$f, @args); } sub try_ { my ($kind, $name, $f, @args) = @_; @@ -50,7 +50,7 @@ sub try_ { sub raw_hd_options { my ($in, $raw_hd) = @_; - diskdrake::interactive::Options($in, {}, $raw_hd); + diskdrake::interactive::Options($in, {}, $raw_hd, fsedit::empty_all_hds()); } sub raw_hd_mount_point { my ($in, $raw_hd) = @_; @@ -111,13 +111,13 @@ sub update { } sub find_fstab_entry { - my ($kind, $e, $add_or_not) = @_; + my ($kind, $e, $b_add_or_not) = @_; my $fs_entry = $kind->to_fstab_entry($e); if (my $fs_entry_ = find { $fs_entry->{device} eq $_->{device} } @{$kind->{val}}) { $fs_entry_; - } elsif ($add_or_not) { + } elsif ($b_add_or_not) { push @{$kind->{val}}, $fs_entry; $fs_entry; } else { diff --git a/perl-install/fs.pm b/perl-install/fs.pm index a8d07edb2..9f3938577 100644 --- a/perl-install/fs.pm +++ b/perl-install/fs.pm @@ -268,18 +268,18 @@ sub prepare_write_fstab { } sub fstab_to_string { - my ($all_hds, $prefix) = @_; + my ($all_hds, $o_prefix) = @_; my $fstab = [ fsedit::get_really_all_fstab($all_hds), @{$all_hds->{special}} ]; - my ($s, undef) = prepare_write_fstab($fstab, $prefix, 'keep_smb_credentials'); + my ($s, undef) = prepare_write_fstab($fstab, $o_prefix, 'keep_smb_credentials'); $s; } sub write_fstab { - my ($all_hds, $prefix) = @_; - log::l("writing $prefix/etc/fstab"); + my ($all_hds, $o_prefix) = @_; + log::l("writing $o_prefix/etc/fstab"); my $fstab = [ fsedit::get_really_all_fstab($all_hds), @{$all_hds->{special}} ]; - my ($s, $smb_credentials) = prepare_write_fstab($fstab, $prefix, ''); - output("$prefix/etc/fstab", $s); + my ($s, $smb_credentials) = prepare_write_fstab($fstab, $o_prefix, ''); + output("$o_prefix/etc/fstab", $s); network::smb::save_credentials($_) foreach @$smb_credentials; } @@ -416,12 +416,13 @@ sub mount_options_help { } sub set_default_options { - my ($part, $is_removable, $useSupermount, $security, $iocharset, $codepage) = @_; + my ($part, %opts) = @_; + #- opts are: is_removable useSupermount security iocharset codepage my ($options, $unknown) = mount_options_unpack($part); - if ($is_removable) { - $options->{supermount} = $useSupermount; + if ($opts{is_removable}) { + $options->{supermount} = $opts{useSupermount}; $part->{type} = 'auto'; } @@ -455,17 +456,17 @@ sub set_default_options { put_in_hash($options, { user => 1, noexec => 0, - }) if $is_removable; + }) if $opts{is_removable}; put_in_hash($options, { - 'umask=0' => $security < 3, 'iocharset=' => $iocharset, 'codepage=' => $codepage, + 'umask=0' => $opts{security} < 3, 'iocharset=' => $opts{iocharset}, 'codepage=' => $opts{codepage}, }); } if (isThisFs('ntfs', $part)) { - put_in_hash($options, { ro => 1, 'umask=0' => $security < 3, 'iocharset=' => $iocharset }); + put_in_hash($options, { ro => 1, 'umask=0' => $opts{security} < 3, 'iocharset=' => $opts{iocharset} }); } if (isThisFs('iso9660', $part) || $is_auto) { - put_in_hash($options, { user => 1, noexec => 0, 'iocharset=' => $iocharset }); + put_in_hash($options, { user => 1, noexec => 0, 'iocharset=' => $opts{iocharset} }); } if (isThisFs('reiserfs', $part)) { $options->{notail} = 1; @@ -493,12 +494,13 @@ sub set_default_options { } sub set_all_default_options { - my ($all_hds, $useSupermount, $security, $iocharset, $codepage) = @_; + my ($all_hds, %opts) = @_; + #- opts are: useSupermount security iocharset codepage my @removables = @{$all_hds->{raw_hds}}; foreach my $part (fsedit::get_really_all_fstab($all_hds)) { - set_default_options($part, member($part, @removables), $useSupermount, $security, $iocharset, $codepage); + set_default_options($part, %opts, is_removable => member($part, @removables)); } } @@ -657,8 +659,8 @@ sub formatMount_part { } sub formatMount_all { - my ($raids, $fstab, $prefix, $wait_message) = @_; - formatMount_part($_, $raids, $fstab, $prefix, $wait_message) + my ($raids, $fstab, $prefix, $o_wait_message) = @_; + formatMount_part($_, $raids, $fstab, $prefix, $o_wait_message) foreach sort { isLoopback($a) ? 1 : isSwap($a) ? -1 : 0 } grep { $_->{mntpoint} } @$fstab; #- ensure the link is there @@ -674,8 +676,8 @@ sub formatMount_all { } sub mount { - my ($dev, $where, $fs, $rdonly, $options, $wait_message) = @_; - log::l("mounting $dev on $where as type $fs, options $options"); + my ($dev, $where, $fs, $b_rdonly, $o_options, $o_wait_message) = @_; + log::l("mounting $dev on $where as type $fs, options $o_options"); -d $where or mkdir_p($where); @@ -684,14 +686,14 @@ sub mount { my @fs_modules = qw(vfat hfs romfs ufs reiserfs xfs jfs ext3); if (member($fs, 'smb', 'smbfs', 'nfs', 'davfs', 'ntfs') && $::isStandalone) { - $wait_message->(N("Mounting partition %s", $dev)) if $wait_message; - system('mount', '-t', $fs, $dev, $where, if_($options, '-o', $options)) == 0 or die \N("mounting partition %s in directory %s failed", $dev, $where); + $o_wait_message->(N("Mounting partition %s", $dev)) if $o_wait_message; + system('mount', '-t', $fs, $dev, $where, if_($o_options, '-o', $o_options)) == 0 or die \N("mounting partition %s in directory %s failed", $dev, $where); return; #- do not update mtab, already done by mount(8) } elsif (member($fs, 'ext2', 'proc', 'usbdevfs', 'iso9660', @fs_modules)) { $where =~ s|/$||; my $flag = c::MS_MGC_VAL(); - $flag |= c::MS_RDONLY() if $rdonly; + $flag |= c::MS_RDONLY() if $b_rdonly; my $mount_opt = ""; if ($fs eq 'vfat') { @@ -701,16 +703,16 @@ sub mount { #- without knowing it, / is forced to be mounted with notail # if $where =~ m|/(boot)?$|; $mount_opt = 'notail'; #- notail in any case - } elsif ($fs eq 'jfs' && !$rdonly) { - $wait_message->(N("Checking %s", $dev)) if $wait_message; + } elsif ($fs eq 'jfs' && !$b_rdonly) { + $o_wait_message->(N("Checking %s", $dev)) if $o_wait_message; #- needed if the system is dirty otherwise mounting read-write simply fails run_program::raw({ timeout => 60 * 60 }, "fsck.jfs", $dev) or do { my $err = $?; die "fsck.jfs failed" if $err & 0xfc00; }; } elsif ($fs eq 'ext2' || $fs eq 'ext3' && $::isInstall) { - if (!$rdonly) { - $wait_message->(N("Checking %s", $dev)) if $wait_message; + if (!$b_rdonly) { + $o_wait_message->(N("Checking %s", $dev)) if $o_wait_message; foreach ('-a', '-y') { run_program::raw({ timeout => 60 * 60 }, "fsck.ext2", $_, $dev); my $err = $?; @@ -734,7 +736,7 @@ sub mount { eval { modules::load('isofs') }; } log::l("calling mount($dev, $where, $fs, $flag, $mount_opt)"); - $wait_message->(N("Mounting partition %s", $dev)) if $wait_message; + $o_wait_message->(N("Mounting partition %s", $dev)) if $o_wait_message; syscall_('mount', $dev, $where, $fs, $flag, $mount_opt) or die \(N("mounting partition %s in directory %s failed", $dev, $where) . " ($!)"); } else { log::l("skipping mounting $fs partition"); @@ -756,14 +758,14 @@ sub umount { } sub mount_part { - my ($part, $prefix, $rdonly, $wait_message) = @_; + my ($part, $o_prefix, $b_rdonly, $o_wait_message) = @_; #- root carrier's link can't be mounted - loopback::carryRootCreateSymlink($part, $prefix); + loopback::carryRootCreateSymlink($part, $o_prefix); log::l("isMounted=$part->{isMounted}, real_mntpoint=$part->{real_mntpoint}, mntpoint=$part->{mntpoint}"); if ($part->{isMounted} && $part->{real_mntpoint} && $part->{mntpoint}) { - log::l("remounting partition on $prefix$part->{mntpoint} instead of $part->{real_mntpoint}"); + log::l("remounting partition on $o_prefix$part->{mntpoint} instead of $part->{real_mntpoint}"); if ($::isInstall) { #- ensure partition will not be busy. require install_any; install_any::getFile('XXX'); @@ -771,7 +773,7 @@ sub mount_part { eval { umount($part->{real_mntpoint}); rmdir $part->{real_mntpoint}; - symlinkf "$prefix$part->{mntpoint}", $part->{real_mntpoint}; + symlinkf "$o_prefix$part->{mntpoint}", $part->{real_mntpoint}; delete $part->{real_mntpoint}; $part->{isMounted} = 0; }; @@ -781,19 +783,19 @@ sub mount_part { unless ($::testing) { if (isSwap($part)) { - $wait_message->(N("Enabling swap partition %s", $part->{device})) if $wait_message; + $o_wait_message->(N("Enabling swap partition %s", $part->{device})) if $o_wait_message; swap::swapon($part->{device}); } else { $part->{mntpoint} or die "missing mount point for partition $part->{device}"; - my $mntpoint = ($prefix || '') . $part->{mntpoint}; + my $mntpoint = ($o_prefix || '') . $part->{mntpoint}; if (isLoopback($part) || $part->{encrypt_key}) { set_loop($part); } elsif (loopback::carryRootLoopback($part)) { $mntpoint = "/initrd/loopfs"; } my $dev = $part->{real_device} || $part->{device}; - mount($dev, $mntpoint, type2fs($part), $rdonly, $part->{options}, $wait_message); + mount($dev, $mntpoint, type2fs($part), $b_rdonly, $part->{options}, $o_wait_message); rmdir "$mntpoint/lost+found"; } } @@ -801,7 +803,7 @@ sub mount_part { } sub umount_part { - my ($part, $prefix) = @_; + my ($part, $o_prefix) = @_; $part->{isMounted} || $part->{real_mntpoint} or return; @@ -811,7 +813,7 @@ sub umount_part { } elsif (loopback::carryRootLoopback($part)) { umount("/initrd/loopfs"); } else { - umount(($prefix || '') . $part->{mntpoint} || devices::make($part->{device})); + umount(($o_prefix || '') . $part->{mntpoint} || devices::make($part->{device})); devices::del_loop(delete $part->{real_device}) if $part->{real_device}; } } @@ -832,13 +834,13 @@ sub umount_all($;$) { # various functions ################################################################################ sub df { - my ($part, $prefix) = @_; + my ($part, $o_prefix) = @_; my $dir = "/tmp/tmp_fs_df"; return $part->{free} if exists $part->{free}; if ($part->{isMounted}) { - $dir = ($prefix || '') . $part->{mntpoint}; + $dir = ($o_prefix || '') . $part->{mntpoint}; } elsif ($part->{notFormatted} && !$part->{isFormatted}) { return; #- won't even try! } else { diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm index b4b65ebc6..978735b2a 100644 --- a/perl-install/fsedit.pm +++ b/perl-install/fsedit.pm @@ -169,7 +169,7 @@ sub lvms { } sub hds { - my ($flags, $ask_before_blanking) = @_; + my ($flags, $o_ask_before_blanking) = @_; $flags ||= {}; $flags->{readonly} && ($flags->{clearall} || $flags->{clear}) and die "conflicting flags readonly and clear/clearall"; @@ -204,7 +204,7 @@ sub hds { if (my $err = $@) { if ($hd->{readonly}) { use_proc_partitions($hd); - } elsif ($ask_before_blanking && $ask_before_blanking->($hd->{device}, $err)) { + } elsif ($o_ask_before_blanking && $o_ask_before_blanking->($hd->{device}, $err)) { partition_table::raw::zero_MBR($hd); } else { #- using it readonly @@ -403,10 +403,10 @@ sub is_one_big_fat_or_NT { } sub file2part { - my ($fstab, $file, $keep_simple_symlinks) = @_; + my ($fstab, $file, $b_keep_simple_symlinks) = @_; my $part; - $file = $keep_simple_symlinks ? common::expand_symlinks_but_simple("$::prefix$file") : expand_symlinks("$::prefix$file"); + $file = $b_keep_simple_symlinks ? common::expand_symlinks_but_simple("$::prefix$file") : expand_symlinks("$::prefix$file"); unless ($file =~ s/^$::prefix//) { my $part = find { loopback::carryRootLoopback($_) } @$fstab or die; log::l("found $part->{mntpoint}"); @@ -461,8 +461,8 @@ sub computeSize { } sub suggest_part { - my ($part, $all_hds, $suggestions) = @_; - $suggestions ||= $suggestions{server} || $suggestions{simple}; + my ($part, $all_hds, $o_suggestions) = @_; + my $suggestions = $o_suggestions || $suggestions{server} || $suggestions{simple}; my $has_swap = any { isSwap($_) } get_all_fstab($all_hds); @@ -498,8 +498,8 @@ sub has_mntpoint { mntpoint2part($mntpoint, [ get_really_all_fstab($all_hds) ]); } sub get_root_ { - my ($fstab, $boot) = @_; - $boot && mntpoint2part("/boot", $fstab) || mntpoint2part("/", $fstab); + my ($fstab, $o_boot) = @_; + $o_boot && mntpoint2part("/boot", $fstab) || mntpoint2part("/", $fstab); } sub get_root { &get_root_ || {} } @@ -573,7 +573,7 @@ sub allocatePartitions { while (suggest_part($part = { start => $start, size => 0, maxsize => $size, rootDevice => $dev }, $all_hds, $to_add)) { my $hd = fsedit::part2hd($part, $all_hds); - add($hd, $part, $all_hds); + add($hd, $part, $all_hds, {}); $size -= $part->{size} + $part->{start} - $start; $start = $part->{start} + $part->{size}; } @@ -581,13 +581,13 @@ sub allocatePartitions { } sub auto_allocate { - my ($all_hds, $suggestions) = @_; + my ($all_hds, $o_suggestions) = @_; my $before = listlength(fsedit::get_all_fstab($all_hds)); - my $suggestions_ = $suggestions || $suggestions{simple}; - allocatePartitions($all_hds, $suggestions_); + my $suggestions = $o_suggestions || $suggestions{simple}; + allocatePartitions($all_hds, $suggestions); - if ($suggestions) { + if ($o_suggestions) { auto_allocate_raids($all_hds, $suggestions); if (auto_allocate_vgs($all_hds, $suggestions)) { #- allocatePartitions needs to be called twice, once for allocating PVs, once for allocating LVs @@ -601,7 +601,7 @@ sub auto_allocate { if ($before == listlength(fsedit::get_all_fstab($all_hds))) { # find out why auto_allocate failed - if (any { !has_mntpoint($_->{mntpoint}, $all_hds) } @$suggestions_) { + if (any { !has_mntpoint($_->{mntpoint}, $all_hds) } @$suggestions) { die \N("Not enough free space for auto-allocating"); } else { die \N("Nothing to do"); @@ -664,7 +664,7 @@ sub undo_prepare { require Data::Dumper; $Data::Dumper::Purity = 1; foreach (@{$all_hds->{hds}}) { - my @h = @{$_}{@partition_table::fields2save}; + my @h = @$_{@partition_table::fields2save}; push @{$_->{undo}}, Data::Dumper->Dump([\@h], ['$h']); } } @@ -672,7 +672,7 @@ sub undo { my ($all_hds) = @_; foreach (@{$all_hds->{hds}}) { my $h; eval pop @{$_->{undo}} || next; - @{$_}{@partition_table::fields2save} = @$h; + @$_{@partition_table::fields2save} = @$h; $_->{isDirty} = $_->{needKernelReread} = 1 if $_->{hasBeenDirty}; } diff --git a/perl-install/ftp.pm b/perl-install/ftp.pm index 05e892c62..c971898a1 100644 --- a/perl-install/ftp.pm +++ b/perl-install/ftp.pm @@ -17,22 +17,22 @@ sub fromEnv() { } sub new { - my ($host, $prefix, $login, $password) = @_; + my ($host, $prefix, $o_login, $o_password) = @_; my @l = do { if ($hosts{"$host$prefix"}) { @{$hosts{"$host$prefix"}}; } else { my %options = (Passive => 1, Timeout => 60, Port => 21); $options{Firewall} = $ENV{PROXY} if $ENV{PROXY}; $options{Port} = $ENV{PROXYPORT} if $ENV{PROXYPORT}; - unless ($login) { - $login = 'anonymous'; - $password = '-drakx@'; + unless ($o_login) { + $o_login = 'anonymous'; + $o_password = '-drakx@'; } my $ftp; foreach (1..10) { $ftp = Net::FTP->new(network::resolv($host), %options) or die; - $ftp && $ftp->login($login, $password) and last; + $ftp && $ftp->login($o_login, $o_password) and last; log::l("ftp login failed, sleeping before trying again"); sleep 5 * $_; diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index 4d524c86e..aa3ef6a6f 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -105,14 +105,14 @@ sub errorOpeningFile($) { return; } sub getFile { - my ($f, $method) = @_; - log::l("getFile $f:$method"); + my ($f, $o_method) = @_; + log::l("getFile $f:$o_method"); my $rel = relGetFile($f); do { if ($f =~ m|^http://|) { require http; http::getFile($f); - } elsif ($method =~ /crypto|update/i) { + } elsif ($o_method =~ /crypto|update/i) { require crypto; crypto::getFile($f); } elsif ($::o->{method} eq "ftp") { @@ -310,9 +310,9 @@ sub setPackages { } sub setDefaultPackages { - my ($o, $clean) = @_; + my ($o, $b_clean) = @_; - if ($clean) { + if ($b_clean) { delete $o->{$_} foreach qw(default_packages compssUsersChoice); #- clean modified variables. } @@ -326,7 +326,7 @@ sub setDefaultPackages { push @{$o->{default_packages}}, uniq(grep { $_ } map { fsedit::package_needed_for_partition_type($_) } @{$o->{fstab}}); #- if no cleaning needed, populate by default, clean is used for second or more call to this function. - unless ($clean) { + unless ($b_clean) { if ($::auto_install && ($o->{compssUsersChoice} || {})->{ALL}) { $o->{compssUsersChoice}{$_} = 1 foreach map { @{$o->{compssUsers}{$_}{flags}} } @{$o->{compssUsersSorted}}; } @@ -564,7 +564,7 @@ sub install_urpmi { http => $ENV{URLPREFIX}, cdrom => "removable://mnt/cdrom" }}{$method} || #- for live_update or live_install script. - readlink "/tmp/image/Mandrake" =~ m,^(\/.*)\/Mandrake\/*$, && "removable:/$1") . "/$_->{rpmsdir}"; + readlink("/tmp/image/Mandrake") =~ m,^(/.*)/Mandrake/*$, && "removable:/$1") . "/$_->{rpmsdir}"; my $need_list = $dir =~ m|^[^:]*://[^/:\@]*:[^/:\@]+\@|; #- use list file only if a password is visible #- build a list file if needed. @@ -665,7 +665,7 @@ sub report_bug { } sub g_auto_install { - my ($replay, $respect_privacy) = @_; + my ($b_replay, $b_respect_privacy) = @_; my $o = {}; require pkgs; @@ -685,20 +685,20 @@ sub g_auto_install { } } - local $o->{partitioning}{auto_allocate} = !$replay; - $o->{autoExitInstall} = !$replay; - $o->{interactiveSteps} = [ 'doPartitionDisks', 'formatPartitions' ] if $replay; + local $o->{partitioning}{auto_allocate} = !$b_replay; + $o->{autoExitInstall} = !$b_replay; + $o->{interactiveSteps} = [ 'doPartitionDisks', 'formatPartitions' ] if $b_replay; #- deep copy because we're modifying it below $o->{users} = [ @{$o->{users} || []} ]; my @user_info_to_remove = ( - if_($respect_privacy, qw(name realname home pw)), + if_($b_respect_privacy, qw(name realname home pw)), qw(oldu oldg password password2), ); $_ = { %{$_ || {}} }, delete @$_{@user_info_to_remove} foreach $o->{superuser}, @{$o->{users} || []}; - if ($respect_privacy && $o->{netcnx}) { + if ($b_respect_privacy && $o->{netcnx}) { if (my $type = $o->{netcnx}{type}) { my @netcnx_type_to_remove = qw(passwd passwd2 login phone_in phone_out); $_ = { %{$_ || {}} }, delete @$_{@netcnx_type_to_remove} foreach $o->{netcnx}{$type}; @@ -750,7 +750,7 @@ sub getAndSaveAutoInstallFloppy { fs::umount($mountdir); run_program::run("losetup", "-d", "/dev/loop6"); - substInFile { s/timeout.*//; s/^(\s*append\s*=\s*\".*)\"/$1 kickstart=floppy\"/ } "$workdir/silo.conf"; #" for po + substInFile { s/timeout.*//; s/^(\s*append\s*=\s*\".*)\"/$1 kickstart=floppy"/ } "$workdir/silo.conf"; #" for po #-TODO output "$workdir/ks.cfg", generate_ks_cfg($o); output "$workdir/boot.msg", "\n7m", "!! If you press enter, an auto-install is going to start. @@ -810,7 +810,7 @@ sub getAndSaveAutoInstallFloppy { sub g_default_packages { - my ($o, $quiet) = @_; + my ($o, $b_quiet) = @_; my $floppy = detect_devices::floppy(); @@ -831,7 +831,7 @@ sub g_default_packages { $str, "\0"); fs::umount("/floppy"); - $quiet or $o->ask_warn('', N("To use this saved packages selection, boot installation with ``linux defcfg=floppy''")); + $b_quiet or $o->ask_warn('', N("To use this saved packages selection, boot installation with ``linux defcfg=floppy''")); } sub loadO { @@ -958,7 +958,7 @@ sub use_root_part { my ($all_hds, $part, $prefix) = @_; { my $handle = any::inspect($part, $prefix) or die; - fs::get_info_from_fstab($all_hds, $handle->{dir}, 'uniq'); + fs::get_info_from_fstab($all_hds, $handle->{dir}); } isSwap($_) and $_->{mntpoint} = 'swap' foreach fsedit::get_really_all_fstab($all_hds); #- use all available swap. } @@ -1032,11 +1032,11 @@ sub copy_advertising { foreach (@files) { chomp; getAndSaveFile("$source_dir/$_", "$dir/$_"); - s/\.png/\.pl/; + s/\.png/.pl/; getAndSaveFile("$source_dir/$_", "$dir/$_"); - s/\.pl/_icon\.png/; + s/\.pl/_icon.png/; getAndSaveFile("$source_dir/$_", "$dir/$_"); - s/_icon\.png/\.png/; + s/_icon\.png/.png/; } @advertising_images = map { "$dir/$_" } @files; } diff --git a/perl-install/install_interactive.pm b/perl-install/install_interactive.pm index 6fc358362..355f60ba4 100644 --- a/perl-install/install_interactive.pm +++ b/perl-install/install_interactive.pm @@ -248,11 +248,11 @@ When you are done, don't forget to save using `w'", partition_table::description } sub partitionWizard { - my ($o, $nodiskdrake) = @_; + my ($o, $b_nodiskdrake) = @_; my %solutions = partitionWizardSolutions($o, $o->{all_hds}); - delete $solutions{diskdrake} if $nodiskdrake; + delete $solutions{diskdrake} if $b_nodiskdrake; my @solutions = sort { $b->[0] <=> $a->[0] } values %solutions; @@ -280,14 +280,14 @@ sub partitionWizard { } sub upNetwork { - my ($o, $pppAvoided) = @_; + my ($o, $b_pppAvoided) = @_; my $_w = $o->wait_message('', N("Bringing up the network")); - install_steps::upNetwork($o, $pppAvoided); + install_steps::upNetwork($o, $b_pppAvoided); } sub downNetwork { - my ($o, $pppOnly) = @_; + my ($o, $b_pppOnly) = @_; my $_w = $o->wait_message('', N("Bringing down the network")); - install_steps::downNetwork($o, $pppOnly); + install_steps::downNetwork($o, $b_pppOnly); } diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 8a7f5578f..4d0b362c7 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -180,7 +180,7 @@ sub doPartitionDisksAfter { } fs::set_removable_mntpoints($o->{all_hds}); - fs::set_all_default_options($o->{all_hds}, $o->{useSupermount}, $o->{security}, lang::fs_options($o->{locale})) + fs::set_all_default_options($o->{all_hds}, %$o, lang::fs_options($o->{locale})) if !$o->{isUpgrade}; $o->{fstab} = [ fsedit::get_all_fstab($o->{all_hds}) ]; @@ -620,7 +620,7 @@ sub updateModulesFromFloppy { my @dest_files = map { chomp_($_) } run_program::rooted_get_stdout($o->{prefix}, 'find', '/lib/modules'); foreach my $s (@src_files) { log::l("found updatable module $s"); - my ($sfile, $sext) = $s =~ /([^\/\.]*\.o)(?:\.gz|\.bz2)?$/; + my ($sfile, $sext) = $s =~ m!([^/\.]*\.o)(?:\.gz|\.bz2)?$!; my $qsfile = quotemeta $sfile; my $qsext = quotemeta $sext; foreach my $target (@dest_files) { @@ -843,7 +843,7 @@ sub setupBootloaderBefore { bootloader::set_append($o->{bootloader}, $_->{device}, 'ide-scsi') foreach @l; } if ($o->{miscellaneous}{HDPARM}) { - bootloader::set_append($o->{bootloader}, $_, 'autotune') foreach grep { /ide.*/ } all("/proc/ide"); + bootloader::set_append($o->{bootloader}, $_, 'autotune') foreach grep { /ide/ } all("/proc/ide"); } if (cat_("/proc/cmdline") =~ /mem=nopentium/) { bootloader::set_append($o->{bootloader}, 'mem', 'nopentium'); @@ -1034,7 +1034,7 @@ sub hasNetwork { #------------------------------------------------------------------------------ sub upNetwork { - my ($o, $pppAvoided) = @_; + my ($o, $b_pppAvoided) = @_; #- do not destroy this file if prefix is '' or even '/' (could it happens ?). if (length($o->{prefix}) > 1) { @@ -1047,7 +1047,7 @@ sub upNetwork { require network::netconnect; network::netconnect::start_internet($o); return 1; - } elsif (!$pppAvoided) { + } elsif (!$b_pppAvoided) { eval { modules::load(qw(serial ppp bsd_comp ppp_deflate)) }; run_program::rooted($o->{prefix}, "/etc/rc.d/init.d/syslog", "start"); require network::netconnect; diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm index 9cbcf89ba..577e78654 100644 --- a/perl-install/install_steps_gtk.pm +++ b/perl-install/install_steps_gtk.pm @@ -478,8 +478,8 @@ sub installPackages { $change_time = time(); my $f = $install_any::advertising_images[$i++ % @install_any::advertising_images]; log::l("advertising $f"); - my $pl = $f; $pl =~ s/\.png$/\.pl/; - my $icon_name = $f; $icon_name =~ s/\.png$/_icon\.png/; + my $pl = $f; $pl =~ s/\.png$/.pl/; + my $icon_name = $f; $icon_name =~ s/\.png$/_icon.png/; my ($draw_text, $width, $height, @data, $icon, $icon_dx, $icon_dy, $icon_px); -e $pl and $draw_text = 1; eval(cat_($pl)) if $draw_text; @@ -503,22 +503,22 @@ sub installPackages { my ($width, $_height, $lines, $widths, $heights, $_ascents, $_descents) = get_text_coord($text, $darea, $area_width, $area_height, 1, 0, 1, 1); if ($first && $icon) { - my $iconx = ($dx-$width)/2 + $x + ${$widths}[0] - $icon_dx; - my $icony = $y + ${$heights}[0] - $icon_dy/2; + my $iconx = ($dx-$width)/2 + $x + $widths->[0] - $icon_dx; + my $icony = $y + $heights->[0] - $icon_dy/2; $icony > 0 or $icony = 0; $icon_px->render_to_drawable($darea->window, $darea->style->bg_gc('normal'), 0, 0, $iconx, $icony, $icon_dx, $icon_dy, 'none', 0, 0); $yicon = $icony + $icon_dy; } my $i = 0; - $yicon > $y + ${$heights}[0] and $decy = $yicon - ($y + ${$heights}[$i]); - foreach (@{$lines}) { + $yicon > $y + $heights->[0] and $decy = $yicon - ($y + $heights->[$i]); + foreach (@$lines) { my $layout = $darea->create_pango_layout($_); my $draw_lay = sub { my ($gc, $decx, $decy) = @_; $darea->window->draw_layout($gc, - ($dx-$width)/2 + $x + ${$widths}[$i] + $decx, - $y + ${$heights}[$i] + $decy, + ($dx-$width)/2 + $x + $widths->[$i] + $decx, + $y + $heights->[$i] + $decy, $layout); }; $draw_lay->($darea->style->black_gc, 0, 0); diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index e11105d25..68e4329b4 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -389,7 +389,7 @@ sub choosePackages { $o->chooseCD($packages) if $o->{method} eq 'cdrom' && !$::oem; my $w = $o->wait_message('', N("Looking for available packages...")); - my $availableC = install_steps::choosePackages(@_); + my $availableC = &install_steps::choosePackages; my $individual; require pkgs; @@ -932,7 +932,7 @@ sub summary { (my $p = find { $_ && ($_->{make} || $_->{model}) } $o->{printer}{configured}{$o->{printer}{DEFAULT}}{queuedata})) { "$p->{make} $p->{model}"; - } elsif (my $p = find { $_ && ($_->{make} || $_->{model}) } + } elsif ($p = find { $_ && ($_->{make} || $_->{model}) } map { $_->{queuedata} } (values %{$o->{printer}{configured}})) { "$p->{make} $p->{model}"; } else { @@ -1166,7 +1166,7 @@ sub setRootPassword { if ($auth eq N_("Windows Domain")) { #- maybe we should browse the network like diskdrake --smb and get the 'doze server names in a list #- but networking isn't setup yet necessarily - $o->ask_warn('', N("For this to work for a W2K PDC, you will probably need to have the admin run: C:\>net localgroup \"Pre-Windows 2000 Compatible Access\" everyone /add and reboot the server.\nYou will also need the username/password of a Domain Admin to join the machine to the Windows(TM) domain.\nIf networking is not yet enabled, Drakx will attempt to join the domain after the network setup step.\nShould this setup fail for some reason and domain authentication is not working, run 'smbpasswd -j DOMAIN -U USER%%PASSWORD' using your Windows(tm) Domain, and Admin Username/Password, after system boot.\nThe command 'wbinfo -t' will test whether your authentication secrets are good.")); + $o->ask_warn('', N("For this to work for a W2K PDC, you will probably need to have the admin run: C:\\>net localgroup \"Pre-Windows 2000 Compatible Access\" everyone /add and reboot the server.\nYou will also need the username/password of a Domain Admin to join the machine to the Windows(TM) domain.\nIf networking is not yet enabled, Drakx will attempt to join the domain after the network setup step.\nShould this setup fail for some reason and domain authentication is not working, run 'smbpasswd -j DOMAIN -U USER%%PASSWORD' using your Windows(tm) Domain, and Admin Username/Password, after system boot.\nThe command 'wbinfo -t' will test whether your authentication secrets are good.")); $o->ask_from('', N("Authentication Windows Domain"), [ { label => N("Windows Domain"), val => \ ($o->{netc}{WINDOMAIN} ||= $o->{netc}{DOMAINNAME}) }, diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm index b06ebdee2..532278f09 100644 --- a/perl-install/interactive.pm +++ b/perl-install/interactive.pm @@ -193,36 +193,36 @@ sub ask_from_listf_raw { } sub ask_from_listf_raw_no_check { - my ($o, $common, $f, $l, $def) = @_; + my ($o, $common, $f, $l, $o_def) = @_; if (@$l <= ($::isWizard ? 1 : 2)) { my ($ok, $cancel) = map { $_ && may_apply($f, $_) } @$l; if (length "$ok$cancel" < 70) { my $ret = eval { put_in_hash($common, { ok => $ok, - if_($cancel, cancel => $cancel, focus_cancel => $def eq $l->[1]) }); + if_($cancel, cancel => $cancel, focus_cancel => $o_def eq $l->[1]) }); ask_from_no_check($o, $common, []) ? $l->[0] : $l->[1]; }; die if $@ && $@ !~ /^wizcancel/; return $@ ? undef : $ret; } } - ask_from_no_check($o, $common, [ { val => \$def, type => 'list', list => $l, format => $f } ]) && $def; + ask_from_no_check($o, $common, [ { val => \$o_def, type => 'list', list => $l, format => $f } ]) && $o_def; } sub ask_from_treelist { - my ($o, $title, $message, $separator, $l, $def) = @_; - ask_from_treelistf($o, $title, $message, $separator, undef, $l, $def); + my ($o, $title, $message, $separator, $l, $o_def) = @_; + ask_from_treelistf($o, $title, $message, $separator, undef, $l, $o_def); } sub ask_from_treelist_ { - my ($o, $title, $message, $separator, $l, $def) = @_; + my ($o, $title, $message, $separator, $l, $o_def) = @_; my $transl = sub { join '|', map { translate($_) } split(quotemeta($separator), $_[0]) }; - ask_from_treelistf($o, $title, $message, $separator, $transl, $l, $def); + ask_from_treelistf($o, $title, $message, $separator, $transl, $l, $o_def); } sub ask_from_treelistf { - my ($o, $title, $message, $separator, $f, $l, $def) = @_; - ask_from($o, $title, $message, [ { val => \$def, separator => $separator, list => $l, format => $f, sort => 1 } ]) or return; - $def; + my ($o, $title, $message, $separator, $f, $l, $o_def) = @_; + ask_from($o, $title, $message, [ { val => \$o_def, separator => $separator, list => $l, format => $f, sort => 1 } ]) or return; + $o_def; } sub ask_many_from_list { diff --git a/perl-install/interactive/newt.pm b/perl-install/interactive/newt.pm index 3e8af3199..b94ae9193 100644 --- a/perl-install/interactive/newt.pm +++ b/perl-install/interactive/newt.pm @@ -392,9 +392,9 @@ sub wait_message_endW { } sub simplify_string { - my ($s, $width) = @_; + my ($s, $o_width) = @_; $s =~ s/\n/ /g; - $s = substr($s, 0, $width || 40); #- truncate if too long + $s = substr($s, 0, $o_width || 40); #- truncate if too long $s; } diff --git a/perl-install/lang.pm b/perl-install/lang.pm index 86db11026..0e14abe15 100644 --- a/perl-install/lang.pm +++ b/perl-install/lang.pm @@ -398,18 +398,18 @@ sub standard_locale { } sub getlocale_for_lang { - my ($lang, $country, $utf8) = @_; - standard_locale($lang, $country, $utf8) || l2locale($lang).($utf8 ? '.UTF-8' : ''); + my ($lang, $country, $o_utf8) = @_; + standard_locale($lang, $country, $o_utf8) || l2locale($lang).($o_utf8 ? '.UTF-8' : ''); } sub getlocale_for_country { - my ($lang, $country, $utf8) = @_; - standard_locale($lang, $country, $utf8) || c2locale($country).($utf8 ? '.UTF-8' : ''); + my ($lang, $country, $o_utf8) = @_; + standard_locale($lang, $country, $o_utf8) || c2locale($country).($o_utf8 ? '.UTF-8' : ''); } sub getLANGUAGE { - my ($lang, $country, $utf8) = @_; - l2language($lang) || join(':', uniq(getlocale_for_lang($lang, $country, $utf8), $lang, if_($lang =~ /^(..)_/, $1))); + my ($lang, $o_country, $o_utf8) = @_; + l2language($lang) || join(':', uniq(getlocale_for_lang($lang, $o_country, $o_utf8), $lang, if_($lang =~ /^(..)_/, $1))); } my %xim = ( @@ -598,7 +598,7 @@ sub l2console_font { } sub get_kde_lang { - my ($locale, $default) = @_; + my ($locale, $o_default) = @_; #- get it using #- echo C $(rpm -qp --qf "%{name}\n" /RPMS/kde-i18n-* | sed 's/kde-i18n-//') @@ -618,11 +618,11 @@ sub get_kde_lang { my $r; $r ||= $valid_lang->($locale->{lang}); $r ||= find { $valid_lang->($_) } split(':', getlocale_for_lang($locale->{lang}, $locale->{country})); - $r || $default || 'C'; + $r || $o_default || 'C'; } sub charset2kde_charset { - my ($charset, $default) = @_; + my ($charset, $o_default) = @_; my $iocharset = ($charsets{$charset} || [])->[3]; my @valid_kde_charsets = qw(big5-0 gb2312.1980-0 iso10646-1 iso8859-1 iso8859-4 iso8859-6 iso8859-8 iso8859-13 iso8859-14 iso8859-15 iso8859-2 iso8859-3 iso8859-5 iso8859-7 iso8859-9 koi8-r koi8-u ksc5601.1987-0 jisx0208.1983-0 microsoft-cp1251 tis620-0); @@ -638,7 +638,7 @@ sub charset2kde_charset { $r ||= $valid_charset->($charset2kde_charset{$charset}); $r ||= $valid_charset->($charset2kde_charset{$iocharset}); $r ||= $valid_charset->($iocharset); - $r || $default || 'iso10646-1'; + $r || $o_default || 'iso10646-1'; } #- font+size for different charsets; the field [0] is the default, @@ -738,7 +738,7 @@ sub l2pango_font { } sub set { - my ($lang, $translate_for_console) = @_; + my ($lang, $b_translate_for_console) = @_; #- disable Arabic in install as no (free) fonts are available. $lang eq 'ar' and $lang='en_US'; @@ -785,7 +785,7 @@ sub set { $ENV{LC_MESSAGES} = $lang; $ENV{LANG} = $lang; - if ($translate_for_console && $lang =~ /^(ko|ja|zh|th)/) { + if ($b_translate_for_console && $lang =~ /^(ko|ja|zh|th)/) { log::l("not translating in console"); $ENV{LANGUAGE} = 'C'; } else { @@ -801,8 +801,8 @@ sub langs { } sub langsLANGUAGE { - my ($l, $c) = @_; - uniq(map { split ':', getLANGUAGE($_, $c) } langs($l)); + my ($l, $o_c) = @_; + uniq(map { split ':', getLANGUAGE($_, $o_c) } langs($l)); } sub langs_selected { @@ -851,7 +851,7 @@ sub write_langs { } sub write { - my ($prefix, $locale, $user_only, $dont_touch_kde_files) = @_; + my ($prefix, $locale, $b_user_only, $b_dont_touch_kde_files) = @_; $locale && $locale->{lang} or return; @@ -867,7 +867,7 @@ sub write { log::l("lang::write: lang:$locale->{lang} country:$locale->{country} locale|lang:$locale_lang locale|country:$locale_country language:$h->{LANGUAGE}"); my ($name, $sfm, $acm) = l2console_font($locale); - if ($name && !$user_only) { + if ($name && !$b_user_only) { my $p = "$prefix/usr/lib/kbd"; if ($name) { eval { @@ -899,11 +899,11 @@ sub write { add2hash $h, { CONSOLE_NOT_LOCALIZED => 'yes' } } - setVarsInSh($prefix . ($user_only ? "$ENV{HOME}/.i18n" : '/etc/sysconfig/i18n'), $h); + setVarsInSh($prefix . ($b_user_only ? "$ENV{HOME}/.i18n" : '/etc/sysconfig/i18n'), $h); eval { my $charset = l2charset($locale->{lang}); - my $confdir = $prefix . ($user_only ? "$ENV{HOME}/.kde" : '/usr') . '/share/config'; + my $confdir = $prefix . ($b_user_only ? "$ENV{HOME}/.kde" : '/usr') . '/share/config'; my ($prev_kde_charset) = cat_("$confdir/kdeglobals") =~ /^Charset=(.*)/mi; mkdir_p($confdir); @@ -915,7 +915,7 @@ sub write { )); my %qt_xim = (zh => 'Over The Spot', ko => 'On The Spot', ja => 'Over The Spot'); - if ($user_only && (my $qt_xim = $qt_xim{substr($locale->{lang}, 0, 2)})) { + if ($b_user_only && (my $qt_xim = $qt_xim{substr($locale->{lang}, 0, 2)})) { update_gnomekderc("$ENV{HOME}/.qt/qtrc", General => (XIMInputStyle => $qt_xim)); } @@ -937,7 +937,7 @@ sub write { StandardFont => charset2kde_font($charset, 0), )); } - } if !$dont_touch_kde_files; + } if !$b_dont_touch_kde_files; } sub bindtextdomain() { @@ -1005,11 +1005,11 @@ sub load_console_font { sub fs_options { my ($locale) = @_; if ($locale->{utf8}) { - ('utf8', undef); + (iocharset => 'utf8', codepage => undef); } else { my $c = $charsets{l2charset($locale->{lang}) || return} or return; my ($iocharset, $codepage) = @$c[3..4]; - $iocharset, $codepage; + (iocharset => $iocharset, codepage => $codepage); } } diff --git a/perl-install/modules.pm b/perl-install/modules.pm index c011423f1..b5b784537 100644 --- a/perl-install/modules.pm +++ b/perl-install/modules.pm @@ -79,7 +79,7 @@ sub unload { } sub load_category { - my ($category, $wait_message, $probe_type) = @_; + my ($category, $o_wait_message, $b_probe_type) = @_; #- probe_category returns the PCMCIA cards. It doesn't know they are already #- loaded, so: @@ -97,19 +97,19 @@ sub load_category { ), ); grep { - $wait_message->($_->{description}, $_->{driver}) if $wait_message; + $o_wait_message->($_->{description}, $_->{driver}) if $o_wait_message; eval { load([ $_->{driver}, $_->{options} ]) }; $_->{error} = $@; $_->{try} = 1 if $_->{driver} eq 'hptraid'; !($_->{error} && $_->{try}); - } probe_category($category, $probe_type), + } probe_category($category, $b_probe_type), map { { driver => $_, description => $_, try => 1 } } @try_modules; } sub probe_category { - my ($category, $probe_type) = @_; + my ($category, $b_probe_type) = @_; my @modules = category2modules($category); @@ -127,7 +127,7 @@ sub probe_category { } else { member($_->{driver}, @modules); } - } detect_devices::probeall($probe_type); + } detect_devices::probeall($b_probe_type); } sub load_ide { diff --git a/perl-install/modules/interactive.pm b/perl-install/modules/interactive.pm index cdf1c2a0c..f7b7801e9 100644 --- a/perl-install/modules/interactive.pm +++ b/perl-install/modules/interactive.pm @@ -24,23 +24,23 @@ sub config_window { } sub load_category { - my ($in, $category, $auto, $at_least_one) = @_; + my ($in, $category, $b_auto, $b_at_least_one) = @_; my @l; { my $w; my $wait_message = sub { $w = wait_load_module($in, $category, @_) }; @l = modules::load_category($category, $wait_message); - @l = modules::load_category($category, $wait_message, 'force') if !@l && $at_least_one; + @l = modules::load_category($category, $wait_message, 'force') if !@l && $b_at_least_one; } if (my @err = grep { $_ } map { $_->{error} } @l) { $in->ask_warn('', join("\n", @err)); } - return @l if $auto && (@l || !$at_least_one); + return @l if $b_auto && (@l || !$b_at_least_one); @l = map { $_->{description} } @l; - if ($at_least_one && !@l) { + if ($b_at_least_one && !@l) { @l = load_category__prompt($in, $category) or return; } diff --git a/perl-install/mouse.pm b/perl-install/mouse.pm index 213a1e60c..6a2cbe87a 100644 --- a/perl-install/mouse.pm +++ b/perl-install/mouse.pm @@ -332,7 +332,7 @@ sub detect() { } sub set_xfree_conf { - my ($mouse, $xfree_conf, $keep_auxmouse_unchanged) = @_; + my ($mouse, $xfree_conf, $b_keep_auxmouse_unchanged) = @_; my @mice = map { { @@ -343,7 +343,7 @@ sub set_xfree_conf { }; } ($mouse, if_($mouse->{auxmouse}, $mouse->{auxmouse})); - if (!$mouse->{auxmouse} && $keep_auxmouse_unchanged) { + if (!$mouse->{auxmouse} && $b_keep_auxmouse_unchanged) { my (undef, @l) = $xfree_conf->get_mice; push @mice, @l; } @@ -390,14 +390,14 @@ sub various_xfree_conf { #- $mouse->{MOUSETYPE} : type of the mouse : string : ex "ps/2" #- $mouse->{XEMU3} : emulate 3rd button : string : 'yes' or 'no' sub write_conf { - my ($in, $mouse, $keep_auxmouse_unchanged) = @_; + my ($in, $mouse, $b_keep_auxmouse_unchanged) = @_; &write($in, $mouse); modules::write_conf('') if $mouse->{device} eq "usbmouse" && !$::testing; require Xconfig::xfree; my $xfree_conf = Xconfig::xfree->read; - set_xfree_conf($mouse, $xfree_conf, $keep_auxmouse_unchanged); + set_xfree_conf($mouse, $xfree_conf, $b_keep_auxmouse_unchanged); $xfree_conf->write; } @@ -437,7 +437,7 @@ sub test_mouse_standalone { } sub test_mouse { - my ($mouse, $_w, $darea, $width, $height, $x_protocol_changed) = @_; + my ($mouse, $_w, $darea, $width, $height, $b_x_protocol_changed) = @_; # $darea->realize; IS IT REALLY NEEDED? generates a Gtk-CRITICAL when run.. require ugtk2; @@ -470,7 +470,7 @@ sub test_mouse { $draw_pixbuf->($image, 0, 0, 210, $height || 200); if ($::isInstall) { $draw_text->(N("Please test the mouse"), $height - 120); - if ($x_protocol_changed && $mouse->{nbuttons} > 3 && member($mouse->{XMOUSETYPE}, 'IMPS/2', 'ExplorerPS/2')) { + if ($b_x_protocol_changed && $mouse->{nbuttons} > 3 && member($mouse->{XMOUSETYPE}, 'IMPS/2', 'ExplorerPS/2')) { $draw_text->(N("To activate the mouse,"), $height - 105); $draw_text->(N("MOVE YOUR WHEEL!"), $height - 90); } diff --git a/perl-install/network/drakfirewall.pm b/perl-install/network/drakfirewall.pm index 8d6e7005a..152007105 100644 --- a/perl-install/network/drakfirewall.pm +++ b/perl-install/network/drakfirewall.pm @@ -119,13 +119,13 @@ sub set_ports { } sub get_conf { - my ($in, $disabled, $ports) = @_; + my ($in, $disabled, $o_ports) = @_; my $possible_servers = default_from_pkgs($in); $_->{hide} = 0 foreach @$possible_servers; - if ($ports) { - $disabled, from_ports($ports); + if ($o_ports) { + $disabled, from_ports($o_ports); } elsif (my $shorewall = network::shorewall::read()) { $shorewall->{disabled}, from_ports(\$shorewall->{ports}); } else { diff --git a/perl-install/network/ethernet.pm b/perl-install/network/ethernet.pm index b74f90fc8..f2b849144 100644 --- a/perl-install/network/ethernet.pm +++ b/perl-install/network/ethernet.pm @@ -192,7 +192,7 @@ want to use the default host name."), if_($::expert, { label => N("Host name"), val => \$netc->{HOSTNAME} }), ], complete => sub { - if ($netc->{ZEROCONF_HOSTNAME} and $netc->{ZEROCONF_HOSTNAME} =~ /\./) { + if ($netc->{ZEROCONF_HOSTNAME} && $netc->{ZEROCONF_HOSTNAME} =~ /\./) { $in->ask_warn('', N("Zeroconf host name must not contain a .")); return 1; } diff --git a/perl-install/network/isdn.pm b/perl-install/network/isdn.pm index 147fb0970..8834d7ba6 100644 --- a/perl-install/network/isdn.pm +++ b/perl-install/network/isdn.pm @@ -15,7 +15,7 @@ use MDK::Common::File; @EXPORT = qw(isdn_write_config isdn_write_config_backend get_info_providers_backend isdn_ask_info isdn_ask_protocol isdn_ask isdn_detect isdn_detect_backend isdn_get_list isdn_get_info); sub configure { - my ($netcnx, $netc, $isdn) = @_; + my ($netcnx, $netc, $_isdn) = @_; isdn_step_1: defined $netc->{autodetect}{isdn}{id} and goto intern_pci; # $::isInstall and $in->set_help('configureNetworkISDN'); @@ -72,8 +72,8 @@ sub isdn_write_config { } sub isdn_write_config_backend { - my ($isdn, $netc, $netcnx) = @_; - defined $netcnx and $netc->{isdntype} = $netcnx->{type}; + my ($isdn, $netc, $o_netcnx) = @_; + defined $o_netcnx and $netc->{isdntype} = $o_netcnx->{type}; if ($isdn->{is_light}) { modules::mergein_conf("$prefix/etc/modules.conf"); if ($isdn->{id}) { @@ -214,7 +214,7 @@ sub get_info_providers_backend { chop; my ($name_, $phone, $real, $dns1, $dns2) = split '=>'; if ($name eq $name_) { - @{$isdn}{qw(user_name phone_out DOMAINNAME2 dnsServer3 dnsServer2)} = + @$isdn{qw(user_name phone_out DOMAINNAME2 dnsServer3 dnsServer2)} = ((split(/\|/, $name_))[2], $phone, $real, $dns1, $dns2); } } diff --git a/perl-install/network/modem.pm b/perl-install/network/modem.pm index 82461dea9..318635441 100644 --- a/perl-install/network/modem.pm +++ b/perl-install/network/modem.pm @@ -22,7 +22,7 @@ sub configure { /^DNS=(.*)$/ and ($modem->{dns1}, $modem->{dns2}) = split(',', $1); } foreach (cat_("/etc/sysconfig/network-scripts/chat-ppp0")) { - /.*ATDT(\d*).*/ and $modem->{phone} = $1; + /.*ATDT(\d*)/ and $modem->{phone} = $1; } foreach (cat_("/etc/sysconfig/network-scripts/ifcfg-ppp0")) { /NAME=(['"]?)(.*)\1/ and $modem->{login} = $2; @@ -215,15 +215,15 @@ END } sub ppp_choose { - my ($in, $netc, $modem, $mouse) = @_; - $mouse ||= {}; + my ($in, $netc, $modem, $o_mouse) = @_; + $o_mouse ||= {}; - $mouse->{device} ||= readlink "$::prefix/dev/mouse"; + $o_mouse->{device} ||= readlink "$::prefix/dev/mouse"; $modem->{device} ||= $in->ask_from_listf_raw({ messsages => N("Please choose which serial port your modem is connected to."), interactive_help_id => 'selectSerialPort', }, \&mouse::serial_port2text, - [ grep { $_ ne $mouse->{device} } (if_(-e '/dev/modem', '/dev/modem'), mouse::serial_ports()) ]) || return; + [ grep { $_ ne $o_mouse->{device} } (if_(-e '/dev/modem', '/dev/modem'), mouse::serial_ports()) ]) || return; my @cnx_list; my $secret = network::tools::read_secret_backend(); @@ -250,7 +250,7 @@ sub ppp_choose { #- TODO: add choice between hcf/hsf/lt ? sub winmodemConfigure { my ($in, $netcnx, $mouse, $netc, $intf) = @_; - my %relocations = ( ltmodem => $in->do_pkgs->check_kernel_module_packages('ltmodem') ); + my %relocations = (ltmodem => $in->do_pkgs->check_kernel_module_packages('ltmodem')); my $type; foreach (keys %{$netc->{autodetect}{winmodem}}) { diff --git a/perl-install/network/netconnect.pm b/perl-install/network/netconnect.pm index 993af1ca4..8ef994583 100644 --- a/perl-install/network/netconnect.pm +++ b/perl-install/network/netconnect.pm @@ -99,7 +99,7 @@ sub pre_func { $::Wizard_splash = 0; } else { #- for i18n : %s is the type of connection of the list: (modem, isdn, adsl, cable, local network); - $in->ask_okcancel(N("Network Configuration Wizard"), N("\n\n\nWe are now going to configure the %s connection.\n\n\nPress OK to continue.", translate($_[0])), 1); + $in->ask_okcancel(N("Network Configuration Wizard"), N("\n\n\nWe are now going to configure the %s connection.\n\n\nPress OK to continue.", translate($text)), 1); } undef $::Wizard_no_previous; } @@ -127,10 +127,10 @@ sub main { my $direct_net_install; if ($first_time && $::isInstall && ($in->{method} eq "ftp" || $in->{method} eq "http" || $in->{method} eq "nfs")) { - (!($::expert || $noauto) or $in->ask_okcancel(N("Network Configuration"), - N("Because you are doing a network installation, your network is already configured. + !$::expert && !$noauto || $in->ask_okcancel(N("Network Configuration"), + N("Because you are doing a network installation, your network is already configured. Click on Ok to keep your configuration, or cancel to reconfigure your Internet & Network connection. -"), 1)) and do { +"), 1) and do { $netcnx->{type} = 'lan'; output_with_perm("$prefix$connect_file", 0755, qq( @@ -233,8 +233,8 @@ If you don't want to use the auto detection, deselect the checkbox. network::configureNetwork2($in, $prefix, $netc, $intf); my $network_configured = 1; - eval { if ($netconnect::need_restart_network && $::isStandalone and (!$::expert or $in->ask_yesorno(N("Network configuration"), - N("The network needs to be restarted. Do you want to restart it ?"), 1))) { + eval { if ($netconnect::need_restart_network && $::isStandalone && (!$::expert || $in->ask_yesorno(N("Network configuration"), + N("The network needs to be restarted. Do you want to restart it ?"), 1))) { if (!run_program::rooted($prefix, "/etc/rc.d/init.d/network restart")) { $success = 0; $in->ask_okcancel(N("Network Configuration"), diff --git a/perl-install/network/network.pm b/perl-install/network/network.pm index b5708fe53..df209fb35 100644 --- a/perl-install/network/network.pm +++ b/perl-install/network/network.pm @@ -55,13 +55,13 @@ sub read_interface_conf { sub read_dhcpd_conf { my ($file) = @_; $file ||= "$::prefix/etc/dhcpd.conf"; - { option_routers => [ cat_($file) =~ /^\s*option routers\s+(\S+)\;/mg ], - subnet_mask => [ if_(cat_($file) =~ /^\s*option subnet-mask\s+(.*)\;/mg, split(' ', $1)) ], - domain_name => [ if_(cat_($file) =~ /^\s*option domain-name\s+\"(.*)\"\;/mg, split(' ', $1)) ], - domain_name_servers => [ if_(cat_($file) =~ /^\s*option domain-name-servers\s+(.*)\;/m, split(' ', $1)) ], - dynamic_bootp => [ if_(cat_($file) =~ /^\s*range dynamic-bootp\s+\S+\.(\d+)\s+\S+\.(\d+)\s*\;/m, split(' ', $1)) ], - default_lease_time => [ if_(cat_($file) =~ /^\s*default-lease-time\s+(.*)\;/m, split(' ', $1)) ], - max_lease_time => [ if_(cat_($file) =~ /^\s*max-lease-time\s+(.*)\;/m, split(' ', $1)) ] }; + { option_routers => [ cat_($file) =~ /^\s*option routers\s+(\S+);/mg ], + subnet_mask => [ if_(cat_($file) =~ /^\s*option subnet-mask\s+(.*);/mg, split(' ', $1)) ], + domain_name => [ if_(cat_($file) =~ /^\s*option domain-name\s+\"(.*)\";/mg, split(' ', $1)) ], + domain_name_servers => [ if_(cat_($file) =~ /^\s*option domain-name-servers\s+(.*);/m, split(' ', $1)) ], + dynamic_bootp => [ if_(cat_($file) =~ /^\s*range dynamic-bootp\s+\S+\.(\d+)\s+\S+\.(\d+)\s*;/m, split(' ', $1)) ], + default_lease_time => [ if_(cat_($file) =~ /^\s*default-lease-time\s+(.*);/m, split(' ', $1)) ], + max_lease_time => [ if_(cat_($file) =~ /^\s*max-lease-time\s+(.*);/m, split(' ', $1)) ] }; } sub read_tmdns_conf { @@ -153,7 +153,7 @@ sub write_resolv_conf { } sub write_interface_conf { - my ($file, $intf, $netc, $prefix) = @_; + my ($file, $intf, $_netc, $prefix) = @_; if ($intf->{HWADDR} && -e "$prefix/sbin/ip") { $intf->{HWADDR} = undef; @@ -375,11 +375,11 @@ notation (for example, 1.2.3.4)."); return 0 if !$intf->{WIRELESS_FREQ}; if ($intf->{WIRELESS_FREQ} !~ /[0-9.]*[kGM]/) { - $in->ask_warn('', N("Freq should have the suffix k, M or G (for example, \"2.46G\" for 2.46 GHz frequency), or add enough \'0\' (zeroes).")); + $in->ask_warn('', N("Freq should have the suffix k, M or G (for example, \"2.46G\" for 2.46 GHz frequency), or add enough '0' (zeroes).")); return (1,6); } if ($intf->{WIRELESS_RATE} !~ /[0-9.]*[kGM]/) { - $in->ask_warn('', N("Rate should have the suffix k, M or G (for example, \"11M\" for 11M), or add enough \'0\' (zeroes).")); + $in->ask_warn('', N("Rate should have the suffix k, M or G (for example, \"11M\" for 11M), or add enough '0' (zeroes).")); return (1,8); } }, @@ -419,15 +419,15 @@ want to use the default host name."), ), ], complete => sub { - if ($netc->{dnsServer} and !is_ip($netc->{dnsServer})) { + if ($netc->{dnsServer} && !is_ip($netc->{dnsServer})) { $in->ask_warn('', N("DNS server address should be in format 1.2.3.4")); return 1; } - if ($netc->{GATEWAY} and !is_ip($netc->{GATEWAY})) { + if ($netc->{GATEWAY} && !is_ip($netc->{GATEWAY})) { $in->ask_warn('', N("Gateway address should be in format 1.2.3.4")); return 1; } - if ($netc->{ZEROCONF_HOSTNAME} and $netc->{ZEROCONF_HOSTNAME} =~ /\./) { + if ($netc->{ZEROCONF_HOSTNAME} && $netc->{ZEROCONF_HOSTNAME} =~ /\./) { $in->ask_warn('', N("Zeroconf host name must not contain a .")); return 1; } @@ -437,7 +437,7 @@ want to use the default host name."), } sub miscellaneous_choose { - my ($in, $u, $clicked, $_no_track_net) = @_; + my ($in, $u, $b_clicked) = @_; # $in->set_help('configureNetworkProxy') if $::isInstall; $in->ask_from('', @@ -450,7 +450,7 @@ sub miscellaneous_choose { $u->{ftp_proxy} =~ m,^($|ftp://|http://), or $in->ask_warn('', N("URL should begin with 'ftp:' or 'http:'")), return 1,1; 0; } - ) or return if $::expert || $clicked; + ) or return if $::expert || $b_clicked; 1; } diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm index 5279552f9..a421c603c 100644 --- a/perl-install/partition_table.pm +++ b/perl-install/partition_table.pm @@ -731,7 +731,7 @@ The only solution is to move your primary partitions to have the hole next to th } sub add { - my ($hd, $part, $primaryOrExtended, $forceNoAdjust) = @_; + my ($hd, $part, $b_primaryOrExtended, $b_forceNoAdjust) = @_; get_normal_parts($hd) >= ($hd->{device} =~ /^rd/ ? 7 : $hd->{device} =~ /^(sd|ida|cciss|ataraid)/ ? 15 : 63) and cdie "maximum number of partitions handled by linux reached"; @@ -739,18 +739,18 @@ sub add { $part->{isFormatted} = 0; $part->{rootDevice} = $hd->{device}; $part->{start} ||= 1 if arch() !~ /^sparc/; #- starting at sector 0 is not allowed - adjustStartAndEnd($hd, $part) unless $forceNoAdjust; + adjustStartAndEnd($hd, $part) unless $b_forceNoAdjust; my $nb_primaries = $hd->{device} =~ /^rd/ ? 3 : 1; if (arch() =~ /^sparc|ppc/ || - $primaryOrExtended eq 'Primary' || - $primaryOrExtended !~ /Extended/ && @{$hd->{primary}{normal} || []} < $nb_primaries) { + $b_primaryOrExtended eq 'Primary' || + $b_primaryOrExtended !~ /Extended/ && @{$hd->{primary}{normal} || []} < $nb_primaries) { eval { add_primary($hd, $part) }; goto success if !$@; } if ($hd->hasExtended) { - eval { add_extended($hd, $part, $primaryOrExtended) }; + eval { add_extended($hd, $part, $b_primaryOrExtended) }; goto success if !$@; } { @@ -779,7 +779,7 @@ sub next_start { } sub load { - my ($hd, $file, $force) = @_; + my ($hd, $file, $b_force) = @_; local *F; open F, $file or die \N("Error reading file %s", $file); @@ -795,12 +795,12 @@ sub load { my %h; @h{@fields2save} = @$h; - $h{totalsectors} == $hd->{totalsectors} or $force or cdie "bad totalsectors"; + $h{totalsectors} == $hd->{totalsectors} or $b_force or cdie "bad totalsectors"; #- unsure we don't modify totalsectors local $hd->{totalsectors}; - @{$hd}{@fields2save} = @$h; + @$hd{@fields2save} = @$h; delete @$_{qw(isMounted isFormatted notFormatted toFormat toFormatUnsure)} foreach get_normal_parts($hd); $hd->{isDirty} = $hd->{needKernelReread} = 1; @@ -808,7 +808,7 @@ sub load { sub save { my ($hd, $file) = @_; - my @h = @{$hd}{@fields2save}; + my @h = @$hd{@fields2save}; require Data::Dumper; eval { output($file, Data::Dumper->Dump([\@h], ['$h']), "\0") } or die \N("Error writing to file %s", $file); diff --git a/perl-install/partition_table/dos.pm b/perl-install/partition_table/dos.pm index e448ad841..cb687e6b0 100644 --- a/perl-install/partition_table/dos.pm +++ b/perl-install/partition_table/dos.pm @@ -35,7 +35,8 @@ sub compute_CHS($$) { } sub CHS2rawCHS { - my ($hd, $c, $h, $s) = @_; + my ($hd, $chs) = @_; + my ($c, $h, $s) = @$chs; if ($c > 1023) { #- no way to have a #cylinder >= 1024 $c = 1023; @@ -51,7 +52,7 @@ sub sector2CHS { my ($s, $h); ($start, $s) = divide($start, $hd->{geom}{sectors}); ($start, $h) = divide($start, $hd->{geom}{heads}); - ($start, $h, $s + 1); + [ $start, $h, $s + 1 ]; } sub read { diff --git a/perl-install/partition_table/lvm_PV.pm b/perl-install/partition_table/lvm_PV.pm index c2ff30fb6..6311a7da5 100644 --- a/perl-install/partition_table/lvm_PV.pm +++ b/perl-install/partition_table/lvm_PV.pm @@ -1,4 +1,4 @@ -package partition_table::lvm; # $Id$ +package partition_table::lvm_PV; # $Id$ use diagnostics; use strict; diff --git a/perl-install/partition_table/mac.pm b/perl-install/partition_table/mac.pm index 942136bf1..004baffbe 100644 --- a/perl-install/partition_table/mac.pm +++ b/perl-install/partition_table/mac.pm @@ -103,7 +103,7 @@ sub read($$) { my $F = partition_table::raw::openit($hd) or die "failed to open device"; c::lseek_sector(fileno($F), $sector, 0) or die "reading of partition in sector $sector failed"; - sysread $F, $tmp, psizeof($bz_format) or die "error while reading bz \(Block Zero\) in sector $sector"; + sysread $F, $tmp, psizeof($bz_format) or die "error while reading bz (Block Zero) in sector $sector"; my %info; @info{@$bz_fields} = unpack $bz_format, $tmp; foreach (1 .. $info{bzDrvrCnt}) { diff --git a/perl-install/partition_table/raw.pm b/perl-install/partition_table/raw.pm index 9d7fb5688..39a1ff026 100644 --- a/perl-install/partition_table/raw.pm +++ b/perl-install/partition_table/raw.pm @@ -109,8 +109,8 @@ sub get_geometry($) { } sub openit { - my ($hd, $mode) = @_; - my $F; sysopen($F, $hd->{file}, $mode || 0) and $F; + my ($hd, $o_mode) = @_; + my $F; sysopen($F, $hd->{file}, $o_mode || 0) and $F; } # cause kernel to re-read partition table diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index 075d6dfb5..3b3631e93 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -245,31 +245,31 @@ sub packageCallbackChoices { #- selection, unselection of package. sub selectPackage { - my ($packages, $pkg, $base, $otherOnly) = @_; + my ($packages, $pkg, $b_base, $o_otherOnly) = @_; - #- select package and dependancies, otherOnly may be a reference + #- select package and dependancies, o_otherOnly may be a reference #- to a hash to indicate package that will strictly be selected #- when value is true, may be selected when value is false (this #- is only used for unselection, not selection) my $state = $packages->{state} ||= {}; $state->{selected} = {}; $packages->resolve_requested($packages->{rpmdb}, $state, packageRequest($packages, $pkg) || {}, - no_flag_update => $otherOnly, keep_state => $otherOnly, + no_flag_update => $o_otherOnly, keep_state => $o_otherOnly, callback_choices => \&packageCallbackChoices); - if ($base || $otherOnly) { + if ($b_base || $o_otherOnly) { foreach (keys %{$state->{selected}}) { my $p = $packages->{depslist}[$_] or next; #- if base is activated, propagate base flag to all selection. - $base and $p->set_flag_base; - $otherOnly and $otherOnly->{$_} = $state->{selected}{$_}; + $b_base and $p->set_flag_base; + $o_otherOnly and $o_otherOnly->{$_} = $state->{selected}{$_}; } } 1; } sub unselectPackage($$;$) { - my ($packages, $pkg, $otherOnly) = @_; + my ($packages, $pkg, $o_otherOnly) = @_; #- base package are not unselectable, #- and already unselected package are no more unselectable. @@ -277,13 +277,13 @@ sub unselectPackage($$;$) { $pkg->flag_selected or return; my $state = $packages->{state} ||= {}; - $state->{unselected} = $otherOnly || {}; - $packages->resolve_unrequested($packages->{rpmdb}, $state, { $pkg->id => undef }, no_flag_update => $otherOnly); + $state->{unselected} = $o_otherOnly || {}; + $packages->resolve_unrequested($packages->{rpmdb}, $state, { $pkg->id => undef }, no_flag_update => $o_otherOnly); 1; } sub togglePackageSelection($$;$) { - my ($packages, $pkg, $otherOnly) = @_; - $pkg->flag_selected ? unselectPackage($packages, $pkg, $otherOnly) : selectPackage($packages, $pkg, 0, $otherOnly); + my ($packages, $pkg, $o_otherOnly) = @_; + $pkg->flag_selected ? unselectPackage($packages, $pkg, $o_otherOnly) : selectPackage($packages, $pkg, 0, $o_otherOnly); } sub setPackageSelection($$$) { my ($packages, $pkg, $value) = @_; @@ -354,7 +354,7 @@ sub psUsingHdlists { my $packages = new URPM; #- add additional fields used by DrakX. - @{$packages}{qw(count mediums)} = (0, {}); + @$packages{qw(count mediums)} = (0, {}); #- parse hdlists file. my $medium = 1; @@ -371,14 +371,14 @@ sub psUsingHdlists { ++$medium; } - log::l("psUsingHdlists read " . scalar @{$packages->{depslist}} . - " headers on " . scalar keys(%{$packages->{mediums}}) . " hdlists"); + log::l("psUsingHdlists read " . int(@{$packages->{depslist}}) . + " headers on " . int(keys %{$packages->{mediums}}) . " hdlists"); $packages; } sub psUsingHdlist { - my ($prefix, $method, $packages, $hdlist, $medium, $rpmsdir, $descr, $selected, $fhdlist) = @_; + my ($prefix, $method, $packages, $hdlist, $medium, $rpmsdir, $descr, $selected, $o_fhdlist) = @_; my $fakemedium = "$descr ($method$medium)"; log::l("trying to read $hdlist for medium $medium"); @@ -399,13 +399,13 @@ sub psUsingHdlist { #- for getting header of package during installation or after by urpmi. my $newf = "$prefix/var/lib/urpmi/hdlist.$fakemedium.cz" . ($hdlist =~ /\.cz2/ && "2"); -e $newf and do { unlink $newf or die "cannot remove $newf: $!" }; - install_any::getAndSaveFile($fhdlist || "Mandrake/base/$hdlist", $newf) or do { unlink $newf; die "no $hdlist found" }; + install_any::getAndSaveFile($o_fhdlist || "Mandrake/base/$hdlist", $newf) or do { unlink $newf; die "no $hdlist found" }; $m->{hdlist_size} = -s $newf; #- keep track of size for post-check. symlinkf $newf, "/tmp/$hdlist"; - #- if $fhdlist is defined, this is preferable not to try to find the associated synthesis. + #- if $o_fhdlist is defined, this is preferable not to try to find the associated synthesis. my $newsf = "$prefix/var/lib/urpmi/synthesis.hdlist.$fakemedium.cz" . ($hdlist =~ /\.cz2/ && "2"); - unless ($fhdlist) { + unless ($o_fhdlist) { #- copy existing synthesis file too. install_any::getAndSaveFile("Mandrake/base/synthesis.$hdlist", $newsf); $m->{synthesis_hdlist_size} = -s $newsf; #- keep track of size for post-check. @@ -430,12 +430,12 @@ sub psUsingHdlist { } else { delete $packages->{mediums}{$medium}; unlink $newf; - $fhdlist or unlink $newsf; + $o_fhdlist or unlink $newsf; die "fatal: no hdlist nor synthesis to read for $fakemedium"; } $m->{start} > $m->{end} and do { delete $packages->{mediums}{$medium}; unlink $newf; - $fhdlist or unlink $newsf; + $o_fhdlist or unlink $newsf; die "fatal: nothing read in hdlist or synthesis for $fakemedium" }; log::l("read " . ($m->{end} - $m->{start} + 1) . " packages in $hdlist"); } @@ -755,9 +755,9 @@ sub openInstallLog { } sub rpmDbOpen { - my ($prefix, $rebuild_needed) = @_; + my ($prefix, $o_rebuild_needed) = @_; - if ($rebuild_needed) { + if ($o_rebuild_needed) { if (my $pid = fork()) { waitpid $pid, 0; $? & 0xff00 and die "rebuilding of rpm database failed"; @@ -812,10 +812,10 @@ sub selectPackagesAlreadyInstalled { } sub selectPackagesToUpgrade { - my ($packages, $_prefix, $medium) = @_; + my ($packages, $_prefix, $o_medium) = @_; #- check before that if medium is given, it should be valid. - $medium && (! defined $medium->{start} || ! defined $medium->{end}) and return; + $o_medium && (! defined $o_medium->{start} || ! defined $o_medium->{end}) and return; log::l("selecting packages to upgrade"); @@ -825,7 +825,7 @@ sub selectPackagesToUpgrade { my %selection; $packages->request_packages_to_upgrade($packages->{rpmdb}, $state, \%selection, requested => undef, - $medium ? (start => $medium->{start}, end => $medium->{end}) : (), + $o_medium ? (start => $o_medium->{start}, end => $o_medium->{end}) : (), ); log::l("resolving dependencies..."); $packages->resolve_requested($packages->{rpmdb}, $state, \%selection, @@ -1011,7 +1011,7 @@ sub install($$$;$$) { log::l("opened rpm database for retry transaction of 1 package only"); $trans->add($retry_pkg, $isUpgrade && allowedToUpgrade($retry_pkg->name)); } else { - log::l("opened rpm database for transaction of " . scalar @transToInstall . + log::l("opened rpm database for transaction of " . int(@transToInstall) . " new packages, still $nb after that to do"); $trans->add($_, $isUpgrade && allowedToUpgrade($_->name)) foreach @transToInstall; @@ -1076,7 +1076,7 @@ sub install($$$;$$) { #- if we are using a retry mode, this means we have to split the transaction with only #- one package for each real transaction. - unless ($retry_pkg) { + if (!$retry_pkg) { my @badPackages; foreach (@transToInstall) { if (!$_->flag_installed && packageMedium($packages, $_)->{selected} && !exists($ignoreBadPkg{$_->name})) { diff --git a/perl-install/resize_fat/boot_sector.pm b/perl-install/resize_fat/boot_sector.pm index c87328637..ffb1b1f34 100644 --- a/perl-install/resize_fat/boot_sector.pm +++ b/perl-install/resize_fat/boot_sector.pm @@ -51,7 +51,7 @@ sub read($) { my ($fs) = @_; my $boot = eval { resize_fat::io::read($fs, 0, $SECTORSIZE) }; $@ and die "reading boot sector failed on device $fs->{fs_name}"; - @{$fs}{@fields} = unpack $format, $boot; + @$fs{@fields} = unpack $format, $boot; $fs->{nb_sectors} = $fs->{small_nb_sectors} || $fs->{big_nb_sectors}; $fs->{cluster_size} = $fs->{cluster_size_in_sectors} * $fs->{sector_size}; @@ -98,7 +98,7 @@ sub read($) { sub write($) { my ($fs) = @_; - my $boot = pack($format, @{$fs}{@fields}); + my $boot = pack($format, @$fs{@fields}); eval { resize_fat::io::write($fs, 0, $SECTORSIZE, $boot) }; $@ and die "writing the boot sector failed on device $fs->{fs_name}"; diff --git a/perl-install/resize_fat/directory.pm b/perl-install/resize_fat/directory.pm index 55bae687f..a742d7c26 100644 --- a/perl-install/resize_fat/directory.pm +++ b/perl-install/resize_fat/directory.pm @@ -41,10 +41,10 @@ sub traverse($$$) { #- empty entry means end of directory $$raw =~ /^\0*$/ and return $directory; - my $entry; @{$entry}{@fields} = unpack $format, $$raw; + my $entry; @$entry{@fields} = unpack $format, $$raw; &$f($curr_dir_name, $entry) - and $$raw = pack $format, @{$entry}{@fields}; + and $$raw = pack $format, @$entry{@fields}; } $directory; } diff --git a/perl-install/scanner.pm b/perl-install/scanner.pm index 7f4b5401f..cab0f344e 100755 --- a/perl-install/scanner.pm +++ b/perl-install/scanner.pm @@ -51,11 +51,11 @@ sub confScanner { my $linetype = $1; $line = $2; next if !$line; - if (!$linetype or - ($linetype eq "USB" and ($port =~ /usb/i or $vendor)) or - ($linetype eq "PARPORT" and !$vendor and - $port =~ /(parport|pt_drv|parallel)/i) or - ($linetype eq "SCSI" and !$vendor and + if (!$linetype || + ($linetype eq "USB" && ($port =~ /usb/i || $vendor)) || + ($linetype eq "PARPORT" && !$vendor && + $port =~ /(parport|pt_drv|parallel)/i) || + ($linetype eq "SCSI" && !$vendor && $port =~ m!(/sg|scsi|/scanner)!i)) { handle_configs::set_directive(\@driverconf, $line, 1); } @@ -77,7 +77,7 @@ sub configured { local *LIST; open LIST, "LC_ALL=C scanimage -L |"; while (my $line = <LIST>) { - if ($line =~ /^\s*device\s*\`([^\`\']+)\'\s+is\s+a\s+(\S.*)$/) { + if ($line =~ /^\s*device\s*`([^`']+)'\s+is\s+a\s+(\S.*)$/) { # Extract port and description my $port = $1; my $description = $2; @@ -120,7 +120,7 @@ sub detect { $vendorid = $1; $productid = $3; } - if ($vendorid and $productid) { + if ($vendorid && $productid) { # We have vendor and product ID, look up the scanner in # the usbtable foreach my $entry (cat_("$scannerDBdir/usbtable")) { @@ -225,7 +225,7 @@ sub resolve_symlinks { my $ls = `ls -l $file`; if ($ls =~ m!\s($file)\s*\->\s*(\S+)\s*$!) { my $target = $2; - if (($target !~ m!^/!) && ($file =~ m!^(.*)/[^/]+$!)) { + if ($target !~ m!^/! && $file =~ m!^(.*)/[^/]+$!) { $target = "$1/$target"; } $file = $target; @@ -376,7 +376,7 @@ sub updateScannerDBfromSane { model => sub { unless ($name) { $name = $val; return } $name = member($mfg, keys %$sane2DB) ? - (ref $sane2DB->{$mfg}) ? $sane2DB->{$mfg}($name) : "$sane2DB->{ $mfg }|$name" : "$mfg|$name"; + ref($sane2DB->{$mfg}) ? $sane2DB->{$mfg}($name) : "$sane2DB->{ $mfg }|$name" : "$mfg|$name"; if (0 && member($name, keys %$scanner::scannerDB)) { print "#[$name] already in ScannerDB!\n"; } else { @@ -389,7 +389,7 @@ sub updateScannerDBfromSane { foreach my $line (@{$configlines{$backend}}) { $line =~ /^\s*(\S*?)LINE/; my $i = $1; - if (!$i or $intf =~ /$i/i) { + if (!$i || $intf =~ /$i/i) { $to_add .= "$line\n"; } } @@ -408,8 +408,8 @@ sub updateScannerDBfromSane { local $_; while (<$F>) { $lineno++; s/\s+$//; - /^\;/ and next; - ($cmd, $val) = /:(\S+)\s*\"([^\;]*)\"/ or next; #log::l("bad line $lineno ($_)"), next; + /^;/ and next; + ($cmd, $val) = /:(\S+)\s*\"([^;]*)\"/ or next; #log::l("bad line $lineno ($_)"), next; my $f = $fs->{$cmd}; $f ? $f->() : log::l("unknown line $lineno ($_)"); } diff --git a/perl-install/security/various.pm b/perl-install/security/various.pm index 7d63c7fdc..23b9174ef 100644 --- a/perl-install/security/various.pm +++ b/perl-install/security/various.pm @@ -6,9 +6,10 @@ use strict; use common; sub config_libsafe { + my $setting = @_ > 1; my ($prefix, $libsafe) = @_; my %t = getVarsFromSh("$prefix/etc/sysconfig/system"); - if (@_ > 1) { + if ($setting) { $t{LIBSAFE} = bool2yesno($libsafe); setVarsInSh("$prefix/etc/sysconfig/system", \%t); } @@ -16,9 +17,10 @@ sub config_libsafe { } sub config_security_user { + my $setting = @_ > 1; my ($prefix, $sec_user) = @_; my %t = getVarsFromSh("$prefix/etc/security/msec/security.conf"); - if (@_ > 1) { + if ($setting) { $t{MAIL_USER} = $sec_user; setVarsInSh("$prefix/etc/security/msec/security.conf", \%t); } diff --git a/perl-install/standalone/diskdrake b/perl-install/standalone/diskdrake index 9026e67ae..171402c22 100755 --- a/perl-install/standalone/diskdrake +++ b/perl-install/standalone/diskdrake @@ -65,7 +65,7 @@ my $in = 'interactive'->vnew('su'); if ($type eq 'fileshare') { require any; - any::fileshare_config($in); + any::fileshare_config($in, ''); $in->exit(0); } @@ -76,13 +76,13 @@ $SIG{__DIE__} = sub { my $m = chomp_($_[0]); log::l("ERROR: $m") }; fs::get_raw_hds('', $all_hds); fs::get_info_from_fstab($all_hds, ''); -fs::merge_info_from_mtab([ fsedit::get_really_all_fstab($all_hds) ], ''); +fs::merge_info_from_mtab([ fsedit::get_really_all_fstab($all_hds) ]); $all_hds->{current_fstab} = fs::fstab_to_string($all_hds, ''); if ($type eq 'hd') { require diskdrake::interactive; - diskdrake::interactive::main($in, $all_hds); + diskdrake::interactive::main($in, $all_hds, 0, '', ''); } elsif ($type eq 'removable') { require diskdrake::removable; $para =~ s|^/dev/||; @@ -94,10 +94,14 @@ if ($type eq 'hd') { my $mntpoint = detect_devices::suggest_mount_point($raw_hd); $raw_hd->{mntpoint} ||= find { !fsedit::has_mntpoint($_, $all_hds) } map { "/mnt/$mntpoint$_" } '', 2 .. 10; - my $use_supermount = 1; + my $useSupermount = 1; require security::level; require lang; - fs::set_default_options($raw_hd, 1, $use_supermount, security::level::get(), lang::fs_options(lang::read())); + fs::set_default_options($raw_hd, + is_removable => 1, + useSupermount => $useSupermount, + security => security::level::get(), + lang::fs_options(lang::read())); } diskdrake::removable::main($in, $all_hds, $raw_hd); } elsif ($type eq 'dav') { diff --git a/perl-install/standalone/draksec b/perl-install/standalone/draksec index b84279c3a..6a08e4f8b 100755 --- a/perl-install/standalone/draksec +++ b/perl-install/standalone/draksec @@ -74,11 +74,11 @@ Security Administrator: } sub new_editable_combo { - my ($string_list, $default_value) = @_; + my ($string_list, $o_default_value) = @_; my $w = new Gtk2::Combo(); $w->entry->set_editable(0); $w->set_popdown_strings(@$string_list) unless is_empty_array_ref $string_list; - $w->entry->set_text($default_value) if $default_value; + $w->entry->set_text($o_default_value) if $o_default_value; $w; } @@ -155,7 +155,7 @@ foreach ([ 'network', N("Network Options") ], [ 'system', N("System Options") ]) my $entry; my $default = $msec->get_function_default($i); if (member($default, @all_choices)) { - $values{$i} = new_editable_combo(member($default, @yesno_choices) ? \@yesno_choices : member($default, @alllocal_choices) ? \@alllocal_choices : ()); + $values{$i} = new_editable_combo(member($default, @yesno_choices) ? \@yesno_choices : if_(member($default, @alllocal_choices), \@alllocal_choices)); $entry = $values{$i}->entry; } else { $values{$i} = new Gtk2::Entry(); diff --git a/perl-install/standalone/drakupdate_fstab b/perl-install/standalone/drakupdate_fstab index 94f1a5d54..aee783cd6 100755 --- a/perl-install/standalone/drakupdate_fstab +++ b/perl-install/standalone/drakupdate_fstab @@ -79,11 +79,13 @@ sub device_name_to_entry { } sub set_options { - my ($part, $use_supermount) = @_; - my $security = security::level::get(); - my ($iocharset, $codepage) = lang::fs_options(lang::read()); + my ($part, $useSupermount) = @_; - fs::set_default_options($part, 1, $use_supermount, $security, $iocharset, $codepage); + fs::set_default_options($part, + is_removable => 1, + useSupermount => $useSupermount, + security => security::level::get(), + lang::fs_options(lang::read())); my ($options, $unknown) = fs::mount_options_unpack($part); $options->{kudzu} = 1 if !$no_flag; @@ -128,15 +130,15 @@ sub main { print STDERR "Already in fstab\n" if $::testing; return; } - my $use_supermount = 0; #- force non-supermount, supermount is too buggy - set_options($part, $use_supermount); + my $useSupermount = 0; #- force non-supermount, supermount is too buggy + set_options($part, $useSupermount); set_mount_point($part, $fstab) or return; my ($line) = fs::prepare_write_fstab([$part]); append_to_file($fstab_file, $line) if $line; if ($::auto) { - print $part->{mntpoint}, " ", $use_supermount ? 'supermount' : 'user', "\n"; + print $part->{mntpoint}, " ", $useSupermount ? 'supermount' : 'user', "\n"; } } else { if (!@$existing_fstab_entries) { diff --git a/perl-install/timezone.pm b/perl-install/timezone.pm index df8da49b2..84c4d685f 100644 --- a/perl-install/timezone.pm +++ b/perl-install/timezone.pm @@ -22,12 +22,13 @@ sub read { } sub ntp_server { + my $setting = @_ > 1; my ($prefix, $server) = @_; my $f = "$prefix/etc/ntp.conf"; -e $f or return; - if (@_ > 1) { + if ($setting) { my $added = 0; substInFile { if (/^#?\s*server\s+(\S*)/ && $1 ne '127.127.1.0') { diff --git a/perl-install/ugtk2.pm b/perl-install/ugtk2.pm index fb0c87458..7e023d74a 100644 --- a/perl-install/ugtk2.pm +++ b/perl-install/ugtk2.pm @@ -283,16 +283,15 @@ sub create_adjustment { } sub create_scrolled_window { - my ($W, $policy, $viewport_shadow) = @_; + my ($W, $o_policy, $o_viewport_shadow) = @_; my $w = Gtk2::ScrolledWindow->new(undef, undef); - $policy ||= [ 'automatic', 'automatic' ]; - $w->set_policy(@$policy); + $w->set_policy($o_policy ? @$o_policy : ('automatic', 'automatic')); if (member(ref($W), qw(Gtk2::Layout Gtk2::Text Gtk2::TextView Gtk2::TreeView))) { $w->add($W) } else { $w->add_with_viewport($W); } - $viewport_shadow and gtkset_shadow_type($w->child, $viewport_shadow); + $o_viewport_shadow and gtkset_shadow_type($w->child, $o_viewport_shadow); $W->can('set_focus_vadjustment') and $W->set_focus_vadjustment($w->get_vadjustment); $W->show; if (ref($W) eq 'Gtk2::TextView') { @@ -432,7 +431,10 @@ sub create_menu { sub create_notebook { my $n = Gtk2::Notebook->new; - add2notebook($n, splice(@_, 0, 2)) while @_; + while (@_) { + my ($title, $book) = splice(@_, 0, 2); + add2notebook($n, $title, $book); + } $n } @@ -460,10 +462,10 @@ sub create_packtable { } sub create_okcancel { - my ($w, $ok, $cancel, $spread, @other) = @_; + my ($w, $o_ok, $o_cancel, $o_spread, @other) = @_; my $wizard_buttons = $::isWizard && !$w->{pop_it}; - $cancel = $wizard_buttons ? N("<- Previous") : N("Cancel") if !defined $cancel && !defined $ok; - $ok = $wizard_buttons ? ($::Wizard_finished ? N("Finish") : N("Next ->")) : N("Ok") if !defined $ok; + my $cancel = defined $o_cancel || defined $o_ok ? $o_cancel : $wizard_buttons ? N("<- Previous") : N("Cancel"); + my $ok = defined $o_ok ? $o_ok : $wizard_buttons ? ($::Wizard_finished ? N("Finish") : N("Next ->")) : N("Ok"); my $b1 = gtksignal_connect($w->{ok} = Gtk2::Button->new($ok), clicked => $w->{ok_clicked} || sub { $w->{retval} = 1; Gtk2->main_quit }); my $b2 = $cancel && gtksignal_connect($w->{cancel} = Gtk2::Button->new($cancel), clicked => $w->{cancel_clicked} || sub { log::l("default cancel_clicked"); undef $w->{retval}; Gtk2->main_quit }); gtksignal_connect($w->{wizcancel} = Gtk2::Button->new(N("Cancel")), clicked => sub { die 'wizcancel' }) if $wizard_buttons && !$::isInstall; @@ -472,7 +474,7 @@ sub create_okcancel { my @l2 = map { gtksignal_connect(Gtk2::Button->new($_->[0]), clicked => $_->[1]) } grep { $_->[2] } @other; my @r2 = map { gtksignal_connect(Gtk2::Button->new($_->[0]), clicked => $_->[1]) } grep { !$_->[2] } @other; - my $box = create_hbox($spread || "edge"); + my $box = create_hbox($o_spread || "edge"); $box->pack_start($_, 0, 0, 1) foreach @l2; $box->pack_end($_, 0, 0, 1) foreach @r2, @l; @@ -538,10 +540,10 @@ sub gtktext_append { gtktext_insert(@_, { 'append' => 1 }) } # [ 'third', { 'font' => 'Serif 15', ... } ], # ... ]); sub gtktext_insert { - my ($textview, $t, $opts) = @_; + my ($textview, $t, %opts) = @_; my $buffer = $textview->get_buffer; if (ref($t) eq 'ARRAY') { - $opts->{append} or $buffer->set_text('', -1); + $opts{append} or $buffer->set_text('', -1); foreach my $token (@$t) { my ($iter1, $iter2); my $c = $buffer->get_char_count; @@ -560,9 +562,9 @@ sub gtktext_insert { #- the following line is needed to move the cursor to the beginning, so that if the #- textview has a scrollbar, it won't scroll to the bottom when focusing (#3633) $buffer->place_cursor(my $iter = $buffer->get_start_iter); $iter->free; - $textview->set_wrap_mode($opts->{wrap_mode} || 'word'); - $textview->set_editable($opts->{editable} || 0); - $textview->set_cursor_visible($opts->{visible} || 0); + $textview->set_wrap_mode($opts{wrap_mode} || 'word'); + $textview->set_editable($opts{editable} || 0); + $textview->set_cursor_visible($opts{visible} || 0); $textview; } @@ -638,8 +640,8 @@ sub string_size { } sub get_text_coord { - my ($text, $widget4style, $max_width, $max_height, $can_be_greater, $can_be_smaller, $centeredx, $centeredy, $wrap_char) = @_; - $wrap_char ||= ' '; + my ($text, $widget4style, $max_width, $max_height, $can_be_greater, $can_be_smaller, $centeredx, $centeredy, $o_wrap_char) = @_; + my $wrap_char = $o_wrap_char || ' '; my $idx = 0; my $real_width = 0; my $real_height = 0; @@ -846,7 +848,7 @@ sub new { $o; } sub main { - my ($o, $completed, $canceled) = @_; + my ($o, $o_completed, $o_canceled) = @_; gtkset_mousecursor_normal(); my $timeout = Gtk2->timeout_add(1000, sub { gtkset_mousecursor_normal(); 1 }); my $_b = MDK::Common::Func::before_leaving { Gtk2->timeout_remove($timeout) }; @@ -854,7 +856,7 @@ sub main { do { Gtk2->main; - } while (!$o->{destroyed} && ($o->{retval} ? $completed && !$completed->() : $canceled && !$canceled->())); + } while (!$o->{destroyed} && ($o->{retval} ? $o_completed && !$o_completed->() : $o_canceled && !$o_canceled->())); $o->destroy; $o->{retval} } |