lib/perl/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 &Fail &IsSet &Set &UnSet &Override &Get &Test &Include &Finish &FindFile &TryFindFile);
  20         @EXPORT_OK = qw();
  21         %EXPORT_TAGS = ();
  22 }
  23
  24 our %vars = ();
  25 our %overriden = ();
  26
  27 sub Log($) {
  28         print @_;
  29 }
  30
  31 sub Fail($) {
  32         Log((shift @_) . "\n");
  33         exit 1;
  34 }
  35
  36 sub IsSet($) {
  37         my ($x) = @_;
  38         return exists $vars{$x};
  39 }
  40
  41 sub Get($) {
  42         my ($x) = @_;
  43         return $vars{$x};
  44 }
  45
  46 sub Set($;$) {
  47         my ($x,$y) = @_;
  48         $y=1 unless defined $y;
  49         $vars{$x}=$y unless $overriden{$x};
  50 }
  51
  52 sub UnSet($) {
  53         my ($x) = @_;
  54         delete $vars{$x} unless $overriden{$x};
  55 }
  56
  57 sub Override($;$) {
  58         my ($x,$y) = @_;
  59         $y=1 unless defined $y;
  60         $vars{$x}=$y;
  61         $overriden{$x} = 1;
  62 }
  63
  64 sub Test($$$) {
  65         my ($var,$msg,$sub) = @_;
  66         Log "$msg... ";
  67         if (!IsSet($var)) {
  68                 Set $var, &$sub();
  69         }
  70         Log Get($var) . "\n";
  71 }
  72
  73 sub TryFindFile($) {
  74         my ($f) = @_;
  75         if (-f $f) {
  76                 return $f;
  77         } elsif ($f !~ /^\// && -f (Get("SRCDIR")."/$f")) {
  78                 return Get("SRCDIR")."/$f";
  79         } else {
  80                 return undef;
  81         }
  82 }
  83
  84 sub FindFile($) {
  85         my ($f) = @_;
  86         my $F;
  87         defined ($F = TryFindFile($f)) or Fail "Cannot find file $f";
  88         return $F;
  89 }
  90
  91 sub Init($$) {
  92         my ($srcdir,$defconfig) = @_;
  93         if ((!defined $defconfig && !@ARGV) || @ARGV && $ARGV[0] eq "--help") {
  94                 print STDERR "Usage: [<srcdir>/]configure " . (defined $defconfig ? "[" : "") . "<config-name>" . (defined $defconfig ? "]" : "") .
  95                         " [<option>[=<value>] | -<option>] ...\n";
  96                 exit 1;
  97         }
  98         if (@ARGV && $ARGV[0] !~ /=/) {
  99                 Set('CONFIG' => shift @ARGV);
 100         } else {
 101                 Set('CONFIG' => $defconfig);
 102         }
 103         Set("SRCDIR", $srcdir);
 104
 105         foreach my $x (@ARGV) {
 106                 if ($x =~ /^(\w+)=(.*)/) {
 107                         Override($1 => $2);
 108                 } elsif ($x =~ /^-(\w+)$/) {
 109                         Override($1 => 1);
 110                         delete $vars{$1};
 111                 } elsif ($x =~ /^(\w+)$/) {
 112                         Override($1 => 1);
 113                 } else {
 114                         print STDERR "Invalid option $_\n";
 115                         exit 1;
 116                 }
 117         }
 118
 119         if (!TryFindFile(Get("CONFIG"))) {
 120                 TryFindFile(Get("CONFIG")."/config") or Fail "Cannot find configuration " . Get("CONFIG");
 121                 Override("CONFIG" => Get("CONFIG")."/config");
 122         }
 123 }
 124
 125 sub Include($) {
 126         my ($f) = @_;
 127         $f = FindFile($f);
 128         Log "Loading configuration $f\n";
 129         require $f;
 130 }
 131
 132 sub Finish() {
 133         print "\n";
 134
 135         if (Get("SRCDIR") ne ".") {
 136                 Log "Preparing for compilation from directory " . Get("SRCDIR") . " to obj/ ... ";
 137                 -l "src" and unlink "src";
 138                 symlink Get("SRCDIR"), "src" or Fail "Cannot link source directory to src: $!";
 139                 Override("SRCDIR" => "src");
 140                 -l "Makefile" and unlink "Makefile";
 141                 -f "Makefile" and Fail "Makefile already exists";
 142                 symlink "src/Makefile", "Makefile" or Fail "Cannot link Makefile: $!";
 143         } else {
 144                 Log "Preparing for compilation from current directory to obj/ ... ";
 145         }
 146         `rm -rf obj` if -d "obj"; Fail "Cannot delete old obj directory" if $?;
 147         -d "obj" or mkdir("obj", 0777) or Fail "Cannot create obj directory: $!";
 148         -d "obj/lib" or mkdir("obj/lib", 0777) or Fail "Cannot create obj/lib directory: $!";
 149         Log "done\n";
 150
 151         Log "Generating autoconf.h... ";
 152         open X, ">obj/lib/autoconf.h" or Fail $!;
 153         print X "/* Generated automatically by $0, please don't touch manually. */\n";
 154         foreach my $x (sort keys %vars) {
 155                 # Don't export variables which contain no underscores
 156                 next unless $x =~ /_/;
 157                 my $v = $vars{$x};
 158                 # Try to add quotes if necessary
 159                 $v = '"' . $v . '"' unless ($v =~ /^"/ || $v =~ /^\d*$/);
 160                 print X "#define $x $v\n";
 161         }
 162         close X;
 163         Log "done\n";
 164
 165         Log "Generating config.mk... ";
 166         open X, ">obj/config.mk" or Fail $!;
 167         print X "# Generated automatically by $0, please don't touch manually.\n";
 168         foreach my $x (sort keys %vars) {
 169                 print X "$x=$vars{$x}\n";
 170         }
 171         close X;
 172         Log "done\n";
 173 }
 174
 175 1;  # OK