X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;ds=inline;f=Debian%2FDebhelper%2FBuildsystem.pm;h=677e3bf995982cd8b09c6ee52cc62fa7e59a7f5a;hb=4fb1f3b2d64a2faa9d961205b1c32f83028172c8;hp=d546d20b6f738c6583e07b83ce895536e00f8a7c;hpb=48f1d3414f3eb11bca9fd5abd0140232a872c999;p=debhelper.git

diff --git a/Debian/Debhelper/Buildsystem.pm b/Debian/Debhelper/Buildsystem.pm
index d546d20..677e3bf 100644
--- a/Debian/Debhelper/Buildsystem.pm
+++ b/Debian/Debhelper/Buildsystem.pm
@@ -1,4 +1,4 @@
-# Defines debhelper buildsystem class interface and implementation
+# Defines debhelper build system class interface and implementation
 # of common functionality.
 #
 # Copyright: © 2008-2009 Modestas Vainius
@@ -8,12 +8,12 @@ package Debian::Debhelper::Buildsystem;
 
 use strict;
 use warnings;
-use Cwd;
+use Cwd ();
 use File::Spec;
 use Debian::Debhelper::Dh_Lib;
 
 # Cache DEB_BUILD_GNU_TYPE value. Performance hit of multiple
-# invocations is noticable when listing buildsystems.
+# invocations is noticable when listing build systems.
 our $DEB_BUILD_GNU_TYPE = dpkg_architecture_value("DEB_BUILD_GNU_TYPE");
 
 # Build system name. Defaults to the last component of the class
@@ -26,7 +26,7 @@ sub NAME {
 		return $1;
 	}
 	else {
-		error("ınvalid buildsystem class name: $class");
+		error("ınvalid build system class name: $class");
 	}
 }
 
@@ -42,57 +42,85 @@ sub DEFAULT_BUILD_DIRECTORY {
 }
 
 # Constructs a new build system object. Named parameters:
-# - builddir -     specifies build directory to use. If not specified,
-#                  in-source build will be performed. If undef or empty,
-#                  DEFAULT_BUILD_DIRECTORY will be used.
-# - build_step -   set this parameter to the name of the build step
-#                  if you want the object to determine its is_buidable
-#                  status automatically (with check_auto_buildable()).
-#                  Do not pass this parameter if is_buildable flag should
-#                  be forced to true or set this parameter to undef if
-#                  is_buildable flag should be false.
+# - sourcedir-     specifies source directory (relative to the current (top)
+#                  directory) where the sources to be built live. If not
+#                  specified or empty, defaults to the current directory.
+# - builddir -     specifies build directory to use. Path is relative to the
+#                  current (top) directory. If undef or empty,
+#                  DEFAULT_BUILD_DIRECTORY directory will be used.
+# - parallel -     number of parallel process to be spawned for building
+#                  sources. Parallel building needs to be supported by the
+#                  underlying build system for this option to be effective.
+#                  Defaults to undef (i.e. parallel disabled, but do not try to
+#                  enforce this limit by messing with environment).
 # Derived class can override the constructor to initialize common object
-# parameters and execute commands to configure build environment if
-# is_buildable flag is set on the object.
+# parameters. Do NOT use constructor to execute commands or otherwise
+# configure/setup build environment. There is absolutely no guarantee the
+# constructed object will be used to build something. Use pre_building_step(),
+# $build_step() or post_building_step() methods for this.
 sub new {
 	my ($class, %opts)=@_;
 
-	my $this = bless({ builddir => undef, is_buildable => 1 }, $class);
-	if (exists $opts{builddir}) {
-		if ($opts{builddir}) {
-			$this->{builddir} = $opts{builddir};
-		}
-		else {
-			$this->{builddir} = $this->DEFAULT_BUILD_DIRECTORY();
+	my $this = bless({ sourcedir => '.',
+	                   builddir => undef,
+	                   parallel => undef,
+	                   cwd => Cwd::getcwd() }, $class);
+
+	if (exists $opts{sourcedir}) {
+		# Get relative sourcedir abs_path (without symlinks)
+		my $abspath = Cwd::abs_path($opts{sourcedir});
+		if (! -d $abspath || $abspath !~ /^\Q$this->{cwd}\E/) {
+			error("invalid or non-existing path to the source directory: ".$opts{sourcedir});
 		}
+		$this->{sourcedir} = File::Spec->abs2rel($abspath, $this->{cwd});
 	}
-	if (exists $opts{build_step}) {
-		if (defined $opts{build_step}) {
-			$this->{is_buildable} = $this->check_auto_buildable($opts{build_step});
-		}
-		else {
-			$this->{is_buildable} = 0;
-		}
+	if (exists $opts{builddir}) {
+		$this->_set_builddir($opts{builddir});
+	}
+	if (defined $opts{parallel} && $opts{parallel} >= 1) {
+		$this->{parallel} = $opts{parallel};
 	}
 	return $this;
 }
 
-# Test is_buildable flag of the object.
-sub is_buildable {
+# Private method to set a build directory. If undef, use default.
+# Do $this->{builddir} = undef or pass $this->get_sourcedir() to
+# unset the build directory.
+sub _set_builddir {
 	my $this=shift;
-	return $this->{is_buildable};
+	my $builddir=shift || $this->DEFAULT_BUILD_DIRECTORY;
+
+	if (defined $builddir) {
+		$builddir = $this->canonpath($builddir); # Canonicalize
+
+		# Sanitize $builddir
+		if ($builddir =~ m#^\.\./#) {
+			# We can't handle those as relative. Make them absolute
+			$builddir = File::Spec->catdir($this->{cwd}, $builddir);
+		}
+		elsif ($builddir =~ /\Q$this->{cwd}\E/) {
+			$builddir = File::Spec::abs2rel($builddir, $this->{cwd});
+		}
+
+		# If build directory ends up the same as source directory, drop it
+		if ($builddir eq $this->get_sourcedir()) {
+			$builddir = undef;
+		}
+	}
+	$this->{builddir} = $builddir;
+	return $builddir;
 }
 
-# This instance method is called to check if the build system is capable
+# This instance method is called to check if the build system is able
 # to auto build a source package. Additional argument $step describes
 # which operation the caller is going to perform (either configure,
 # build, test, install or clean). You must override this method for the
 # build system module to be ever picked up automatically. This method is
 # used in conjuction with @Dh_Buildsystems::BUILDSYSTEMS.
 #
-# This method is supposed to be called with source root directory being
-# working directory. Use $this->get_buildpath($path) method to get full
-# path to the files in the build directory.
+# This method is supposed to be called inside the source root directory.
+# Use $this->get_buildpath($path) method to get full path to the files
+# in the build directory.
 sub check_auto_buildable {
 	my $this=shift;
 	my ($step) = @_;
@@ -100,64 +128,151 @@ sub check_auto_buildable {
 }
 
 # Derived class can call this method in its constructor
-# to enforce in-source building even if the user requested otherwise.
+# to enforce in source building even if the user requested otherwise.
 sub enforce_in_source_building {
 	my $this=shift;
-	if ($this->{builddir}) {
-		# Do not emit warning unless the object is buildable.
-		if ($this->is_buildable()) {
-			warning("warning: " . $this->NAME() .
-			    " does not support building outside-source. In-source build enforced.");
-		}
+	if ($this->get_builddir()) {
+		$this->{warn_insource} = 1;
 		$this->{builddir} = undef;
 	}
 }
 
-# Derived class can call this method in its constructor to enforce
-# outside-source building even if the user didn't request it.
-sub enforce_outside_source_building {
-	my ($this, $builddir) = @_;
-	if (!defined $this->{builddir}) {
-		$this->{builddir} = ($builddir && $builddir ne ".") ? $builddir : $this->DEFAULT_BUILD_DIRECTORY();
+# Derived class can call this method in its constructor to *prefer*
+# out of source building. Unless build directory has already been
+# specified building will proceed in the DEFAULT_BUILD_DIRECTORY or
+# the one specified in the 'builddir' named parameter (which may
+# match the source directory). Typically you should pass @_ from
+# the constructor to this call.
+sub prefer_out_of_source_building {
+	my $this=shift;
+	my %args=@_;
+	if (!defined $this->get_builddir()) {
+		if (!$this->_set_builddir($args{builddir}) && !$args{builddir}) {
+			# If we are here, DEFAULT_BUILD_DIRECTORY matches
+			# the source directory, building might fail.
+			error("default build directory is the same as the source directory." .
+			      " Please specify a custom build directory");
+		}
+	}
+}
+
+# Enhanced version of File::Spec::canonpath. It collapses ..
+# too so it may return invalid path if symlinks are involved.
+# On the other hand, it does not need for the path to exist.
+sub canonpath {
+	my ($this, $path)=@_;
+	my @canon;
+	my $back=0;
+	for my $comp (split(m%/+%, $path)) {
+		if ($comp eq '.') {
+			next;
+		}
+		elsif ($comp eq '..') {
+			if (@canon > 0) { pop @canon; }  else { $back++; }
+		}
+		else {
+			push @canon, $comp;
+		}
+	}
+	return (@canon + $back > 0) ? join('/', ('..')x$back, @canon) : '.';
+}
+
+# Given both $path and $base are relative to the $root, converts and
+# returns path of $path being relative to the $base. If either $path or
+# $base is absolute, returns another $path (converted to) absolute.
+sub _rel2rel {
+	my ($this, $path, $base, $root)=@_;
+	$root = $this->{cwd} unless defined $root;
+
+	if (File::Spec->file_name_is_absolute($path)) {
+		return $path;
 	}
+	elsif (File::Spec->file_name_is_absolute($base)) {
+		return File::Spec->rel2abs($path, $root);
+	}
+	else {
+		return File::Spec->abs2rel(
+			File::Spec->rel2abs($path, $root),
+			File::Spec->rel2abs($base, $root)
+		);
+	}
+}
+
+# Get path to the source directory
+# (relative to the current (top) directory)
+sub get_sourcedir {
+	my $this=shift;
+	return $this->{sourcedir};
 }
 
-# Get path to the specified build directory
+# Convert path relative to the source directory to the path relative
+# to the current (top) directory.
+sub get_sourcepath {
+	my ($this, $path)=@_;
+	return File::Spec->catfile($this->get_sourcedir(), $path);
+}
+
+# Get path to the build directory if it was specified
+# (relative to the current (top) directory). undef if the same
+# as the source directory.
 sub get_builddir {
 	my $this=shift;
 	return $this->{builddir};
 }
 
-# Construct absolute path to the file from the given path that is relative
-# to the build directory.
+# Convert path that is relative to the build directory to the path
+# that is relative to the current (top) directory.
+# If $path is not specified, always returns build directory path
+# relative to the current (top) directory regardless if builddir was
+# specified or not.
 sub get_buildpath {
-	my ($this, $path) = @_;
-	if ($this->get_builddir()) {
-		return File::Spec->catfile($this->get_builddir(), $path);
-	}
-	else {
-		return File::Spec->catfile('.', $path);
+	my ($this, $path)=@_;
+	my $builddir = $this->get_builddir() || $this->get_sourcedir();
+	if (defined $path) {
+		return File::Spec->catfile($builddir, $path);
 	}
+	return $builddir;
 }
 
-# When given a relative path in the source tree, converts it
-# to the path that is relative to the build directory.
-# If $path is not given, returns relative path to the root of the
-# source tree from the build directory.
-sub get_rel2builddir_path {
+# When given a relative path to the source directory, converts it
+# to the path that is relative to the build directory. If $path is
+# not given, returns a path to the source directory that is relative
+# to the build directory.
+sub get_source_rel2builddir {
 	my $this=shift;
 	my $path=shift;
 
-	if (defined $path) {
-		$path = File::Spec->catfile(Cwd::getcwd(), $path);
+	my $dir = '.';
+	if ($this->get_builddir()) {
+		$dir = $this->_rel2rel($this->get_sourcedir(), $this->get_builddir());
 	}
-	else {
-		$path = Cwd::getcwd();
+	if (defined $path) {
+		return File::Spec->catfile($dir, $path);
 	}
+	return $dir;
+}
+
+sub get_parallel {
+	my $this=shift;
+	return $this->{parallel};
+}
+
+# When given a relative path to the build directory, converts it
+# to the path that is relative to the source directory. If $path is
+# not given, returns a path to the build directory that is relative
+# to the source directory.
+sub get_build_rel2sourcedir {
+	my $this=shift;
+	my $path=shift;
+
+	my $dir = '.';
 	if ($this->get_builddir()) {
-		return File::Spec->abs2rel($path, Cwd::abs_path($this->get_builddir()));
+		$dir = $this->_rel2rel($this->get_builddir(), $this->get_sourcedir());
+	}
+	if (defined $path) {
+		return File::Spec->catfile($dir, $path);
 	}
-	return $path;
+	return $dir;
 }
 
 # Creates a build directory.
@@ -176,16 +291,33 @@ sub _cd {
 	}
 }
 
-# Changes working directory the build directory (if needed), calls doit(@_)
-# and changes working directory back to the source directory.
+# Changes working directory to the source directory (if needed),
+# calls doit(@_) and changes working directory back to the top
+# directory.
+sub doit_in_sourcedir {
+	my $this=shift;
+	if ($this->get_sourcedir() ne '.') {
+		my $sourcedir = $this->get_sourcedir();
+		$this->_cd($sourcedir);
+		doit(@_);
+		$this->_cd($this->_rel2rel($this->{cwd}, $sourcedir));
+	}
+	else {
+		doit(@_);
+	}
+	return 1;
+}
+
+# Changes working directory to the build directory (if needed),
+# calls doit(@_) and changes working directory back to the top
+# directory.
 sub doit_in_builddir {
 	my $this=shift;
-	if ($this->get_builddir()) {
-		my $builddir = $this->get_builddir();
-		my $sourcedir = $this->get_rel2builddir_path();
-		$this->_cd($builddir);
+	if ($this->get_buildpath() ne '.') {
+		my $buildpath = $this->get_buildpath();
+		$this->_cd($buildpath);
 		doit(@_);
-		$this->_cd($sourcedir);
+		$this->_cd($this->_rel2rel($this->{cwd}, $buildpath));
 	}
 	else {
 		doit(@_);
@@ -193,33 +325,57 @@ sub doit_in_builddir {
 	return 1;
 }
 
-# In case of outside-source tree building, whole build directory
-# gets wiped (if it exists) and 1 is returned. Otherwise, nothing
-# is done and 0 is returned.
-sub clean_builddir {
+# In case of out of source tree building, whole build directory
+# gets wiped (if it exists) and 1 is returned. If build directory
+# had 2 or more levels, empty parent directories are also deleted.
+# If build directory does not exist, nothing is done and 0 is returned.
+sub rmdir_builddir {
 	my $this=shift;
+	my $only_empty=shift;
 	if ($this->get_builddir()) {
-		if (-d $this->get_builddir()) {
-			doit("rm", "-rf", $this->get_builddir());
+		my $buildpath = $this->get_buildpath();
+		if (-d $buildpath) {
+			my @dir = File::Spec->splitdir($this->get_build_rel2sourcedir());
+			my $peek;
+			if (not $only_empty) {
+				doit("rm", "-rf", $buildpath);
+				pop @dir;
+			}
+			# If build directory is relative and had 2 or more levels, delete
+			# empty parent directories until the source or top directory level.
+			if (not File::Spec->file_name_is_absolute($buildpath)) {
+				while (($peek=pop @dir) && $peek ne '.' && $peek ne '..') {
+					my $dir = $this->get_sourcepath(File::Spec->catdir(@dir, $peek));
+					doit("rmdir", "--ignore-fail-on-non-empty", $dir);
+					last if -d $dir;
+				}
+			}
 		}
 		return 1;
 	}
 	return 0;
 }
 
-
 # Instance method that is called before performing any step (see below).
 # Action name is passed as an argument. Derived classes overriding this
 # method should also call SUPER implementation of it.
-sub pre_step {
+sub pre_building_step {
 	my $this=shift;
 	my ($step)=@_;
+
+	# Warn if in source building was enforced but build directory was
+	# specified. See enforce_in_source_building().
+	if ($this->{warn_insource}) {
+		warning("warning: " . $this->NAME() .
+		    " does not support building out of source tree. In source building enforced.");
+		delete $this->{warn_insource};
+	}
 }
 
 # Instance method that is called after performing any step (see below).
 # Action name is passed as an argument. Derived classes overriding this
 # method should also call SUPER implementation of it.
-sub post_step {
+sub post_building_step {
 	my $this=shift;
 	my ($step)=@_;
 }
@@ -229,7 +385,7 @@ sub post_step {
 # In case of failure, the method may just error() out.
 #
 # These methods should be overriden by derived classes to
-# implement buildsystem specific steps needed to build the
+# implement build system specific steps needed to build the
 # source. Arbitary number of custom step arguments might be
 # passed. Default implementations do nothing.
 sub configure {
@@ -254,4 +410,4 @@ sub clean {
 	my $this=shift;
 }
 
-1;
+1