From 949a885497d3d05e4dc0dc20e52ecb758d9b677c Mon Sep 17 00:00:00 2001 From: Francois Pons Date: Tue, 14 Nov 2000 15:31:59 +0000 Subject: removed foreach (<... which are eating memory --- perl-install/Xconfig.pm | 6 +++--- perl-install/Xconfigurator.pm | 18 ++++++++++-------- perl-install/commands.pm | 8 +++++--- perl-install/common.pm | 6 +++--- perl-install/detect_devices.pm | 24 ++++++++++++------------ perl-install/fsedit.pm | 5 +++-- perl-install/lang.pm | 3 ++- perl-install/modparm.pm | 6 +++--- perl-install/modules.pm | 6 +++--- perl-install/network.pm | 6 ++++-- perl-install/pkgs.pm | 32 +++++++++++++++++++------------- perl-install/printer.pm | 34 ++++++++++++++++++++++------------ 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 () { + local *F; open F, "$prefix/etc/X11/XF86Config" or return {}; + local $_; + while () { 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 () { $lineno++; + local $_; + while () { $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 () { chop; + local $_; + while () { 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 () { + local *F; open F, $file or die "can't open monitors database ($file): $!"; + local $_; + my $lineno = 0; while () { $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 () { + local *F; open F, "$prefix$o->{card}{prog} :9 -probeonly -pn -xf86config $f 2>&1 |"; + local $_; + while () { $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 () { print G $_ } + local $_; + while () { 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 () { $n-- or return; print } + while () { $n-- or return; print } } else { - @_ = (); foreach () { push @_, $_; @_ > $n and shift; } + @_ = (); while () { 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 () { + local *F; open F, $_[0] or return; + local $_; + while () { 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 () { + local *F; open F, "/proc/scsi/scsi" or return 0; + local $_; + while () { /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 () { $elem->{$1} = $2 if /(.*):(.*);/ } + local *F; open F, "/proc/parport/$_/autoprobe" or next; + local $_; + while () { $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 () { + local *F; open F, "/proc/bus/usb/devices" or return; + local $_; + while () { $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 () { + local *F; open F, "serial_probe 2>/dev/null |"; + local $_; + my %current = (); while () { $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 () { + local *F; open F, "rescuept $dev|"; + local $_; + while () { 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 () { + local $_; + while () { /^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 () { + local *F; open F, $file or log::l("missing $file: $!"), return; + local $_; + while () { 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 () { + local *F; open F, $file or log::l("error opening $file: $!"), return 0; + local $_; + while () { 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 () { + local $_; + while () { /^\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 () { + local $_; + while () { /^[#\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 () { + local *F; open F, "packdrake $newf |"; + local $_; + while () { 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 () { + local *F; open F, "$prefix/var/lib/urpmi/depslist.ordered" or die "can't find dependancies list"; + local $_; + while () { 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 () { + local *F; open F, "$prefix/var/lib/urpmi/compss" or die "can't find compss"; + local $_; + while () { /^\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 () { + local $_; + while () { 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 () { + local $_; + while () { 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 () { + local $_; + while () { 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 () { + local $_; + while () { 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 () { + local $_; + while () { 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 () { + local $_; + while () { 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 () { + while () { 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 () { + local $_; + while () { 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 () { + local $_; + while () { /^(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 () { + local $_; + while () { /^\*([^\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 () { + local $_; + while () { chomp; my ($ppd, $mf, $descr, $lang) = split /\|/; $ppd && $mf && $descr and $descr_to_ppd{"$mf|$descr" . ($lang && " ($lang)")} = $ppd; -- cgit v1.2.1