]> git.donarmstrong.com Git - debhelper.git/blobdiff - Debian/Debhelper/Dh_Lib.pm
Make it possible to pass perl code to autoscript.
[debhelper.git] / Debian / Debhelper / Dh_Lib.pm
index fb83480b5324b69182c26fcc2e17587e1678332b..7b550b0ea5752820d98d1a84d49b5255c3aeeedc 100644 (file)
@@ -15,11 +15,12 @@ use vars qw(@ISA @EXPORT %dh);
            &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 &write_log &dpkg_architecture_value
-           &sourcepackage
-           &is_make_jobserver_unavailable &clean_jobserver_makeflags);
+           &inhibit_log &load_log &write_log &commit_override_log
+           &dpkg_architecture_value &sourcepackage
+           &is_make_jobserver_unavailable &clean_jobserver_makeflags
+           &cross_command &set_buildflags &get_buildoption);
 
-my $max_compat=8;
+my $max_compat=10;
 
 sub init {
        my %params=@_;
@@ -106,16 +107,36 @@ sub END {
        }
 }
 
+sub logfile {
+       my $package=shift;
+       my $ext=pkgext($package);
+       return "debian/${ext}debhelper.log"
+}
+
+sub add_override {
+       my $line=shift;
+       $line="override_$ENV{DH_INTERNAL_OVERRIDE} $line"
+               if defined $ENV{DH_INTERNAL_OVERRIDE};
+       return $line;
+}
+
+sub remove_override {
+       my $line=shift;
+       $line=~s/^\Qoverride_$ENV{DH_INTERNAL_OVERRIDE}\E\s+//
+               if defined $ENV{DH_INTERNAL_OVERRIDE};
+       return $line;
+}
+
 sub load_log {
        my ($package, $db)=@_;
-       my $ext=pkgext($package);
 
        my @log;
-       open(LOG, "<", "debian/${ext}debhelper.log") || return;
+       open(LOG, "<", logfile($package)) || return;
        while (<LOG>) {
                chomp;
-               push @log, $_;
-               $db->{$package}{$_}=1 if defined $db;
+               my $command=remove_override($_);
+               push @log, $command;
+               $db->{$package}{$command}=1 if defined $db;
        }
        close LOG;
        return @log;
@@ -125,13 +146,26 @@ sub write_log {
        my $cmd=shift;
        my @packages=@_;
 
-       return if defined $ENV{DH_INHIBIT_LOG} && $cmd eq $ENV{DH_INHIBIT_LOG};
+       return if $dh{NO_ACT};
 
        foreach my $package (@packages) {
-               my $ext=pkgext($package);
-               my $log="debian/${ext}debhelper.log";
+               my $log=logfile($package);
                open(LOG, ">>", $log) || error("failed to write to ${log}: $!");
-               print LOG $cmd."\n";
+               print LOG add_override($cmd)."\n";
+               close LOG;
+       }
+}
+
+sub commit_override_log {
+       my @packages=@_;
+
+       return if $dh{NO_ACT};
+
+       foreach my $package (@packages) {
+               my @log=map { remove_override($_) } load_log($package);
+               my $log=logfile($package);
+               open(LOG, ">", $log) || error("failed to write to ${log}: $!");
+               print LOG $_."\n" foreach @log;
                close LOG;
        }
 }
@@ -294,29 +328,35 @@ sub dirname {
 
        sub compat {
                my $num=shift;
+               my $nowarn=shift;
        
                if (! defined $c) {
                        $c=1;
-                       if (defined $ENV{DH_COMPAT}) {
-                               $c=$ENV{DH_COMPAT};
-                       }
-                       elsif (-e 'debian/compat') {
-                               # Try the file..
+                       if (-e 'debian/compat') {
                                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");
+                                       warning("debian/compat is empty, assuming level $c")
+                                               unless defined $ENV{DH_COMPAT};
                                }
                                else {
                                        chomp $l;
                                        $c=$l;
                                }
                        }
+                       else {
+                               warning("No compatibility level specified in debian/compat");
+                               warning("This package will soon FTBFS; time to fix it!");
+                       }
+
+                       if (defined $ENV{DH_COMPAT}) {
+                               $c=$ENV{DH_COMPAT};
+                       }
                }
 
-               if ($c <= 4 && ! $warned_compat) {
-                       warning("Compatibility levels before 5 are deprecated.");
+               if ($c <= 4 && ! $warned_compat && ! $nowarn) {
+                       warning("Compatibility levels before 5 are deprecated (level $c in use)");
                        $warned_compat=1;
                }
        
@@ -464,7 +504,8 @@ sub pkgfilename {
 # 1: package
 # 2: script to add to
 # 3: filename of snippet
-# 4: sed to run on the snippet. Ie, s/#PACKAGE#/$PACKAGE/
+# 4: either text: shell-quoted sed to run on the snippet. Ie, 's/#PACKAGE#/$PACKAGE/'
+#    or a sub to run on each line of the snippet. Ie sub { s/#PACKAGE#/$PACKAGE/ }
 sub autoscript {
        my $package=shift;
        my $script=shift;
@@ -493,18 +534,34 @@ sub autoscript {
           && !compat(5)) {
                # Add fragments to top so they run in reverse order when removing.
                complex_doit("echo \"# Automatically added by ".basename($0)."\"> $outfile.new");
-               complex_doit("sed \"$sed\" $infile >> $outfile.new");
+               autoscript_sed($sed, $infile, "$outfile.new");
                complex_doit("echo '# End automatically added section' >> $outfile.new");
                complex_doit("cat $outfile >> $outfile.new");
                complex_doit("mv $outfile.new $outfile");
        }
        else {
                complex_doit("echo \"# Automatically added by ".basename($0)."\">> $outfile");
-               complex_doit("sed \"$sed\" $infile >> $outfile");
+               autoscript_sed($sed, $infile, $outfile);
                complex_doit("echo '# End automatically added section' >> $outfile");
        }
 }
 
+sub autoscript_sed {
+       my $sed = shift;
+       my $infile = shift;
+       my $outfile = shift;
+       if (ref($sed) eq 'CODE') {
+               open(IN, $infile) or die "$infile: $!";
+               open(OUT, ">>$outfile") or die "$outfile: $!";
+               while (<IN>) { $sed->(); print OUT }
+               close(OUT) or die "$outfile: $!";
+               close(IN) or die "$infile: $!";
+       }
+       else {
+               complex_doit("sed \"$sed\" $infile >> $outfile");
+       }
+}
+
 # Removes a whole substvar line.
 sub delsubstvar {
        my $package=shift;
@@ -578,12 +635,22 @@ sub filedoublearray {
        my $file=shift;
        my $globdir=shift;
 
+       # executable config files are a v9 thing.
+       my $x=! compat(8) && -x $file;
+       if ($x) {
+               require Cwd;
+               my $cmd=Cwd::abs_path($file);
+               open (DH_FARRAY_IN, "$cmd |") || error("cannot run $file: $!");
+       }
+       else {
+               open (DH_FARRAY_IN, $file) || error("cannot read $file: $!");
+       }
+
        my @ret;
-       open (DH_FARRAY_IN, $file) || error("cannot read $file: $1");
        while (<DH_FARRAY_IN>) {
                chomp;
                # Only ignore comments and empty lines in v5 mode.
-               if (! compat(4)) {
+               if (! compat(4) && ! $x)  {
                        next if /^#/ || /^$/;
                }
                my @line;
@@ -592,7 +659,7 @@ sub filedoublearray {
                # The tricky bit is that the glob expansion is done
                # as if we were in the specified directory, so the
                # filenames that come out are relative to it.
-               if (defined $globdir && ! compat(2)) {
+               if (defined $globdir && ! compat(2) && ! $x) {
                        foreach (map { glob "$globdir/$_" } split) {
                                s#^$globdir/##;
                                push @line, $_;
@@ -603,7 +670,8 @@ sub filedoublearray {
                }
                push @ret, [@line];
        }
-       close DH_FARRAY_IN;
+
+       close DH_FARRAY_IN || error("problem reading $file: $!");
        
        return @ret;
 }
@@ -858,4 +926,55 @@ sub clean_jobserver_makeflags {
        }
 }
 
+# If cross-compiling, returns appropriate cross version of command.
+sub cross_command {
+       my $command=shift;
+       if (dpkg_architecture_value("DEB_BUILD_GNU_TYPE")
+           ne dpkg_architecture_value("DEB_HOST_GNU_TYPE")) {
+               return dpkg_architecture_value("DEB_HOST_GNU_TYPE")."-$command";
+       }
+       else {
+               return $command;
+       }
+}
+
+# Sets environment variables from dpkg-buildflags. Avoids changing
+# any existing environment variables.
+sub set_buildflags {
+       return if $ENV{DH_INTERNAL_BUILDFLAGS} || compat(8);
+       $ENV{DH_INTERNAL_BUILDFLAGS}=1;
+
+       eval "use Dpkg::BuildFlags";
+       if ($@) {
+               warning "unable to load build flags: $@";
+               return;
+       }
+
+       my $buildflags = Dpkg::BuildFlags->new();
+       $buildflags->load_config();
+       foreach my $flag ($buildflags->list()) {
+               next unless $flag =~ /^[A-Z]/; # Skip flags starting with lowercase
+               if (! exists $ENV{$flag}) {
+                       $ENV{$flag} = $buildflags->get($flag);
+               }
+       }
+}
+
+# Gets a DEB_BUILD_OPTIONS option, if set.
+sub get_buildoption {
+       my $wanted=shift;
+
+       return undef unless exists $ENV{DEB_BUILD_OPTIONS};
+
+       foreach my $opt (split(/\s+/, $ENV{DEB_BUILD_OPTIONS})) {
+               # currently parallel= is the only one with a parameter
+               if ($opt =~ /^parallel=(-?\d+)$/ && $wanted eq 'parallel') {
+                       return $1;
+               }
+               elsif ($opt eq $wanted) {
+                       return 1;
+               }
+       }
+}
+
 1