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