removed foreach (<... which are eating memory

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;