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