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
  27 sub debPrint() {
  28   print "VARS:\n";
  29 #  print "$_: $vars{$_}\n" foreach( keys %vars );
  30 }
  31
  32 sub Log($) {
  33         print @_;
  34 }
  35
  36 sub Notice($) {
  37         print @_ if $vars{"VERBOSE"};
  38 }
  39
  40 sub Warn($) {
  41         print "WARNING: ", @_;
  42 }
  43
  44 sub Fail($) {
  45         Log("ERROR: " . (shift @_) . "\n");
  46         exit 1;
  47 }
  48
  49 sub IsSet($) {
  50         my ($x) = @_;
  51         return exists $vars{$x};
  52 }
  53
  54 sub IsGiven($) {
  55         my ($x) = @_;
  56         return exists $overriden{$x};
  57 }
  58
  59 sub Get($) {
  60         my ($x) = @_;
  61         return $vars{$x};
  62 }
  63
  64 sub Set($;$) {
  65         my ($x,$y) = @_;
  66         $y=1 unless defined $y;
  67         $vars{$x}=$y unless $overriden{$x};
  68 }
  69
  70 sub UnSet($) {
  71         my ($x) = @_;
  72         delete $vars{$x} unless $overriden{$x};
  73 }
  74
  75 sub Append($$) {
  76         my ($x,$y) = @_;
  77         Set($x, (IsSet($x) ? (Get($x) . " $y") : $y));
  78 }
  79
  80 sub Override($;$) {
  81         my ($x,$y) = @_;
  82         $y=1 unless defined $y;
  83         $vars{$x}=$y;
  84         $overriden{$x} = 1;
  85 }
  86
  87 sub Test($$$) {
  88         my ($var,$msg,$sub) = @_;
  89         Log "$msg ... ";
  90         if (!IsSet($var)) {
  91                 Set $var, &$sub();
  92         }
  93         Log Get($var) . "\n";
  94 }
  95
  96 sub TryFindFile($) {
  97         my ($f) = @_;
  98         if (-f $f) {
  99                 return $f;
 100         } elsif ($f !~ /^\// && -f (Get("SRCDIR")."/$f")) {
 101                 return Get("SRCDIR")."/$f";
 102         } else {
 103                 return undef;
 104         }
 105 }
 106
 107 sub FindFile($) {
 108         my ($f) = @_;
 109         my $F;
 110         defined ($F = TryFindFile($f)) or Fail "Cannot find file $f";
 111         return $F;
 112 }
 113
 114 sub Init($$) {
 115   print "YYY\n";
 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 Finish() {
 162         print "\n";
 163
 164         if (Get("SRCDIR") ne ".") {
 165                 Log "Preparing for compilation from directory " . Get("SRCDIR") . " to obj/ ... ";
 166                 -l "src" and unlink "src";
 167                 symlink Get("SRCDIR"), "src" or Fail "Cannot link source directory to src: $!";
 168                 Override("SRCDIR" => "src");
 169                 -l "Makefile" and unlink "Makefile";
 170                 -f "Makefile" and Fail "Makefile already exists";
 171                 symlink "src/Makefile", "Makefile" or Fail "Cannot link Makefile: $!";
 172         } else {
 173                 Log "Preparing for compilation from current directory to obj/ ... ";
 174         }
 175         if (-d "obj") {
 176                 `rm -rf obj`; Fail "Cannot delete old obj directory" if $?;
 177         }
 178         -d "obj" or mkdir("obj", 0777) or Fail "Cannot create obj directory: $!";
 179         -d "obj/ucw" or mkdir("obj/ucw", 0777) or Fail "Cannot create obj/ucw directory: $!";
 180         Log "done\n";
 181
 182         Log "Generating autoconf.h ... ";
 183         open X, ">obj/autoconf.h" or Fail $!;
 184         print X "/* Generated automatically by $0, please don't touch manually. */\n";
 185         foreach my $x (sort keys %vars) {
 186                 # Don't export variables which contain no underscores
 187                 next unless $x =~ /_/;
 188                 my $v = $vars{$x};
 189                 # Try to add quotes if necessary
 190                 $v = '"' . $v . '"' unless ($v =~ /^"/ || $v =~ /^\d*$/);
 191                 print X "#define $x $v\n";
 192         }
 193         close X;
 194         Log "done\n";
 195
 196         Log "Generating config.mk ... ";
 197         open X, ">obj/config.mk" or Fail $!;
 198         print X "# Generated automatically by $0, please don't touch manually.\n";
 199         foreach my $x (sort keys %vars) {
 200                 print X "$x=$vars{$x}\n";
 201         }
 202         print X "s=\${SRCDIR}\n";
 203         print X "o=obj\n";
 204         close X;
 205         Log "done\n";
 206 }
 207
 208 sub TryCmd($) {
 209         my ($cmd) = @_;
 210         my $res = `$cmd`;
 211         defined $res or return;
 212         chomp $res;
 213         return $res unless $?;
 214         return;
 215 }
 216
 217 sub maybe_manually($) {
 218         my ($n) = @_;
 219         if (IsGiven($n)) {
 220                 if (Get("$n")) { Log "YES (set manually)\n"; }
 221                 else { Log "NO (set manually)\n"; }
 222                 return 1;
 223         }
 224         return 0;
 225 }
 226
 227 sub PkgConfig($@) {
 228         my $pkg = shift @_;
 229         my %opts = @_;
 230         my $upper = $pkg; $upper =~ tr/a-z/A-Z/; $upper =~ s/[^0-9A-Z]+/_/g;
 231         Log "Checking for package $pkg ... ";
 232         maybe_manually("CONFIG_HAVE_$upper") and return Get("CONFIG_HAVE_$upper");
 233         my $ver = TryCmd("pkg-config --modversion $pkg 2>/dev/null");
 234         if (!defined $ver) {
 235                 Log("NONE\n");
 236                 return 0;
 237         }
 238         if (defined($opts{minversion})) {
 239                 my $min = $opts{minversion};
 240                 if (!defined TryCmd("pkg-config --atleast-version=$min $pkg")) {
 241                         Log("NO: version $ver is too old (need >= $min)\n");
 242                         return 0;
 243                 }
 244         }
 245         Log("YES: version $ver\n");
 246         Set("CONFIG_HAVE_$upper" => 1);
 247         Set("CONFIG_VER_$upper" => $ver);
 248         my $cf = TryCmd("pkg-config --cflags $pkg");
 249         Set("${upper}_CFLAGS" => $cf) if defined $cf;
 250         my $lf = TryCmd("pkg-config --libs $pkg");
 251         Set("${upper}_LIBS" => $lf) if defined $lf;
 252         return 1;
 253 }
 254
 255 sub ver_norm($) {
 256         my ($v) = @_;
 257         return join(".", map { sprintf("%05s", $_) } split(/\./, $v));
 258 }
 259
 260 sub TrivConfig($@) {
 261         my $pkg = shift @_;
 262         my %opts = @_;
 263         my $upper = $pkg; $upper =~ tr/a-z/A-Z/; $upper =~ s/[^0-9A-Z]+/_/g;
 264         Log "Checking for package $pkg ... ";
 265         maybe_manually("CONFIG_HAVE_$upper") and return Get("CONFIG_HAVE_$upper");
 266         my $pc = $opts{script};
 267         my $ver = TryCmd("$pc --version 2>/dev/null");
 268         if (!defined $ver) {
 269                 Log("NONE\n");
 270                 return 0;
 271         }
 272         if (defined($opts{minversion})) {
 273                 my $min = $opts{minversion};
 274                 if (ver_norm($ver) lt ver_norm($min)) {
 275                         Log("NO: version $ver is too old (need >= $min)\n");
 276                         return 0;
 277                 }
 278         }
 279         Log("YES: version $ver\n");
 280         Set("CONFIG_HAVE_$upper" => 1);
 281         Set("CONFIG_VER_$upper" => $ver);
 282
 283         my $want = $opts{want};
 284         defined $want or $want = ["cflags", "libs"];
 285         for my $w (@$want) {
 286                 my $uw = $w; $uw =~ tr/a-z-/A-Z_/;
 287                 my $cf = TryCmd("$pc --$w");
 288                 Set("${upper}_${uw}" => $cf) if defined $cf;
 289         }
 290         return 1;
 291 }
 292
 293 1;  # OK