diff options
Diffstat (limited to 'perl-install')
57 files changed, 269 insertions, 274 deletions
diff --git a/perl-install/Newt/Newt.pm b/perl-install/Newt/Newt.pm index fdf9c0232..4b7c9a995 100644 --- a/perl-install/Newt/Newt.pm +++ b/perl-install/Newt/Newt.pm @@ -7,7 +7,7 @@ use DynaLoader; use vars qw($VERSION @ISA); @ISA = qw(DynaLoader); $VERSION = '0.01'; -bootstrap Newt $VERSION; +Newt->bootstrap($VERSION); package Newt::Component; # $Id$ package Newt::Grid; # $Id$ diff --git a/perl-install/Xconfig/card.pm b/perl-install/Xconfig/card.pm index 79853c5b5..9b5b4ded7 100644 --- a/perl-install/Xconfig/card.pm +++ b/perl-install/Xconfig/card.pm @@ -137,7 +137,7 @@ sub probe() { else { internal_error() } $_->{VideoRam} = 4096 if $_->{Driver} eq 'i810'; - $_->{Options_xfree4}{UseFBDev} = undef if arch =~ /ppc/ && $_->{Driver} eq 'r128'; + $_->{Options_xfree4}{UseFBDev} = undef if arch() =~ /ppc/ && $_->{Driver} eq 'r128'; $card; } @c; @@ -532,7 +532,7 @@ sub readCardsDB { my ($file) = @_; my ($card, %cards); - my $F = common::openFileMaybeCompressed($file); + my $F = openFileMaybeCompressed($file); my ($lineno, $cmd, $val) = 0; my $fs = { diff --git a/perl-install/Xconfig/monitor.pm b/perl-install/Xconfig/monitor.pm index 135e1865f..8038818cd 100644 --- a/perl-install/Xconfig/monitor.pm +++ b/perl-install/Xconfig/monitor.pm @@ -180,7 +180,7 @@ sub readMonitorsDB { my ($file) = @_; my @monitors; - my $F = common::openFileMaybeCompressed($file); + my $F = openFileMaybeCompressed($file); local $_; my $lineno = 0; while (<$F>) { $lineno++; diff --git a/perl-install/Xconfig/parse.pm b/perl-install/Xconfig/parse.pm index aefc2742a..0099b4666 100644 --- a/perl-install/Xconfig/parse.pm +++ b/perl-install/Xconfig/parse.pm @@ -148,13 +148,6 @@ my @want_string = qw(Identifier DeviceName VendorName ModelName BoardName Driver @want_string = map { lc } @want_string; sub from_raw { - foreach my $e (@_) { - ($e->{l}, my $l) = ({}, $e->{l}); - from_raw__rec($e, $_) foreach @$l; - - delete $e->{kind}; - } - sub from_raw__rec { my ($current, $e) = @_; if ($e->{l}) { @@ -177,6 +170,13 @@ sub from_raw { } delete $e->{name}; } + + foreach my $e (@_) { + ($e->{l}, my $l) = ({}, $e->{l}); + from_raw__rec($e, $_) foreach @$l; + + delete $e->{kind}; + } } sub before_to_string { diff --git a/perl-install/Xconfig/resolution_and_depth.pm b/perl-install/Xconfig/resolution_and_depth.pm index c39704d9a..daeac5806 100644 --- a/perl-install/Xconfig/resolution_and_depth.pm +++ b/perl-install/Xconfig/resolution_and_depth.pm @@ -260,7 +260,7 @@ sub choose_gtk { $pixmap_mo, gtkpack2(new Gtk::HBox(0,0), create_packtable({ col_spacings => 5, row_spacings => 5 }, - [ $x_res_combo = new Gtk::Combo, new Gtk::Label("")], + [ $x_res_combo = new Gtk::Combo, new Gtk::Label("") ], [ $depth_combo = new Gtk::Combo, gtkadd(gtkset_shadow_type(new Gtk::Frame, 'etched_out'), $pix_colors) ], ), ), diff --git a/perl-install/Xconfig/test.pm b/perl-install/Xconfig/test.pm index 8065eaacb..f7db6e4be 100644 --- a/perl-install/Xconfig/test.pm +++ b/perl-install/Xconfig/test.pm @@ -53,7 +53,7 @@ sub test { $ENV{HOME} || $::isInstall or die q($HOME is unset, so I don't know where to put my temporary files); my $f_err = "$::prefix$ENV{HOME}/tmp/.drakx.Xoutput"; my $pid; - unless ($pid = fork) { + unless ($pid = fork()) { system("xauth add :9 . `mcookie`"); open STDERR, ">$f_err"; chroot $::prefix if $::prefix; diff --git a/perl-install/Xconfig/xfree3.pm b/perl-install/Xconfig/xfree3.pm index 9b69b3cb6..afb890d91 100644 --- a/perl-install/Xconfig/xfree3.pm +++ b/perl-install/Xconfig/xfree3.pm @@ -101,7 +101,7 @@ sub get_device_section_fields { sub default_ModeLine { my ($raw_X) = @_; - $raw_X->SUPER::default_ModeLine . our $default_ModeLine; + $raw_X->SUPER::default_ModeLine . (our $default_ModeLine); } sub new_device_sections { diff --git a/perl-install/any.pm b/perl-install/any.pm index 2b00d9534..cf72e6082 100644 --- a/perl-install/any.pm +++ b/perl-install/any.pm @@ -287,7 +287,7 @@ You can add some more or change the existing ones."), { label => N("Image"), val => \$e->{kernel_or_dev}, list => [ map { s/$prefix//; $_ } glob_("$prefix/boot/vmlinuz*") ], not_edit => 0 }, { label => N("Root"), val => \$e->{root}, list => [ map { "/dev/$_->{device}" } @$fstab ], not_edit => !$::expert }, { label => N("Append"), val => \$e->{append} }, - if_(arch !~ /ppc|ia64/, + if_(arch() !~ /ppc|ia64/, { label => N("Video mode"), val => \$e->{vga}, list => [ keys %bootloader::vga_modes ], format => sub { $bootloader::vga_modes{$_[0]} }, not_edit => !$::expert }, ), { label => N("Initrd"), val => \$e->{initrd}, list => [ map { s/$prefix//; $_ } glob_("$prefix/boot/initrd*") ], not_edit => 0 }, @@ -1022,7 +1022,7 @@ Allowing this will permit users to simply click on \"Share\" in konqueror and na N("The per-user sharing uses the group \"fileshare\". You can use userdrake to add a user in this group.") }, [])) { - if (!fork) { exec "userdrake" or c::_exit(0) } + if (!fork()) { exec "userdrake" or c::_exit(0) } } } } diff --git a/perl-install/bootloader.pm b/perl-install/bootloader.pm index 81737f4c8..3dc16deaf 100644 --- a/perl-install/bootloader.pm +++ b/perl-install/bootloader.pm @@ -565,7 +565,7 @@ sub keytable { -r "$::prefix/$f" && $f; } -sub has_profiles { to_bool(get_label("office", $b)) } +sub has_profiles { my ($b) = @_; to_bool(get_label("office", $b)) } sub set_profiles { my ($b, $want_profiles) = @_; diff --git a/perl-install/bootlook.pm b/perl-install/bootlook.pm index 9d2132577..cc9694e65 100644 --- a/perl-install/bootlook.pm +++ b/perl-install/bootlook.pm @@ -24,7 +24,7 @@ use common; use Gtk; use Gtk::Gdk::Pixbuf; use Config; -init Gtk; +Gtk->int; use POSIX; use lib qw(/usr/lib/libDrakX); use interactive; @@ -46,6 +46,7 @@ my @winm; my @usernames; parse_etc_passwd(); +my $no_bootsplash; my $x_mode = isXlaunched(); my $a_mode = -e "/etc/aurora/Monitor" ? 1 : 0; my $l_mode = isAutologin(); @@ -53,7 +54,7 @@ my %auto_mode = get_autologin(""); my $inmain = 0; my $lilogrub = chomp_(`detectloader -q`); -my $window = $::isEmbedded ? new Gtk::Plug ($::XID) : new Gtk::Window ("toplevel"); +my $window = $::isEmbedded ? new Gtk::Plug($::XID) : new Gtk::Window("toplevel"); $window->signal_connect(delete_event => sub { $::isEmbedded ? kill('USR1', $::CCPID) : Gtk->exit(0) }); $window->set_title(N("Boot Style Configuration")); $window->border_width(2); @@ -84,10 +85,10 @@ $user_combo->entry->set_text($auto_mode{autologin}) if $auto_mode{autologin}; my $desktop_combo = new Gtk::Combo; $desktop_combo->set_popdown_strings(get_wm()); $desktop_combo->entry->set_text($auto_mode{desktop}) if $auto_mode{desktop}; -my $a_c_button = new Gtk::RadioButton (N("NewStyle Categorizing Monitor")); -my $a_h_button = new Gtk::RadioButton N("NewStyle Monitor"), $a_c_button; -my $a_v_button = new Gtk::RadioButton N("Traditional Monitor"), $a_c_button; -my $a_g_button = new Gtk::RadioButton N("Traditional Gtk+ Monitor"),$a_c_button; +my $a_c_button = new Gtk::RadioButton(N("NewStyle Categorizing Monitor")); +my $a_h_button = new Gtk::RadioButton(N("NewStyle Monitor"), $a_c_button); +my $a_v_button = new Gtk::RadioButton(N("Traditional Monitor"), $a_c_button); +my $a_g_button = new Gtk::RadioButton(N("Traditional Gtk+ Monitor"),$a_c_button); my $a_button = new Gtk::CheckButton(N("Launch Aurora at boot time")); my $a_box = new Gtk::VBox(0, 0); my $x_box = new Gtk::VBox(0, 0); @@ -133,7 +134,7 @@ foreach (keys(%combo)) { $combo{'thms'}->set_popdown_strings(@thms); $combo{'lilo'}->set_popdown_strings(@lilo_thms); $combo{'boot'}->set_popdown_strings(@boot_thms) if !$no_bootsplash; -my $lilo_pixbuf; +my ($lilo_pixbuf, $boot_pixmap); my $lilo_pic = gtkpng($themes{'def_thmb'}); my $boot_pixbuf; @@ -167,7 +168,7 @@ $combo{'lilo'}->entry->signal_connect(changed => sub { $no_bootsplash == 0 and $combo{'boot'}->entry->signal_connect( changed => sub { - local $img_file = $themes{'path'}.$combo{'boot'}->entry->get_text().$themes{'boot'}{'path'}."bootsplash-$cur_res.jpg"; + my $img_file = $themes{'path'}.$combo{'boot'}->entry->get_text().$themes{'boot'}{'path'}."bootsplash-$cur_res.jpg"; undef($boot_pixmap); $boot_pixmap = gtkcreate_png_pixbuf( $img_file); $boot_pixmap = $boot_pixmap->scale_simple(155,116,0); @@ -197,7 +198,7 @@ sub { } #bootsplash install if (-f $themes{'path'} . $combo{'boot'}->entry->get_text() . $themes{'boot'}{'path'} . "bootsplash-$cur_res.jpg") { - $bootsplash_cont = "# -*- Mode: shell-script -*- + my $bootsplash_cont = "# -*- Mode: shell-script -*- # Specify here if you want add the splash logo to initrd when # generating an initrd. You can specify : # @@ -257,12 +258,12 @@ Launch \"lilo\" as root in command line to complete LiLo theme installation.")); gtkadd($window, gtkpack__(my $global_vbox = new Gtk::VBox(0,0), - gtkadd(new Gtk::Frame ("$disp_mode"), + gtkadd(new Gtk::Frame("$disp_mode"), # gtkpack__(new Gtk::VBox(0,0), (gtkpack_(gtkset_border_width(new Gtk::HBox(0, 0),5), 1, N("You are currently using %s as your boot manager. Click on Configure to launch the setup wizard.", $lilogrub), - 0, gtksignal_connect(new Gtk::Button (N("Configure")), clicked => $::lilo_choice), + 0, gtksignal_connect(new Gtk::Button(N("Configure")), clicked => $::lilo_choice), )), # "" #we need some place under the button -- replaced by gtkset_border_width( for the moment # ) @@ -317,16 +318,16 @@ Click on Configure to launch the setup wizard.", $lilogrub), # ) # ), # X - gtkadd(new Gtk::Frame (N("System mode")), + gtkadd(new Gtk::Frame(N("System mode")), gtkpack__(new Gtk::VBox(0, 5), - gtksignal_connect(gtkset_active(new Gtk::CheckButton (N("Launch the graphical environment when your system starts")), $x_mode), clicked => sub { + gtksignal_connect(gtkset_active(new Gtk::CheckButton(N("Launch the graphical environment when your system starts")), $x_mode), clicked => sub { $x_box->set_sensitive(!$x_mode); $x_mode = !$x_mode; }), gtkpack__(gtkset_sensitive ($x_box, $x_mode), - gtkset_active($x_no_button = new Gtk::RadioButton (N("No, I don't want autologin")), !$l_mode), + gtkset_active(my $x_no_button = new Gtk::RadioButton(N("No, I don't want autologin")), !$l_mode), gtkpack__(new Gtk::HBox(0, 10), - gtkset_active($x_yes_button = new Gtk::RadioButton((N("Yes, I want autologin with this (user, desktop)")), $x_no_button), $l_mode), + gtkset_active(my $x_yes_button = new Gtk::RadioButton((N("Yes, I want autologin with this (user, desktop)")), $x_no_button), $l_mode), gtkpack__(new Gtk::VBox(0, 10), $user_combo, $desktop_combo @@ -335,7 +336,7 @@ Click on Configure to launch the setup wizard.", $lilogrub), ) ) ), - gtkadd (gtkset_layout(new Gtk::HButtonBox, -end), + gtkadd (gtkset_layout(new Gtk::HButtonBox, 'end'), gtksignal_connect(new Gtk::Button(N("OK")), clicked => sub { updateInit(); updateAutologin(); updateAurora(); $::isEmbedded ? kill('USR1',$::CCPID) : Gtk->exit(0) }), gtksignal_connect(new Gtk::Button(N("Cancel")), clicked => sub { $::isEmbedded ? kill('USR1', $::CCPID) : Gtk->exit(0) }) ) @@ -367,7 +368,7 @@ Gtk->exit(0); #------------------------------------------------------------- sub parse_etc_passwd { - my ($uname, $uid); + my ($uname, $uid, @user_info); setpwent(); do { @user_info = getpwent(); @@ -394,11 +395,11 @@ sub print_hello { sub isXlaunched { my $line; + local *INITTAB; open INITTAB, "/etc/inittab" or die N("can not open /etc/inittab for reading: %s", $!); while (<INITTAB>) { if (/id:([1-6]):initdefault:/) { $line = $_; last } } - close INITTAB; $line =~ s/id:([1-6]):initdefault:/$1/; return $line-3; } @@ -444,11 +445,11 @@ sub updateAurora { sub isAutologin { my $line; + local *AUTOLOGIN; open AUTOLOGIN, "/etc/sysconfig/autologin"; while (<AUTOLOGIN>) { if (/AUTOLOGIN=(yes|no)/) { $line = $_; last } } - close AUTOLOGIN; $line =~ s/AUTOLOGIN=(yes|no)/$1/; chomp($line); $line = $line eq "yes"; @@ -468,7 +469,7 @@ sub get_autologin { } sub updateAutologin { - my ($usern,$deskt) = ($user_combo->entry->get_text(), $desktop_combo->entry->get_text()); + my ($usern, $deskt) = ($user_combo->entry->get_text(), $desktop_combo->entry->get_text()); if ($x_yes_button->get_active()) { $in->do_pkgs->install('autologin') if $x_mode; set_autologin('',$usern,$deskt); diff --git a/perl-install/c/stuff.pm b/perl-install/c/stuff.pm index 459b827c7..405f896cd 100644 --- a/perl-install/c/stuff.pm +++ b/perl-install/c/stuff.pm @@ -7,8 +7,9 @@ require DynaLoader; @ISA = qw(DynaLoader); $VERSION = '0.01'; +# perl_checker: EXPORT-ALL -bootstrap c::stuff $VERSION; +c::stuff->bootstrap($VERSION); sub from_utf8 { iconv($_[0], "utf-8", standard_charset()) } sub to_utf8 { iconv($_[0], standard_charset(), "utf-8") } diff --git a/perl-install/commands.pm b/perl-install/commands.pm index f5cc2f44c..4d562a7ca 100644 --- a/perl-install/commands.pm +++ b/perl-install/commands.pm @@ -10,7 +10,7 @@ package commands; # $Id$ use diagnostics; use strict; -use vars qw($printable_chars); +use vars qw($printable_chars *ROUTE); #-###################################################################################### #- misc imports @@ -287,15 +287,15 @@ sub head_tail { my ($h, $n) = getopts(\@_, qw(hn)); $h || @_ < to_bool($n) and die "usage: $0 [-h] [-n lines] [<file>]\n"; $n = $n ? shift : 10; - local *F; @_ ? open(F, $_[0]) || die "error: can't open file $_[0]\n" : (*F = *STDIN); + my $fh; @_ ? open($fh, $_[0]) || die "error: can't open file $_[0]\n" : ($fh = *STDIN); if ($0 eq 'head') { local $_; - while (<F>) { $n-- or return; print } + while (<$fh>) { $n-- or return; print } } else { @_ = (); local $_; - while (<F>) { push @_, $_; @_ > $n and shift } + while (<$fh>) { push @_, $_; @_ > $n and shift } print @_; } } @@ -430,7 +430,7 @@ sub route { my ($titles, @l) = cat_("/proc/net/route"); my @titles = split ' ', $titles; my %l; - open ROUTE, ">&STDOUT"; #-# ROUTE must be not be localised otherwise the "format ROUTE" fails + open ROUTE, ">&STDOUT"; #- ROUTE must be not be localised otherwise the "format ROUTE" fails format ROUTE_TOP = Destination Gateway Mask Iface . @@ -441,7 +441,7 @@ $l{Destination}, $l{Gateway}, $l{Mask}, $l{Iface} foreach (@l) { /^\s*$/ and next; @l{@titles} = split; - $_ = join ".", reverse map { hex } unpack "a2a2a2a2", $_ foreach @l{qw(Destination Gateway Mask)}; + $_ = join ".", reverse map { hex $_ } unpack "a2a2a2a2", $_ foreach @l{qw(Destination Gateway Mask)}; $l{Destination} = 'default' if $l{Destination} eq "0.0.0.0"; $l{Gateway} = '*' if $l{Gateway} eq "0.0.0.0"; write ROUTE; @@ -492,18 +492,18 @@ sub lspci { require detect_devices; print join "\n", detect_devices::stringlist(1), ''; } -*lssbus = *lspci; +*lssbus = \&lspci; sub dmesg { print cat_("/tmp/syslog") } sub sort { my ($n, $h) = getopts(\@_, qw(nh)); $h and die "usage: sort [-n] [<file>]\n"; - local *F; @_ ? open(F, $_[0]) || die "error: can't open file $_[0]\n" : (*F = *STDIN); + my $fh; @_ ? open($fh, $_[0]) || die "error: can't open file $_[0]\n" : ($fh = *STDIN); if ($n) { - print(sort { $a <=> $b } <F>); + print(sort { $a <=> $b } <$fh>); } else { - print(sort <F>); + print(sort <$fh>); } } diff --git a/perl-install/devices.pm b/perl-install/devices.pm index 20e5c157b..bc84710f8 100644 --- a/perl-install/devices.pm +++ b/perl-install/devices.pm @@ -112,43 +112,43 @@ sub entry { $minor = 16 * $1 + ($2 || 0); } elsif (/(.*?)(\d+)$/) { ($type, $major, $minor) = - @{ ${{"fd" => [ c::S_IFBLK(), 2, 0 ], + @{ ${{"fd" => [ c::S_IFBLK(), 2, 0 ], "hidbp-mse-" => [ c::S_IFCHR(), 10, 32 ], - "lp" => [ c::S_IFCHR(), 6, 0 ], + "lp" => [ c::S_IFCHR(), 6, 0 ], "usb/lp" => [ c::S_IFCHR(), 180, 0 ], "input/event" => [ c::S_IFCHR(), 13, 64 ], - "loop" => [ c::S_IFBLK(), 7, 0 ], - "md" => [ c::S_IFBLK(), 9, 0 ], - "nst" => [ c::S_IFCHR(), 9, 128], - "scd" => [ c::S_IFBLK(), 11, 0 ], - "ttyS" => [ c::S_IFCHR(), 4, 64 ], - "ubd/" => [ c::S_IFBLK(), 98, 0 ], + "loop" => [ c::S_IFBLK(), 7, 0 ], + "md" => [ c::S_IFBLK(), 9, 0 ], + "nst" => [ c::S_IFCHR(), 9, 128 ], + "scd" => [ c::S_IFBLK(), 11, 0 ], + "ttyS" => [ c::S_IFCHR(), 4, 64 ], + "ubd/" => [ c::S_IFBLK(), 98, 0 ], }}{$1} }; $minor += $2; } unless ($type) { ($type, $major, $minor) = - @{ ${{"aztcd" => [ c::S_IFBLK(), 29, 0 ], - "bpcd" => [ c::S_IFBLK(), 41, 0 ], - "cdu31a" => [ c::S_IFBLK(), 15, 0 ], - "cdu535" => [ c::S_IFBLK(), 24, 0 ], - "cm206cd" => [ c::S_IFBLK(), 32, 0 ], - "gscd" => [ c::S_IFBLK(), 16, 0 ], - "mcd" => [ c::S_IFBLK(), 23, 0 ], - "mcdx" => [ c::S_IFBLK(), 20, 0 ], - "mem" => [ c::S_IFCHR(), 1, 1 ], - "optcd" => [ c::S_IFBLK(), 17, 0 ], - "kbd" => [ c::S_IFCHR(), 11, 0 ], - "psaux" => [ c::S_IFCHR(), 10, 1 ], - "atibm" => [ c::S_IFCHR(), 10, 3 ], - "random" => [ c::S_IFCHR(), 1, 8 ], - "sbpcd" => [ c::S_IFBLK(), 25, 0 ], - "sjcd" => [ c::S_IFBLK(), 18, 0 ], - "tty" => [ c::S_IFCHR(), 5, 0 ], - "usbmouse" => [ c::S_IFCHR(), 13, 63], #- aka /dev/input/mice - "adbmouse" => [ c::S_IFCHR(), 10, 10], #- PPC - "zero" => [ c::S_IFCHR(), 1, 5 ], - "null" => [ c::S_IFCHR(), 1, 3 ], + @{ ${{"aztcd" => [ c::S_IFBLK(), 29, 0 ], + "bpcd" => [ c::S_IFBLK(), 41, 0 ], + "cdu31a" => [ c::S_IFBLK(), 15, 0 ], + "cdu535" => [ c::S_IFBLK(), 24, 0 ], + "cm206cd" => [ c::S_IFBLK(), 32, 0 ], + "gscd" => [ c::S_IFBLK(), 16, 0 ], + "mcd" => [ c::S_IFBLK(), 23, 0 ], + "mcdx" => [ c::S_IFBLK(), 20, 0 ], + "mem" => [ c::S_IFCHR(), 1, 1 ], + "optcd" => [ c::S_IFBLK(), 17, 0 ], + "kbd" => [ c::S_IFCHR(), 11, 0 ], + "psaux" => [ c::S_IFCHR(), 10, 1 ], + "atibm" => [ c::S_IFCHR(), 10, 3 ], + "random" => [ c::S_IFCHR(), 1, 8 ], + "sbpcd" => [ c::S_IFBLK(), 25, 0 ], + "sjcd" => [ c::S_IFBLK(), 18, 0 ], + "tty" => [ c::S_IFCHR(), 5, 0 ], + "usbmouse" => [ c::S_IFCHR(), 13, 63 ], #- aka /dev/input/mice + "adbmouse" => [ c::S_IFCHR(), 10, 10 ], #- PPC + "zero" => [ c::S_IFCHR(), 1, 5 ], + "null" => [ c::S_IFCHR(), 1, 3 ], }}{$_} or die "unknown device $_ (caller is " . join(":", caller()) . ")" }; } ($type, $major, $minor); diff --git a/perl-install/diskdrake/interactive.pm b/perl-install/diskdrake/interactive.pm index cb9266d99..9761e59c5 100644 --- a/perl-install/diskdrake/interactive.pm +++ b/perl-install/diskdrake/interactive.pm @@ -244,7 +244,7 @@ sub Done { eval { raid::verify($all_hds->{raids}) }; if (my $err = $@) { $::expert or die; - $in->ask_okcancel('', [ formatError($err), N("Continue anyway?")]) or return; + $in->ask_okcancel('', [ formatError($err), N("Continue anyway?") ]) or return; } foreach (@{$all_hds->{hds}}) { if (!write_partitions($in, $_)) { diff --git a/perl-install/fs.pm b/perl-install/fs.pm index f60807af0..cd15d96d2 100644 --- a/perl-install/fs.pm +++ b/perl-install/fs.pm @@ -202,7 +202,7 @@ sub prepare_write_fstab { my @l = map { my $device = isLoopback($_) ? - ($_->{mntpoint} eq '/' ? "/initrd/loopfs" : "$_->{loopback_device}{mntpoint}") . $_->{loopback_file} : + ($_->{mntpoint} eq '/' ? "/initrd/loopfs" : $_->{loopback_device}{mntpoint}) . $_->{loopback_file} : part2device($prefix, $_->{device}, $_->{type}); my $real_mntpoint = $_->{mntpoint} || ${{ '/tmp/hdimage' => '/mnt/hd' }}{$_->{real_mntpoint}}; @@ -740,7 +740,7 @@ sub umount { my ($mntpoint) = @_; $mntpoint =~ s|/$||; log::l("calling umount($mntpoint)"); - syscall_('umount', $mntpoint) or die N("error unmounting %s: %s", $mntpoint, "$!"); + syscall_('umount', $mntpoint) or die N("error unmounting %s: %s", $mntpoint, $!); substInFile { $_ = '' if /(^|\s)$mntpoint\s/ } '/etc/mtab'; #- don't care about error, if we can't read, we won't manage to write... (and mess mtab) } diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm index 05ca2bac1..7a4c63d7a 100644 --- a/perl-install/fsedit.pm +++ b/perl-install/fsedit.pm @@ -561,8 +561,8 @@ sub add { sub allocatePartitions { my ($all_hds, $to_add) = @_; - foreach my $part (get_all_holes($all_hds)) { - my ($start, $size, $dev) = @$part{"start", "size", "rootDevice"}; + foreach my $part_ (get_all_holes($all_hds)) { + my ($start, $size, $dev) = @$part_{"start", "size", "rootDevice"}; my $part; while (suggest_part($part = { start => $start, size => 0, maxsize => $size, rootDevice => $dev }, $all_hds, $to_add)) { @@ -691,7 +691,7 @@ sub move { local (*F, *G); sysopen F, $hd->{file}, 0 or die ''; - sysopen G, $hd2->{file}, 2 or die N("Error opening %s for writing: %s", $hd2->{file}, "$!"); + sysopen G, $hd2->{file}, 2 or die N("Error opening %s for writing: %s", $hd2->{file}, $!); my $base = $part1->{start}; my $base2 = $part2->{start}; diff --git a/perl-install/ftp.pm b/perl-install/ftp.pm index 0af478004..618943573 100644 --- a/perl-install/ftp.pm +++ b/perl-install/ftp.pm @@ -52,7 +52,7 @@ sub getFile { my ($f, @para) = @_; $f eq 'XXX' and rewindGetFile(), return; #- special case to force closing connection. foreach (1..3) { - my ($ftp, $retr) = new(@para ? @para : fromEnv); + my ($ftp, $retr) = new(@para ? @para : fromEnv()); eval { $$retr->close if $$retr }; $@ and rewindGetFile(); #- in case Timeout got us on "->close" $$retr = $ftp->retr($f) and return $$retr; diff --git a/perl-install/harddrake/data.pm b/perl-install/harddrake/data.pm index d1bbc5bed..610db6426 100644 --- a/perl-install/harddrake/data.pm +++ b/perl-install/harddrake/data.pm @@ -22,19 +22,19 @@ sub unknown { our @tree = ( - ["FLOPPY", "Floppy", "floppy.png", "", \&detect_devices::floppies, 0 ], - ["HARDDISK", "Disk", "harddisk.png", "$sbindir/diskdrake", \&detect_devices::hds, 1 ], - ["CDROM", "CDROM", "cd.png", "", sub { grep { !(detect_devices::isBurner($_) || detect_devices::isDvdDrive($_)) } &detect_devices::cdroms }, 0 ], - ["BURNER", "CD/DVD burners", "cd.png", "", \&detect_devices::burners(), 0 ], - ["DVDROM", "DVD-ROM", "cd.png", "", sub { grep { ! detect_devices::isBurner($_) } detect_devices::dvdroms() }, 0 ], - ["TAPE", "Tape", "tape.png", "", \&detect_devices::tapes, 0 ], - ["VIDEO", "Videocard", "video.png", "$sbindir/XFdrake", sub { grep { $_->{driver} =~ /^(Card|Server):/ || $_->{media_type} =~ /DISPLAY_VGA/ } @devices }, 1 ], - ["TV", "Tvcard", "tv.png", "/usr/bin/XawTV", sub { grep { $_->{media_type} =~ /MULTIMEDIA_VIDEO/ && $_->{bus} eq 'PCI' || $_->{driver} eq 'usbvision' } @devices }, 0 ], - ["MULTIMEDIA_OTHER", "Other MultiMedia devices", "multimedia.png", "", sub { grep { $_->{media_type} =~ /MULTIMEDIA_OTHER/ } @devices }, 0 ], - ["AUDIO", "Soundcard", "sound.png", "$sbindir/draksound", sub { grep { $_->{media_type} =~ /MULTIMEDIA_AUDIO/ } @devices }, 0 ], - ["WEBCAM", "Webcam", "webcam.png", "", sub { grep { $_->{media_type} =~ /MULTIMEDIA_VIDEO/ && $_->{bus} ne 'PCI' } @devices }, 0 ], - ["CPU", "Processors", "cpu.png", "", sub { detect_devices::getCPUs() }, 0 ], - ["ETHERNET", "Ethernetcard", "hw_network.png", "$sbindir/drakconnect", sub { + [ "FLOPPY", "Floppy", "floppy.png", "", \&detect_devices::floppies, 0 ], + [ "HARDDISK", "Disk", "harddisk.png", "$sbindir/diskdrake", \&detect_devices::hds, 1 ], + [ "CDROM", "CDROM", "cd.png", "", sub { grep { !(detect_devices::isBurner($_) || detect_devices::isDvdDrive($_)) } &detect_devices::cdroms }, 0 ], + [ "BURNER", "CD/DVD burners", "cd.png", "", \&detect_devices::burners(), 0 ], + [ "DVDROM", "DVD-ROM", "cd.png", "", sub { grep { ! detect_devices::isBurner($_) } detect_devices::dvdroms() }, 0 ], + [ "TAPE", "Tape", "tape.png", "", \&detect_devices::tapes, 0 ], + [ "VIDEO", "Videocard", "video.png", "$sbindir/XFdrake", sub { grep { $_->{driver} =~ /^(Card|Server):/ || $_->{media_type} =~ /DISPLAY_VGA/ } @devices }, 1 ], + [ "TV", "Tvcard", "tv.png", "/usr/bin/XawTV", sub { grep { $_->{media_type} =~ /MULTIMEDIA_VIDEO/ && $_->{bus} eq 'PCI' || $_->{driver} eq 'usbvision' } @devices }, 0 ], + [ "MULTIMEDIA_OTHER", "Other MultiMedia devices", "multimedia.png", "", sub { grep { $_->{media_type} =~ /MULTIMEDIA_OTHER/ } @devices }, 0 ], + [ "AUDIO", "Soundcard", "sound.png", "$sbindir/draksound", sub { grep { $_->{media_type} =~ /MULTIMEDIA_AUDIO/ } @devices }, 0 ], + [ "WEBCAM", "Webcam", "webcam.png", "", sub { grep { $_->{media_type} =~ /MULTIMEDIA_VIDEO/ && $_->{bus} ne 'PCI' } @devices }, 0 ], + [ "CPU", "Processors", "cpu.png", "", sub { detect_devices::getCPUs() }, 0 ], + [ "ETHERNET", "Ethernetcard", "hw_network.png", "$sbindir/drakconnect", sub { #- generic NIC detection for USB seems broken (class, subclass, #- protocol report are not accurate) so I'll need to verify against #- known drivers :-( @@ -42,25 +42,25 @@ our @tree = # should be taken from detect_devices.pm or modules.pm. it's identical grep { $_->{media_type} =~ /^NETWORK/ || member($_->{driver}, @usbnet) || $_->{type} eq 'network' } @devices }, 1 ], - ["MODEM", "Modem", "modem.png", "", sub { detect_devices::getModem() }, 0 ], - ["BRIDGE", "Bridge(s)", "memory.png", "", sub { grep { $_->{media_type} =~ /BRIDGE/ } @devices }, 0 ], - ["UNKNOWN", "Unknown/Others", "unknown.png", "", \&unknown, 0 ], + [ "MODEM", "Modem", "modem.png", "", sub { detect_devices::getModem() }, 0 ], + [ "BRIDGE", "Bridge(s)", "memory.png", "", sub { grep { $_->{media_type} =~ /BRIDGE/ } @devices }, 0 ], + [ "UNKNOWN", "Unknown/Others", "unknown.png", "", \&unknown, 0 ], - ["PRINTER", "Printer", "hw_printer.png", "$sbindir/printerdrake", sub { + [ "PRINTER", "Printer", "hw_printer.png", "$sbindir/printerdrake", sub { require printer::detect; printer::detect::detect() }, 0 ], - ["SCANNER", "Scanner", "scanner.png", "$sbindir/scannerdrake", sub { + [ "SCANNER", "Scanner", "scanner.png", "$sbindir/scannerdrake", sub { require scanner; scanner::detect() }, 0 ], - ["MOUSE", "Mouse", "hw_mouse.png", "$sbindir/mousedrake", sub { + [ "MOUSE", "Mouse", "hw_mouse.png", "$sbindir/mousedrake", sub { require mouse; require modules; modules::mergein_conf('/etc/modules.conf') if -r '/etc/modules.conf'; &mouse::detect() }, 1 ], - ["JOYSTICK", "Joystick", "joystick.png", "", sub {}, 0 ], + [ "JOYSTICK", "Joystick", "joystick.png", "", sub {}, 0 ], - ["ATA_STORAGE", "(E)IDE/ATA controllers", "ide_hd.png", "", sub { grep { $_->{media_type} =~ /STORAGE_(IDE|OTHER)/ } @devices }, 0 ], - ["SCSI_CONTROLLER", "SCSI controllers", "scsi.png", "", sub { grep { $_->{media_type} =~ /STORAGE_SCSI/ } @devices }, 0 ], - ["USB_CONTROLLER", "USB controllers", "usb.png", "", sub { grep { $_->{media_type} =~ /SERIAL_USB/ } @devices }, 0 ], - ["SMB_CONTROLLER", "SMBus controllers", "usb.png", "", sub { grep { $_->{media_type} =~ /SERIAL_SMBUS/ } @devices }, 0 ], + [ "ATA_STORAGE", "(E)IDE/ATA controllers", "ide_hd.png", "", sub { grep { $_->{media_type} =~ /STORAGE_(IDE|OTHER)/ } @devices }, 0 ], + [ "SCSI_CONTROLLER", "SCSI controllers", "scsi.png", "", sub { grep { $_->{media_type} =~ /STORAGE_SCSI/ } @devices }, 0 ], + [ "USB_CONTROLLER", "USB controllers", "usb.png", "", sub { grep { $_->{media_type} =~ /SERIAL_USB/ } @devices }, 0 ], + [ "SMB_CONTROLLER", "SMBus controllers", "usb.png", "", sub { grep { $_->{media_type} =~ /SERIAL_SMBUS/ } @devices }, 0 ], ); diff --git a/perl-install/harddrake/sound.pm b/perl-install/harddrake/sound.pm index 8a20842dd..250ae75cc 100644 --- a/perl-install/harddrake/sound.pm +++ b/perl-install/harddrake/sound.pm @@ -51,7 +51,7 @@ my %alsa2oss = "snd-es1938" => [ "esssolo1" ], "snd-es1968" => [ "maestro" ], # isa "snd-es968" => [ "unknown" ], - "snd-fm801" => [ "unknown"], + "snd-fm801" => [ "unknown" ], "snd-gusclassic" => [ "gus" ], # isa "snd-gusextreme" => [ "gus" ], # isa "snd-gusmax" => [ "gus" ], # isa @@ -99,7 +99,7 @@ my %oss2alsa = "es1371" => [ "snd-ens1371" ], "esssolo1" => [ "snd-es1938" ], "gus" => ["snd-interwave", "snd-gusclassic", "snd-gusmax", "snd-gusextreme"], - "i810_audio" => [ "snd-intel8x0"], + "i810_audio" => [ "snd-intel8x0" ], "mad16" => [ "snd-opti93x" ], "maestro" => [ "snd-es1968" ], "maestro3" => [ "snd-maestro3" ], @@ -107,7 +107,7 @@ my %oss2alsa = "msnd_pinnacle" => [ "unknown" ], "msnd_pinnacle" => [ "unknown" ], "nm256_audio" => [ "snd-nm256" ], - "nvaudio" => [ "snd-intel8x0"], + "nvaudio" => [ "snd-intel8x0" ], "opl3" => [ "snd-opl3sa2" ], "opl3sa" => [ "snd-opl3sa2" ], "opl3sa2" => [ "snd-opl3sa2" ], diff --git a/perl-install/harddrake/ui.pm b/perl-install/harddrake/ui.pm index 25bb5ac74..a0b503734 100644 --- a/perl-install/harddrake/ui.pm +++ b/perl-install/harddrake/ui.pm @@ -12,57 +12,57 @@ use interactive; my %fields = ( "alternative_drivers" => [ N("Alternative drivers"), - N("the list of alternative drivers for this sound card")], + N("the list of alternative drivers for this sound card") ], "bus" => [ N("Bus"), - N("this is the physical bus on which the device is plugged (eg: PCI, USB, ...)")], + N("this is the physical bus on which the device is plugged (eg: PCI, USB, ...)") ], "channel" => [N("Channel"), N("EIDE/SCSI channel")], "bogomips" => [N("Bogomips"), N("The GNU/Linux kernel needs to do run a calculation loop at boot time to initialize a timer counter. Its result is stored as bogomips as a way to \"benchmark\" the cpu.")], "bus_id" => [ N("Bus identification"), - N("- PCI and USB devices: this list the vendor, device, subvendor and subdevice PCI/USB ids")], + N("- PCI and USB devices: this list the vendor, device, subvendor and subdevice PCI/USB ids") ], "bus_location" => [ N("Location on the bus"), N("- pci devices: this gives the PCI slot, device and function of this card - eide devices: the device is either a slave or a master device -- scsi devices: the scsi bus and the scsi device ids")], +- scsi devices: the scsi bus and the scsi device ids") ], "cache size" => [ N("Cache size"), N("Size of the (second level) cpu cache") ], "coma_bug" => [ N("Coma bug:"), N("Does this cpu has Cyrix 6x86 Coma bug ?") ], - "cpu family" => [ N("Cpuid family"), N("Family of the cpu (eg: 6 for i686 class)")], - "cpuid level" => [ N("Cpuid level"), N("Information level that one can obtain through the cpuid instruction")], - "cpu MHz" => [ N("Frequency (MHz)"), N("The cpu frequency in Mhz (Mega herz which in first approximation may be coarsely assimilated to number of instructions the cpu is able to execute per second)")], - "description" => [ N("Description"), N("This field describe the device")], + "cpu family" => [ N("Cpuid family"), N("Family of the cpu (eg: 6 for i686 class)") ], + "cpuid level" => [ N("Cpuid level"), N("Information level that one can obtain through the cpuid instruction") ], + "cpu MHz" => [ N("Frequency (MHz)"), N("The cpu frequency in Mhz (Mega herz which in first approximation may be coarsely assimilated to number of instructions the cpu is able to execute per second)") ], + "description" => [ N("Description"), N("This field describe the device") ], "device" => [ N("Old device file"), - N("old static device name used in dev package")], + N("old static device name used in dev package") ], "devfs_device" => [ N("New devfs device"), - N("new dinamic device name generated by incore kernel devfs")], - "driver" => [ N("Module"), N("the module of the GNU/Linux kernel that handle that device")], - "flags" => [ N("Flags"), N("CPU flags reported by the kernel")], + N("new dinamic device name generated by incore kernel devfs") ], + "driver" => [ N("Module"), N("the module of the GNU/Linux kernel that handle that device") ], + "flags" => [ N("Flags"), N("CPU flags reported by the kernel") ], "fdiv_bug" => [ N("Fdiv bug"), N("Early Intel Pentium chips manufactured have a bug in their floating point processor which did not achieve the attended precision when performing a Floating point DIVision (FDIV)") ], - "fpu" => [ N("Is FPU present"), N("yes means the processor has an arithmetic coprocessor")], - "fpu_exception" => [ N("Does FPU have an irq vector"), N("yes means the arithmetic coprocessor has an exception vector attached")], + "fpu" => [ N("Is FPU present"), N("yes means the processor has an arithmetic coprocessor") ], + "fpu_exception" => [ N("Does FPU have an irq vector"), N("yes means the arithmetic coprocessor has an exception vector attached") ], "f00f_bug" => [N("F00f bug"), N("Early pentium were buggy and freezed when decoding the F00F bytecode")], "hlt_bug" => [ N("Halt bug"), N("Some of the early i486DX-100 chips cannot reliably return to operating mode after the \"halt\" instruction is used") ], "info" => [N("Floppy format"), N("Format of floppies the drive accept")], "level" => [N("Level"), N("Sub generation of the cpu")], - "media_type" => [ N("Media class"), N("class of hardware device")], + "media_type" => [ N("Media class"), N("class of hardware device") ], "Model" => [N("Model"), N("hard disk model")], "model" => [N("Model"), N("Generation of the cpu (eg: 8 for PentiumIII, ...)")], "model name" => [N("Model name"), N("Official vendor name of the cpu")], - "nbuttons" => [ N("Number of buttons"), "the number of buttons the mouse have"], - "name" => [ N("Name"), "the name of the cpu"], + "nbuttons" => [ N("Number of buttons"), "the number of buttons the mouse have" ], + "name" => [ N("Name"), "the name of the cpu" ], "port" => [N("Port"), N("network printer port")], - "processor" => [ N("Processor ID"), N("the number of the processor")], + "processor" => [ N("Processor ID"), N("the number of the processor") ], "stepping" => [ N("Model stepping"), N("Stepping of the cpu (sub model (generation) number)") ], - "type" => [ N("Type"), N("The type of bus on which the mouse is connected")], - "Vendor" => [ N("Vendor"), N("the vendor name of the device")], - "vendor_id" => [ N("Vendor"), N("the vendor name of the processor")] + "type" => [ N("Type"), N("The type of bus on which the mouse is connected") ], + "Vendor" => [ N("Vendor"), N("the vendor name of the device") ], + "vendor_id" => [ N("Vendor"), N("the vendor name of the processor") ] ); @@ -71,7 +71,7 @@ my ($in, %IDs, $pid, $w); my (%options, %check_boxes); my $conffile = "/etc/sysconfig/harddrake2/ui.conf"; -my ($modem_check_box, $printer_check_box, $current_device); +my ($modem_check_box, $printer_check_box, $current_device); my @menu_items = ( @@ -95,7 +95,7 @@ my @menu_items = } }, { path => N("/_Help").N("/_Report Bug"), - callback => sub { unless (fork) { exec("drakbug --report harddrake2 &") } } }, + callback => sub { unless (fork()) { exec("drakbug --report harddrake2 &") } } }, { path => N("/_Help").N("/_About..."), callback => sub { $in->ask_warn(N("About Harddrake"), @@ -153,7 +153,7 @@ sub detect { $_->{device} = '/dev/'.$_->{device} if exists $_->{device}; push @$devices_list, $_; } - push @class_tree, [ $devices_list, [ [$title], 5], $icon, [ 0, ($title =~ /Unknown/ ? 0 : 1) ], $title, $configurator ]; + push @class_tree, [ $devices_list, [ [$title], 5 ], $icon, [ 0, ($title =~ /Unknown/ ? 0 : 1) ], $title, $configurator ]; } @class_tree; } @@ -257,7 +257,7 @@ sub new { my $custom_id = $_->{custom_id}; delete $_->{custom_id}; $custom_id .= ' ' while exists($tree->{data}{$custom_id}); - my $hw_item = $tree->insert_node($hw_class_tree, undef, [$custom_id ], 5, (undef) x 4, 1, 0); + my $hw_item = $tree->insert_node($hw_class_tree, undef, [$custom_id], 5, (undef) x 4, 1, 0); $tree->{data}{$custom_id} = $_; $tree->{configurator}{$custom_id} = $configurator; } diff --git a/perl-install/help.pm b/perl-install/help.pm index ea43d33f5..68f9373cc 100644 --- a/perl-install/help.pm +++ b/perl-install/help.pm @@ -6,7 +6,7 @@ use common; # Write a mail to <documentation@mandrakesoft.com> if # you want it changed. -%steps = ( +our %steps = ( empty => '', addUser => diff --git a/perl-install/install2.pm b/perl-install/install2.pm index e8084e8ae..3025abc9f 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -342,7 +342,7 @@ sub main { $o->ask_warn('', $msg); setVirtual(1); require install_steps_auto_install; - install_steps_auto_install_non_interactive::errorInStep (); + install_steps_auto_install_non_interactive::errorInStep(); }; $ENV{PERL_BADLANG} = 1; umask 022; @@ -486,7 +486,7 @@ sub main { undef $::auto_install; } else { print "Error using auto_install\n$@\n"; - install_steps_auto_install_non_interactive::errorInStep (); + install_steps_auto_install_non_interactive::errorInStep(); } } else { log::l("auto install config file loaded successfully"); diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index ec9ef9ad6..6e0003e97 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -228,7 +228,7 @@ sub spawnShell { -x "/bin/sh" or die "cannot open shell - /bin/sh doesn't exist"; - fork and return; + fork() and return; $ENV{DISPLAY} ||= ":0"; #- why not :pp @@ -749,7 +749,7 @@ sub g_auto_install { local $o->{partitioning}{auto_allocate} = !$replay; $o->{autoExitInstall} = !$replay; - $o->{interactiveSteps} = [ 'doPartitionDisks', 'formatPartitions'] if $replay; + $o->{interactiveSteps} = [ 'doPartitionDisks', 'formatPartitions' ] if $replay; #- deep copy because we're modifying it below $o->{users} = [ @{$o->{users} || []} ]; @@ -897,7 +897,7 @@ sub g_default_packages { } sub loadO { - my ($O, $f) = @_; $f ||= auto_inst_file; + my ($O, $f) = @_; $f ||= auto_inst_file(); my $o; if ($f =~ /^(floppy|patch)$/) { my $f = $f eq "floppy" ? 'auto_inst.cfg' : "patch"; diff --git a/perl-install/install_gtk.pm b/perl-install/install_gtk.pm index 8b5b89ac9..a12146948 100644 --- a/perl-install/install_gtk.pm +++ b/perl-install/install_gtk.pm @@ -140,7 +140,7 @@ sub create_steps_window { "$ENV{SHARE_PATH}/step-$color$type.xpm"; }; $darea->set_usize($PIX_W+3,$PIX_H); - $darea->set_events(['exposure_mask', 'enter_notify_mask', 'leave_notify_mask', 'button_press_mask', 'button_release_mask' ]); + $darea->set_events(['exposure_mask', 'enter_notify_mask', 'leave_notify_mask', 'button_press_mask', 'button_release_mask']); $darea->signal_connect(expose_event => sub { $draw_pix->($f->('')) }); if ($step->{reachable}) { $darea->signal_connect(enter_notify_event => sub { $in_button = 1; $draw_pix->($f->('-on')) }); @@ -177,7 +177,7 @@ sub create_logo_window { #------------------------------------------------------------------------------ sub init_sizes() { - ($::rootheight, $::rootwidth) = my_gtk::gtkroot()->get_size; + ($::rootheight, $::rootwidth) = gtkroot()->get_size; $::live and $::rootheight -= 80; #- ($::rootheight, $::rootwidth) = (min(768, $::rootheight), min(1024, $::rootwidth)); ($::stepswidth, $::stepsheight) = (145, $::rootheight); diff --git a/perl-install/install_interactive.pm b/perl-install/install_interactive.pm index f1efc2730..627305e8d 100644 --- a/perl-install/install_interactive.pm +++ b/perl-install/install_interactive.pm @@ -3,8 +3,6 @@ package install_interactive; # $Id$ use diagnostics; use strict; -use vars; - use common; use partition_table qw(:types); use partition_table::raw; @@ -202,9 +200,9 @@ When you are done, don't forget to save using `w'", partition_table::description print "\n\n"; my $pid = 0; if (arch() =~ /ppc/) { - $pid = fork or exec "pdisk", devices::make($_->{device}); + $pid = fork() or exec "pdisk", devices::make($_->{device}); } else { - $pid = fork or exec "fdisk", devices::make($_->{device}); + $pid = fork() or exec "fdisk", devices::make($_->{device}); } waitpid($pid, 0); } diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 6df6bd0d2..659ec72ac 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -501,7 +501,8 @@ GridHeight=70 #- fix bad update-alternatives that may occurs after upgrade (but let them for install too). if (-d "$o->{prefix}/etc/alternatives") { - local (*ALTERNATE_DIR, $_); opendir ALTERNATE_DIR, "$o->{prefix}/etc/alternatives"; + local *ALTERNATE_DIR; opendir ALTERNATE_DIR, "$o->{prefix}/etc/alternatives"; + local $_; while (defined($_ = readdir ALTERNATE_DIR)) { -e "$o->{prefix}/etc/alternatives/$_" and next; log::l("fixing broken alternative $_"); @@ -691,7 +692,7 @@ sub configureServices { } #------------------------------------------------------------------------------ sub configurePrinter { - my($o) = @_; + my ($o) = @_; $o->do_pkgs->install('foomatic', 'printer-utils', 'printer-testpages', if_($o->do_pkgs->is_installed('gimp'), 'gimpprint')); diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm index e29efddf0..d5a16e173 100644 --- a/perl-install/install_steps_gtk.pm +++ b/perl-install/install_steps_gtk.pm @@ -47,7 +47,7 @@ sub new($$) { my $xpmac_opts = cat_("/proc/cmdline"); unless (-d "/var/log") { mkdir("/var/log") } local $SIG{CHLD} = sub { $ok = 0 if waitpid(-1, c::WNOHANG()) > 0 }; - unless (fork) { + unless (fork()) { exec $_[0], (arch() =~ /^sparc/ || arch() eq "ppc" ? () : "-kb"), "-dpms", "-s", "240", ($_[0] =~ /Xpmac/ ? $xpmac_opts !~ /ofonly/ ? ("-mode", "17", "-depth", "32") : "-mach64" : ()), ($_[0] =~ /Xsun/ || $_[0] =~ /Xpmac/ ? ("-fp", "/usr/X11R6/lib/X11/fonts:unscaled") : @@ -57,7 +57,7 @@ sub new($$) { sleep 1; log::l("Server died"), return 0 if !$ok; if (c::Xtest($ENV{DISPLAY})) { - fork || exec("aewm-drakx") || exec("true"); + fork() || exec("aewm-drakx") || exec("true"); return 1; } } diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm index 9df2d82f3..acd33624c 100644 --- a/perl-install/interactive.pm +++ b/perl-install/interactive.pm @@ -104,7 +104,7 @@ sub vnew { if ($su && $>) { die "you must be root to run this program"; } - require 'log.pm'; + require log; undef *log::l; *log::l = sub {}; # otherwise, it will bother us :( require interactive::newt; @@ -276,7 +276,7 @@ sub ask_from_normalize { $e->{type} ||= 'combo'; if (!$e->{not_edit}) { - die q(when using "not_edit" you must use strings, not a data structure) if ref ${$e->{val}} || grep { ref } @$li; + die q(when using "not_edit" you must use strings, not a data structure) if ref ${$e->{val}} || grep { ref $_ } @$li; } if ($e->{type} ne 'combo' || $e->{not_edit}) { ${$e->{val}} = $li->[0] if !member(may_apply($e->{format}, ${$e->{val}}), map { may_apply($e->{format}, $_) } @$li); @@ -302,7 +302,7 @@ sub ask_from_normalize { if ($_->{list} && $_->{not_edit} && !$_->{allow_empty_list}) { if (@{$_->{list}} == ()) { eval { - require 'log.pm'; + require log; log::l("ask_from_normalize: empty list for $_->{label}\n" . backtrace()); }; } diff --git a/perl-install/interactive/http.pm b/perl-install/interactive/http.pm index 33deb4b22..359e61401 100644 --- a/perl-install/interactive/http.pm +++ b/perl-install/interactive/http.pm @@ -27,7 +27,7 @@ sub open_stdout { # cont_stdout must be called after open_stdout and before the first print sub cont_stdout { my ($title) = @_; - print CGI::start_html(-title => $title) if $no_header; + print CGI::start_html('-title' => $title) if $no_header; $no_header = 0; } @@ -49,7 +49,7 @@ sub end() { close STDOUT; unlink $pipe_r, $pipe_w; } -sub exit() { end; exit($_[1]) } +sub exit() { end(); exit($_[1]) } END { end() } sub ask_fromW { @@ -64,7 +64,7 @@ sub ask_fromW { # print $q->img({ -src => "/icons/$o->{icon}" }) if $o->{icon}; print @{$common->{messages}}; - print $q->start_form(-name => 'form', -action => $script_name, -method => 'post'); + print $q->start_form('-name' => 'form', '-action' => $script_name, '-method' => 'post'); print "<table>\n"; @@ -79,21 +79,21 @@ sub ask_fromW { $e->{type} = $e->{not_edit} ? 'list' : 'entry' if $e->{type} eq 'combo'; if ($e->{type} eq 'bool') { - print $q->checkbox(-name => "w$::i", -checked => ${$e->{val}} && 'on', -label => $e->{text} || " "); + print $q->checkbox('-name' => "w$::i", '-checked' => ${$e->{val}} && 'on', '-label' => $e->{text} || " "); } elsif ($e->{type} eq 'button') { print "nobuttonyet"; } elsif ($e->{type} =~ /list/) { my %t; $t{$_} = may_apply($e->{format}, $_) foreach @{$e->{list}}; - print $q->scrolling_list(-name => "w$::i", - -values => $e->{list}, - -default => [ ${$e->{val}} ], - -size => 5, -multiple => '', -labels => \%t); + print $q->scrolling_list('-name' => "w$::i", + '-values' => $e->{list}, + '-default' => [ ${$e->{val}} ], + '-size' => 5, '-multiple' => '', '-labels' => \%t); } else { print $e->{hidden} ? - $q->password_field(-name => "w$::i", -default => ${$e->{val}}) : - $q->textfield( -name => "w$::i", -default => ${$e->{val}}); + $q->password_field('-name' => "w$::i", '-default' => ${$e->{val}}) : + $q->textfield( '-name' => "w$::i", '-default' => ${$e->{val}}); } print "</td></tr>\n"; @@ -101,8 +101,8 @@ sub ask_fromW { print "</table>\n"; print $q->p(); - print $q->submit(-name => 'ok_submit', -value => $common->{ok} || N("Ok")); - print $q->submit(-name => 'cancel_submit', -value => $common->{cancel} || N("Cancel")) if $common->{cancel} || !exists $common->{ok}; + print $q->submit('-name' => 'ok_submit', '-value' => $common->{ok} || N("Ok")); + print $q->submit('-name' => 'cancel_submit', '-value' => $common->{cancel} || N("Cancel")) if $common->{cancel} || !exists $common->{ok}; print $q->hidden('state'), $q->hidden('uid'); print $q->end_form, $q->end_html; diff --git a/perl-install/interactive/newt.pm b/perl-install/interactive/newt.pm index 2f5f18791..46f9797e5 100644 --- a/perl-install/interactive/newt.pm +++ b/perl-install/interactive/newt.pm @@ -28,7 +28,7 @@ sub leave_console { Newt::Resume() } sub suspend { Newt::Suspend() } sub resume { Newt::Resume() } sub end() { Newt::Finished() } -sub exit() { end; exit($_[1]) } +sub exit() { end(); exit($_[1]) } END { end() } sub myTextbox { diff --git a/perl-install/interactive/stdio.pm b/perl-install/interactive/stdio.pm index 2abe2d5c9..b43d3591d 100644 --- a/perl-install/interactive/stdio.pm +++ b/perl-install/interactive/stdio.pm @@ -61,7 +61,7 @@ ask_fromW_begin: }; my @labels; - my $format_label = sub { my ($e) = @_; return "`${$e->{val}}' $e->{label} $e->{text}\n" }; + my $format_label = sub { my ($e) = @_; return sprintf("`%s' %s %s\n", ${$e->{val}}, $e->{label}, $e->{text}) }; my $do_widget = sub { my ($e, $ind) = @_; @@ -106,10 +106,10 @@ ask_fromW_begin: my $i = readln(); ${$e->{val}} = $i || ${$e->{val}}; ${$e->{val}} = '' if ${$e->{val}} eq 'void'; - print "Setting to <${$e->{val}}>\n"; + print "Setting to <", ${$e->{val}}, ">\n"; $i and $common->{callbacks}{changed}->($ind); } else { - print "UNSUPPORTED WIDGET TYPE (type <$e->{type}> label <$e->{label}> text <$e->{text}> val <${$e->{val}}>\n"; + printf "UNSUPPORTED WIDGET TYPE (type <%s> label <%s> text <%s> val <%s>\n", $e->{type}, $e->{label}, $e->{text}, ${$e->{val}}; } }; diff --git a/perl-install/lang.pm b/perl-install/lang.pm index 0a8620be8..37469827d 100644 --- a/perl-install/lang.pm +++ b/perl-install/lang.pm @@ -799,7 +799,7 @@ sub get_x_fontset { my $dir = "/usr/X11R6/lib/X11/fonts"; if (! -e "$dir/$f" && $::isInstall && common::usingRamdisk()) { unlink "$dir/$_" foreach values %bigfonts; - install_any::remove_bigseldom_used (); + install_any::remove_bigseldom_used(); install_any::getAndSaveFile("$dir/$f"); } } diff --git a/perl-install/log.pm b/perl-install/log.pm index c0fdde7a5..3295ba8f9 100644 --- a/perl-install/log.pm +++ b/perl-install/log.pm @@ -2,6 +2,8 @@ package log; # $Id$ use diagnostics; use strict; +use vars qw(*LOG *LOG2); + use c; @@ -11,7 +13,6 @@ use c; my $logOpen = 0; my $logDebugMessages = 0; - #-###################################################################################### #- Functions #-###################################################################################### diff --git a/perl-install/modules.pm b/perl-install/modules.pm index 3b30d01d8..7733eb582 100644 --- a/perl-install/modules.pm +++ b/perl-install/modules.pm @@ -48,7 +48,7 @@ sub load { my @network_devices = $network_module ? detect_devices::getNet() : (); if ($::testing || $::blank) { - log::l("i would load module $_ (@{$options{$_}})") foreach @l; + log::l("i would load module $_ (" . join(" ", @{$options{$_}}) . ")") foreach @l; } elsif ($::isStandalone || $::live) { run_program::run('/sbin/modprobe', $_, @{$options{$_}}) or !run_program::run('/sbin/modprobe', '-n', $_) #- ignore missing modules diff --git a/perl-install/mouse.pm b/perl-install/mouse.pm index 04acaad88..8ba23f7c4 100644 --- a/perl-install/mouse.pm +++ b/perl-install/mouse.pm @@ -23,7 +23,7 @@ my %mice = 'sunmouse' => [ [ 'sunmouse' ], [ [ 3, 'sun', 'sun', N_("Sun - Mouse") ] - ]] + ] ] ) : ( 'PS/2' => @@ -37,7 +37,7 @@ my %mice = [ 5, 'netmouse', 'NetMousePS/2', N_("Genius NetMouse") ], [ 5, 'netmouse', 'NetScrollPS/2', N_("Genius NetScroll") ], [ 7, 'ps/2', 'ExplorerPS/2', N_("Microsoft Explorer") ], - ]], + ] ], 'USB' => [ [ 'usbmouse' ], @@ -46,7 +46,7 @@ my %mice = [ 3, 'ps/2', 'PS/2', N_("Generic") ], [ 5, 'ps/2', 'IMPS/2', N_("Wheel") ], [ 7, 'ps/2', 'ExplorerPS/2', N_("Microsoft Explorer") ], - ]], + ] ], N_("serial") => [ [ map { "ttyS$_" } 0..3 ], @@ -63,19 +63,19 @@ my %mice = [ 2, 'MMHitTab', 'MMHittab', N_("MM HitTablet") ], [ 3, 'Logitech', 'Logitech', N_("Logitech Mouse (serial, old C7 type)") ], [ 3, 'Microsoft', 'ThinkingMouse', N_("Kensington Thinking Mouse") ], - ]], + ] ], N_("busmouse") => [ [ arch() eq 'ppc' ? 'adbmouse' : ('atibm', 'inportbm', 'logibm') ], [ if_(arch() eq 'ppc', [ 1, 'Busmouse', 'BusMouse', N_("1 button") ]), [ 2, 'Busmouse', 'BusMouse', N_("2 buttons") ], [ 3, 'Busmouse', 'BusMouse', N_("3 buttons") ], - ]], + ] ], N_("none") => [ [ 'none' ], [ [ 0, 'none', 'Microsoft', N_("No mouse") ], - ]], + ] ], ); @@ -442,7 +442,7 @@ sub test_mouse_install { $w->{window}->set_usize(undef, $height+10); $w->sync; # HACK Gtk::Gdk->pointer_grab($darea->window, 1, - [ 'pointer_motion_mask'], + [ 'pointer_motion_mask' ], $darea->window, undef, 0); $w->main; } @@ -465,6 +465,8 @@ sub test_mouse_standalone { sub test_mouse { my ($mouse, $w, $darea, $width, $height) = @_; + require my_gtk; + my_gtk->import(qw(:wrappers)); $darea->realize(); my $wait = 0; my ($m3_image, $m3_mask) = gtkcreate_xpm('mouse_3b.xpm'); diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm index 1fecfd5cf..91b6310d6 100644 --- a/perl-install/my_gtk.pm +++ b/perl-install/my_gtk.pm @@ -89,14 +89,14 @@ sub new { $::WizardWindow->show_all; flush(); } - $::WizardTable->attach($o->{window}, 0, 2, 1, 2, [-fill, -expand], [-fill, -expand], 0, 0); + $::WizardTable->attach($o->{window}, 0, 2, 1, 2, ['fill', 'expand'], ['fill', 'expand'], 0, 0); } if ($::isEmbedded && !$my_gtk::pop_it && !eval { $::Plug && $::Plug->child }) { $o->{isEmbedded} = 1; $o->{window} = new Gtk::HBox(0,0); $o->{rwindow} = $o->{window}; - $::Plug ||= new Gtk::Plug ($::XID); + $::Plug ||= new Gtk::Plug($::XID); $::Plug->show; flush(); $::Plug->add($o->{window}); @@ -329,7 +329,7 @@ sub _ask_okcancel($@) { sub _ask_file { my ($o, $title, $path) = @_; - my $f = $o->{rwindow} = new Gtk::FileSelection $title; + my $f = $o->{rwindow} = new Gtk::FileSelection($title); $f->set_filename($path); $f->ok_button->signal_connect(clicked => sub { $o->{retval} = $f->get_filename; Gtk->main_quit }); $f->cancel_button->signal_connect(clicked => sub { Gtk->main_quit }); diff --git a/perl-install/network/adsl.pm b/perl-install/network/adsl.pm index 79f186426..35b5bcd34 100644 --- a/perl-install/network/adsl.pm +++ b/perl-install/network/adsl.pm @@ -20,7 +20,7 @@ sub configure { # N("The most common way to connect with adsl is pppoe. # Some connections use pptp, a few ones use dhcp. # If you don't know, choose 'use pppoe'"), [N_("use pppoe"), N_("use pptp"), N_("use dhcp"), N_("Alcatel speedtouch usb"), N_("ECI Hi-Focus")]) or return; - my $l = [N_("use pppoe"), + my $l = [ N_("use pppoe"), N_("use pptp"), N_("use dhcp"), N_("Alcatel speedtouch usb") . if_($netc->{autodetect}{adsl}{speedtouch}, " - detected"), diff --git a/perl-install/network/ethernet.pm b/perl-install/network/ethernet.pm index 9458eb292..4752258ce 100644 --- a/perl-install/network/ethernet.pm +++ b/perl-install/network/ethernet.pm @@ -202,7 +202,7 @@ N("Please enter your host name if you know it. Some DHCP servers require the hostname to work. Your host name should be a fully-qualified host name, such as ``mybox.mylab.myco.com''."), - [ { label => N("Host name"), val => \$netc->{HOSTNAME} }]) or goto configureNetwork_step_1; + [ { label => N("Host name"), val => \$netc->{HOSTNAME} } ]) or goto configureNetwork_step_1; $netc->{HOSTNAME} ne $dhcp_hostname and $netc->{DHCP_HOSTNAME} = $netc->{HOSTNAME}; } else { configureNetworkNet($in, $netc, $last ||= {}, @l) or goto configureNetwork_step_1; diff --git a/perl-install/network/isdn.pm b/perl-install/network/isdn.pm index 8879ffd82..0466c4030 100644 --- a/perl-install/network/isdn.pm +++ b/perl-install/network/isdn.pm @@ -19,7 +19,7 @@ sub configure { defined $netc->{autodetect}{isdn}{id} and goto intern_pci; $::isInstall and $in->set_help('configureNetworkISDN'); my $e = $in->ask_from_list_(N("Network Configuration Wizard"), - N("What kind is your ISDN connection?"), [ N_("Internal ISDN card"), N_("External ISDN modem")] + N("What kind is your ISDN connection?"), [ N_("Internal ISDN card"), N_("External ISDN modem") ] ) or return; if ($e =~ /card/) { intern_pci: @@ -51,7 +51,7 @@ sub isdn_write_config { standard, but with less tools. We recommand the light configuration. -"), [ N_("New configuration (isdn-light)"), N_("Old configuration (isdn4net)")] +"), [ N_("New configuration (isdn-light)"), N_("Old configuration (isdn4net)") ] ) or return; my ($rmpackage, $instpackage) = $e =~ /light/ ? ('isdn4net', 'isdn-light') : ('isdn-light', 'isdn4net'); if (!$::isStandalone) { diff --git a/perl-install/network/isdn_consts.pm b/perl-install/network/isdn_consts.pm index eff83b0b5..b93a75e11 100644 --- a/perl-install/network/isdn_consts.pm +++ b/perl-install/network/isdn_consts.pm @@ -1,6 +1,6 @@ package network::isdn; # $Id$ -@isdndata = +our @isdndata = ( { description => "Teles 16.0 (ISA)", #1 irq, mem, io driver => 'hisax', diff --git a/perl-install/network/network.pm b/perl-install/network/network.pm index 55d5c324b..b99bc38b7 100644 --- a/perl-install/network/network.pm +++ b/perl-install/network/network.pm @@ -176,7 +176,7 @@ sub guessHostname { write_resolv_conf("$prefix/etc/resolv.conf", $netc); - my $name = gethostbyaddr(Socket::inet_aton($intf->{IPADDR}), AF_INET) or log::l("reverse name lookup failed"), return 0; + my $name = gethostbyaddr(Socket::inet_aton($intf->{IPADDR}), Socket::AF_INET()) or log::l("reverse name lookup failed"), return 0; log::l("reverse name lookup worked"); @@ -317,7 +317,7 @@ notation (for example, 1.2.3.4)."); { label => N("Automatic IP"), val => \$pump, type => "bool", text => N("(bootp/dhcp)") }, if_($::expert, { label => N("Start at boot"), val => \$onboot, type => "bool" }), if_($intf->{wireless_eth}, - { label => "WIRELESS_MODE", val => \$intf->{WIRELESS_MODE}, list => [ "Ad-hoc", "Managed", "Master", "Repeater", "Secondary", "Auto"] }, + { label => "WIRELESS_MODE", val => \$intf->{WIRELESS_MODE}, list => [ "Ad-hoc", "Managed", "Master", "Repeater", "Secondary", "Auto" ] }, { label => "WIRELESS_ESSID", val => \$intf->{WIRELESS_ESSID} }, { label => "WIRELESS_NWID", val => \$intf->{WIRELESS_NWID} }, { label => "WIRELESS_FREQ", val => \$intf->{WIRELESS_FREQ} }, diff --git a/perl-install/network/tools.pm b/perl-install/network/tools.pm index 07d8e5d6e..78075fd68 100644 --- a/perl-install/network/tools.pm +++ b/perl-install/network/tools.pm @@ -129,12 +129,12 @@ sub detect_timezone { sub type2interface { my ($i) = @_; - $i =~ /$_->[0]/ and return $_->[1] foreach [ modem => 'ppp'], - [ isdn_internal => 'ippp'], - [ isdn_external => 'ppp'], - [ adsl => 'ppp'], - [ cable => 'eth'], - [ lan => 'eth']; + $i =~ /$_->[0]/ and return $_->[1] foreach [ modem => 'ppp' ], + [ isdn_internal => 'ippp' ], + [ isdn_external => 'ppp' ], + [ adsl => 'ppp' ], + [ cable => 'eth' ], + [ lan => 'eth' ]; } sub connected { gethostbyname("mandrakesoft.com") ? 1 : 0 } diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm index 37bb16e73..513246344 100644 --- a/perl-install/partition_table.pm +++ b/perl-install/partition_table.pm @@ -337,7 +337,7 @@ sub assign_device_numbers { #- not if it's an IBM machine using a DOS partition table though if (arch() =~ /ppc/ && detect_devices::get_mac_model() !~ /^IBM/) { #- first sort the normal parts - $hd->{primary}{normal} = [sort { $a->{start} <=> $b->{start} } @{$hd->{primary}{normal}} ]; + $hd->{primary}{normal} = [ sort { $a->{start} <=> $b->{start} } @{$hd->{primary}{normal}} ]; #- now loop through them, assigning partition numbers - reserve one for the holes foreach (@{$hd->{primary}{normal}}) { @@ -596,7 +596,7 @@ sub write { my @magic_parts = grep { $_->{isMounted} && $_->{real_mntpoint} } get_normal_parts($hd); foreach (@magic_parts) { - syscall_('umount', $_->{real_mntpoint}) or log::l(N("error unmounting %s: %s", $_->{real_mntpoint}, "$!")); + syscall_('umount', $_->{real_mntpoint}) or log::l(N("error unmounting %s: %s", $_->{real_mntpoint}, $!)); } $hd->kernel_read; foreach (@magic_parts) { diff --git a/perl-install/partition_table/gpt.pm b/perl-install/partition_table/gpt.pm index 425a34e39..ef8ddb187 100644 --- a/perl-install/partition_table/gpt.pm +++ b/perl-install/partition_table/gpt.pm @@ -167,7 +167,7 @@ sub write { foreach (@$pt) { $_->{ending} = $_->{start} + $_->{size} - 1; - $_->{guid} ||= generate_guid; + $_->{guid} ||= generate_guid(); $_->{gpt_type} = $gpt_types{$_->{type}} || $_->{gpt_type} || $gpt_types{0x83}; } my $partitionEntries = join('', map { @@ -251,7 +251,7 @@ sub info { alternateLBA => $hd->{totalsectors} - 1, firstUsableLBA => $nb_sect + 2, lastUsableLBA => $hd->{totalsectors} - $nb_sect - 2, - guid => generate_guid, + guid => generate_guid(), partitionEntriesLBA => 2, nbPartitions => $nb_sect * 512 / psizeof($partitionEntry_format), partitionEntrySize => psizeof($partitionEntry_format), diff --git a/perl-install/printer/detect.pm b/perl-install/printer/detect.pm index 7ab4a9f1b..2c5b42e2e 100644 --- a/perl-install/printer/detect.pm +++ b/perl-install/printer/detect.pm @@ -79,7 +79,7 @@ sub whatNetPrinter { val => { CLASS => 'PRINTER', MODEL => N("Unknown Model"), MANUFACTURER => "", - DESCRIPTION => "$share->{description}", + DESCRIPTION => $share->{description}, SERIALNUMBER => "" } }; diff --git a/perl-install/printer/gimp.pm b/perl-install/printer/gimp.pm index c6d7a08d0..2655c4340 100644 --- a/perl-install/printer/gimp.pm +++ b/perl-install/printer/gimp.pm @@ -32,8 +32,8 @@ sub configure { "/etc/foomatic/$queue.ppd"); } elsif (-r "$::prefix/usr/share/postscript/ppd/$queue.ppd") { # Check PPD directory of GPR, too - run_program::rooted - ($::prefix, + run_program::rooted( + $::prefix, "ln", "-sf", "/usr/share/postscript/ppd/$queue.ppd", "/etc/foomatic/$queue.ppd"); @@ -89,13 +89,13 @@ sub addcupsremoteto { # Remove server name from queue name $q =~ s/^([^@]*)@.*$/$1/; if (-x "$::prefix/usr/bin/wget") { - eval(run_program::rooted - ($::prefix, "/usr/bin/wget", "-O", + eval(run_program::rooted( + $::prefix, "/usr/bin/wget", "-O", "/etc/foomatic/$queue.ppd", "http://$server:631/printers/$q.ppd")); } else { - eval(run_program::rooted - ($::prefix, "/usr/bin/curl", "-o", + eval(run_program::rooted( + $::prefix, "/usr/bin/curl", "-o", "/etc/foomatic/$queue.ppd", "http://$server:631/printers/$q.ppd")); } @@ -198,7 +198,7 @@ sub makeprinterentry { $configfile = addentry($queue, "Driver: $gimpprintdriver", $configfile); $configfile = removeentry($queue, "Destination:", $configfile); $configfile = addentry($queue, - "Destination: /usr/bin/$spoolers{$printer->{SPOOLER}{print_command}} -P $queue -o raw", $configfile); + sprintf("Destination: /usr/bin/%s -P %s -o raw", $spoolers{$printer->{SPOOLER}{print_command}}, $queue), $configfile); } else { $configfile = removeentry($queue, "PPD-File:", $configfile); $configfile = addentry($queue, "PPD-File: /etc/foomatic/$queue.ppd", $configfile); @@ -206,7 +206,7 @@ sub makeprinterentry { $configfile = addentry($queue, "Driver: ps2", $configfile); $configfile = removeentry($queue, "Destination:", $configfile); $configfile = addentry($queue, - "Destination: /usr/bin/$spoolers{$printer->{SPOOLER}{print_command}} -P $queue", $configfile); + sprintf("Destination: /usr/bin/%s -P %s", $spoolers{$printer->{SPOOLER}{print_command}}, $queue), $configfile); } return $configfile; } diff --git a/perl-install/printer/main.pm b/perl-install/printer/main.pm index a93daf28f..6eaa34561 100644 --- a/perl-install/printer/main.pm +++ b/perl-install/printer/main.pm @@ -58,7 +58,7 @@ sub spooler { sub printer_type($) { my ($printer) = @_; - foreach ($printer->{SPOOLER}) { + for ($printer->{SPOOLER}) { /cups/ && return @printer_type_inv{qw(LOCAL), qw(LPD SOCKET SMB), $::expert ? qw(URI) : ()}; @@ -1045,7 +1045,7 @@ sub restart_queue($) { my $queue = $printer->{QUEUE}; # Restart the daemon(s) - foreach ($printer->{SPOOLER}) { + for ($printer->{SPOOLER}) { /cups/ && do { #- restart cups. printer::services::restart("cups"); diff --git a/perl-install/printer/office.pm b/perl-install/printer/office.pm index 2498bcabe..459ae4d8e 100644 --- a/perl-install/printer/office.pm +++ b/perl-install/printer/office.pm @@ -55,13 +55,13 @@ sub configureoffice { my $queue = $1; my $server = $2; if (-x "$::prefix/usr/bin/wget") { - eval(run_program::rooted - ($::prefix, "/usr/bin/wget", "-O", + eval(run_program::rooted( + $::prefix, "/usr/bin/wget", "-O", "/etc/foomatic/$queue.ppd", "http://$server:631/printers/$queue.ppd")); } else { - eval(run_program::rooted - ($::prefix, "/usr/bin/curl", "-o", + eval(run_program::rooted( + $::prefix, "/usr/bin/curl", "-o", "/etc/foomatic/$queue.ppd", "http://$server:631/printers/$queue.ppd")); } @@ -124,13 +124,13 @@ sub add_cups_remote_to_office { # Remove server name from queue name $q =~ s/^([^@]*)@.*$/$1/; if (-x "$::prefix/usr/bin/wget") { - eval(run_program::rooted - ($::prefix, "/usr/bin/wget", "-O", + eval(run_program::rooted( + $::prefix, "/usr/bin/wget", "-O", "/etc/foomatic/$queue.ppd", "http://$server:631/printers/$q.ppd")); } else { - eval(run_program::rooted - ($::prefix, "/usr/bin/curl", "-o", + eval(run_program::rooted( + $::prefix, "/usr/bin/curl", "-o", "/etc/foomatic/$queue.ppd", "http://$server:631/printers/$q.ppd")); } @@ -207,7 +207,7 @@ sub makestarofficeprinterentry { # symbol correctly. $configfile = removeentry("ports", "$queue=", $configfile); $configfile = addentry("ports", - "$queue=/usr/bin/perl -p -e \"s=16#80 /euro=16#80 /Euro=\" | /usr/bin/$spoolers{$printer->{SPOOLER}{print_command}} -P $queue", + "$queue=/usr/bin/perl -p -e \"s=16#80 /euro=16#80 /Euro=\" | /usr/bin/" . $spoolers{$printer->{SPOOLER}{print_command}} . " -P $queue", $configfile); # Make printer's section $configfile = addsection("$queue,PostScript,$queue", $configfile); @@ -261,14 +261,14 @@ sub makeopenofficeprinterentry { # symbol correctly. $configfile = removeentry($queue, "Command=", $configfile); $configfile = addentry($queue, - "Command=/usr/bin/perl -p -e \"s=/euro /unused=/Euro /unused=\" | /usr/bin/$spoolers{$printer->{SPOOLER}{print_command}} -P $queue", + "Command=/usr/bin/perl -p -e \"s=/euro /unused=/Euro /unused=\" | /usr/bin/" . $spoolers{$printer->{SPOOLER}{print_command}} . " -P $queue", $configfile); # "Comment" line $configfile = removeentry($queue, "Comment=", $configfile); if ($printer->{configured}{$queue} && $printer->{configured}{$queue}{queuedata}{desc}) { - $configfile = addentry - ($queue, + $configfile = addentry( + $queue, "Comment=$printer->{configured}{$queue}{queuedata}{desc}", $configfile); } else { @@ -280,8 +280,8 @@ sub makeopenofficeprinterentry { $configfile = removeentry($queue, "Location=", $configfile); if ($printer->{configured}{$queue} && $printer->{configured}{$queue}{queuedata}{loc}) { - $configfile = addentry - ($queue, + $configfile = addentry( + $queue, "Location=$printer->{configured}{$queue}{queuedata}{loc}", $configfile); } else { diff --git a/perl-install/printer/printerdrake.pm b/perl-install/printer/printerdrake.pm index aea361bab..e2ea9f52b 100644 --- a/perl-install/printer/printerdrake.pm +++ b/perl-install/printer/printerdrake.pm @@ -140,7 +140,7 @@ sub setup_printer_connection { my ($printer, $in, $upNetwork) = @_; # Choose the appropriate connection config dialog my $done = 1; - foreach ($printer->{TYPE}) { + for ($printer->{TYPE}) { /LOCAL/ and setup_local_autoscan ($printer, $in, $upNetwork) and last; /LPD/ and setup_lpd ($printer, $in, $upNetwork) and last; /SOCKET/ and setup_socket ($printer, $in, $upNetwork) and last; @@ -155,7 +155,7 @@ sub setup_printer_connection { sub first_time_dialog { my ($printer, $in, $upNetwork) = @_; - return 1 if printer::default::get_spooler () or $::isInstall; + return 1 if printer::default::get_spooler() or $::isInstall; # Wait message my $w = $in->wait_message(N("Printerdrake"), N("Checking your system...")); @@ -339,7 +339,6 @@ If you want to add, remove, or rename a printer, or if you want to change the de sub setup_local_autoscan { my ($printer, $in, $upNetwork) = @_; - my $device; my $queue = $printer->{OLD_QUEUE}; my $expert_or_modify = $::expert || !$printer->{NEW}; my $do_auto_detect = @@ -866,7 +865,7 @@ Do you really want to continue setting up this printer as you are doing now?"), #- build a suitable URI. $printer->{currentqueue}{connect} = join '', ("smb://", ($smbuser && ($smbuser . - ($smbpassword && ":$smbpassword") . "@")), ($workgroup && "$workgroup/"), + ($smbpassword && ":$smbpassword") . '@')), ($workgroup && "$workgroup/"), ($smbserver || $smbserverip), "/$smbshare"); if (!$::testing && !files_exist('/usr/bin/smbclient')) { @@ -935,7 +934,7 @@ complete => sub { # Generate the Foomatic URI $printer->{currentqueue}{connect} = join '', ("ncp://", ($ncpuser && ($ncpuser . - ($ncppassword && ":$ncppassword") . "@")), + ($ncppassword && ":$ncppassword") . '@')), "$ncpserver/$ncpqueue"); $in->do_pkgs->install('ncpfs') if !$::testing && !files_exist('/usr/bin/nprint'); @@ -952,7 +951,7 @@ sub setup_socket { $in->set_help('setupSocket') if $::isInstall; - my ($hostname, $port, $uri, $remotehost,$remoteport); + my ($hostname, $port, $uri, $remotehost, $remoteport); my $queue = $printer->{OLD_QUEUE}; if ($printer->{configured}{$queue} && $printer->{currentqueue}{connect} =~ m!^(socket:|ptal:/hpjd:)!) { @@ -1231,8 +1230,7 @@ complete => sub { sub setup_common { - my ($printer, $in, $makemodel, $device, $do_auto_detect, - @autodetected) = @_; + my ($printer, $in, $makemodel, $device, $do_auto_detect, @autodetected) = @_; #- Check whether the printer is an HP multi-function device and #- configure HPOJ if it is one @@ -2200,16 +2198,16 @@ sub printer_help { $raw = 1; } # Information about scanning with HP's multi-function devices - $scanning = scanner_help - ($printer->{configured}{$queue}{queuedata}{make} . " " . + $scanning = scanner_help( + $printer->{configured}{$queue}{queuedata}{make} . " " . $printer->{configured}{$queue}{queuedata}{model}, $printer->{configured}{$queue}{queuedata}{connect}); if ($scanning) { $scanning = "\n\n$scanning\n\n"; } # Information about photo card access with HP's multi-function devices - $photocard = photocard_help - ($printer->{configured}{$queue}{queuedata}{make} . " " . + $photocard = photocard_help( + $printer->{configured}{$queue}{queuedata}{make} . " " . $printer->{configured}{$queue}{queuedata}{model}, $printer->{configured}{$queue}{queuedata}{connect}); if ($photocard) { @@ -2494,8 +2492,8 @@ sub check_network { if ($choice eq N("Configure the network now")) { if ($::isInstall) { require network::netconnect; - network::netconnect::main - ($in->{prefix}, $in->{netcnx} ||= {}, + network::netconnect::main( + $in->{prefix}, $in->{netcnx} ||= {}, $in->{netc}, $in->{mouse}, $in, $in->{intf}, 0, $in->{lang} eq "fr_FR" && diff --git a/perl-install/resize_fat/c_rewritten.pm b/perl-install/resize_fat/c_rewritten.pm index d74ecb5d3..1447c8da0 100644 --- a/perl-install/resize_fat/c_rewritten.pm +++ b/perl-install/resize_fat/c_rewritten.pm @@ -1,14 +1,14 @@ package resize_fat::c_rewritten; # $Id$ use strict; -use vars qw($VERSION @ISA); require DynaLoader; -@ISA = qw(DynaLoader); -$VERSION = '0.01'; +our @ISA = qw(DynaLoader); +our $VERSION = '0.01'; +our @EXPORT_OK = qw(next set_next); -bootstrap resize_fat::c_rewritten $VERSION; +resize_fat::c_rewritten->bootstrap($VERSION); 1; diff --git a/perl-install/resize_fat/fat.pm b/perl-install/resize_fat/fat.pm index bb762e28e..71c50790e 100644 --- a/perl-install/resize_fat/fat.pm +++ b/perl-install/resize_fat/fat.pm @@ -5,9 +5,7 @@ use strict; use resize_fat::any; use resize_fat::io; -use resize_fat::c_rewritten; - -1; +use resize_fat::c_rewritten qw(next set_next); sub read($) { my ($fs) = @_; @@ -97,9 +95,6 @@ sub endianness($$) { $r; } -*next = \&resize_fat::c_rewritten::next; -*set_next = \&resize_fat::c_rewritten::set_next; - sub get_free($) { @@ -136,3 +131,5 @@ sub set_available($$) { my ($fs, $cluster) = @_; set_next ($fs, $cluster, 0); } + +1; diff --git a/perl-install/resize_fat/io.pm b/perl-install/resize_fat/io.pm index 7643a0953..bd7d32263 100644 --- a/perl-install/resize_fat/io.pm +++ b/perl-install/resize_fat/io.pm @@ -61,11 +61,11 @@ sub check_mounted($) { } } -sub open($) { +sub open { my ($fs) = @_; check_mounted($fs->{device}); - sysopen F, $fs->{fs_name}, 2 or sysopen F, $fs->{fs_name}, 0 or die "error opening device $fs->{fs_name} for writing\n"; - $fs->{fd} = *F; + sysopen $fs->{fd}, $fs->{fs_name}, 2 or + sysopen $fs->{fd}, $fs->{fs_name}, 0 or die "error opening device $fs->{fs_name} for writing\n"; } diff --git a/perl-install/scanner.pm b/perl-install/scanner.pm index 3c9ff6ff2..8eef579ff 100755 --- a/perl-install/scanner.pm +++ b/perl-install/scanner.pm @@ -32,7 +32,7 @@ use log; my $_sanedir = "$prefix/etc/sane.d"; my $_scannerDBdir = "$prefix$ENV{SHARE_PATH}/ldetect-lst"; -$scannerDB = readScannerDB("$_scannerDBdir/ScannerDB"); +my $scannerDB = readScannerDB("$_scannerDBdir/ScannerDB"); sub confScanner { my ($model, $port) = @_; @@ -167,15 +167,12 @@ sub updateScannerDBfromSane { "UMAX" => "Umax", "Vobis/Highscreen" => "Vobis", }; - - opendir YREP, $_sanesrcdir or die "can't open $_sanesrcdir: $!"; - @files = grep /.*desc$/, readdir YREP; - closedir YREP; - foreach my $i (@files) { - my $F = common::openFileMaybeCompressed("$_sanesrcdir/$i"); - print Y "\n# from $i"; + + foreach my $f (glob_("$_sanesrcdir/*.desc")) { + my $F = common::openFileMaybeCompressed($f); + print Y "\n# from $f"; my ($lineno, $cmd, $val) = 0; - my ($name, $intf, $comment,$mfg); + my ($name, $intf, $comment, $mfg, $backend); my $fs = { backend => sub { $backend = $val }, mfg => sub { $mfg = $val; $name = undef },#bug when a new mfg comes. should called $fs->{ $name }(); but ?? diff --git a/perl-install/standalone.pm b/perl-install/standalone.pm index 553ec1e6c..36807d1af 100644 --- a/perl-install/standalone.pm +++ b/perl-install/standalone.pm @@ -7,7 +7,7 @@ use Config; #- for sanity (if a use standalone is made during install, MANY problems will happen) if ($::isInstall) { - require 'log.pm'; + require log; log::l('ERROR: use standalone made during install :-('); require common; log::l('backtrace: ' . backtrace()); @@ -246,7 +246,7 @@ $SIG{SEGV} = sub { my $progname = $0; $progname =~ s|.*/||; exec("drakbug --inci sub import { ($standalone_name = $0) =~ s|.*/||; - c::openlog("$standalone_name"."[$$]"); + c::openlog($standalone_name."[$$]"); explanations('### Program is starting ###'); eval "*MDK::Common::$_ = *$_" foreach @common_functs; diff --git a/perl-install/swap.pm b/perl-install/swap.pm index 7b7c51586..e170c2473 100644 --- a/perl-install/swap.pm +++ b/perl-install/swap.pm @@ -81,6 +81,7 @@ sub make($;$) { my $rdev = (stat $devicename)[6]; $rdev == 0x300 || $rdev == 0x340 and die "$devicename is not a good device for swap"; + local *F; sysopen F, $devicename, 2 or die "opening $devicename for writing failed: $!"; if ($version == 0) { $maxpages = $V0_MAX_PAGES } diff --git a/perl-install/timezone.pm b/perl-install/timezone.pm index ad79cdb6b..9c8d10521 100644 --- a/perl-install/timezone.pm +++ b/perl-install/timezone.pm @@ -2,7 +2,6 @@ package timezone; # $Id$ use diagnostics; use strict; -use vars; use common; use log; @@ -132,7 +131,7 @@ my %l2t = ( ); sub fuzzyChoice { - my ($b, $count) = common::bestMatchSentence($_[0], keys %l2t); + my ($b, $count) = bestMatchSentence($_[0], keys %l2t); $count ? $b : ''; } sub bestTimezone { $l2t{fuzzyChoice($_[0])} || 'GMT' } diff --git a/perl-install/ugtk.pm b/perl-install/ugtk.pm index 66b616eaa..63d9ba153 100644 --- a/perl-install/ugtk.pm +++ b/perl-install/ugtk.pm @@ -48,7 +48,6 @@ sub gtkpack__ { gtkpowerpack(0, 1, @_) } sub gtkpack2 { gtkpowerpack(1, 0, @_) } sub gtkpack2_ { gtkpowerpack('arg', 0, @_) } sub gtkpack2__ { gtkpowerpack(0, 0, @_) } -sub gtkpack3 { gtkpowerpack($a ? 1 : 0, 0, @_) } sub gtkput { $_[0]->put(gtkshow($_[1]), $_[2], $_[3]); $_[0] } sub gtkpixmap { new Gtk::Pixmap(gdkpixmap(@_)) } sub gtkresize { $_[0]->window->resize($_[1], $_[2]); $_[0] } @@ -286,14 +285,14 @@ sub create_dialog { $dialog->border_width(10); $dialog->vbox->pack_start(new Gtk::Label($label),1,1,0); - my $button = new Gtk::Button N("OK"); + my $button = new Gtk::Button(N("OK")); $button->can_default(1); $button->signal_connect(clicked => sub { $ret = 1; $dialog->destroy(); Gtk->main_quit() }); $dialog->action_area->pack_start($button, 1, 1, 0); $button->grab_default; if ($c) { - my $button2 = new Gtk::Button N("Cancel"); + my $button2 = new Gtk::Button(N("Cancel")); $button2->signal_connect(clicked => sub { $ret = 0; $dialog->destroy(); Gtk->main_quit() }); $button2->can_default(1); $dialog->action_area->pack_start($button2, 1, 1, 0); @@ -306,7 +305,7 @@ sub create_dialog { # drakfloppy / logdrake sub destroy_window { - my($widget, $windowref, $w2) = @_; + my ($widget, $windowref, $w2) = @_; $$windowref = undef; $w2 = undef if defined $w2; 0; @@ -363,7 +362,7 @@ sub create_packtable { sub createScrolledWindow { my ($W, $policy, $viewport_shadow) = @_; my $w = new Gtk::ScrolledWindow(undef, undef); - $policy ||= [ 'automatic', 'automatic']; + $policy ||= [ 'automatic', 'automatic' ]; $w->set_policy(@{$policy}); if (member(ref $W, qw(Gtk::CList Gtk::CTree Gtk::Text))) { $w->add($W) @@ -541,8 +540,8 @@ sub gtkicons_labels_widget { $y_round, $x_back2, $y_back2, $icon_width, $icon_height, $exec_func, $exec_hash) = @_; my @tab; - my $cursor_hand = new Gtk::Gdk::Cursor 60; - my $cursor_normal = new Gtk::Gdk::Cursor 68; + my $cursor_hand = new Gtk::Gdk::Cursor(60); + my $cursor_normal = new Gtk::Gdk::Cursor(68); my @args = @$args; foreach (@args) { my ($label, $tag) = ($_->[0], $_->[1]); @@ -579,7 +578,7 @@ sub gtkicons_labels_widget { }; $darea->{state} = 0; $darea->signal_connect(expose_event => $draw); - $darea->set_events(['exposure_mask', 'enter_notify_mask', 'leave_notify_mask', 'button_press_mask', 'button_release_mask' ]); + $darea->set_events([ 'exposure_mask', 'enter_notify_mask', 'leave_notify_mask', 'button_press_mask', 'button_release_mask' ]); $darea->signal_connect(enter_notify_event => sub { if ($darea->{state} == 0) { $darea->{state} = 1; |