]> git.donarmstrong.com Git - debhelper.git/blobdiff - Debian/Debhelper/Buildsystem.pm
misc minor changes
[debhelper.git] / Debian / Debhelper / Buildsystem.pm
index 718ef733321b4cb07dc7e6716fe236c5f475b890..c63f8153b5358457f7d59c7dfea7965e3933d39e 100644 (file)
@@ -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,65 @@ 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. 
 # 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, }, $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});
                }
+               $this->{sourcedir} = File::Spec->abs2rel($abspath, $curdir);
        }
-       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});
        }
        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->{builddir} = ($builddir) ? $builddir : $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;
+               }
+       }
 }
 
-# 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) = @_;
@@ -103,61 +111,134 @@ 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.
+# out of source building even if the user didn't request it. However,
+# if 'builddir' named parameter is passed, accept its value as the
+# build directory even if it matches the source directory (meaning out
+# of source is only prefered to in source, not enforced).
 sub enforce_out_of_source_building {
-       my ($this, $builddir) = @_;
-       if (!defined $this->{builddir}) {
-               $this->{builddir} = ($builddir && $builddir ne ".") ? $builddir : $this->DEFAULT_BUILD_DIRECTORY();
+       my $this=shift;
+       my %args=@_;
+       if (!defined $this->get_builddir()) {
+               $this->_set_builddir($args{builddir});
+               if (!defined $this->get_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");
+               }
        }
 }
 
-# Get path to the specified 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 same directory,
+# converts and returns path of $path being relative the $base.
+sub _rel2rel {
+       my ($this, $path, $base, $root)=@_;
+       $root = "/tmp" if !defined $root;
+       
+       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};
+}
+
+# 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;
+}
+
+# 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 +257,35 @@ 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();
+               my $curdir = Cwd::getcwd();
+               $this->_cd($sourcedir);
+               doit(@_);
+               $this->_cd($this->_rel2rel($curdir, $sourcedir, $curdir));
+       }
+       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();
+               my $curdir = Cwd::getcwd();
+               $this->_cd($buildpath);
                doit(@_);
-               $this->_cd($sourcedir);
+               $this->_cd($this->_rel2rel($curdir, $buildpath, $curdir));
        }
        else {
                doit(@_);
@@ -194,32 +294,52 @@ sub doit_in_builddir {
 }
 
 # In case of out of 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 {
+# 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 && ! $dh{NO_ACT}) {
+                       my @spdir = File::Spec->splitdir($this->get_build_rel2sourcedir());
+                       my $peek;
+                       if (!$only_empty) {
+                               doit("rm", "-rf", $buildpath);
+                               pop @spdir;
+                       }
+                       # If build directory had 2 or more levels, delete empty
+                       # parent directories until the source directory level.
+                       while (($peek=pop(@spdir)) && $peek ne '.' && $peek ne '..') {
+                               last if ! rmdir($this->get_sourcepath(File::Spec->catdir(@spdir, $peek)));
+                       }
                }
                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 +349,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 +374,4 @@ sub clean {
        my $this=shift;
 }
 
-1;
+1