&filedoublearray &getpackages &basename &dirname &xargs %dh
&compat &addsubstvar &delsubstvar &excludefile &package_arch
&is_udeb &udeb_filename &debhelper_script_subst &escape_shell
- &inhibit_log &load_log);
+ &inhibit_log &load_log &write_log &dpkg_architecture_value
+ &sourcepackage);
my $max_compat=7;
while (<LOG>) {
chomp;
push @log, $_;
- $db->{$package}{$_}=1 if (defined $db);
+ $db->{$package}{$_}=1 if defined $db;
}
close LOG;
return @log;
# Try the file..
open (COMPAT_IN, "debian/compat") || error "debian/compat: $!";
my $l=<COMPAT_IN>;
+ close COMPAT_IN;
if (! defined $l || ! length $l) {
warning("debian/compat is empty, assuming level $c");
}
#
# It tries several filenames:
# * debian/package.filename.buildarch
+# * debian/package.filename.buildos
# * debian/package.filename
-# * debian/file (if the package is the main package)
-# If --name was specified then tonly the first two are tried, and they must
-# have the name after the pacage name:
+# * debian/filename (if the package is the main package)
+# If --name was specified then the files
+# must have the name after the package name:
# * debian/package.name.filename.buildarch
+# * debian/package.name.filename.buildos
# * debian/package.name.filename
+# * debian/name.filename (if the package is the main package)
sub pkgfile {
my $package=shift;
my $filename=shift;
}
my @try=("debian/$package.$filename.".buildarch(),
+ "debian/$package.$filename.".buildos(),
"debian/$package.$filename");
if ($package eq $dh{MAINPACKAGE}) {
push @try, "debian/$filename";
return 0;
}
+sub dpkg_architecture_value {
+ my $var = shift;
+ my $value=`dpkg-architecture -q$var 2>/dev/null` || error("dpkg-architecture failed");
+ chomp $value;
+ return $value;
+}
+
# Returns the build architecture. (Memoized)
{
my $arch;
sub buildarch {
- return $arch if defined $arch;
-
- $arch=`dpkg-architecture -qDEB_HOST_ARCH 2>/dev/null` || error("dpkg-architecture failed");
- chomp $arch;
+ if (!defined $arch) {
+ $arch=dpkg_architecture_value('DEB_HOST_ARCH');
+ }
return $arch;
}
}
+# Returns the build OS. (Memoized)
+{
+ my $os;
+
+ sub buildos {
+ if (!defined $os) {
+ $os=dpkg_architecture_value("DEB_HOST_ARCH_OS");
+ }
+ return $os;
+ }
+}
+
# Passed an arch and a list of arches to match against, returns true if matched
sub samearch {
my $arch=shift;
return 0;
}
+# Returns source package name
+sub sourcepackage {
+ open (CONTROL, 'debian/control') ||
+ error("cannot read debian/control: $!\n");
+ while (<CONTROL>) {
+ chomp;
+ s/\s+$//;
+ if (/^Source:\s*(.*)/) {
+ close CONTROL;
+ return $1;
+ }
+ }
+
+ close CONTROL;
+ error("could not find Source: line in control file.");
+}
+
# Returns a list of packages in the control file.
-# Must pass "arch" or "indep" or "same" to specify arch-dependant or
-# -independant or same arch packages. If nothing is specified, returns all
-# packages.
+# Pass "arch" or "indep" to specify arch-dependant or
+# independant. If nothing is specified, returns all packages.
# As a side effect, populates %package_arches and %package_types with the
# types of all packages (not only those returned).
my (%package_types, %package_arches);
%package_arches=();
$type="" if ! defined $type;
-
- # Look up the build arch if we need to.
- my $buildarch='';
- if ($type eq 'same') {
- $buildarch=buildarch();
- }
my $package="";
my $arch="";
$package_types{$package}=$package_type;
$package_arches{$package}=$arch;
}
+
if ($package &&
(($type eq 'indep' && $arch eq 'all') ||
- ($type eq 'arch' && $arch ne 'all') ||
- ($type eq 'same' && ($arch eq 'any' || samearch($buildarch, $arch))) ||
+ ($type eq 'arch' && ($arch eq 'any' ||
+ ($arch ne 'all' &&
+ samearch(buildarch(), $arch)))) ||
! $type)) {
push @list, $package;
$package="";