dpkg-architecture: Move host and build arch detection code to Dpkg::Arch

ChangeLog

@@ -1,3 +1,10 @@
+2007-11-04  Guillem Jover  <guillem@debian.org>
+
+	* scripts/dpkg-architecture.pl: Move host and build arch detection
+	to ...
+	* scripts/Dpkg/Arch.pm (get_host_arch): ... here.
+	(get_build_arch, get_gcc_host_gnu_type): Likewise. New function.
+
 2007-11-04  Guillem Jover  <guillem@debian.org>
 
 	* scripts/dpkg-architecture.pl: Wrap long strings for die calls

TODO

@@ -12,7 +12,7 @@ lenny
 1.14.x
 ------
 
- * Make dpkg bootstrappable (modularize dpkg-architecture).
+ * Make dpkg bootstrappable.
 
  * Support udeb natively:
    - Add field Package-Type and friends.

debian/changelog

@@ -54,6 +54,8 @@ dpkg (1.14.8) UNRELEASED; urgency=low
   * Switch perl programs to use the new Dpkg/ErrorHandling module.
   * Switch perl programs to use the new Dpkg/Arch module.
   * Add support for format strings in Dpkg::ErrorHandling functions.
+  * Move build and host arch detection code from dpkg-architecture to
+    Dpkg::Arch.
 
   [ Updated dselect translations ]
   * Czech (Miroslav Kure).

scripts/Dpkg/Arch.pm

@@ -5,13 +5,15 @@ use warnings;
 
 use Exporter;
 our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(get_host_arch get_valid_arches debarch_eq debarch_is
+our @EXPORT_OK = qw(get_build_arch get_host_arch get_gcc_host_gnu_type
+                    get_valid_arches debarch_eq debarch_is
                     debarch_to_gnutriplet gnutriplet_to_debarch
                     debtriplet_to_gnutriplet gnutriplet_to_debtriplet
                     debtriplet_to_debarch debarch_to_debtriplet);
 
 use Dpkg;
-use Dpkg::ErrorHandling qw(syserr subprocerr);
+use Dpkg::Gettext;
+use Dpkg::ErrorHandling qw(syserr subprocerr warning);
 
 my (@cpu, @os);
 my (%cputable, %ostable);
@@ -21,15 +23,63 @@ my %debtriplet_to_debarch;
 my %debarch_to_debtriplet;
 
 {
+    my $build_arch;
     my $host_arch;
+    my $gcc_host_gnu_type;
+
+    sub get_build_arch()
+    {
+	return $build_arch if defined $build_arch;
+
+	my $build_arch = `dpkg --print-architecture`;
+	# FIXME: Handle bootstrapping
+	syserr("dpkg --print-architecture failed") if $? >> 8;
+
+	chomp $build_arch;
+	return $build_arch;
+    }
+
+    sub get_gcc_host_gnu_type()
+    {
+	return $gcc_host_gnu_type if defined $gcc_host_gnu_type;
+
+	my $gcc_host_gnu_type = `\${CC:-gcc} -dumpmachine`;
+	if ($? >> 8) {
+	    $gcc_host_gnu_type = '';
+	} else {
+	    chomp $gcc_host_gnu_type;
+	}
+
+	return $gcc_host_gnu_type;
+    }
 
     sub get_host_arch()
     {
 	return $host_arch if defined $host_arch;
 
-	$host_arch = `dpkg-architecture -qDEB_HOST_ARCH`;
-	$? && subprocerr("dpkg-architecture -qDEB_HOST_ARCH");
-	chomp $host_arch;
+	my $gcc_host_gnu_type = get_gcc_host_gnu_type();
+
+	if ($gcc_host_gnu_type eq '') {
+	    warning(_g("Couldn't determine gcc system type, falling back to " .
+	               "default (native compilation)"));
+	} else {
+	    my (@host_archtriplet) = gnutriplet_to_debtriplet($gcc_host_gnu_type);
+	    $host_arch = debtriplet_to_debarch(@host_archtriplet);
+
+	    if (defined $host_arch) {
+		$gcc_host_gnu_type = debtriplet_to_gnutriplet(@host_archtriplet);
+	    } else {
+		warning(_g("Unknown gcc system type %s, falling back to " .
+		           "default (native compilation)"), $gcc_host_gnu_type);
+		$gcc_host_gnu_type = '';
+	    }
+	}
+
+	if (!defined($host_arch)) {
+	    # Switch to native compilation.
+	    $host_arch = get_build_arch();
+	}
+
 	return $host_arch;
     }
 }

scripts/dpkg-architecture.pl

@@ -25,9 +25,8 @@ use warnings;
 use Dpkg;
 use Dpkg::Gettext;
 use Dpkg::ErrorHandling qw(warning syserr usageerr);
-use Dpkg::Arch qw(get_valid_arches debarch_eq debarch_is
-                  debtriplet_to_gnutriplet gnutriplet_to_debtriplet
-                  debtriplet_to_debarch debarch_to_debtriplet
+use Dpkg::Arch qw(get_build_arch get_host_arch get_gcc_host_gnu_type
+                  get_valid_arches debarch_eq debarch_is debarch_to_debtriplet
                   debarch_to_gnutriplet gnutriplet_to_debarch);
 
 textdomain("dpkg-dev");
@@ -124,38 +123,13 @@ while (@ARGV) {
 
 # Set default values:
 
-chomp (my $deb_build_arch = `dpkg --print-architecture`);
-&syserr("dpkg --print-architecture failed") if $?>>8;
+my $deb_build_arch = get_build_arch();
 my $deb_build_gnu_type = debarch_to_gnutriplet($deb_build_arch);
 
-# Default host: Current gcc.
-my $gcc = `\${CC:-gcc} -dumpmachine`;
-if ($?>>8) {
-    warning(_g("Couldn't determine gcc system type, falling back to default (native compilation)"));
-    $gcc = '';
-} else {
-    chomp $gcc;
-}
+my $deb_host_arch = get_host_arch();
+my $deb_host_gnu_type = debarch_to_gnutriplet($deb_host_arch);
 
-my $deb_host_arch = undef;
-my $deb_host_gnu_type;
-
-if ($gcc ne '') {
-    my (@deb_host_archtriplet) = gnutriplet_to_debtriplet($gcc);
-    $deb_host_arch = debtriplet_to_debarch(@deb_host_archtriplet);
-    unless (defined $deb_host_arch) {
-	warning(_g("Unknown gcc system type %s, falling back to default " .
-	           "(native compilation)"), $gcc);
-	$gcc = '';
-    } else {
-	$gcc = $deb_host_gnu_type = debtriplet_to_gnutriplet(@deb_host_archtriplet);
-    }
-}
-if (!defined($deb_host_arch)) {
-    # Default host: Native compilation.
-    $deb_host_arch = $deb_build_arch;
-    $deb_host_gnu_type = $deb_build_gnu_type;
-}
+# Set user values:
 
 if ($req_host_arch ne '' && $req_host_gnu_type eq '') {
     $req_host_gnu_type = debarch_to_gnutriplet($req_host_arch);
@@ -185,8 +159,8 @@ if ($req_host_gnu_type ne '' && $req_host_arch ne '') {
 $deb_host_arch = $req_host_arch if $req_host_arch ne '';
 $deb_host_gnu_type = $req_host_gnu_type if $req_host_gnu_type ne '';
 
-#$gcc = `\${CC:-gcc} --print-libgcc-file-name`;
-#$gcc =~ s!^.*gcc-lib/(.*)/\d+(?:.\d+)*/libgcc.*$!$1!s;
+my $gcc = get_gcc_host_gnu_type();
+
 warning(_g("Specified GNU system type %s does not match gcc system type %s."),
         $deb_host_gnu_type, $gcc)
     if !($req_is_arch or $req_eq_arch) &&