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