The branch, master has been updated
via 997652024cbd4490eb46ea73abc638e168b60c39 (commit)
from 76209ff4c9d406a4d167d09745ebf8e0b48c3394 (commit)
- Shortlog ------------------------------------------------------------
9976520 Switch perl programs to use the new Dpkg/Arch module
Summary of changes:
ChangeLog | 22 ++++
debian/changelog | 1 +
debian/dpkg-dev.install | 1 +
scripts/Dpkg/Arch.pm | 242 ++++++++++++++++++++++++++++++++++++++++
scripts/Makefile.am | 1 +
scripts/controllib.pl | 232 +--------------------------------------
scripts/dpkg-architecture.pl | 6 +-
scripts/dpkg-checkbuilddeps.pl | 1 +
scripts/dpkg-genchanges.pl | 1 +
scripts/dpkg-gencontrol.pl | 1 +
scripts/dpkg-source.pl | 1 +
scripts/po/POTFILES.in | 1 +
12 files changed, 276 insertions(+), 234 deletions(-)
-----------------------------------------------------------------------
Details of changes:
commit 997652024cbd4490eb46ea73abc638e168b60c39
Author: Guillem Jover <[EMAIL PROTECTED]>
Date: Fri Oct 12 07:16:27 2007 +0300
Switch perl programs to use the new Dpkg/Arch module
diff --git a/ChangeLog b/ChangeLog
index afd178c..307e893 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,25 @@
+2007-10-12 Guillem Jover <[EMAIL PROTECTED]>
+
+ * scripts/controllib.pl ($host_arch, get_host_arch, get_valid_arches)
+ (@cpu, @os, %cputable, %ostable, %cputable_re, %ostable_re)
+ (%debtriplet_to_debarch, %debarch_to_debtriplet, read_cputable)
+ (read_ostable, read_triplettable, debtriplet_to_gnutriplet)
+ (gnutriplet_to_debtriplet, debtriplet_to_debarch)
+ (debarch_to_debtriplet, debwildcard_to_debtriplet)
+ (debarch_eq, debarch_is): Move to ...
+ * scripts/Dpkg/Arch.pm: ... here. New file.
+ * scripts/Makefile.am (nobase_dist_perllib_DATA): Add 'Dpkg/Arch.pm'.
+ * scripts/po/POTFILES.in: Add 'scripts/Dpkg/Arch.pm'.
+
+ * scripts/controllib.pl: Use new Dpkg::Arch module.
+ * scripts/dpkg-architecture.pl: Likewise.
+ * scripts/dpkg-checkbuilddeps.pl: Likewise.
+ * scripts/dpkg-genchanges.pl: Likewise.
+ * scripts/dpkg-gencontrol.pl: Likewise.
+ * scripts/dpkg-source.pl: Likewise.
+
+ * scripts/dpkg-architecture.pl: Do not require controllib.pl anymore.
+
2007-10-12 Frank Lichtenheld <[EMAIL PROTECTED]>
* scripts/t/300_Dpkg_BuildOptions.t: New file.
diff --git a/debian/changelog b/debian/changelog
index 7b9cfec..49b0519 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -43,6 +43,7 @@ dpkg (1.14.8) UNRELEASED; urgency=low
[ Guillem Jover ]
* Use shipped perl modules when calling perl programs at build time.
* Switch perl programs to use the new Dpkg/ErrorHandling module.
+ * Switch perl programs to use the new Dpkg/Arch module.
[ Updated dpkg translations ]
* Polish (Robert Luberda).
diff --git a/debian/dpkg-dev.install b/debian/dpkg-dev.install
index df13a81..bdee88d 100644
--- a/debian/dpkg-dev.install
+++ b/debian/dpkg-dev.install
@@ -17,6 +17,7 @@ usr/bin/dpkg-shlibdeps
usr/bin/dpkg-source
usr/lib/dpkg/controllib.pl
usr/lib/dpkg/parsechangelog
+usr/share/perl5/Dpkg/Arch.pm
usr/share/perl5/Dpkg/Path.pm
usr/share/perl5/Dpkg/Version.pm
usr/share/perl5/Dpkg/ErrorHandling.pm
diff --git a/scripts/Dpkg/Arch.pm b/scripts/Dpkg/Arch.pm
new file mode 100644
index 0000000..3cf7e4d
--- /dev/null
+++ b/scripts/Dpkg/Arch.pm
@@ -0,0 +1,242 @@
+package Dpkg::Arch;
+
+use strict;
+use warnings;
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(get_host_arch get_valid_arches debarch_eq debarch_is
+ debtriplet_to_gnutriplet gnutriplet_to_debtriplet
+ debtriplet_to_debarch debarch_to_debtriplet);
+
+use Dpkg;
+use Dpkg::ErrorHandling qw(syserr subprocerr);
+
+my (@cpu, @os);
+my (%cputable, %ostable);
+my (%cputable_re, %ostable_re);
+
+my %debtriplet_to_debarch;
+my %debarch_to_debtriplet;
+
+{
+ my $host_arch;
+
+ 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;
+ return $host_arch;
+ }
+}
+
+sub get_valid_arches()
+{
+ read_cputable() if ([EMAIL PROTECTED]);
+ read_ostable() if ([EMAIL PROTECTED]);
+
+ foreach my $os (@os) {
+ foreach my $cpu (@cpu) {
+ my $arch = debtriplet_to_debarch(split(/-/, $os, 2), $cpu);
+ print $arch."\n" if defined($arch);
+ }
+ }
+}
+
+sub read_cputable
+{
+ local $_;
+
+ open CPUTABLE, "$pkgdatadir/cputable"
+ or syserr(_g("unable to open cputable"));
+ while (<CPUTABLE>) {
+ if (m/^(?!\#)(\S+)\s+(\S+)\s+(\S+)/) {
+ $cputable{$1} = $2;
+ $cputable_re{$1} = $3;
+ push @cpu, $1;
+ }
+ }
+ close CPUTABLE;
+}
+
+sub read_ostable
+{
+ local $_;
+
+ open OSTABLE, "$pkgdatadir/ostable"
+ or syserr(_g("unable to open ostable"));
+ while (<OSTABLE>) {
+ if (m/^(?!\#)(\S+)\s+(\S+)\s+(\S+)/) {
+ $ostable{$1} = $2;
+ $ostable_re{$1} = $3;
+ push @os, $1;
+ }
+ }
+ close OSTABLE;
+}
+
+sub read_triplettable()
+{
+ read_cputable() if ([EMAIL PROTECTED]);
+
+ local $_;
+
+ open TRIPLETTABLE, "$pkgdatadir/triplettable"
+ or syserr(_g("unable to open triplettable"));
+ while (<TRIPLETTABLE>) {
+ if (m/^(?!\#)(\S+)\s+(\S+)/) {
+ my $debtriplet = $1;
+ my $debarch = $2;
+
+ if ($debtriplet =~ /<cpu>/) {
+ foreach my $_cpu (@cpu) {
+ (my $dt = $debtriplet) =~ s/<cpu>/$_cpu/;
+ (my $da = $debarch) =~ s/<cpu>/$_cpu/;
+
+ $debarch_to_debtriplet{$da} = $dt;
+ $debtriplet_to_debarch{$dt} = $da;
+ }
+ } else {
+ $debarch_to_debtriplet{$2} = $1;
+ $debtriplet_to_debarch{$1} = $2;
+ }
+ }
+ }
+ close TRIPLETTABLE;
+}
+
+sub debtriplet_to_gnutriplet(@)
+{
+ read_cputable() if ([EMAIL PROTECTED]);
+ read_ostable() if ([EMAIL PROTECTED]);
+
+ my ($abi, $os, $cpu) = @_;
+
+ return undef unless defined($abi) && defined($os) && defined($cpu) &&
+ exists($cputable{$cpu}) && exists($ostable{"$abi-$os"});
+ return join("-", $cputable{$cpu}, $ostable{"$abi-$os"});
+}
+
+sub gnutriplet_to_debtriplet($)
+{
+ my ($gnu) = @_;
+ return undef unless defined($gnu);
+ my ($gnu_cpu, $gnu_os) = split(/-/, $gnu, 2);
+ return undef unless defined($gnu_cpu) && defined($gnu_os);
+
+ read_cputable() if ([EMAIL PROTECTED]);
+ read_ostable() if ([EMAIL PROTECTED]);
+
+ my ($os, $cpu);
+
+ foreach my $_cpu (@cpu) {
+ if ($gnu_cpu =~ /^$cputable_re{$_cpu}$/) {
+ $cpu = $_cpu;
+ last;
+ }
+ }
+
+ foreach my $_os (@os) {
+ if ($gnu_os =~ /^(.*-)?$ostable_re{$_os}$/) {
+ $os = $_os;
+ last;
+ }
+ }
+
+ return undef if !defined($cpu) || !defined($os);
+ return (split(/-/, $os, 2), $cpu);
+}
+
+sub debtriplet_to_debarch(@)
+{
+ read_triplettable() if (!%debtriplet_to_debarch);
+
+ my ($abi, $os, $cpu) = @_;
+
+ if (!defined($abi) || !defined($os) || !defined($cpu)) {
+ return undef;
+ } elsif (exists $debtriplet_to_debarch{"$abi-$os-$cpu"}) {
+ return $debtriplet_to_debarch{"$abi-$os-$cpu"};
+ } else {
+ return undef;
+ }
+}
+
+sub debarch_to_debtriplet($)
+{
+ read_triplettable() if (!%debarch_to_debtriplet);
+
+ local ($_) = @_;
+ my $arch;
+
+ if (/^linux-([^-]*)/) {
+ # XXX: Might disappear in the future, not sure yet.
+ $arch = $1;
+ } else {
+ $arch = $_;
+ }
+
+ my $triplet = $debarch_to_debtriplet{$arch};
+
+ if (defined($triplet)) {
+ return split('-', $triplet, 3);
+ } else {
+ return undef;
+ }
+}
+
+sub debwildcard_to_debtriplet($)
+{
+ local ($_) = @_;
+
+ if (/any/) {
+ if (/^([^-]*)-([^-]*)-(.*)/) {
+ return ($1, $2, $3);
+ } elsif (/^([^-]*)-([^-]*)$/) {
+ return ('any', $1, $2);
+ } else {
+ return ($_, $_, $_);
+ }
+ } else {
+ return debarch_to_debtriplet($_);
+ }
+}
+
+sub debarch_eq($$)
+{
+ my ($a, $b) = @_;
+
+ return 1 if ($a eq $b);
+
+ my @a = debarch_to_debtriplet($a);
+ my @b = debarch_to_debtriplet($b);
+
+ return 0 if grep(!defined, (@a, @b));
+
+ return ($a[0] eq $b[0] && $a[1] eq $b[1] && $a[2] eq $b[2]);
+}
+
+sub debarch_is($$)
+{
+ my ($real, $alias) = @_;
+
+ return 1 if ($alias eq $real or $alias eq 'any');
+
+ my @real = debarch_to_debtriplet($real);
+ my @alias = debwildcard_to_debtriplet($alias);
+
+ return 0 if grep(!defined, (@real, @alias));
+
+ if (($alias[0] eq $real[0] || $alias[0] eq 'any') &&
+ ($alias[1] eq $real[1] || $alias[1] eq 'any') &&
+ ($alias[2] eq $real[2] || $alias[2] eq 'any')) {
+ return 1;
+ }
+
+ return 0;
+}
+
+1;
diff --git a/scripts/Makefile.am b/scripts/Makefile.am
index d3793f6..9663fdb 100644
--- a/scripts/Makefile.am
+++ b/scripts/Makefile.am
@@ -72,6 +72,7 @@ CLEANFILES = \
perllibdir = $(PERL_LIBDIR)
nobase_dist_perllib_DATA = \
+ Dpkg/Arch.pm \
Dpkg/Shlibs.pm \
Dpkg/Shlibs/Objdump.pm \
Dpkg/Shlibs/SymbolFile.pm \
diff --git a/scripts/controllib.pl b/scripts/controllib.pl
index 908455f..5cd55eb 100755
--- a/scripts/controllib.pl
+++ b/scripts/controllib.pl
@@ -8,6 +8,7 @@ use POSIX qw(:errno_h);
use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(warning error failure internerr syserr subprocerr);
+use Dpkg::Arch qw(get_host_arch debarch_is);
textdomain("dpkg-dev");
@@ -83,237 +84,6 @@ sub capit {
return join '-', @pieces;
}
-#
-# Architecture library
-#
-
-my (@cpu, @os);
-my (%cputable, %ostable);
-my (%cputable_re, %ostable_re);
-
-my %debtriplet_to_debarch;
-my %debarch_to_debtriplet;
-
-{
- my $host_arch;
-
- 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;
- return $host_arch;
- }
-}
-
-sub get_valid_arches()
-{
- read_cputable() if ([EMAIL PROTECTED]);
- read_ostable() if ([EMAIL PROTECTED]);
-
- foreach my $os (@os) {
- foreach my $cpu (@cpu) {
- my $arch = debtriplet_to_debarch(split(/-/, $os, 2), $cpu);
- print $arch."\n" if defined($arch);
- }
- }
-}
-
-sub read_cputable
-{
- local $_;
-
- open CPUTABLE, "$pkgdatadir/cputable"
- or syserr(_g("unable to open cputable"));
- while (<CPUTABLE>) {
- if (m/^(?!\#)(\S+)\s+(\S+)\s+(\S+)/) {
- $cputable{$1} = $2;
- $cputable_re{$1} = $3;
- push @cpu, $1;
- }
- }
- close CPUTABLE;
-}
-
-sub read_ostable
-{
- local $_;
-
- open OSTABLE, "$pkgdatadir/ostable"
- or syserr(_g("unable to open ostable"));
- while (<OSTABLE>) {
- if (m/^(?!\#)(\S+)\s+(\S+)\s+(\S+)/) {
- $ostable{$1} = $2;
- $ostable_re{$1} = $3;
- push @os, $1;
- }
- }
- close OSTABLE;
-}
-
-sub read_triplettable()
-{
- read_cputable() if ([EMAIL PROTECTED]);
-
- local $_;
-
- open TRIPLETTABLE, "$pkgdatadir/triplettable"
- or syserr(_g("unable to open triplettable"));
- while (<TRIPLETTABLE>) {
- if (m/^(?!\#)(\S+)\s+(\S+)/) {
- my $debtriplet = $1;
- my $debarch = $2;
-
- if ($debtriplet =~ /<cpu>/) {
- foreach my $_cpu (@cpu) {
- (my $dt = $debtriplet) =~ s/<cpu>/$_cpu/;
- (my $da = $debarch) =~ s/<cpu>/$_cpu/;
-
- $debarch_to_debtriplet{$da} = $dt;
- $debtriplet_to_debarch{$dt} = $da;
- }
- } else {
- $debarch_to_debtriplet{$2} = $1;
- $debtriplet_to_debarch{$1} = $2;
- }
- }
- }
- close TRIPLETTABLE;
-}
-
-sub debtriplet_to_gnutriplet(@)
-{
- read_cputable() if ([EMAIL PROTECTED]);
- read_ostable() if ([EMAIL PROTECTED]);
-
- my ($abi, $os, $cpu) = @_;
-
- return undef unless defined($abi) && defined($os) && defined($cpu) &&
- exists($cputable{$cpu}) && exists($ostable{"$abi-$os"});
- return join("-", $cputable{$cpu}, $ostable{"$abi-$os"});
-}
-
-sub gnutriplet_to_debtriplet($)
-{
- my ($gnu) = @_;
- return undef unless defined($gnu);
- my ($gnu_cpu, $gnu_os) = split(/-/, $gnu, 2);
- return undef unless defined($gnu_cpu) && defined($gnu_os);
-
- read_cputable() if ([EMAIL PROTECTED]);
- read_ostable() if ([EMAIL PROTECTED]);
-
- my ($os, $cpu);
-
- foreach my $_cpu (@cpu) {
- if ($gnu_cpu =~ /^$cputable_re{$_cpu}$/) {
- $cpu = $_cpu;
- last;
- }
- }
-
- foreach my $_os (@os) {
- if ($gnu_os =~ /^(.*-)?$ostable_re{$_os}$/) {
- $os = $_os;
- last;
- }
- }
-
- return undef if !defined($cpu) || !defined($os);
- return (split(/-/, $os, 2), $cpu);
-}
-
-sub debtriplet_to_debarch(@)
-{
- read_triplettable() if (!%debtriplet_to_debarch);
-
- my ($abi, $os, $cpu) = @_;
-
- if (!defined($abi) || !defined($os) || !defined($cpu)) {
- return undef;
- } elsif (exists $debtriplet_to_debarch{"$abi-$os-$cpu"}) {
- return $debtriplet_to_debarch{"$abi-$os-$cpu"};
- } else {
- return undef;
- }
-}
-
-sub debarch_to_debtriplet($)
-{
- read_triplettable() if (!%debarch_to_debtriplet);
-
- local ($_) = @_;
- my $arch;
-
- if (/^linux-([^-]*)/) {
- # XXX: Might disappear in the future, not sure yet.
- $arch = $1;
- } else {
- $arch = $_;
- }
-
- my $triplet = $debarch_to_debtriplet{$arch};
-
- if (defined($triplet)) {
- return split('-', $triplet, 3);
- } else {
- return undef;
- }
-}
-
-sub debwildcard_to_debtriplet($)
-{
- local ($_) = @_;
-
- if (/any/) {
- if (/^([^-]*)-([^-]*)-(.*)/) {
- return ($1, $2, $3);
- } elsif (/^([^-]*)-([^-]*)$/) {
- return ('any', $1, $2);
- } else {
- return ($_, $_, $_);
- }
- } else {
- return debarch_to_debtriplet($_);
- }
-}
-
-sub debarch_eq($$)
-{
- my ($a, $b) = @_;
-
- return 1 if ($a eq $b);
-
- my @a = debarch_to_debtriplet($a);
- my @b = debarch_to_debtriplet($b);
-
- return 0 if grep(!defined, (@a, @b));
-
- return ($a[0] eq $b[0] && $a[1] eq $b[1] && $a[2] eq $b[2]);
-}
-
-sub debarch_is($$)
-{
- my ($real, $alias) = @_;
-
- return 1 if ($alias eq $real or $alias eq 'any');
-
- my @real = debarch_to_debtriplet($real);
- my @alias = debwildcard_to_debtriplet($alias);
-
- return 0 if grep(!defined, (@real, @alias));
-
- if (($alias[0] eq $real[0] || $alias[0] eq 'any') &&
- ($alias[1] eq $real[1] || $alias[1] eq 'any') &&
- ($alias[2] eq $real[2] || $alias[2] eq 'any')) {
- return 1;
- }
-
- return 0;
-}
-
sub substvars {
my ($v) = @_;
my $lhs;
diff --git a/scripts/dpkg-architecture.pl b/scripts/dpkg-architecture.pl
index ae643d8..e59ad14 100755
--- a/scripts/dpkg-architecture.pl
+++ b/scripts/dpkg-architecture.pl
@@ -25,9 +25,9 @@ use warnings;
use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(warning syserr usageerr);
-
-push(@INC,$dpkglibdir);
-require 'controllib.pl';
+use Dpkg::Arch qw(get_valid_arches debarch_eq debarch_is
+ debtriplet_to_gnutriplet gnutriplet_to_debtriplet
+ debtriplet_to_debarch debarch_to_debtriplet);
textdomain("dpkg-dev");
diff --git a/scripts/dpkg-checkbuilddeps.pl b/scripts/dpkg-checkbuilddeps.pl
index 6c14ba4..db28b10 100755
--- a/scripts/dpkg-checkbuilddeps.pl
+++ b/scripts/dpkg-checkbuilddeps.pl
@@ -8,6 +8,7 @@ use Getopt::Long;
use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(error);
+use Dpkg::Arch qw(get_host_arch);
push(@INC,$dpkglibdir);
require 'controllib.pl';
diff --git a/scripts/dpkg-genchanges.pl b/scripts/dpkg-genchanges.pl
index ff76124..107c9cf 100755
--- a/scripts/dpkg-genchanges.pl
+++ b/scripts/dpkg-genchanges.pl
@@ -9,6 +9,7 @@ use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(warning error failure unknown internerr syserr
subprocerr usageerr);
+use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
push(@INC,$dpkglibdir);
require 'controllib.pl';
diff --git a/scripts/dpkg-gencontrol.pl b/scripts/dpkg-gencontrol.pl
index caf40c8..4cae8e7 100755
--- a/scripts/dpkg-gencontrol.pl
+++ b/scripts/dpkg-gencontrol.pl
@@ -9,6 +9,7 @@ use Dpkg;
use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(warning error failure unknown internerr syserr
subprocerr usageerr);
+use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
push(@INC,$dpkglibdir);
require 'controllib.pl';
diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl
index ad4bc04..95baed5 100755
--- a/scripts/dpkg-source.pl
+++ b/scripts/dpkg-source.pl
@@ -8,6 +8,7 @@ use Dpkg::Gettext;
use Dpkg::ErrorHandling qw(warning warnerror error failure unknown
internerr syserr subprocerr usageerr
$warnable_error $quiet_warnings);
+use Dpkg::Arch qw(debarch_eq);
my @filesinarchive;
my %dirincluded;
diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in
index 197539e..55554a1 100644
--- a/scripts/po/POTFILES.in
+++ b/scripts/po/POTFILES.in
@@ -15,6 +15,7 @@ scripts/dpkg-scansources.pl
scripts/dpkg-shlibdeps.pl
scripts/dpkg-source.pl
scripts/changelog/debian.pl
+scripts/Dpkg/Arch.pm
scripts/Dpkg/Shlibs.pm
scripts/Dpkg/Shlibs/Objdump.pm
scripts/Dpkg/Shlibs/SymbolFile.pm
--
dpkg's main repository
--
To UNSUBSCRIBE, email to [EMAIL PROTECTED]
with a subject of "unsubscribe". Trouble? Contact [EMAIL PROTECTED]
