summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Xconfig.pm6
-rw-r--r--perl-install/Xconfigurator.pm18
-rw-r--r--perl-install/commands.pm8
-rw-r--r--perl-install/common.pm6
-rw-r--r--perl-install/detect_devices.pm24
-rw-r--r--perl-install/fsedit.pm5
-rw-r--r--perl-install/lang.pm3
-rw-r--r--perl-install/modparm.pm6
-rw-r--r--perl-install/modules.pm6
-rw-r--r--perl-install/network.pm6
-rw-r--r--perl-install/pkgs.pm32
-rw-r--r--perl-install/printer.pm34
12 files changed, 89 insertions, 65 deletions
diff --git a/perl-install/Xconfig.pm b/perl-install/Xconfig.pm
index 585ed7247..350c7df33 100644
--- a/perl-install/Xconfig.pm
+++ b/perl-install/Xconfig.pm
@@ -40,9 +40,9 @@ sub getinfoFromXF86Config {
$o->{card}{server} ||= $1 if readlink("$prefix/etc/X11/X") =~ /XF86_ (\w+)$/x; #- /x for perl2fcalls
- local *F;
- open F, "$prefix/etc/X11/XF86Config" or return {};
- foreach (<F>) {
+ local *F; open F, "$prefix/etc/X11/XF86Config" or return {};
+ local $_;
+ while (<F>) {
if (/^Section "Keyboard"/ .. /^EndSection/) {
$o->{keyboard}{xkb_keymap} ||= $1 if /^\s*XkbLayout\s+"(.*?)"/;
} elsif (/^Section "Pointer"/ .. /^EndSection/) {
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 98ab284ea..163801f13 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -57,7 +57,8 @@ sub readCardsDB {
COMMENT => sub {},
};
- foreach (<F>) { $lineno++;
+ local $_;
+ while (<F>) { $lineno++;
s/\s+$//;
/^#/ and next;
/^$/ and next;
@@ -80,7 +81,8 @@ sub cardName2RealName {
my $file = "/usr/X11R6/lib/X11/CardsNames";
my ($name) = @_;
local *F; open F, $file or die "can't find $file\n";
- foreach (<F>) { chop;
+ local $_;
+ while (<F>) { chop;
my ($name_, $real) = split '=>';
return $real if $name eq $name_;
}
@@ -100,9 +102,9 @@ sub readMonitorsDB {
%monitors and return;
- local *F;
- open F, $file or die "can't open monitors database ($file): $!";
- my $lineno = 0; foreach (<F>) {
+ local *F; open F, $file or die "can't open monitors database ($file): $!";
+ local $_;
+ my $lineno = 0; while (<F>) {
$lineno++;
s/\s+$//;
/^#/ and next;
@@ -384,9 +386,9 @@ sub testConfig($) {
#- restart_xfs;
my $f = $tmpconfig . ($o->{card}{use_xf4} && "-4");
- local *F;
- open F, "$prefix$o->{card}{prog} :9 -probeonly -pn -xf86config $f 2>&1 |";
- foreach (<F>) {
+ local *F; open F, "$prefix$o->{card}{prog} :9 -probeonly -pn -xf86config $f 2>&1 |";
+ local $_;
+ while (<F>) {
$o->{card}{memory} ||= $2 if /(videoram|Video RAM):\s*(\d*)/;
# look for clocks
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
index f9b532958..e2d0f4c0d 100644
--- a/perl-install/commands.pm
+++ b/perl-install/commands.pm
@@ -261,7 +261,8 @@ sub cp {
local (*F, *G);
open F, $src or die "can't open $src for reading: $!\n";
open G, "> $dest" or $force or die "can't create $dest : $!\n";
- foreach (<F>) { print G $_ }
+ local $_;
+ while (<F>) { print G $_ }
chmod mode($src), $dest;
}
}
@@ -328,10 +329,11 @@ sub head_tail {
$n = $n ? shift : 10;
local *F; @_ ? open(F, $_[0]) || die "error: can't open file $_[0]\n" : (*F = *STDIN);
+ local $_;
if ($0 eq 'head') {
- foreach (<F>) { $n-- or return; print }
+ while (<F>) { $n-- or return; print }
} else {
- @_ = (); foreach (<F>) { push @_, $_; @_ > $n and shift; }
+ @_ = (); while (<F>) { push @_, $_; @_ > $n and shift; }
print @_;
}
}
diff --git a/perl-install/common.pm b/perl-install/common.pm
index 9dcb55300..2b85f8032 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -409,9 +409,9 @@ sub formatLines($) {
sub getVarsFromSh($) {
my %l;
- local *F;
- open F, $_[0] or return;
- foreach (<F>) {
+ local *F; open F, $_[0] or return;
+ local $_;
+ while (<F>) {
my ($v, $val, $val2) =
/^\s* # leading space
(\w+) = # variable
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index 29356e9b5..79bfedb71 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -75,9 +75,9 @@ sub isUSBFDUDrive { $_[0]->{info} =~ /USB-?FDU/ }
sub isRemovableDrive { &isZipDrive || &isLS120Drive || &isUSBFDUDrive } #-or &isJazzDrive }
sub hasSCSI() {
- local *F;
- open F, "/proc/scsi/scsi" or return 0;
- foreach (<F>) {
+ local *F; open F, "/proc/scsi/scsi" or return 0;
+ local $_;
+ while (<F>) {
/devices: none/ and log::l("no scsi devices are available"), return 0;
}
#- log::l("scsi devices are available");
@@ -247,10 +247,10 @@ sub hasUltra66 {
sub whatParport() {
my @res =();
foreach (0..3) {
- local *F;
my $elem = {};
- open F, "/proc/parport/$_/autoprobe" or next;
- foreach (<F>) { $elem->{$1} = $2 if /(.*):(.*);/ }
+ local *F; open F, "/proc/parport/$_/autoprobe" or next;
+ local $_;
+ while (<F>) { $elem->{$1} = $2 if /(.*):(.*);/ }
push @res, { port => "/dev/lp$_", val => $elem};
}
@res;
@@ -258,9 +258,9 @@ sub whatParport() {
sub whatUsbport() {
my ($i, $elem, @res) = (0, {});
- local *F;
- open F, "/proc/bus/usb/devices" or return;
- foreach (<F>) {
+ local *F; open F, "/proc/bus/usb/devices" or return;
+ local $_;
+ while (<F>) {
$elem->{$1} = $2 if /S:\s+(.*)=(.*\S)/;
if (/I:.*Driver=(printer|usblp)/ && $elem->{Manufacturer} && $elem->{Product}) {
my $MF = ${{ 'Hewlett-Packard' => 'HP' }}{$elem->{Manufacturer}} || $elem->{Manufacturer};
@@ -303,9 +303,9 @@ sub probeSerialDevices {
print STDERR "Please wait while probing serial ports...\n";
#- start probing all serial ports... really faster than before ...
#- ... but still take some time :-)
- local *F;
- open F, "serial_probe 2>/dev/null |";
- my %current = (); foreach (<F>) {
+ local *F; open F, "serial_probe 2>/dev/null |";
+ local $_;
+ my %current = (); while (<F>) {
$serialprobe{$current{DEVICE}} = { %current } and %current = () if /^\s*$/ && $current{DEVICE};
$current{$1} = $2 if /^([^=]+)=(.*?)\s*$/;
}
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index 0e6d2a049..6e16f0810 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -385,8 +385,9 @@ sub rescuept($) {
my ($ext, @hd);
my $dev = devices::make($hd->{device});
- open F, "rescuept $dev|";
- foreach (<F>) {
+ local *F; open F, "rescuept $dev|";
+ local $_;
+ while (<F>) {
my ($st, $si, $id) = /start=\s*(\d+),\s*size=\s*(\d+),\s*Id=\s*(\d+)/ or next;
my $part = { start => $st, size => $si, type => hex($id) };
if (isExtended($part)) {
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
index 79da314fe..78c8b954e 100644
--- a/perl-install/lang.pm
+++ b/perl-install/lang.pm
@@ -367,7 +367,8 @@ sub load_po($) {
} else {
open F, $f; #- not returning here help avoiding reading the same multiple times.
}
- foreach (<F>) {
+ local $_;
+ while (<F>) {
/^msgstr/ and $state = 1;
/^msgid/ && !$fuzzy and $state = 2;
s/@/\\@/g;
diff --git a/perl-install/modparm.pm b/perl-install/modparm.pm
index b4dd71c13..b6aee8905 100644
--- a/perl-install/modparm.pm
+++ b/perl-install/modparm.pm
@@ -19,9 +19,9 @@ sub read_modparm_file {
my @line;
my %modparm_hash;
- local *F;
- open F, $file or log::l("missing $file: $!"), return;
- foreach (<F>) {
+ local *F; open F, $file or log::l("missing $file: $!"), return;
+ local $_;
+ while (<F>) {
chomp;
@line = split ':';
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 6e8c8a039..7178396ca 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -507,9 +507,9 @@ sub read_already_loaded() {
sub load_deps($) {
my ($file) = @_;
- local *F;
- open F, $file or log::l("error opening $file: $!"), return 0;
- foreach (<F>) {
+ local *F; open F, $file or log::l("error opening $file: $!"), return 0;
+ local $_;
+ while (<F>) {
my ($f, $deps) = split ':';
push @{$deps{$f}}, split ' ', $deps;
}
diff --git a/perl-install/network.pm b/perl-install/network.pm
index 126bb00fc..5e687c857 100644
--- a/perl-install/network.pm
+++ b/perl-install/network.pm
@@ -32,7 +32,8 @@ sub read_resolv_conf {
my %netc;
local *F; open F, $file or die "cannot open $file: $!";
- foreach (<F>) {
+ local $_;
+ while (<F>) {
/^\s*nameserver\s+(\S+)/ and $netc{shift @l} = $1;
}
\%netc;
@@ -88,7 +89,8 @@ sub write_resolv_conf {
my (%search, %dns, @unknown);
local *F; open F, $file;
- foreach (<F>) {
+ local $_;
+ while (<F>) {
/^[#\s]*search\s+(.*?)\s*$/ and $search{$1} = $., next;
/^[#\s]*nameserver\s+(.*?)\s*$/ and $dns{$1} = $., next;
/^.*# ppp temp entry\s*$/ and next;
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index bc6abcef0..916c0448d 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -394,7 +394,8 @@ sub psUpdateHdlistsDeps {
#- parse hdlist.list file.
my $medium = 1;
- foreach (<$listf>) {
+ local $_;
+ while (<$listf>) {
chomp;
s/\s*#.*$//;
/^\s*$/ and next;
@@ -425,7 +426,8 @@ sub psUsingHdlists {
#- parse hdlist.list file.
my $medium = 1;
- foreach (<$listf>) {
+ local $_;
+ while (<$listf>) {
chomp;
s/\s*#.*$//;
/^\s*$/ and next;
@@ -474,8 +476,9 @@ sub psUsingHdlist {
#- extract filename from archive, this take advantage of verifying
#- the archive too.
- open F, "packdrake $newf |";
- foreach (<F>) {
+ local *F; open F, "packdrake $newf |";
+ local $_;
+ while (<F>) {
chomp;
/^[dlf]\s+/ or next;
if (/^f\s+\d+\s+(.*)/) {
@@ -521,7 +524,8 @@ sub getOtherDeps($$) {
#- this version of getDeps is customized for handling errors more easily and
#- convert reference by name to deps id including closure computation.
- foreach (<$f>) {
+ local $_;
+ while (<$f>) {
my ($name, $version, $release, $size, $deps) = /^(\S*)-([^-\s]+)-([^-\s]+)\s+(\d+)\s+(.*)/;
my $pkg = $packages->[0]{$name};
@@ -566,9 +570,9 @@ sub getDeps($) {
#- cross reference to be resolved on id (think of loop requires)
#- provides should be updated after base flag has been set to save
#- memory.
- local *F;
- open F, "$prefix/var/lib/urpmi/depslist.ordered" or die "cann't find dependancies list";
- foreach (<F>) {
+ local *F; open F, "$prefix/var/lib/urpmi/depslist.ordered" or die "can't find dependancies list";
+ local $_;
+ while (<F>) {
my ($name, $version, $release, $sizeDeps) = /^(\S*)-([^-\s]+)-([^-\s]+)\s+(.*)/;
my $pkg = $packages->[0]{$name};
@@ -624,9 +628,9 @@ sub readCompss {
#- this is necessary for urpmi.
install_any::getAndSaveFile('Mandrake/base/compss', "$prefix/var/lib/urpmi/compss");
- local *F;
- open F, "$prefix/var/lib/urpmi/compss" or die "can't find compss";
- foreach (<F>) {
+ local *F; open F, "$prefix/var/lib/urpmi/compss" or die "can't find compss";
+ local $_;
+ while (<F>) {
/^\s*$/ || /^#/ and next;
s/#.*//;
@@ -646,7 +650,8 @@ sub readCompssList {
my $f = install_any::getFile('Mandrake/base/compssList') or die "can't find compssList";
my @levels = split ' ', <$f>;
- foreach (<$f>) {
+ local $_;
+ while (<$f>) {
/^\s*$/ || /^#/ and next;
my ($name, @values) = split;
my $p = packageByName($packages, $name) or log::l("unknown entry $name (in compssList)"), next;
@@ -679,7 +684,8 @@ sub readCompssUsers {
};
my $file = 'Mandrake/base/compssUsers';
my $f = $meta_class && install_any::getFile("$file.$meta_class") || install_any::getFile($file) or die "can't find $file";
- foreach (<$f>) {
+ local $_;
+ while (<$f>) {
/^\s*$/ || /^#/ and next;
s/#.*//;
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index 3b408d74c..e3ce0f7fa 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -125,7 +125,8 @@ sub read_configured_queue($) {
#- read /etc/printcap file.
local *PRINTCAP; open PRINTCAP, "$prefix/etc/printcap" or return;
- foreach (<PRINTCAP>) {
+ local $_;
+ while (<PRINTCAP>) {
chomp;
my $p = '(?:\{(.*?)\}|(\S+))';
if (/^##PRINTTOOL3##\s+$p\s+$p\s+$p\s+$p\s+$p\s+$p\s+$p(?:\s+$p)?/) {
@@ -157,7 +158,8 @@ sub read_configured_queue($) {
foreach (values %{$printer->{configured}}) {
my $entry = $_;
local *F; open F, "$prefix$entry->{SPOOLDIR}/general.cfg" or next;
- foreach (<F>) {
+ local $_;
+ while (<F>) {
chomp;
if (/^\s*(?:export\s+)?PRINTER_TYPE=(.*?)\s*$/) { $entry->{TYPE} = $1 unless defined $entry->{TYPE} }
elsif (/^\s*(?:export\s+)?ASCII_TO_PS=(.*?)\s*$/) { $entry->{ASCII_TO_PS} = $1 eq 'YES' unless defined $entry->{ASCII_TO_PS} }
@@ -170,7 +172,8 @@ sub read_configured_queue($) {
foreach (values %{$printer->{configured}}) {
my $entry = $_;
local *F; open F, "$prefix$entry->{SPOOLDIR}/postscript.cfg" or next;
- foreach (<F>) {
+ local $_;
+ while (<F>) {
chomp;
if (/^\s*(?:export\s+)?GSDEVICE=(.*?)\s*$/) { $entry->{GSDRIVER} = $1 unless defined $entry->{GSDRIVER} }
elsif (/^\s*(?:export\s+)?RESOLUTION=(.*?)\s*$/) { $entry->{RESOLUTION} = $1 unless defined $entry->{RESOLUTION} }
@@ -191,7 +194,8 @@ sub read_configured_queue($) {
foreach (values %{$printer->{configured}}) {
my $entry = $_;
local *F; open F, "$prefix$entry->{SPOOLDIR}/textonly.cfg" or next;
- foreach (<F>) {
+ local $_;
+ while (<F>) {
chomp;
if (/^\s*(?:export\s+)?TEXTONLYOPTIONS=(.*?)\s*$/) { $entry->{TEXTONLYOPTIONS} = $1 unless defined $entry->{TEXTONLYOPTIONS}; $entry->{TEXTONLYOPTIONS} =~ s/^\"(.*)\"/$1/ }
elsif (/^\s*(?:export\s+)?CRLFTRANS=(.*?)\s*$/) { $entry->{CRLF} = $1 eq 'YES' unless defined $entry->{CRLF} }
@@ -206,7 +210,8 @@ sub read_configured_queue($) {
if ($entry->{TYPE} eq 'SMB') {
my $config_file = "$prefix$entry->{SPOOLDIR}/.config";
local *F; open F, "$config_file" or next; #die "Can't open $config_file $!";
- foreach (<F>) {
+ local $_;
+ while (<F>) {
chomp;
if (/^\s*share='\\\\(.*?)\\(.*?)'/) {
$entry->{SMBHOST} = $1;
@@ -225,7 +230,8 @@ sub read_configured_queue($) {
} elsif ($entry->{TYPE} eq 'NCP') {
my $config_file = "$prefix$entry->{SPOOLDIR}/.config";
local *F; open F, "$config_file" or next; #die "Can't open $config_file $!";
- foreach (<F>) {
+ local $_;
+ while (<F>) {
chomp;
if (/^\s*server=(.*)/) {
$entry->{NCPHOST} = $1;
@@ -251,8 +257,9 @@ sub read_printer_db(;$) {
scalar(keys %thedb) > 4 and return; #- try reparse if using only ppa, POSTSCRIPT, TEXT.
my %available_devices; #- keep only available devices in our database.
+ local $_; #- use of while (<...
local *AVAIL; open AVAIL, ($::testing ? "$prefix" : "chroot $prefix/ ") . "/usr/bin/gs --help |";
- foreach (<AVAIL>) {
+ while (<AVAIL>) {
if (/^Available devices:/ ... /^\S/) {
@available_devices{split /\s+/, $_} = () if /^\s+/;
}
@@ -262,7 +269,6 @@ sub read_printer_db(;$) {
delete $available_devices{''};
@available_devices{qw/POSTSCRIPT TEXT/} = (); #- these are always available.
- local $_; #- use of while (<...
local *DBPATH; #- don't have to do close ... and don't modify globals at least
open DBPATH, $dbpath or die "An error has occurred on $dbpath : $!";
@@ -343,7 +349,8 @@ sub read_printers_conf {
#- State > Idle|Stopped
#- Accepting > Yes|No
local *PRINTERS; open PRINTERS, "$prefix/etc/cups/printers.conf" or return;
- foreach (<PRINTERS>) {
+ local $_;
+ while (<PRINTERS>) {
chomp;
/^\s*#/ and next;
if (/^\s*<(?:DefaultPrinter|Printer)\s+([^>]*)>/) { $current = { mode => 'CUPS', QUEUE => $1, } }
@@ -361,7 +368,8 @@ sub get_direct_uri {
#- get the local printer to access via a Device URI.
my @direct_uri;
local *F; open F, ($::testing ? "$prefix" : "chroot $prefix/ ") . "/usr/sbin/lpinfo -v |";
- foreach (<F>) {
+ local $_;
+ while (<F>) {
/^(direct|usb|serial)\s+(\S*)/ and push @direct_uri, $2;
}
close F;
@@ -374,7 +382,8 @@ sub get_descr_from_ppd {
#- if there is no ppd, this means this is the PostScript generic filter.
local *F; open F, "$prefix/etc/cups/ppd/$printer->{QUEUE}.ppd" or return "Generic PostScript";
- foreach (<F>) {
+ local $_;
+ while (<F>) {
/^\*([^\s:]*)\s*:\s*\"([^\"]*)\"/ and do { $ppd{$1} = $2; next };
/^\*([^\s:]*)\s*:\s*([^\s\"]*)/ and do { $ppd{$1} = $2; next };
}
@@ -394,7 +403,8 @@ sub poll_ppd_base {
foreach (1..60) {
local *PPDS; open PPDS, ($::testing ? "$prefix" : "chroot $prefix/ ") . "/usr/bin/poll_ppd_base -a |";
- foreach (<PPDS>) {
+ local $_;
+ while (<PPDS>) {
chomp;
my ($ppd, $mf, $descr, $lang) = split /\|/;
$ppd && $mf && $descr and $descr_to_ppd{"$mf|$descr" . ($lang && " ($lang)")} = $ppd;
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-01 05:37:14 +0000