X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debian%2FDebhelper%2FBuildsystem.pm;h=763baa9d1773d40957c87f11122fc094cf632034;hb=6dd52d5bc8b79447bfa7183c5de406c399d5884d;hp=5bebfe2e2ed5853b86404c1b9ecbd6b5858ff93d;hpb=9803d8bb635132458142416d32273c9c754b2aca;p=debhelper.git diff --git a/Debian/Debhelper/Buildsystem.pm b/Debian/Debhelper/Buildsystem.pm index 5bebfe2..763baa9 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,14 +8,10 @@ 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. -our $DEB_BUILD_GNU_TYPE = dpkg_architecture_value("DEB_BUILD_GNU_TYPE"); - # Build system name. Defaults to the last component of the class # name. Do not override this method unless you know what you are # doing. @@ -26,7 +22,7 @@ sub NAME { return $1; } else { - error("ınvalid buildsystem class name: $class"); + error("ınvalid build system class name: $class"); } } @@ -38,126 +34,247 @@ sub DESCRIPTION { # Default build directory. Can be overriden in the derived # class if really needed. sub DEFAULT_BUILD_DIRECTORY { - "obj-" . $DEB_BUILD_GNU_TYPE; + "obj-" . dpkg_architecture_value("DEB_BUILD_GNU_TYPE"); } # 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_action - set this parameter to the name of the build action -# 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 - max number of parallel processes to be spawned for building +# sources (-1 = unlimited; 1 = no parallel) # 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_action}) { - if (defined $opts{build_action}) { - $this->{is_buildable} = $this->check_auto_buildable($opts{build_action}); - } - else { - $this->{is_buildable} = 0; - } + if (exists $opts{builddir}) { + $this->_set_builddir($opts{builddir}); + } + if (defined $opts{parallel}) { + $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 -# to auto build a source package. Additional argument $action 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 instance method is called to check if the build system is able +# to build a source package. It will be called during the build +# system auto-selection process, inside the root directory of the debian +# source package. The current build step is passed as an argument. +# Return 0 if the source is not buildable, or a positive integer +# otherwise. # -# 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. +# Generally, it is enough to look for invariant unique build system +# files shipped with clean source to determine if the source might +# be buildable or not. However, if the build system is derived from +# another other auto-buildable build system, this method +# may also check if the source has already been built with this build +# system partitially by looking for temporary files or other common +# results the build system produces during the build process. The +# latter checks must be unique to the current build system and must +# be very unlikely to be true for either its parent or other build +# systems. If it is determined that the source has already built +# partitially with this build system, the value returned must be +# greater than the one of the SUPER call. sub check_auto_buildable { my $this=shift; - my ($action) = @_; + my ($step)=@_; return 0; } # 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; + foreach 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 +293,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,35 +327,59 @@ 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 action (see below). +# 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_action { +sub pre_building_step { my $this=shift; - my ($action)=@_; + 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 action (see below). +# 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_action { +sub post_building_step { my $this=shift; - my ($action)=@_; + my ($step)=@_; } # The instance methods below provide support for configuring, @@ -229,8 +387,8 @@ sub post_action { # In case of failure, the method may just error() out. # # These methods should be overriden by derived classes to -# implement buildsystem specific actions needed to build the -# source. Arbitary number of custom action arguments might be +# 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 { my $this=shift; @@ -254,4 +412,4 @@ sub clean { my $this=shift; } -1; +1