X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debian%2FDebhelper%2FDh_Lib.pm;h=f1b39226be061c4e7fa86475202f0885138b4e21;hb=0b49e3bc664a3d10b3a54359b8aa4b8d5e505eb2;hp=e2d26b259ea2c998d39d86403a889d5bb7918d3c;hpb=3605d515acc588025eab1f32b159a961bf0773bb;p=debhelper.git diff --git a/Debian/Debhelper/Dh_Lib.pm b/Debian/Debhelper/Dh_Lib.pm index e2d26b2..f1b3922 100644 --- a/Debian/Debhelper/Dh_Lib.pm +++ b/Debian/Debhelper/Dh_Lib.pm @@ -11,11 +11,12 @@ use Exporter; 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 &filedoublearray - &GetPackages &basename &dirname &xargs %dh &compat &addsubstvar - &delsubstvar &excludefile); + &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 &escape_shell); -my $max_compat=4; +my $max_compat=5; sub init { # If DH_OPTIONS is set, prepend it @ARGV. @@ -45,7 +46,7 @@ sub init { # Another way to set excludes. if (exists $ENV{DH_ALWAYS_EXCLUDE} && length $ENV{DH_ALWAYS_EXCLUDE}) { - push @{$dh{EXCLUDE}}, $ENV{DH_ALWAYS_EXCLUDE}; + push @{$dh{EXCLUDE}}, split(":", $ENV{DH_ALWAYS_EXCLUDE}); } # Generate EXCLUDE_FIND. @@ -55,7 +56,7 @@ sub init { my $x=$_; $x=escape_shell($x); $x=~s/\./\\./g; - $dh{EXCLUDE_FIND}.="-regex .*$x.* -or "; + $dh{EXCLUDE_FIND}.="-regex .\\*$x.\\* -or "; } $dh{EXCLUDE_FIND}=~s/ -or $//; } @@ -72,7 +73,7 @@ sub init { $dh{NO_ACT}=1; } - my @allpackages=GetPackages(); + my @allpackages=getpackages(); # 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. @@ -99,6 +100,12 @@ sub init { # This package gets special treatement: files and directories specified on # the command line may affect it. $dh{FIRSTPACKAGE}=${$dh{DOPACKAGES}}[0]; + + # If no error handling function was specified, just propigate + # errors out. + if (! exists $dh{ERROR_HANDLER} || ! defined $dh{ERROR_HANDLER}) { + $dh{ERROR_HANDLER}='exit $?'; + } } # Pass it an array containing the arguments of a shell command like would @@ -117,7 +124,7 @@ sub escape_shell { # 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 { @@ -238,25 +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") || die "debian/compat: $!"; - $c=; - chomp $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=; + if (! defined $l || ! length $l) { + warning("debian/compat is empty, assuming level $c"); + } + else { + chomp $l; + $c=$l; + } + } + } - if ($c > $max_compat) { - error("Sorry, but $max_compat is the highest compatibility level of debhelper currently supported."); - } + 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."); + } - return ($c <= $num); + return ($c <= $num); + } } # Pass it a name of a binary package, it returns the name of the tmp dir to @@ -283,10 +308,18 @@ sub tmpdir { # * debian/package.filename.buildarch # * 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/package.name.filename.buildarch +# * debian/package.name.filename sub pkgfile { my $package=shift; my $filename=shift; + if (defined $dh{NAME}) { + $filename="$dh{NAME}.$filename"; + } + if (-f "debian/$package.$filename.".buildarch()) { return "debian/$package.$filename.".buildarch(); } @@ -302,7 +335,7 @@ sub pkgfile { } # Pass it a name of a binary package, it returns the name to prefix to files -# in debian for this package. +# in debian/ for this package. sub pkgext { my $package=shift; @@ -312,6 +345,18 @@ sub pkgext { return "$package."; } +# Pass it the name of a binary package, it returns the name to install +# files by in eg, etc. Normally this is the same, but --name can override +# it. +sub pkgfilename { + my $package=shift; + + if (defined $dh{NAME}) { + return $dh{NAME}; + } + return $package; +} + # Returns 1 if the package is a native debian package, null otherwise. # As a side effect, sets $dh{VERSION} to the version of this package. { @@ -392,7 +437,7 @@ sub delsubstvar { 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"); } } @@ -416,7 +461,7 @@ sub addsubstvar { my $line=""; if (-e $substvarfile) { my %items; - open(SUBSTVARS_IN, "$substvarfile") || die "read $substvarfile: $!"; + open(SUBSTVARS_IN, "$substvarfile") || error "read $substvarfile: $!"; while () { chomp; if (/^\Q$substvar\E=(.*)/) { @@ -439,7 +484,11 @@ sub addsubstvar { } 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); } } @@ -455,6 +504,11 @@ sub filedoublearray { my @ret; open (DH_FARRAY_IN, $file) || error("cannot read $file: $1"); while () { + chomp; + # Only ignore comments and empty lines in v5 mode. + if (! compat(4)) { + next if /^#/ || /^$/; + } my @line; # Only do glob expansion in v3 mode. # @@ -499,7 +553,7 @@ sub excludefile { 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; } @@ -509,8 +563,14 @@ sub excludefile { # Must pass "arch" or "indep" or "same" to specify arch-dependant or # -independant or same arch packages. If nothing is specified, returns all # packages. -sub GetPackages { +# 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); +sub getpackages { my $type=shift; + + %package_types=(); + %package_arches=(); $type="" if ! defined $type; @@ -522,6 +582,7 @@ sub GetPackages { my $package=""; my $arch=""; + my $package_type; my @list=(); my %seen; open (CONTROL, 'debian/control') || @@ -538,12 +599,20 @@ sub GetPackages { else { error("debian/control has a duplicate entry for $package"); } + $package_type="deb"; } if (/^Architecture:\s*(.*)/) { $arch=$1; } + if (/^X[BC]*-Package-Type:\s*(.*)/) { + $package_type=$1; + } if (!$_ or eof) { # end of stanza. + if ($package) { + $package_types{$package}=$package_type; + $package_arches{$package}=$arch; + } if ($package && (($type eq 'indep' && $arch eq 'all') || ($type eq 'arch' && $arch ne 'all') || @@ -560,4 +629,59 @@ sub GetPackages { return @list; } +# Returns the arch a package will build for. +sub package_arch { + my $package=shift; + + return $package_arches{$package} eq 'all' ? "all" : buildarch(); +} + +# Return true if a given package is really a udeb. +sub is_udeb { + my $package=shift; + + return $package_types{$package} eq 'udeb'; +} + +# Generates the filename that is used for a udeb package. +sub udeb_filename { + my $package=shift; + + my $filearch=package_arch($package); + isnative($package); # side effect + my $version=$dh{VERSION}; + $version=~s/^[0-9]+://; # strip any epoch + return "${package}_${version}_$filearch.udeb"; +} + +# Handles #DEBHELPER# substitution in a script; also can generate a new +# script from scratch if none exists but there is a .debhelper file for it. +sub debhelper_script_subst { + my $package=shift; + my $script=shift; + + my $tmp=tmpdir($package); + my $ext=pkgext($package); + my $file=pkgfile($package,$script); + + if ($file ne '') { + if (-f "debian/$ext$script.debhelper") { + # Add this into the script, where it has #DEBHELPER# + complex_doit("perl -pe 's~#DEBHELPER#~qx{cat debian/$ext$script.debhelper}~eg' < $file > $tmp/DEBIAN/$script"); + } + else { + # Just get rid of any #DEBHELPER# in the script. + complex_doit("sed s/#DEBHELPER#// < $file > $tmp/DEBIAN/$script"); + } + doit("chown","0:0","$tmp/DEBIAN/$script"); + doit("chmod",755,"$tmp/DEBIAN/$script"); + } + elsif ( -f "debian/$ext$script.debhelper" ) { + complex_doit("printf '#!/bin/sh\nset -e\n' > $tmp/DEBIAN/$script"); + complex_doit("cat debian/$ext$script.debhelper >> $tmp/DEBIAN/$script"); + doit("chown","0:0","$tmp/DEBIAN/$script"); + doit("chmod",755,"$tmp/DEBIAN/$script"); + } +} + 1