Browse Source

scripts: Use the state keyword

This moves the variables closer to the block they are being used in. And
protects them from external access.
Guillem Jover 11 years ago
parent
commit
79ad650071
5 changed files with 63 additions and 58 deletions
  1. 1 0
      debian/changelog
  2. 26 23
      scripts/Dpkg/Arch.pm
  3. 2 1
      scripts/Dpkg/Shlibs.pm
  4. 31 32
      scripts/Dpkg/Shlibs/Objdump.pm
  5. 3 2
      scripts/Dpkg/Vendor.pm

+ 1 - 0
debian/changelog

@@ -8,6 +8,7 @@ dpkg (1.18.1) UNRELEASED; urgency=low
   * Perl modules:
     - Add missing strict and warnings pragmas for submodules.
     - Use non-destructive substitutions inside map.
+    - Use the state keyword to simplify the code.
 
   [ Updated programs translations ]
   * German (Sven Joachim).

+ 26 - 23
scripts/Dpkg/Arch.pm

@@ -17,6 +17,7 @@ package Dpkg::Arch;
 
 use strict;
 use warnings;
+use feature qw(state);
 
 our $VERSION = '0.01';
 our @EXPORT_OK = qw(
@@ -59,31 +60,31 @@ my %abibits;
 my %debtriplet_to_debarch;
 my %debarch_to_debtriplet;
 
+sub get_raw_build_arch()
 {
-    my $build_arch;
-    my $host_arch;
-    my $gcc_host_gnu_type;
+    state $build_arch;
 
-    sub get_raw_build_arch()
-    {
-	return $build_arch if defined $build_arch;
+    return $build_arch if defined $build_arch;
 
-	# Note: We *always* require an installed dpkg when inferring the
-	# build architecture. The bootstrapping case is handled by
-	# dpkg-architecture itself, by avoiding computing the DEB_BUILD_
-	# variables when they are not requested.
+    # Note: We *always* require an installed dpkg when inferring the
+    # build architecture. The bootstrapping case is handled by
+    # dpkg-architecture itself, by avoiding computing the DEB_BUILD_
+    # variables when they are not requested.
 
-	$build_arch = `dpkg --print-architecture`;
-	syserr('dpkg --print-architecture failed') if $? >> 8;
+    $build_arch = `dpkg --print-architecture`;
+    syserr('dpkg --print-architecture failed') if $? >> 8;
 
-	chomp $build_arch;
-	return $build_arch;
-    }
+    chomp $build_arch;
+    return $build_arch;
+}
 
-    sub get_build_arch()
-    {
-	return Dpkg::BuildEnv::get('DEB_BUILD_ARCH') || get_raw_build_arch();
-    }
+sub get_build_arch()
+{
+    return Dpkg::BuildEnv::get('DEB_BUILD_ARCH') || get_raw_build_arch();
+}
+
+{
+    my $gcc_host_gnu_type;
 
     sub get_gcc_host_gnu_type()
     {
@@ -101,6 +102,8 @@ my %debarch_to_debtriplet;
 
     sub get_raw_host_arch()
     {
+        state $host_arch;
+
 	return $host_arch if defined $host_arch;
 
 	$gcc_host_gnu_type = get_gcc_host_gnu_type();
@@ -128,11 +131,11 @@ my %debarch_to_debtriplet;
 
 	return $host_arch;
     }
+}
 
-    sub get_host_arch()
-    {
-	return Dpkg::BuildEnv::get('DEB_HOST_ARCH') || get_raw_host_arch();
-    }
+sub get_host_arch()
+{
+    return Dpkg::BuildEnv::get('DEB_HOST_ARCH') || get_raw_host_arch();
 }
 
 sub get_valid_arches()

+ 2 - 1
scripts/Dpkg/Shlibs.pm

@@ -18,6 +18,7 @@ package Dpkg::Shlibs;
 
 use strict;
 use warnings;
+use feature qw(state);
 
 our $VERSION = '0.02';
 our @EXPORT_OK = qw(
@@ -48,9 +49,9 @@ use constant DEFAULT_MULTILIB_PATH =>
 my @librarypaths;
 my $librarypaths_init;
 
-my %visited;
 sub parse_ldso_conf {
     my $file = shift;
+    state %visited;
     local $_;
 
     open my $fh, '<', $file or syserr(g_('cannot open %s'), $file);

+ 31 - 32
scripts/Dpkg/Shlibs/Objdump.pm

@@ -17,6 +17,7 @@ package Dpkg::Shlibs::Objdump;
 
 use strict;
 use warnings;
+use feature qw(state);
 
 our $VERSION = '0.01';
 
@@ -82,41 +83,39 @@ sub has_object {
     return exists $self->{objects}{$objid};
 }
 
-{
-    my %format; # Cache of result
-    sub get_format {
-	my ($file, $objdump) = @_;
+sub get_format {
+    my ($file, $objdump) = @_;
+    state %format;
 
-	$objdump //= $OBJDUMP;
+    $objdump //= $OBJDUMP;
 
-	if (exists $format{$file}) {
-	    return $format{$file};
-	} else {
-	    my ($output, %opts, $pid, $res);
-	    local $_;
+    if (exists $format{$file}) {
+        return $format{$file};
+    } else {
+        my ($output, %opts, $pid, $res);
+        local $_;
 
-	    if ($objdump ne 'objdump') {
-		$opts{error_to_file} = '/dev/null';
-	    }
-	    $pid = spawn(exec => [ $objdump, '-a', '--', $file ],
-			 env => { LC_ALL => 'C' },
-			 to_pipe => \$output, %opts);
-	    while (<$output>) {
-		chomp;
-		if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
-		    $format{$file} = $1;
-		    $res = $format{$file};
-		    last;
-		}
-	    }
-	    close($output);
-	    wait_child($pid, nocheck => 1);
-	    if ($?) {
-		subprocerr('objdump') if $objdump eq 'objdump';
-		$res = get_format($file, 'objdump');
-	    }
-	    return $res;
-	}
+        if ($objdump ne 'objdump') {
+            $opts{error_to_file} = '/dev/null';
+        }
+        $pid = spawn(exec => [ $objdump, '-a', '--', $file ],
+                     env => { LC_ALL => 'C' },
+                     to_pipe => \$output, %opts);
+        while (<$output>) {
+            chomp;
+            if (/^\s*\S+:\s*file\s+format\s+(\S+)\s*$/) {
+                $format{$file} = $1;
+                $res = $format{$file};
+                last;
+            }
+        }
+        close($output);
+        wait_child($pid, nocheck => 1);
+        if ($?) {
+            subprocerr('objdump') if $objdump eq 'objdump';
+            $res = get_format($file, 'objdump');
+        }
+        return $res;
     }
 }
 

+ 3 - 2
scripts/Dpkg/Vendor.pm

@@ -17,6 +17,7 @@ package Dpkg::Vendor;
 
 use strict;
 use warnings;
+use feature qw(state);
 
 our $VERSION = '1.01';
 our @EXPORT_OK = qw(
@@ -87,9 +88,9 @@ if there's no file for the given vendor.
 
 =cut
 
-my %VENDOR_CACHE;
 sub get_vendor_info(;$) {
     my $vendor = shift || 'default';
+    state %VENDOR_CACHE;
     return $VENDOR_CACHE{$vendor} if exists $VENDOR_CACHE{$vendor};
 
     my $file = get_vendor_file($vendor);
@@ -148,9 +149,9 @@ object.
 
 =cut
 
-my %OBJECT_CACHE;
 sub get_vendor_object {
     my $vendor = shift || get_current_vendor() || 'Default';
+    state %OBJECT_CACHE;
     return $OBJECT_CACHE{$vendor} if exists $OBJECT_CACHE{$vendor};
 
     my ($obj, @names);