Debian/Debhelper/Buildsystem.pm

   1 # Defines debhelper buildsystem 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 buildsystems.
  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 buildsystem 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 #                  source directory unless it starts with ./, then it is
  50 #                  assumed to be relative to the top directory. If undef or
  51 #                  empty, DEFAULT_BUILD_DIRECTORY relative to the source
  52 #                  directory will be used. If not specified, in source build
  53 #                  will be attempted.
  54 # - build_step -   set this parameter to the name of the build step
  55 #                  if you want the object to determine its is_buidable
  56 #                  status automatically (with check_auto_buildable()).
  57 #                  Do not pass this parameter if is_buildable flag should
  58 #                  be forced to true or set this parameter to undef if
  59 #                  is_buildable flag should be false.
  60 # Derived class can override the constructor to initialize common object
  61 # parameters and execute commands to configure build environment if
  62 # is_buildable flag is set on the object.
  63 sub new {
  64         my ($class, %opts)=@_;
  65
  66         my $this = bless({ sourcedir => '.',
  67                            builddir => undef,
  68                            is_buildable => 1 }, $class);
  69
  70         if (exists $opts{sourcedir}) {
  71                 # Get relative sourcedir abs_path (without symlinks)
  72                 my $curdir = Cwd::getcwd();
  73                 my $abspath = Cwd::abs_path($opts{sourcedir});
  74                 if (! -d $abspath || $abspath !~ /^\Q$curdir\E/) {
  75                         error("Invalid or non-existing path to the source directory: ".$opts{sourcedir});
  76                 }
  77                 $this->{sourcedir} = File::Spec->abs2rel($abspath, $curdir);
  78         }
  79         if (exists $opts{builddir}) {
  80                 $this->_set_builddir($opts{builddir});
  81         }
  82         if (exists $opts{build_step}) {
  83                 if (defined $opts{build_step}) {
  84                         $this->{is_buildable} = $this->check_auto_buildable($opts{build_step});
  85                 }
  86                 else {
  87                         $this->{is_buildable} = 0;
  88                 }
  89         }
  90         return $this;
  91 }
  92
  93 # Private method to set a build directory. If undef, use default.
  94 # Do $this->{builddir} = undef or pass $this->get_sourcedir() to
  95 # unset the build directory.
  96 sub _set_builddir {
  97         my $this=shift;
  98         my $builddir=shift;
  99         if ($builddir) {
 100                 if ($builddir =~ m!^\./(.*)!) {
 101                         # Specified as relative to the current directory
 102                         $this->{builddir} = $1;
 103                 }
 104                 else {
 105                         # Specified as relative to the source directory
 106                         $this->{builddir} = $this->get_sourcepath($builddir);
 107                 }
 108         }
 109         else {
 110                 # Relative to the source directory by default
 111                 $this->{builddir} = $this->get_sourcepath($this->DEFAULT_BUILD_DIRECTORY());
 112         }
 113
 114         # Canonicalize. If build directory ends up the same as source directory, drop it
 115         if (defined $this->{builddir}) {
 116                 $this->{builddir} = $this->_canonpath($this->{builddir});
 117                 if ($this->{builddir} eq $this->get_sourcedir()) {
 118                         $this->{builddir} = undef;
 119                 }
 120         }
 121 }
 122
 123 # Test is_buildable flag of the object.
 124 sub is_buildable {
 125         my $this=shift;
 126         return $this->{is_buildable};
 127 }
 128
 129 # This instance method is called to check if the build system is capable
 130 # to auto build a source package. Additional argument $step describes
 131 # which operation the caller is going to perform (either configure,
 132 # build, test, install or clean). You must override this method for the
 133 # build system module to be ever picked up automatically. This method is
 134 # used in conjuction with @Dh_Buildsystems::BUILDSYSTEMS.
 135 #
 136 # This method is supposed to be called with source root directory being
 137 # working directory. Use $this->get_buildpath($path) method to get full
 138 # path to the files in the build directory.
 139 sub check_auto_buildable {
 140         my $this=shift;
 141         my ($step) = @_;
 142         return 0;
 143 }
 144
 145 # Derived class can call this method in its constructor
 146 # to enforce in source building even if the user requested otherwise.
 147 sub enforce_in_source_building {
 148         my $this=shift;
 149         if ($this->{builddir}) {
 150                 # Do not emit warning unless the object is buildable.
 151                 if ($this->is_buildable()) {
 152                         warning("warning: " . $this->NAME() .
 153                             " does not support building out of source tree. In source building enforced.");
 154                 }
 155                 $this->{builddir} = undef;
 156         }
 157 }
 158
 159 # Derived class can call this method in its constructor to enforce
 160 # out of source building even if the user didn't request it.
 161 sub enforce_out_of_source_building {
 162         my ($this, $builddir) = @_;
 163         if (!defined $this->get_builddir()) {
 164                 $this->_set_builddir($builddir);
 165                 # The build directory might have been dropped if it matched the
 166                 # source directory. Just set to default in this case.
 167                 if (!defined $this->get_builddir()) {
 168                         $this->_set_builddir();
 169                 }
 170         }
 171 }
 172
 173 # Enhanced version of File::Spec::canonpath. It collapses ..
 174 # too so it may return invalid path if symlinks are involved.
 175 # On the other hand, it does not need for the path to exist.
 176 sub _canonpath {
 177         my ($this, $path)=@_;
 178         my @canon;
 179         my $back=0;
 180         for my $comp (split(m%/+%, $path)) {
 181                 if ($comp eq '.') {
 182                         next;
 183                 }
 184                 elsif ($comp eq '..') {
 185                         if (@canon > 0) { pop @canon; }  else { $back++; }
 186                 }
 187                 else {
 188                         push @canon, $comp;
 189                 }
 190         }
 191         return (@canon + $back > 0) ? join('/', ('..')x$back, @canon) : '.';
 192 }
 193
 194 # Given both $path and $base are relative to the same directory,
 195 # converts and returns path of $path being relative the $base.
 196 sub _rel2rel {
 197         my ($this, $path, $base, $root)=@_;
 198         $root = File::Spec->rootdir() if !defined $root;
 199
 200         return File::Spec->abs2rel(
 201             File::Spec->rel2abs($path, $root),
 202             File::Spec->rel2abs($base, $root)
 203         );
 204 }
 205
 206 # Get path to the source directory
 207 # (relative to the current (top) directory)
 208 sub get_sourcedir {
 209         my $this=shift;
 210         return $this->{sourcedir};
 211 }
 212
 213 # Convert path relative to the source directory to the path relative
 214 # to the current (top) directory.
 215 sub get_sourcepath {
 216         my ($this, $path)=@_;
 217         return File::Spec->catfile($this->get_sourcedir(), $path);
 218 }
 219
 220 # Get path to the build directory if it was specified
 221 # (relative to the current (top) directory). undef otherwise.
 222 sub get_builddir {
 223         my $this=shift;
 224         return $this->{builddir};
 225 }
 226
 227 # Convert path that is relative to the build directory to the path
 228 # that is relative to the current (top) directory.
 229 # If $path is not specified, always returns build directory path
 230 # relative to the current (top) directory regardless if builddir was
 231 # specified or not.
 232 sub get_buildpath {
 233         my ($this, $path)=@_;
 234         my $builddir = $this->get_builddir() || $this->get_sourcedir();
 235         if (defined $path) {
 236                 return File::Spec->catfile($builddir, $path);
 237         }
 238         return $builddir;
 239 }
 240
 241 # When given a relative path to the source directory, converts it
 242 # to the path that is relative to the build directory. If $path is
 243 # not given, returns a path to the source directory that is relative
 244 # to the build directory.
 245 sub get_source_rel2builddir {
 246         my $this=shift;
 247         my $path=shift;
 248
 249         my $dir = '.';
 250         if ($this->get_builddir()) {
 251                 $dir = $this->_rel2rel($this->get_sourcedir(), $this->get_builddir());
 252         }
 253         if (defined $path) {
 254                 return File::Spec->catfile($dir, $path);
 255         }
 256         return $dir;
 257 }
 258
 259 # When given a relative path to the build directory, converts it
 260 # to the path that is relative to the source directory. If $path is
 261 # not given, returns a path to the build directory that is relative
 262 # to the source directory.
 263 sub get_build_rel2sourcedir {
 264         my $this=shift;
 265         my $path=shift;
 266
 267         my $dir = '.';
 268         if ($this->get_builddir()) {
 269                 $dir = $this->_rel2rel($this->get_builddir(), $this->get_sourcedir());
 270         }
 271         if (defined $path) {
 272                 return File::Spec->catfile($dir, $path);
 273         }
 274         return $dir;
 275 }
 276
 277 # Creates a build directory.
 278 sub mkdir_builddir {
 279         my $this=shift;
 280         if ($this->get_builddir()) {
 281                 doit("mkdir", "-p", $this->get_builddir());
 282         }
 283 }
 284
 285 sub _cd {
 286         my ($this, $dir)=@_;
 287         if (! $dh{NO_ACT}) {
 288                 verbose_print("cd $dir");
 289                 chdir $dir or error("error: unable to chdir to $dir");
 290         }
 291 }
 292
 293 # Changes working directory to the source directory (if needed)
 294 # calls doit(@_) and changes working directory back to the top
 295 # directory.
 296 sub doit_in_sourcedir {
 297         my $this=shift;
 298         if ($this->get_sourcedir() ne '.') {
 299                 my $sourcedir = get_sourcedir();
 300                 my $curdir = Cwd::getcwd();
 301                 $this->_cd($sourcedir);
 302                 doit(@_);
 303                 $this->_cd($this->_rel2rel($curdir, $sourcedir, $curdir));
 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                 my $curdir = Cwd::getcwd();
 319                 $this->_cd($buildpath);
 320                 doit(@_);
 321                 $this->_cd($this->_rel2rel($curdir, $buildpath, $curdir));
 322         }
 323         else {
 324                 doit(@_);
 325         }
 326         return 1;
 327 }
 328
 329 # In case of out of source tree building, whole build directory
 330 # gets wiped (if it exists) and 1 is returned. If build directory
 331 # had 2 or more levels, empty parent directories are also deleted.
 332 # If build directory does not exist, nothing is done and 0 is returned.
 333 sub rmdir_builddir {
 334         my $this=shift;
 335         if ($this->get_builddir()) {
 336                 my $buildpath = $this->get_buildpath();
 337                 if (-d $buildpath && ! $dh{NO_ACT}) {
 338                         doit("rm", "-rf", $buildpath);
 339                         # If build directory had 2 or more levels, delete empty
 340                         # parent directories until the source directory level.
 341                         my @spdir = File::Spec->splitdir($this->get_build_rel2sourcedir());
 342                         my $peek;
 343                         pop @spdir;
 344                         while (($peek=pop(@spdir)) && $peek ne '.' && $peek ne '..') {
 345                                 last if ! rmdir($this->get_sourcepath(File::Spec->catdir(@spdir, $peek)));
 346                         }
 347                 }
 348                 return 1;
 349         }
 350         return 0;
 351 }
 352
 353 # Instance method that is called before performing any step (see below).
 354 # Action name is passed as an argument. Derived classes overriding this
 355 # method should also call SUPER implementation of it.
 356 sub pre_building_step {
 357         my $this=shift;
 358         my ($step)=@_;
 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 buildsystem 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;