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