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

diff --git a/ChangeLog b/ChangeLog
index 9c40bb37777645e814ff46584e8064fb38626af3..3241f271f800fd02938f98b0b59ed01362b6d916 100644 (file)
--- a/ChangeLog
+++ b/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

diff --git a/TODO b/TODO
index 5daf07db87da90786cc96d2cae6ab97e526f7383..ef838800c18189b545f24d0f8e6da357d33c5561 100644 (file)
--- a/TODO
+++ b/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.

diff --git a/debian/changelog b/debian/changelog
index c69c7b8e629eb69f9e39e0994565ee70f2ed0af4..4dcd024475f0c78ae423b703212362df0661bc8c 100644 (file)
--- a/debian/changelog
+++ b/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).

diff --git a/scripts/Dpkg/Arch.pm b/scripts/Dpkg/Arch.pm
index 547d6311fd073db1a70f8703bb51506dc2f70b35..714a63e7aff393d5401ce496edd2dfd1e673bbd4 100644 (file)
--- a/scripts/Dpkg/Arch.pm
+++ b/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;
     }
 }

diff --git a/scripts/dpkg-architecture.pl b/scripts/dpkg-architecture.pl
index 858d6e4171f00ccd7e0725ab6bec07bf8acceb18..e44956e5b643661959bb6e300b8b72527764253c 100755 (executable)
--- a/scripts/dpkg-architecture.pl
+++ b/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) &&