]> git.donarmstrong.com Git - debhelper.git/blobdiff - Debian/Debhelper/Buildsystem.pm
More verbose rmdir_builddir() and more its tests
[debhelper.git] / Debian / Debhelper / Buildsystem.pm
index ca43391fa607b08d0d2e796ea075dba7cc16c1e3..6eca336f932b9aae77718dda4799c019cd7f7486 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
@@ -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,11 +46,8 @@ 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.
+#                  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. Do NOT use constructor to execute commands or otherwise
 # configure/setup build environment. There is absolutely no guarantee the
@@ -60,16 +57,16 @@ sub new {
        my ($class, %opts)=@_;
 
        my $this = bless({ sourcedir => '.',
-                          builddir => undef, }, $class);
+                          builddir => undef,
+                          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});
@@ -82,41 +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;
 }
 
-# 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) = @_;
@@ -133,24 +128,38 @@ sub enforce_in_source_building {
        }
 }
 
-# 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;
@@ -168,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
@@ -195,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};
@@ -267,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(@_);
@@ -292,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(@_);
@@ -309,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,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 {
@@ -381,4 +403,4 @@ sub clean {
        my $this=shift;
 }
 
-1;
+1