r1691: * dh_installinit: Added --error-handler option. Based on work by Thom May.

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

diff --git a/Debian/Debhelper/Dh_Lib.pm b/Debian/Debhelper/Dh_Lib.pm
index 41b7a6346882f0cfb2d1965f8686a3cc6f33ad81..5449dcaa7d3b1b86fd6acdbd2ea4451ccdd8b0f7 100644 (file)
--- a/Debian/Debhelper/Dh_Lib.pm
+++ b/Debian/Debhelper/Dh_Lib.pm
@@ -11,9 +11,10 @@ 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 &is_udeb
+           &udeb_filename);
 
 my $max_compat=4;
 
@@ -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.
@@ -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
@@ -283,10 +290,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 +317,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 +327,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.
 {
@@ -513,8 +540,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;
        
@@ -526,6 +559,7 @@ sub GetPackages {
 
        my $package="";
        my $arch="";
+       my $package_type;
        my @list=();
        my %seen;
        open (CONTROL, 'debian/control') ||
@@ -542,12 +576,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') ||
@@ -564,4 +606,18 @@ sub GetPackages {
        return @list;
 }
 
+sub is_udeb {
+       my $package=shift;
+       
+       return $package_types{$package} eq 'udeb';
+}
+
+sub udeb_filename {
+       my $package=shift;
+       
+       my $filearch=$package_arches{$package} eq 'all' ? "all" : buildarch();
+       isnative($package); # side effect
+       return "${package}_$dh{VERSION}_$filearch.udeb";
+}
+
 1