Debian/Debhelper/Buildsystem.pm

   1 # Defines debhelper build system class interface and implementation
   2 # of common functionality.
   3 #
   4 # Copyright: © 2008-2009 Modestas Vainius
   5 # License: GPL-2+
   6
   7 package Debian::Debhelper::Buildsystem;
   8
   9 use strict;
  10 use warnings;
  11 use Cwd ();
  12 use File::Spec;
  13 use Debian::Debhelper::Dh_Lib;
  14
  15 # Cache DEB_BUILD_GNU_TYPE value. Performance hit of multiple
  16 # invocations is noticable when listing build systems.
  17 our $DEB_BUILD_GNU_TYPE = dpkg_architecture_value("DEB_BUILD_GNU_TYPE");
  18
  19 # Build system name. Defaults to the last component of the class
  20 # name. Do not override this method unless you know what you are
  21 # doing.
  22 sub NAME {
  23         my $this=shift;
  24         my $class = ref($this) || $this;
  25         if ($class =~ m/^.+::([^:]+)$/) {
  26                 return $1;
  27         }
  28         else {
  29                 error("ınvalid build system class name: $class");
  30         }
  31 }
  32
  33 # Description of the build system to be shown to the users.
  34 sub DESCRIPTION {
  35         error("class lacking a DESCRIPTION");
  36 }
  37
  38 # Default build directory. Can be overriden in the derived
  39 # class if really needed.
  40 sub DEFAULT_BUILD_DIRECTORY {
  41         "obj-" . $DEB_BUILD_GNU_TYPE;
  42 }
  43
  44 # Constructs a new build system object. Named parameters:
  45 # - sourcedir-     specifies source directory (relative to the current (top)
  46 #                  directory) where the sources to be built live. If not
  47 #                  specified or empty, defaults to the current directory.
  48 # - builddir -     specifies build directory to use. Path is relative to the
  49 #                  current (top) directory. If undef or empty,
  50 #                  DEFAULT_BUILD_DIRECTORY directory will be used.
  51 # - parallel -     max number of parallel processes to be spawned for building
  52 #                  sources (-1 = unlimited; 1 = no parallel)
  53 # Derived class can override the constructor to initialize common object
  54 # parameters. Do NOT use constructor to execute commands or otherwise
  55 # configure/setup build environment. There is absolutely no guarantee the
  56 # constructed object will be used to build something. Use pre_building_step(),
  57 # $build_step() or post_building_step() methods for this.
  58 sub new {
  59         my ($class, %opts)=@_;
  60
  61         my $this = bless({ sourcedir => '.',
  62                            builddir => undef,
  63                            parallel => undef,
  64                            cwd => Cwd::getcwd() }, $class);
  65
  66         if (exists $opts{sourcedir}) {
  67                 # Get relative sourcedir abs_path (without symlinks)
  68                 my $abspath = Cwd::abs_path($opts{sourcedir});
  69                 if (! -d $abspath || $abspath !~ /^\Q$this->{cwd}\E/) {
  70                         error("invalid or non-existing path to the source directory: ".$opts{sourcedir});
  71                 }
  72                 $this->{sourcedir} = File::Spec->abs2rel($abspath, $this->{cwd});
  73         }
  74         if (exists $opts{builddir}) {
  75                 $this->_set_builddir($opts{builddir});
  76         }
  77         if (defined $opts{parallel}) {
  78                 $this->{parallel} = $opts{parallel};
  79         }
  80         return $this;
  81 }
  82
  83 # Private method to set a build directory. If undef, use default.
  84 # Do $this->{builddir} = undef or pass $this->get_sourcedir() to
  85 # unset the build directory.
  86 sub _set_builddir {
  87         my $this=shift;
  88         my $builddir=shift || $this->DEFAULT_BUILD_DIRECTORY;
  89
  90         if (defined $builddir) {
  91                 $builddir = $this->canonpath($builddir); # Canonicalize
  92
  93                 # Sanitize $builddir
  94                 if ($builddir =~ m#^\.\./#) {
  95                         # We can't handle those as relative. Make them absolute
  96                         $builddir = File::Spec->catdir($this->{cwd}, $builddir);
  97                 }
  98                 elsif ($builddir =~ /\Q$this->{cwd}\E/) {
  99                         $builddir = File::Spec->abs2rel($builddir, $this->{cwd});
 100                 }
 101
 102                 # If build directory ends up the same as source directory, drop it
 103                 if ($builddir eq $this->get_sourcedir()) {
 104                         $builddir = undef;
 105                 }
 106         }
 107         $this->{builddir} = $builddir;
 108         return $builddir;
 109 }
 110
 111 # This instance method is called to check if the build system is able
 112 # to build a source package. It will be called during the build
 113 # system auto-selection process, inside the root directory of the debian
 114 # source package. The current build step is passed as an argument.
 115 # Return 0 if the source is not buildable, or a positive integer
 116 # otherwise.
 117 #
 118 # Generally, it is enough to look for invariant unique build system
 119 # files shipped with clean source to determine if the source might
 120 # be buildable or not. However, if the build system is derived from
 121 # another other auto-buildable build system, this method
 122 # may also check if the source has already been built with this build
 123 # system partitially by looking for temporary files or other common
 124 # results the build system produces during the build process. The
 125 # latter checks must be unique to the current build system and must
 126 # be very unlikely to be true for either its parent or other build
 127 # systems. If it is determined that the source has already built
 128 # partitially with this build system, the value returned must be
 129 # greater than the one of the SUPER call.
 130 sub check_auto_buildable {
 131         my $this=shift;
 132         my ($step)=@_;
 133         return 0;
 134 }
 135
 136 # Derived class can call this method in its constructor
 137 # to enforce in source building even if the user requested otherwise.
 138 sub enforce_in_source_building {
 139         my $this=shift;
 140         if ($this->get_builddir()) {
 141                 $this->{warn_insource} = 1;
 142                 $this->{builddir} = undef;
 143         }
 144 }
 145
 146 # Derived class can call this method in its constructor to *prefer*
 147 # out of source building. Unless build directory has already been
 148 # specified building will proceed in the DEFAULT_BUILD_DIRECTORY or
 149 # the one specified in the 'builddir' named parameter (which may
 150 # match the source directory). Typically you should pass @_ from
 151 # the constructor to this call.
 152 sub prefer_out_of_source_building {
 153         my $this=shift;
 154         my %args=@_;
 155         if (!defined $this->get_builddir()) {
 156                 if (!$this->_set_builddir($args{builddir}) && !$args{builddir}) {
 157                         # If we are here, DEFAULT_BUILD_DIRECTORY matches
 158                         # the source directory, building might fail.
 159                         error("default build directory is the same as the source directory." .
 160                               " Please specify a custom build directory");
 161                 }
 162         }
 163 }
 164
 165 # Enhanced version of File::Spec::canonpath. It collapses ..
 166 # too so it may return invalid path if symlinks are involved.
 167 # On the other hand, it does not need for the path to exist.
 168 sub canonpath {
 169         my ($this, $path)=@_;
 170         my @canon;
 171         my $back=0;
 172         foreach my $comp (split(m%/+%, $path)) {
 173                 if ($comp eq '.') {
 174                         next;
 175                 }
 176                 elsif ($comp eq '..') {
 177                         if (@canon > 0) { pop @canon; }  else { $back++; }
 178                 }
 179                 else {
 180                         push @canon, $comp;
 181                 }
 182         }
 183         return (@canon + $back > 0) ? join('/', ('..')x$back, @canon) : '.';
 184 }
 185
 186 # Given both $path and $base are relative to the $root, converts and
 187 # returns path of $path being relative to the $base. If either $path or
 188 # $base is absolute, returns another $path (converted to) absolute.
 189 sub _rel2rel {
 190         my ($this, $path, $base, $root)=@_;
 191         $root = $this->{cwd} unless defined $root;
 192
 193         if (File::Spec->file_name_is_absolute($path)) {
 194                 return $path;
 195         }
 196         elsif (File::Spec->file_name_is_absolute($base)) {
 197                 return File::Spec->rel2abs($path, $root);
 198         }
 199         else {
 200                 return File::Spec->abs2rel(
 201                         File::Spec->rel2abs($path, $root),
 202                         File::Spec->rel2abs($base, $root)
 203                 );
 204         }
 205 }
 206
 207 # Get path to the source directory
 208 # (relative to the current (top) directory)
 209 sub get_sourcedir {
 210         my $this=shift;
 211         return $this->{sourcedir};
 212 }
 213
 214 # Convert path relative to the source directory to the path relative
 215 # to the current (top) directory.
 216 sub get_sourcepath {
 217         my ($this, $path)=@_;
 218         return File::Spec->catfile($this->get_sourcedir(), $path);
 219 }
 220
 221 # Get path to the build directory if it was specified
 222 # (relative to the current (top) directory). undef if the same
 223 # as the source directory.
 224 sub get_builddir {
 225         my $this=shift;
 226         return $this->{builddir};
 227 }
 228
 229 # Convert path that is relative to the build directory to the path
 230 # that is relative to the current (top) directory.
 231 # If $path is not specified, always returns build directory path
 232 # relative to the current (top) directory regardless if builddir was
 233 # specified or not.
 234 sub get_buildpath {
 235         my ($this, $path)=@_;
 236         my $builddir = $this->get_builddir() || $this->get_sourcedir();
 237         if (defined $path) {
 238                 return File::Spec->catfile($builddir, $path);
 239         }
 240         return $builddir;
 241 }
 242
 243 # When given a relative path to the source directory, converts it
 244 # to the path that is relative to the build directory. If $path is
 245 # not given, returns a path to the source directory that is relative
 246 # to the build directory.
 247 sub get_source_rel2builddir {
 248         my $this=shift;
 249         my $path=shift;
 250
 251         my $dir = '.';
 252         if ($this->get_builddir()) {
 253                 $dir = $this->_rel2rel($this->get_sourcedir(), $this->get_builddir());
 254         }
 255         if (defined $path) {
 256                 return File::Spec->catfile($dir, $path);
 257         }
 258         return $dir;
 259 }
 260
 261 sub get_parallel {
 262         my $this=shift;
 263         return $this->{parallel};
 264 }
 265
 266 # When given a relative path to the build directory, converts it
 267 # to the path that is relative to the source directory. If $path is
 268 # not given, returns a path to the build directory that is relative
 269 # to the source directory.
 270 sub get_build_rel2sourcedir {
 271         my $this=shift;
 272         my $path=shift;
 273
 274         my $dir = '.';
 275         if ($this->get_builddir()) {
 276                 $dir = $this->_rel2rel($this->get_builddir(), $this->get_sourcedir());
 277         }
 278         if (defined $path) {
 279                 return File::Spec->catfile($dir, $path);
 280         }
 281         return $dir;
 282 }
 283
 284 # Creates a build directory.
 285 sub mkdir_builddir {
 286         my $this=shift;
 287         if ($this->get_builddir()) {
 288                 doit("mkdir", "-p", $this->get_builddir());
 289         }
 290 }
 291
 292 sub _cd {
 293         my ($this, $dir)=@_;
 294         if (! $dh{NO_ACT}) {
 295                 verbose_print("cd $dir");
 296                 chdir $dir or error("error: unable to chdir to $dir");
 297         }
 298 }
 299
 300 # Changes working directory to the source directory (if needed),
 301 # calls doit(@_) and changes working directory back to the top
 302 # directory.
 303 sub doit_in_sourcedir {
 304         my $this=shift;
 305         if ($this->get_sourcedir() ne '.') {
 306                 my $sourcedir = $this->get_sourcedir();
 307                 $this->_cd($sourcedir);
 308                 doit(@_);
 309                 $this->_cd($this->_rel2rel($this->{cwd}, $sourcedir));
 310         }
 311         else {
 312                 doit(@_);
 313         }
 314         return 1;
 315 }
 316
 317 # Changes working directory to the build directory (if needed),
 318 # calls doit(@_) and changes working directory back to the top
 319 # directory.
 320 sub doit_in_builddir {
 321         my $this=shift;
 322         if ($this->get_buildpath() ne '.') {
 323                 my $buildpath = $this->get_buildpath();
 324                 $this->_cd($buildpath);
 325                 doit(@_);
 326                 $this->_cd($this->_rel2rel($this->{cwd}, $buildpath));
 327         }
 328         else {
 329                 doit(@_);
 330         }
 331         return 1;
 332 }
 333
 334 # In case of out of source tree building, whole build directory
 335 # gets wiped (if it exists) and 1 is returned. If build directory
 336 # had 2 or more levels, empty parent directories are also deleted.
 337 # If build directory does not exist, nothing is done and 0 is returned.
 338 sub rmdir_builddir {
 339         my $this=shift;
 340         my $only_empty=shift;
 341         if ($this->get_builddir()) {
 342                 my $buildpath = $this->get_buildpath();
 343                 if (-d $buildpath) {
 344                         my @dir = File::Spec->splitdir($this->get_build_rel2sourcedir());
 345                         my $peek;
 346                         if (not $only_empty) {
 347                                 doit("rm", "-rf", $buildpath);
 348                                 pop @dir;
 349                         }
 350                         # If build directory is relative and had 2 or more levels, delete
 351                         # empty parent directories until the source or top directory level.
 352                         if (not File::Spec->file_name_is_absolute($buildpath)) {
 353                                 while (($peek=pop @dir) && $peek ne '.' && $peek ne '..') {
 354                                         my $dir = $this->get_sourcepath(File::Spec->catdir(@dir, $peek));
 355                                         doit("rmdir", "--ignore-fail-on-non-empty", $dir);
 356                                         last if -d $dir;
 357                                 }
 358                         }
 359                 }
 360                 return 1;
 361         }
 362         return 0;
 363 }
 364
 365 # Instance method that is called before performing any step (see below).
 366 # Action name is passed as an argument. Derived classes overriding this
 367 # method should also call SUPER implementation of it.
 368 sub pre_building_step {
 369         my $this=shift;
 370         my ($step)=@_;
 371
 372         # Warn if in source building was enforced but build directory was
 373         # specified. See enforce_in_source_building().
 374         if ($this->{warn_insource}) {
 375                 warning("warning: " . $this->NAME() .
 376                     " does not support building out of source tree. In source building enforced.");
 377                 delete $this->{warn_insource};
 378         }
 379 }
 380
 381 # Instance method that is called after performing any step (see below).
 382 # Action name is passed as an argument. Derived classes overriding this
 383 # method should also call SUPER implementation of it.
 384 sub post_building_step {
 385         my $this=shift;
 386         my ($step)=@_;
 387 }
 388
 389 # The instance methods below provide support for configuring,
 390 # building, testing, install and cleaning source packages.
 391 # In case of failure, the method may just error() out.
 392 #
 393 # These methods should be overriden by derived classes to
 394 # implement build system specific steps needed to build the
 395 # source. Arbitary number of custom step arguments might be
 396 # passed. Default implementations do nothing.
 397 sub configure {
 398         my $this=shift;
 399 }
 400
 401 sub build {
 402         my $this=shift;
 403 }
 404
 405 sub test {
 406         my $this=shift;
 407 }
 408
 409 # destdir parameter specifies where to install files.
 410 sub install {
 411         my $this=shift;
 412         my $destdir=shift;
 413 }
 414
 415 sub clean {
 416         my $this=shift;
 417 }
 418
 419 1