r1987: * Do script fragement reversal only in v6, since it can break certian

[debhelper.git] / Debian / Debhelper / Dh_Lib.pm

diff --git a/Debian/Debhelper/Dh_Lib.pm b/Debian/Debhelper/Dh_Lib.pm
index 5ae611c62c6e5dd7f837b4046317b7a7d0db4226..c72e559f44e676d69586e8373cf233d6b7955f88 100644 (file)
--- a/Debian/Debhelper/Dh_Lib.pm
+++ b/Debian/Debhelper/Dh_Lib.pm
@@ -14,9 +14,9 @@ use vars qw(@ISA @EXPORT %dh);
            &pkgfile &pkgext &pkgfilename &isnative &autoscript &filearray
            &filedoublearray &getpackages &basename &dirname &xargs %dh
            &compat &addsubstvar &delsubstvar &excludefile &package_arch
-           &is_udeb &udeb_filename &debhelper_script_subst);
+           &is_udeb &udeb_filename &debhelper_script_subst &escape_shell);
 
-my $max_compat=4;
+my $max_compat=6;
 
 sub init {
        # If DH_OPTIONS is set, prepend it @ARGV.
@@ -55,8 +55,8 @@ sub init {
                foreach (@{$dh{EXCLUDE}}) {
                        my $x=$_;
                        $x=escape_shell($x);
-                       $x=~s/\./\\./g;
-                       $dh{EXCLUDE_FIND}.="-regex .*$x.* -or ";
+                       $x=~s/\./\\\\./g;
+                       $dh{EXCLUDE_FIND}.="-regex .\\*$x.\\* -or ";
                }
                $dh{EXCLUDE_FIND}=~s/ -or $//;
        }
@@ -104,7 +104,7 @@ sub init {
        # If no error handling function was specified, just propigate
        # errors out.
        if (! exists $dh{ERROR_HANDLER} || ! defined $dh{ERROR_HANDLER}) {
-               $dh{ERROR_HANDLER}='exit $?';
+               $dh{ERROR_HANDLER}='exit \$?';
        }
 }
 
@@ -245,31 +245,43 @@ sub dirname {
 
 # Pass in a number, will return true iff the current compatibility level
 # is less than or equal to that number.
-sub compat {
-       my $num=shift;
+{
+       my $warned_compat=0;
+       my $c;
+
+       sub compat {
+               my $num=shift;
        
-       my $c=1;
-       if (defined $ENV{DH_COMPAT}) {
-               $c=$ENV{DH_COMPAT};
-       }
-       elsif (-e 'debian/compat') {
-               # Try the file..
-               open (COMPAT_IN, "debian/compat") || error "debian/compat: $!";
-               my $l=<COMPAT_IN>;
-               if (! defined $l || ! length $l) {
-                       warning("debian/compat is empty, assuming level $c");
+               if (! defined $c) {
+                       $c=1;
+                       if (defined $ENV{DH_COMPAT}) {
+                               $c=$ENV{DH_COMPAT};
+                       }
+                       elsif (-e 'debian/compat') {
+                               # Try the file..
+                               open (COMPAT_IN, "debian/compat") || error "debian/compat: $!";
+                               my $l=<COMPAT_IN>;
+                               if (! defined $l || ! length $l) {
+                                       warning("debian/compat is empty, assuming level $c");
+                               }
+                               else {
+                                       chomp $l;
+                                       $c=$l;
+                               }
+                       }
                }
-               else {
-                       chomp $l;
-                       $c=$l
+
+               if ($c < 4 && ! $warned_compat) {
+                       warning("Compatibility levels before 4 are deprecated.");
+                       $warned_compat=1;
+               }
+       
+               if ($c > $max_compat) {
+                       error("Sorry, but $max_compat is the highest compatibility level supported by this debhelper.");
                }
-       }
 
-       if ($c > $max_compat) {
-               error("Sorry, but $max_compat is the highest compatibility level of debhelper currently supported.");
+               return ($c <= $num);
        }
-
-       return ($c <= $num);
 }
 
 # Pass it a name of a binary package, it returns the name of the tmp dir to
@@ -393,7 +405,7 @@ sub autoscript {
        my $filename=shift;
        my $sed=shift || "";
 
-       # This is the file we will append to.
+       # This is the file we will modify.
        my $outfile="debian/".pkgext($package)."$script.debhelper";
 
        # Figure out what shell script snippet to use.
@@ -411,9 +423,20 @@ sub autoscript {
                }
        }
 
-       complex_doit("echo \"# Automatically added by ".basename($0)."\">> $outfile");
-       complex_doit("sed \"$sed\" $infile >> $outfile");
-       complex_doit("echo '# End automatically added section' >> $outfile");
+       if (-e $outfile && ($script eq 'postrm' || $script eq 'prerm')
+          && !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");
+               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");
+               complex_doit("echo '# End automatically added section' >> $outfile");
+       }
 }
 
 # Removes a whole substvar line.
@@ -492,6 +515,11 @@ sub filedoublearray {
        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)) {
+                       next if /^#/ || /^$/;
+               }
                my @line;
                # Only do glob expansion in v3 mode.
                #
@@ -536,12 +564,24 @@ sub excludefile {
        sub buildarch {
                return $arch if defined $arch;
 
-               $arch=`dpkg-architecture -qDEB_HOST_ARCH 2>/dev/null` || error($!);
+               $arch=`dpkg-architecture -qDEB_HOST_ARCH 2>/dev/null` || error("dpkg-architecture failed");
                chomp $arch;
                return $arch;
        }
 }
 
+# Passed an arch and a list of arches to match against, returns true if matched
+sub samearch {
+       my $arch=shift;
+       my @archlist=split(/\s+/,shift);
+
+       foreach my $a (@archlist) {
+               system("dpkg-architecture", "-a$arch", "-i$a") == 0 && return 1;
+       }
+
+       return 0;
+}
+
 # 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
@@ -587,7 +627,7 @@ sub getpackages {
                if (/^Architecture:\s*(.*)/) {
                        $arch=$1;
                }
-               if (/^X[BC]*-Package-Type:\s*(.*)/) {
+               if (/^(?:X[BC]*-)?Package-Type:\s*(.*)/) {
                        $package_type=$1;
                }
                
@@ -599,7 +639,7 @@ sub getpackages {
                        if ($package &&
                            (($type eq 'indep' && $arch eq 'all') ||
                             ($type eq 'arch' && $arch ne 'all') ||
-                            ($type eq 'same' && ($arch eq 'any' || $arch =~ /\b$buildarch\b/)) ||
+                            ($type eq 'same' && ($arch eq 'any' || samearch($buildarch, $arch))) ||
                             ! $type)) {
                                push @list, $package;
                                $package="";