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