perl_checker compliance

13 files changed, 19 insertions, 23 deletions

diff --git a/perl-install/Xconfig/resolution_and_depth.pm b/perl-install/Xconfig/resolution_and_depth.pm
index 81559dee7..5d448572a 100644
--- a/perl-install/Xconfig/resolution_and_depth.pm
+++ b/perl-install/Xconfig/resolution_and_depth.pm
@@ -104,7 +104,7 @@ sub allowed {
 	push @resolution_and_depth,
 	  map {
 	      my $Depth = $_;
-	      map { m/(\d+)x(\d+)/; { X => $1, Y => $2, Depth => $Depth } } @resolutions;
+	      map { m/(\d+)x(\d+)/ && { X => $1, Y => $2, Depth => $Depth } } @resolutions;
 	  } @depths;
     }
     $prefered_depth, @resolution_and_depth;
@@ -293,8 +293,7 @@ sub choose_gtk {
     $x_res_combo->set_popdown_strings(uniq map { "$_->{X}x$_->{Y}" } sort { $a->{X} <=> $b->{X} } @resolutions);
     $x_res_combo->entry->signal_connect(changed => sub {
 	$x_res_combo->entry->get_text eq '' and return;  #- FIXME temporarily workaround gtk suckiness (set_text generates two 'change' signals, one when removing the whole, one for inserting the replacement..)
-	$x_res_combo->entry->get_text =~ /(\d+)x(\d+)/;
-	$set_chosen_x_res->($1, $2);
+	$set_chosen_x_res->($1, $2) if $x_res_combo->entry->get_text =~ /(\d+)x(\d+)/;
 	
 	if (!member($chosen_Depth, @{$x_res2depth{$chosen_x_res}})) {
 	    $set_chosen_Depth->(max(@{$x_res2depth{$chosen_x_res}}));
diff --git a/perl-install/c.pm b/perl-install/c.pm
index 56996ecf5..ee44fa426 100644
--- a/perl-install/c.pm
+++ b/perl-install/c.pm
@@ -6,7 +6,7 @@ use c::stuff;
 use MDK::Common;
 
 sub AUTOLOAD() {
-    $AUTOLOAD =~ /::(.*)/;
+    $AUTOLOAD =~ /::(.*)/ or return;
     my @l = eval { &{$c::stuff::{$1}} };
     if (my $err = $@) {
 	$err =~ /Undefined subroutine &main::/ ?
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index dde0ce63f..57dd842f1 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -368,8 +368,7 @@ sub getCPUs() {
 		  push @cpus, $cpu if $cpu;
 		  $cpu = {};
 	   }
-	   /^([^\t]*).*:\s(.*)$/;
-	   $cpu->{$1} = $2 if $1;
+	   $cpu->{$1} = $2 if /^([^\t]+).*:\s(.*)$/;
     }
     push @cpus, $cpu;
     @cpus;
diff --git a/perl-install/http.pm b/perl-install/http.pm
index 34158f7bd..4e19eed8b 100644
--- a/perl-install/http.pm
+++ b/perl-install/http.pm
@@ -29,7 +29,7 @@ sub getFile {
 
     #- skip until empty line
     my ($now, $last, $buf, $tmp) = 0;
-    my $read = sub { sysread($sock, $buf, 1) || die; $tmp .= $buf };
+    my $read = sub { sysread($sock, $buf, 1) or die ''; $tmp .= $buf };
     do {
 	$last = $now;
 	&$read; &$read if $buf =~ /\015/;
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index e019b8538..47fdca801 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -343,9 +343,9 @@ sub main {
 #-    c::unlimit_core() unless $::testing;
 
     my ($cfg, $patch, @auto);
-    my %cmdline; map { 
+    my %cmdline = map { 
 	my ($n, $v) = split '=';
-	$cmdline{$n} = $v || 1;
+	$n => $v || 1;
     } split ' ', cat_("/proc/cmdline");
 
     my $opt; foreach (@_) {
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 6de423d50..ff886ad3d 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -99,8 +99,7 @@ sub selectLanguage {
     $o->{locale}{langs} ||= { $o->{locale}{lang} => 1 };
 
     if (!exists $o->{locale}{country}) {
-	lang::l2locale($o->{locale}{lang}) =~ /^.._(..)/;
-	$o->{locale}{country} = $1;
+	$o->{locale}{country} = $1 if lang::l2locale($o->{locale}{lang}) =~ /^.._(..)/;
     }
 
     lang::langs_selected($o->{locale});
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
index 603b5d81a..f497c438a 100644
--- a/perl-install/interactive.pm
+++ b/perl-install/interactive.pm
@@ -107,7 +107,7 @@ sub vnew {
 
     require 'log.pm'; #- "require log" causes some pb, perl thinking that "log" is the log() function
     undef *log::l;
-    *log::l = sub() {}; # otherwise, it will bother us :(
+    *log::l = sub {}; # otherwise, it will bother us :(
     require interactive::newt;
     interactive::newt->new;
 }
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
index 6a13bad9a..04f1d9c69 100644
--- a/perl-install/lang.pm
+++ b/perl-install/lang.pm
@@ -1027,7 +1027,7 @@ sub during_install__l2charset {
 }
 
 sub get_unneeded_png_lang_files() {
-    print join(' ', map { m|(langs/lang-(.*)\.png)|; if_(!member($2, list_langs()), $1) } glob("pixmaps/langs/lang-*.png"));
+    print join(' ', map { if_(m|(langs/lang-(.*)\.png)| && !member($2, list_langs()), $1) } glob("pixmaps/langs/lang-*.png"));
 }
 
 sub check() {
diff --git a/perl-install/network/adsl.pm b/perl-install/network/adsl.pm
index 893a9955b..d7605a90e 100644
--- a/perl-install/network/adsl.pm
+++ b/perl-install/network/adsl.pm
@@ -161,11 +161,11 @@ user "$adsl->{login}"
     }
 
     if ($adsl_type eq 'speedtouch') {
-	$netc->{vpivci} =~ /(\d+)_(\d+)/;
+	my ($vpi, $vci) = $netc->{vpivci} =~ /(\d+)_(\d+)/ or return;
 	output("$prefix/etc/ppp/peers/adsl", 
 qq(noauth
 noipdefault
-pty "/usr/sbin/pppoa3 -c -vpi $1 -vci $2"
+pty "/usr/sbin/pppoa3 -c -vpi $vpi -vci $vci"
 sync
 kdebug 1
 noaccomp
@@ -195,13 +195,13 @@ and copy the mgmt.o in /usr/share/speedtouch"));
     }
 
     if ($adsl_type eq 'eci') {
-	$netc->{vpivci} =~ /(\d+)_(\d+)/;
+	my ($vpi, $vci) = $netc->{vpivci} =~ /(\d+)_(\d+)/ or return;
 	output("$prefix/etc/ppp/peers/adsl", 
 qq(debug
 kdebug 1
 noipdefault
 defaultroute
-pty "/usr/bin/pppoeci -v 1 -vpi $1 -vci $2"
+pty "/usr/bin/pppoeci -v 1 -vpi $vpi -vci $vci"
 sync
 noaccomp
 nopcomp
diff --git a/perl-install/network/isdn.pm b/perl-install/network/isdn.pm
index 0028ecce7..b3da0ff16 100644
--- a/perl-install/network/isdn.pm
+++ b/perl-install/network/isdn.pm
@@ -159,8 +159,7 @@ sub isdn_read_config {
 	$isdn->{driver} = $c->{ippp0}{alias};
 	#- 'type' 'protocol' 'mem' 'io' 'io0' 'io1' 'irq'  'id'
 	foreach (split(' ', $c->{$isdn->{driver}}{options})) {
-	    /(.*)=(.*)/;
-	    $isdn->{$1} = $2;
+	    $isdn->{$1} = $2 if /(.*)=(.*)/;
 	}
 	foreach my $f ('ioptions1B', 'ioptions2B') {
 	    foreach (cat_("$prefix/etc/ppp/$f")) {
diff --git a/perl-install/partition_table/sun.pm b/perl-install/partition_table/sun.pm
index bcae6d296..9dcae18de 100644
--- a/perl-install/partition_table/sun.pm
+++ b/perl-install/partition_table/sun.pm
@@ -66,7 +66,7 @@ sub compute_crc($) {
     my @l2b = unpack "n256", $tmp;
     my $crc = 0;
 
-    map { $crc ^= $_ } @l2b;
+    $crc ^= $_ foreach @l2b;
 
     $crc;
 }
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index e780927cc..001d7bc3c 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -1039,8 +1039,8 @@ sub install($$$;$$) {
 		my @allpids = grep { /^\d+$/ } all("/proc");
 		my %ppids;
 		foreach (@allpids) {
-		    cat_("/proc/$_/status") =~ /^PPid:\s+(\d+)/m;
-		    push @{$ppids{$1 || 1}}, $_;
+		    push @{$ppids{$1 || 1}}, $_
+		      if cat_("/proc/$_/status") =~ /^PPid:\s+(\d+)/m;
 		}
 		my @killpid = difference2(\@allpids, [ @prev_pids, 
 						       difference2([ $$, hashtree2list(getppid(), \%ppids) ],
diff --git a/perl-install/swap.pm b/perl-install/swap.pm
index 659c9da07..512c72c27 100644
--- a/perl-install/swap.pm
+++ b/perl-install/swap.pm
@@ -28,7 +28,7 @@ my $signature_format_v1 = "x1024 I I I I125"; #- bootbits, version, last_page, n
 1;
 
 sub kernel_greater_or_equal($$$) {
-    c::kernel_version() =~ /(\d*)\.(\d*)\.(\d*)/;
+    c::kernel_version() =~ /(\d*)\.(\d*)\.(\d*)/ or return;
     ($1 <=> $_[0] || $2 <=> $_[1] || $3 <=> $_[2]) >= 0;
 }