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