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