use vars qw(@ISA @EXPORT %dh);
@ISA=qw(Exporter);
@EXPORT=qw(&init &doit &complex_doit &verbose_print &error &warning &tmpdir
- &pkgfile &pkgext &isnative &autoscript &filearray &GetPackages
- &basename &dirname &xargs %dh &compat &addsubstvar &delsubstvar);
+ &pkgfile &pkgext &isnative &autoscript &filearray &filedoublearray
+ &GetPackages &basename &dirname &xargs %dh &compat &addsubstvar
+ &delsubstvar &excludefile);
my $max_compat=4;
%dh=Debian::Debhelper::Dh_Getopt::parseopts();
}
+ # Another way to set excludes.
+ if (exists $ENV{DH_ALWAYS_EXCLUDE} && length $ENV{DH_ALWAYS_EXCLUDE}) {
+ push @{$dh{EXCLUDE}}, $ENV{DH_ALWAYS_EXCLUDE};
+ }
+
+ # Generate EXCLUDE_FIND.
+ if ($dh{EXCLUDE}) {
+ $dh{EXCLUDE_FIND}='';
+ foreach (@{$dh{EXCLUDE}}) {
+ my $x=$_;
+ $x=escape_shell($x);
+ $x=~s/\./\\./g;
+ $dh{EXCLUDE_FIND}.="-regex .*$x.* -or ";
+ }
+ $dh{EXCLUDE_FIND}=~s/ -or $//;
+ }
+
# Check to see if DH_VERBOSE environment variable was set, if so,
# make sure verbose is on.
if (defined $ENV{DH_VERBOSE} && $ENV{DH_VERBOSE} ne "") {
$dh{NO_ACT}=1;
}
- # Get the name of the main binary package (first one listed in
- # debian/control).
my @allpackages=GetPackages();
- $dh{MAINPACKAGE}=$allpackages[0];
+ # Get the name of the main binary package (first one listed in
+ # debian/control). Only if the main package was not set on the
+ # command line.
+ if (! exists $dh{MAINPACKAGE} || ! defined $dh{MAINPACKAGE}) {
+ $dh{MAINPACKAGE}=$allpackages[0];
+ }
# Check if packages to build have been specified, if not, fall back to
# the default, doing them all.
# Pass it an array containing the arguments of a shell command like would
# be run by exec(). It turns that into a line like you might enter at the
-# shell, escaping metacharacters and quoting qrguments that contain spaces.
+# shell, escaping metacharacters and quoting arguments that contain spaces.
sub escape_shell {
my @args=@_;
my $line="";
if ($word=~/\s/) {
# Escape only a few things since it will be quoted.
# Note we use double quotes because you cannot
- # escape ' in qingle quotes, while " can be escaped
+ # escape ' in single quotes, while " can be escaped
# in double.
# This does make -V"foo bar" turn into "-Vfoo bar",
# but that will be parsed identically by the shell
# anyway..
- $word=~s/([\n`\$"\\])/\$1/g;
+ $word=~s/([\n`\$"\\])/\\$1/g;
push @ret, "\"$word\"";
}
else {
verbose_print(escape_shell(@_));
if (! $dh{NO_ACT}) {
- system(@_) == 0 || error("command returned error code");
+ my $ret=system(@_);
+ $ret == 0 || error("command returned error code $ret");
}
}
# Returns the basename of the argument passed to it.
sub basename {
my $fn=shift;
-
+
+ $fn=~s/\/$//g; # ignore trailing slashes
$fn=~s:^.*/(.*?)$:$1:;
return $fn;
}
sub dirname {
my $fn=shift;
+ $fn=~s/\/$//g; # ignore trailing slashes
$fn=~s:^(.*)/.*?$:$1:;
return $fn;
}
}
elsif (-e 'debian/compat') {
# Try the file..
- open (COMPAT_IN, "debian/compat") || die "debian/compat: $!";
+ open (COMPAT_IN, "debian/compat") || error "debian/compat: $!";
$c=<COMPAT_IN>;
chomp $c;
}
my $substvarfile="debian/${ext}substvars";
if (-e $substvarfile) {
- complex_doit("grep -v '^${substvar}=' $substvarfile > $substvarfile.new || true");
+ complex_doit("grep -s -v '^${substvar}=' $substvarfile > $substvarfile.new || true");
doit("mv", "$substvarfile.new","$substvarfile");
}
}
my $ext=pkgext($package);
my $substvarfile="debian/${ext}substvars";
my $str=$deppackage;
- $str.=" ($verinfo)" if length $verinfo;
+ $str.=" ($verinfo)" if defined $verinfo && length $verinfo;
# Figure out what the line will look like, based on what's there
# now, and what we're to add or remove.
my $line="";
if (-e $substvarfile) {
my %items;
- open(SUBSTVARS_IN, "$substvarfile") || die "read $substvarfile: $!";
+ open(SUBSTVARS_IN, "$substvarfile") || error "read $substvarfile: $!";
while (<SUBSTVARS_IN>) {
chomp;
if (/^\Q$substvar\E=(.*)/) {
}
if (length $line) {
- complex_doit("echo '${substvar}=$line' >> $substvarfile");
+ complex_doit("(grep -s -v ${substvar} $substvarfile; echo ".escape_shell("${substvar}=$line").") > $substvarfile.new");
+ doit("mv", "$substvarfile.new", $substvarfile);
+ }
+ else {
+ delsubstvar($package,$substvar);
}
}
-# Reads in the specified file, one word at a time, and returns an array of
-# the result. If a value is passed in as the second parameter, then glob
+# Reads in the specified file, one line at a time. splits on words,
+# and returns an array of arrays of the contents.
+# If a value is passed in as the second parameter, then glob
# expansion is done in the directory specified by the parameter ("." is
# frequently a good choice).
-sub filearray {
+sub filedoublearray {
my $file=shift;
my $globdir=shift;
my @ret;
open (DH_FARRAY_IN, $file) || error("cannot read $file: $1");
while (<DH_FARRAY_IN>) {
+ my @line;
# Only do glob expansion in v3 mode.
#
# The tricky bit is that the glob expansion is done
if (defined $globdir && ! compat(2)) {
for (map { glob "$globdir/$_" } split) {
s#^$globdir/##;
- push @ret, $_;
+ push @line, $_;
}
}
else {
- push @ret, split;
+ @line = split;
}
+ push @ret, [@line];
}
close DH_FARRAY_IN;
return @ret;
}
+# Reads in the specified file, one word at a time, and returns an array of
+# the result. Can do globbing as does filedoublearray.
+sub filearray {
+ return map { @$_ } filedoublearray(@_);
+}
+
+# Passed a filename, returns true if -X says that file should be excluded.
+sub excludefile {
+ my $filename = shift;
+ foreach my $f (@{$dh{EXCLUDE}}) {
+ return 1 if $filename =~ /\Q$f\E/;
+ }
+ return 0;
+}
+
# Returns the build architecture. (Memoized)
{
my $arch;
sub buildarch {
return $arch if defined $arch;
- $arch=`dpkg --print-architecture` || error($!);
+ $arch=`dpkg-architecture -qDEB_HOST_ARCH 2>/dev/null` || error($!);
chomp $arch;
return $arch;
}