ucw/perl/UCW/Configure.pm

   1 #       Perl module for UCW Configure Scripts
   2 #
   3 #       (c) 2005 Martin Mares <mj@ucw.cz>
   4 #
   5 #       This software may be freely distributed and used according to the terms
   6 #       of the GNU Lesser General Public License.
   7
   8 package UCW::Configure;
   9
  10 use strict;
  11 use warnings;
  12
  13 BEGIN {
  14         # The somewhat hairy Perl export mechanism
  15         use Exporter();
  16         our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  17         $VERSION = 1.0;
  18         @ISA = qw(Exporter);
  19         @EXPORT = qw(&Init &Log &Notice &Warn &Fail &IsSet &IsGiven &Set &UnSet &Append &Override &Get &Test &Include &Finish &FindFile &TryFindFile &TryCmd &PkgConfig &TrivConfig &debPrint);
  20         @EXPORT_OK = qw();
  21         %EXPORT_TAGS = ();
  22 }
  23
  24 our %vars;
  25 our %overriden;
  26 our @postconfigs;
  27
  28 sub debPrint() {
  29   print "VARS:\n";
  30 #  print "$_: $vars{$_}\n" foreach( keys %vars );
  31 }
  32
  33 sub Log($) {
  34         print @_;
  35 }
  36
  37 sub Notice($) {
  38         print @_ if $vars{"VERBOSE"};
  39 }
  40
  41 sub Warn($) {
  42         print "WARNING: ", @_;
  43 }
  44
  45 sub Fail($) {
  46         Log("ERROR: " . (shift @_) . "\n");
  47         exit 1;
  48 }
  49
  50 sub IsSet($) {
  51         my ($x) = @_;
  52         return exists $vars{$x};
  53 }
  54
  55 sub IsGiven($) {
  56         my ($x) = @_;
  57         return exists $overriden{$x};
  58 }
  59
  60 sub Get($) {
  61         my ($x) = @_;
  62         return $vars{$x};
  63 }
  64
  65 sub Set($;$) {
  66         my ($x,$y) = @_;
  67         $y=1 unless defined $y;
  68         $vars{$x}=$y unless $overriden{$x};
  69 }
  70
  71 sub UnSet($) {
  72         my ($x) = @_;
  73         delete $vars{$x} unless $overriden{$x};
  74 }
  75
  76 sub Append($$) {
  77         my ($x,$y) = @_;
  78         Set($x, (IsSet($x) ? (Get($x) . " $y") : $y));
  79 }
  80
  81 sub Override($;$) {
  82         my ($x,$y) = @_;
  83         $y=1 unless defined $y;
  84         $vars{$x}=$y;
  85         $overriden{$x} = 1;
  86 }
  87
  88 sub Test($$$) {
  89         my ($var,$msg,$sub) = @_;
  90         Log "$msg ... ";
  91         if (!IsSet($var)) {
  92                 Set $var, &$sub();
  93         }
  94         Log Get($var) . "\n";
  95 }
  96
  97 sub TryFindFile($) {
  98         my ($f) = @_;
  99         if (-f $f) {
 100                 return $f;
 101         } elsif ($f !~ /^\// && -f (Get("SRCDIR")."/$f")) {
 102                 return Get("SRCDIR")."/$f";
 103         } else {
 104                 return undef;
 105         }
 106 }
 107
 108 sub FindFile($) {
 109         my ($f) = @_;
 110         my $F;
 111         defined ($F = TryFindFile($f)) or Fail "Cannot find file $f";
 112         return $F;
 113 }
 114
 115 sub Init($$) {
 116         my ($srcdir,$defconfig) = @_;
 117         sub usage($) {
 118                 my ($dc) = @_;
 119                 print STDERR "Usage: [<srcdir>/]configure " . (defined $dc ? "[" : "") . "<config-name>" . (defined $dc ? "]" : "") .
 120                         " [<option>[=<value>] | -<option>] ...\n";
 121                 exit 1;
 122         }
 123         Set('CONFIG' => $defconfig) if defined $defconfig;
 124         if (@ARGV) {
 125                 usage($defconfig) if $ARGV[0] eq "--help";
 126                 if (!defined($defconfig) || $ARGV[0] !~ /^-?[A-Z][A-Z0-9_]*(=|$)/) {
 127                         # This does not look like an option, so read it as a file name
 128                         Set('CONFIG' => shift @ARGV);
 129                 }
 130         }
 131         Set("SRCDIR", $srcdir);
 132
 133         foreach my $x (@ARGV) {
 134                 if ($x =~ /^(\w+)=(.*)/) {
 135                         Override($1 => $2);
 136                 } elsif ($x =~ /^-(\w+)$/) {
 137                         Override($1 => 0);
 138                         delete $vars{$1};
 139                 } elsif ($x =~ /^(\w+)$/) {
 140                         Override($1 => 1);
 141                 } else {
 142                         print STDERR "Invalid option $x\n";
 143                         exit 1;
 144                 }
 145         }
 146
 147         defined Get("CONFIG") or usage($defconfig);
 148         if (!TryFindFile(Get("CONFIG"))) {
 149                 TryFindFile(Get("CONFIG")."/config") or Fail "Cannot find configuration " . Get("CONFIG");
 150                 Override("CONFIG" => Get("CONFIG")."/config");
 151         }
 152 }
 153
 154 sub Include($) {
 155         my ($f) = @_;
 156         $f = FindFile($f);
 157         Notice "Loading configuration $f\n";
 158         require $f;
 159 }
 160
 161 sub PostConfig(&) {
 162         unshift @postconfigs, $_[0];
 163 }
 164
 165 sub Finish() {
 166         for my $post (@postconfigs) {
 167                 &$post();
 168         }
 169
 170         print "\n";
 171
 172         if (Get("SRCDIR") ne ".") {
 173                 Log "Preparing for compilation from directory " . Get("SRCDIR") . " to obj/ ... ";
 174                 -l "src" and unlink "src";
 175                 symlink Get("SRCDIR"), "src" or Fail "Cannot link source directory to src: $!";
 176                 Override("SRCDIR" => "src");
 177                 -l "Makefile" and unlink "Makefile";
 178                 -f "Makefile" and Fail "Makefile already exists";
 179                 symlink "src/Makefile", "Makefile" or Fail "Cannot link Makefile: $!";
 180         } else {
 181                 Log "Preparing for compilation from current directory to obj/ ... ";
 182         }
 183         if (-d "obj") {
 184                 `rm -rf obj`; Fail "Cannot delete old obj directory" if $?;
 185         }
 186         -d "obj" or mkdir("obj", 0777) or Fail "Cannot create obj directory: $!";
 187         -d "obj/ucw" or mkdir("obj/ucw", 0777) or Fail "Cannot create obj/ucw directory: $!";
 188         Log "done\n";
 189
 190         Log "Generating autoconf.h ... ";
 191         open X, ">obj/autoconf.h" or Fail $!;
 192         print X "/* Generated automatically by $0, please don't touch manually. */\n";
 193         foreach my $x (sort keys %vars) {
 194                 # Don't export variables which contain no underscores
 195                 next unless $x =~ /_/;
 196                 my $v = $vars{$x};
 197                 # Try to add quotes if necessary
 198                 $v = '"' . $v . '"' unless ($v =~ /^"/ || $v =~ /^\d*$/);
 199                 print X "#define $x $v\n";
 200         }
 201         close X;
 202         Log "done\n";
 203
 204         Log "Generating config.mk ... ";
 205         open X, ">obj/config.mk" or Fail $!;
 206         print X "# Generated automatically by $0, please don't touch manually.\n";
 207         foreach my $x (sort keys %vars) {
 208                 print X "$x=$vars{$x}\n";
 209         }
 210         print X "s=\${SRCDIR}\n";
 211         print X "o=obj\n";
 212         close X;
 213         Log "done\n";
 214 }
 215
 216 sub TryCmd($) {
 217         my ($cmd) = @_;
 218         my $res = `$cmd`;
 219         defined $res or return;
 220         chomp $res;
 221         return $res unless $?;
 222         return;
 223 }
 224
 225 sub maybe_manually($) {
 226         my ($n) = @_;
 227         if (IsGiven($n)) {
 228                 if (Get("$n")) { Log "YES (set manually)\n"; }
 229                 else { Log "NO (set manually)\n"; }
 230                 return 1;
 231         }
 232         return 0;
 233 }
 234
 235 sub PkgConfig($@) {
 236         my $pkg = shift @_;
 237         my %opts = @_;
 238         my $upper = $pkg; $upper =~ tr/a-z/A-Z/; $upper =~ s/[^0-9A-Z]+/_/g;
 239         Log "Checking for package $pkg ... ";
 240         maybe_manually("CONFIG_HAVE_$upper") and return Get("CONFIG_HAVE_$upper");
 241         my $ver = TryCmd("pkg-config --modversion $pkg 2>/dev/null");
 242         if (!defined $ver) {
 243                 Log("NONE\n");
 244                 return 0;
 245         }
 246         if (defined($opts{minversion})) {
 247                 my $min = $opts{minversion};
 248                 if (!defined TryCmd("pkg-config --atleast-version=$min $pkg")) {
 249                         Log("NO: version $ver is too old (need >= $min)\n");
 250                         return 0;
 251                 }
 252         }
 253         Log("YES: version $ver\n");
 254         Set("CONFIG_HAVE_$upper" => 1);
 255         Set("CONFIG_VER_$upper" => $ver);
 256         my $cf = TryCmd("pkg-config --cflags $pkg");
 257         Set("${upper}_CFLAGS" => $cf) if defined $cf;
 258         my $lf = TryCmd("pkg-config --libs $pkg");
 259         Set("${upper}_LIBS" => $lf) if defined $lf;
 260         return 1;
 261 }
 262
 263 sub ver_norm($) {
 264         my ($v) = @_;
 265         return join(".", map { sprintf("%05s", $_) } split(/\./, $v));
 266 }
 267
 268 sub TrivConfig($@) {
 269         my $pkg = shift @_;
 270         my %opts = @_;
 271         my $upper = $pkg; $upper =~ tr/a-z/A-Z/; $upper =~ s/[^0-9A-Z]+/_/g;
 272         Log "Checking for package $pkg ... ";
 273         maybe_manually("CONFIG_HAVE_$upper") and return Get("CONFIG_HAVE_$upper");
 274         my $pc = $opts{script};
 275         my $ver = TryCmd("$pc --version 2>/dev/null");
 276         if (!defined $ver) {
 277                 Log("NONE\n");
 278                 return 0;
 279         }
 280         if (defined($opts{minversion})) {
 281                 my $min = $opts{minversion};
 282                 if (ver_norm($ver) lt ver_norm($min)) {
 283                         Log("NO: version $ver is too old (need >= $min)\n");
 284                         return 0;
 285                 }
 286         }
 287         Log("YES: version $ver\n");
 288         Set("CONFIG_HAVE_$upper" => 1);
 289         Set("CONFIG_VER_$upper" => $ver);
 290
 291         my $want = $opts{want};
 292         defined $want or $want = ["cflags", "libs"];
 293         for my $w (@$want) {
 294                 my $uw = $w; $uw =~ tr/a-z-/A-Z_/;
 295                 my $cf = TryCmd("$pc --$w");
 296                 Set("${upper}_${uw}" => $cf) if defined $cf;
 297         }
 298         return 1;
 299 }
 300
 301 1;  # OK