Debian/Debhelper/Dh_Buildsystems.pm

   1 # A module for loading and managing debhelper buildsystem plugins.
   2 #
   3 # Copyright: © 2009 Modestas Vainius
   4 # License: GPL-2+
   5
   6 package Debian::Debhelper::Dh_Buildsystems;
   7
   8 use strict;
   9 use warnings;
  10 use Debian::Debhelper::Dh_Lib;
  11
  12 use Exporter qw( import );
  13 our @EXPORT_OK = qw( DEFAULT_BUILD_DIRECTORY );
  14
  15 # IMPORTANT: more specific buildsystems should go first
  16 # XXX JEH as noted, this has to match historical order for back-compat
  17 my @BUILDSYSTEMS = (
  18     "autotools",
  19     "cmake",
  20     "perl_build",
  21     "perl_makefile",
  22     "python_distutils",
  23     "makefile",
  24 );
  25
  26 sub DEFAULT_BUILD_DIRECTORY {
  27         return "obj-" . dpkg_architecture_value("DEB_BUILD_GNU_TYPE");
  28 }
  29
  30 sub new {
  31         my $cls=shift;
  32         my %opts=@_;
  33         my $self = bless({
  34             'o_dir' => undef,
  35             'o_system' => undef,
  36             'loaded_buildsystems' => [] }, $cls);
  37
  38         # XXX JEH AFAICS, these 2 env variables are never used or documented
  39         if (!exists $opts{noenv}) {
  40                 if (exists $ENV{DH_AUTO_BUILDDIRECTORY}) {
  41                         $self->_set_build_directory_option("env", $ENV{DH_AUTO_BUILDDIRECTORY});
  42                 }
  43                 if (exists $ENV{DH_AUTO_BUILDSYSTEM}) {
  44                         $self->{o_system} = $ENV{DH_AUTO_BUILDSYSTEM};
  45                 }
  46         }
  47         return $self;
  48 }
  49
  50 sub get_options {
  51         my $self=shift;
  52         my @options=@_;
  53
  54         my $set_dir = sub { $self->_set_build_directory_option(@_) };
  55         my $list_bs = sub { $self->list_buildsystems(@_); exit 0 };
  56
  57         push @options, (
  58             "b:s" => $set_dir,
  59             "build-directory:s" => $set_dir,
  60             "builddirectory:s" => $set_dir,
  61
  62             "m=s" => \$self->{o_system},
  63             "build-system=s" => \$self->{o_system},
  64             "buildsystem=s" => \$self->{o_system},
  65
  66             "l" => $list_bs,
  67             "--list" => $list_bs,
  68         );
  69         my %options = @options;
  70         return \%options;
  71 }
  72
  73 sub _set_build_directory_option {
  74         # XXX JEH option argument is not used, would be less confusing to
  75         # not pass extra getopt value in
  76         my ($self, $option, $value) = @_;
  77         if (!$value || $value eq "auto") {
  78                 # Autogenerate build directory name
  79                 $self->{o_dir} = DEFAULT_BUILD_DIRECTORY;
  80         }
  81         else {
  82                 $self->{o_dir} = $value;
  83         }
  84 }
  85
  86 # XXX JEH this sub is not used
  87 sub _dump_options {
  88         my $self=shift;
  89         for my $opt (qw(o_dir o_system)) {
  90                 if (defined $self->{$opt}) {
  91                         print $opt, ": ", $self->{$opt}, "\n";
  92                 }
  93         }
  94 }
  95
  96 sub _get_buildsystem_module {
  97         my ($self, $system) = @_;
  98         my $module = "Debian::Debhelper::Buildsystem::$system";
  99
 100         if (grep $module, @{$self->{loaded_buildsystems}} == 0) {
 101                 eval "use $module";
 102                 if ($@) {
 103                         error("Unable to load buildsystem '$system': $@");
 104                 }
 105                 push @{$self->{loaded_buildsystems}}, $module;
 106         }
 107         return $module;
 108 }
 109
 110 sub load_buildsystem {
 111         # XXX JEH the $system param is never passed
 112         # by any call to this function
 113         my ($self, $action, $system) = @_;
 114
 115         if (!defined $system) {
 116                 $system = $self->{o_system};
 117         }
 118         if (defined $system) {
 119                 my $module =  $self->_get_buildsystem_module($system);
 120                 verbose_print("Selected buildsystem (specified): ".$module->NAME());
 121                 return $module->new($self->{o_dir});
 122         }
 123         else {
 124                 # Try to determine build system automatically
 125                 for $system (@BUILDSYSTEMS) {
 126                         my $module = $self->_get_buildsystem_module($system);
 127                         my $inst = $module->new($self->{o_dir});
 128                         if ($inst->is_buildable($action)) {
 129                                 verbose_print("Selected buildsystem (auto): ".$module->NAME());
 130                                 return $inst;
 131                         }
 132                 }
 133         }
 134         return;
 135 }
 136
 137 sub load_all_buildsystems {
 138         my $self=shift;
 139         for my $system (@BUILDSYSTEMS) {
 140                 $self->_get_buildsystem_module($system);
 141         }
 142         return @{$self->{loaded_buildsystems}};
 143 }
 144
 145 sub list_buildsystems {
 146         my $self=shift;
 147         for my $system ($self->load_all_buildsystems()) {
 148                 printf("%s - %s.\n", $system->NAME(), $system->DESCRIPTION());
 149         }
 150 }
 151
 152 sub init_dh_auto_tool {
 153         my $self=shift;
 154
 155         Debian::Debhelper::Dh_Lib::init(
 156             options => $self->get_options(@_));
 157         $self->{initialized}=1;
 158 }
 159
 160 sub run_dh_auto_tool {
 161         my $self=shift;
 162         my $toolname = basename($0);
 163         my $buildsystem;
 164
 165         # XXX JEH does this if ever not fire?
 166         if (!exists $self->{initialized}) {
 167                 $self->init_dh_auto_tool();
 168         }
 169
 170         # Guess action from the dh_auto_* name
 171         $toolname =~ s/^dh_auto_//;
 172         if (grep(/^\Q$toolname\E$/, qw{configure build test install clean}) == 0) {
 173                 error("Unrecognized dh auto tool: ".basename($0));
 174         }
 175
 176         $buildsystem = $self->load_buildsystem($toolname);
 177         if (defined $buildsystem) {
 178                 return $buildsystem->$toolname(@_, @{$dh{U_PARAMS}});
 179         }
 180         return 0;
 181 }
 182
 183 # XXX JEH generally, why does this need to be an OO object at all?
 184 # The entire state stored in this object is o_dir and o_system;
 185 # and the object is used as a singleton. So why not have a single sub
 186 # that parses the command line, loads the specified system, and uses it,
 187 # passing it the build directory. It would be both shorter and easier to
 188 # understand.
 189
 190 1;