X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debian%2FDebhelper%2FBuildsystem.pm;h=6eca336f932b9aae77718dda4799c019cd7f7486;hb=b90485a4fdfa023848e83c34a6db2fa12905201e;hp=f8028619adf4e2b26019154f1b948d58930c6fcc;hpb=6f84d7f67943b67d2630985722085c7b4132ce0a;p=debhelper.git

diff --git a/Debian/Debhelper/Buildsystem.pm b/Debian/Debhelper/Buildsystem.pm
index f802861..6eca336 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
@@ -13,7 +13,7 @@ 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");
 	}
 }
 
@@ -46,47 +46,31 @@ sub DEFAULT_BUILD_DIRECTORY {
 #                  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
-#                  source directory unless it starts with ./, then it is
-#                  assumed to be relative to the top directory. If undef or
-#                  empty, DEFAULT_BUILD_DIRECTORY relative to the source
-#                  directory will be used. If not specified, in source build
-#                  will be attempted.
-# - 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.
+#                  current (top) directory. If undef or empty,
+#                  DEFAULT_BUILD_DIRECTORY directory will be used. 
 # 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({ sourcedir => '.',
 	                   builddir => undef,
-	                   is_buildable => 1 }, $class);
+	                   cwd => Cwd::getcwd() }, $class);
 
 	if (exists $opts{sourcedir}) {
 		# Get relative sourcedir abs_path (without symlinks)
-		my $curdir = Cwd::getcwd();
 		my $abspath = Cwd::abs_path($opts{sourcedir});
-		if (! -d $abspath || $abspath !~ /^\Q$curdir\E/) {
-			error("Invalid or non-existing path to the source directory: ".$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, $curdir);
+		$this->{sourcedir} = File::Spec->abs2rel($abspath, $this->{cwd});
 	}
 	if (exists $opts{builddir}) {
 		$this->_set_builddir($opts{builddir});
 	}
-	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;
-		}
-	}
 	return $this;
 }
 
@@ -95,47 +79,39 @@ sub new {
 # unset the build directory.
 sub _set_builddir {
 	my $this=shift;
-	my $builddir=shift;
-	if ($builddir) {
-		if ($builddir =~ m!^\./(.*)!) {
-			# Specified as relative to the current directory
-			$this->{builddir} = $1;
+	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);
 		}
-		else {
-			# Specified as relative to the source directory
-			$this->{builddir} = $this->get_sourcepath($builddir);
+		elsif ($builddir =~ /\Q$this->{cwd}\E/) {
+			$builddir = File::Spec::abs2rel($builddir, $this->{cwd});
 		}
-	}
-	else {
-		# Relative to the source directory by default
-		$this->{builddir} = $this->get_sourcepath($this->DEFAULT_BUILD_DIRECTORY());
-	}
 
-	# Canonicalize. If build directory ends up the same as source directory, drop it
-	if (defined $this->{builddir}) {
-		$this->{builddir} = $this->_canonpath($this->{builddir});
-		if ($this->{builddir} eq $this->get_sourcedir()) {
-			$this->{builddir} = undef;
+		# 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;
 }
 
-# Test is_buildable flag of the object.
-sub is_buildable {
-	my $this=shift;
-	return $this->{is_buildable};
-}
-
-# 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) = @_;
@@ -146,34 +122,44 @@ sub check_auto_buildable {
 # 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 out of source tree. In source building enforced.");
-		}
+	if ($this->get_builddir()) {
+		$this->{warn_insource} = 1;
 		$this->{builddir} = undef;
 	}
 }
 
-# Derived class can call this method in its constructor to enforce
-# out of source building even if the user didn't request it.
-sub enforce_out_of_source_building {
-	my ($this, $builddir) = @_;
+# 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()) {
-		$this->_set_builddir($builddir);
-		# The build directory might have been dropped if it matched the
-		# source directory. Just set to default in this case.
-		if (!defined $this->get_builddir()) {
-			$this->_set_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");
 		}
 	}
 }
 
+# Derived class can call this method in its constructor to *enforce*
+# out of source building even if the user didn't request it.
+# Build directory is set to DEFAULT_BUILD_DIRECTORY or building
+# fails if it is not possible to set it
+sub enforce_out_of_source_building {
+	my $this=shift;
+	$this->prefer_out_of_source_building();
+}
+
 # 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 {
+sub canonpath {
 	my ($this, $path)=@_;
 	my @canon;
 	my $back=0;
@@ -191,16 +177,23 @@ sub _canonpath {
 	return (@canon + $back > 0) ? join('/', ('..')x$back, @canon) : '.';
 }
 
-# Given both $path and $base are relative to the same directory,
-# converts and returns path of $path being relative the $base.
+# 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 = File::Spec->rootdir() if !defined $root;
-	
-	return File::Spec->abs2rel(
-	    File::Spec->rel2abs($path, $root),
-	    File::Spec->rel2abs($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
@@ -218,7 +211,8 @@ sub get_sourcepath {
 }
 
 # Get path to the build directory if it was specified
-# (relative to the current (top) directory). undef otherwise.
+# (relative to the current (top) directory). undef if the same
+# as the source directory.
 sub get_builddir {
 	my $this=shift;
 	return $this->{builddir};
@@ -290,17 +284,16 @@ sub _cd {
 	}
 }
 
-# Changes working directory to the source directory (if needed)
+# 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 = get_sourcedir();
-		my $curdir = Cwd::getcwd();
+		my $sourcedir = $this->get_sourcedir();
 		$this->_cd($sourcedir);
 		doit(@_);
-		$this->_cd($this->_rel2rel($curdir, $sourcedir, $curdir));
+		$this->_cd($this->_rel2rel($this->{cwd}, $sourcedir));
 	}
 	else {
 		doit(@_);
@@ -315,10 +308,9 @@ sub doit_in_builddir {
 	my $this=shift;
 	if ($this->get_buildpath() ne '.') {
 		my $buildpath = $this->get_buildpath();
-		my $curdir = Cwd::getcwd();
 		$this->_cd($buildpath);
 		doit(@_);
-		$this->_cd($this->_rel2rel($curdir, $buildpath, $curdir));
+		$this->_cd($this->_rel2rel($this->{cwd}, $buildpath));
 	}
 	else {
 		doit(@_);
@@ -332,17 +324,24 @@ sub doit_in_builddir {
 # 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()) {
 		my $buildpath = $this->get_buildpath();
 		if (-d $buildpath && ! $dh{NO_ACT}) {
-			doit("rm", "-rf", $buildpath);
-			# If build directory had 2 or more levels, delete empty
-			# parent directories until the source directory level.
 			my @spdir = File::Spec->splitdir($this->get_build_rel2sourcedir());
 			my $peek;
-			pop @spdir;
-			while (($peek=pop(@spdir)) && $peek ne '.' && $peek ne '..') {
-				last if ! rmdir($this->get_sourcepath(File::Spec->catdir(@spdir, $peek)));
+			if (!$only_empty) {
+				doit("rm", "-rf", $buildpath);
+				pop @spdir;
+			}
+			# If build directory is relative and had 2 or more levels, delete
+			# empty parent directories until the source directory level.
+			if (not File::Spec->file_name_is_absolute($buildpath)) {
+				while (($peek=pop(@spdir)) && $peek ne '.' && $peek ne '..') {
+					my $dir = $this->get_sourcepath(File::Spec->catdir(@spdir, $peek));
+					verbose_print("rmdir $dir");
+					last if ! rmdir($dir);
+				}
 			}
 		}
 		return 1;
@@ -356,6 +355,14 @@ sub rmdir_builddir {
 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).
@@ -371,7 +378,7 @@ sub post_building_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 {
@@ -396,4 +403,4 @@ sub clean {
 	my $this=shift;
 }
 
-1;
+1