ucw/perl/UCW/Configure.pm

   1 #       Perl module for UCW Configure Scripts
   2 #
   3 #       (c) 2005--2010 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 use IO::File;
  13
  14 BEGIN {
  15         # The somewhat hairy Perl export mechanism
  16         use Exporter();
  17         our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  18         $VERSION = 1.0;
  19         @ISA = qw(Exporter);
  20         @EXPORT = qw(&Init &Log &Notice &Warn &Fail &IsSet &IsGiven &Set &UnSet &Append &Override &Get &Test &TestBool &Include &Finish &FindFile &TryFindFile &DebugDump &PostConfig &AtWrite);
  21         @EXPORT_OK = qw();
  22         %EXPORT_TAGS = ();
  23 }
  24
  25 our %vars;
  26 our %overriden;
  27 our @postconfigs;
  28 our @atwrites;
  29
  30 sub DebugDump() {
  31         print "VARS:\n";
  32         print "$_: $vars{$_}\n" foreach( keys %vars );
  33 }
  34
  35 sub Log($) {
  36         print @_;
  37         STDOUT->flush;
  38 }
  39
  40 sub Notice($) {
  41         print @_ if $vars{"VERBOSE"};
  42         STDOUT->flush;
  43 }
  44
  45 sub Warn($) {
  46         print "WARNING: ", @_;
  47         STDOUT->flush;
  48 }
  49
  50 sub Fail($) {
  51         Log("ERROR: " . (shift @_) . "\n");
  52         exit 1;
  53 }
  54
  55 sub IsSet($) {
  56         my ($x) = @_;
  57         return exists $vars{$x};
  58 }
  59
  60 sub IsGiven($) {
  61         my ($x) = @_;
  62         return exists $overriden{$x};
  63 }
  64
  65 sub Get($) {
  66         my ($x) = @_;
  67         return $vars{$x};
  68 }
  69
  70 sub Set($;$) {
  71         my ($x,$y) = @_;
  72         $y=1 unless defined $y;
  73         $vars{$x}=$y unless $overriden{$x};
  74 }
  75
  76 sub UnSet($) {
  77         my ($x) = @_;
  78         delete $vars{$x} unless $overriden{$x};
  79 }
  80
  81 sub Append($$) {
  82         my ($x,$y) = @_;
  83         Set($x, (IsSet($x) ? (Get($x) . " $y") : $y));
  84 }
  85
  86 sub Override($;$) {
  87         my ($x,$y) = @_;
  88         $y=1 unless defined $y;
  89         $vars{$x}=$y;
  90         $overriden{$x} = 1;
  91 }
  92
  93 sub Test($$$) {
  94         my ($var,$msg,$sub) = @_;
  95         Log "$msg ... ";
  96         if (IsSet($var)) {
  97                 Log Get($var) . " (preset)\n";
  98         } else {
  99                 my $val = &$sub();
 100                 Set($var, $val);
 101                 Log "$val\n";
 102         }
 103 }
 104
 105 sub TestBool($$$) {
 106         my ($var,$msg,$sub) = @_;
 107         Log "$msg ... ";
 108         if (IsSet($var) || IsGiven($var)) {
 109                 Log ((Get($var) ? "yes" : "no") . " (set)\n");
 110         } else {
 111                 my ($val, $comment) = &$sub();
 112                 Set($var, $val);
 113                 Log (($val ? "yes" : "no") . "\n");
 114         }
 115 }
 116
 117 sub TryFindFile($) {
 118         my ($f) = @_;
 119         if ($f =~ m{^/}) {
 120                 return (-f $f) ? $f : undef;
 121         } elsif (-f $f) {
 122                 return "./$f";
 123         } elsif (-f (Get("SRCDIR")."/$f")) {
 124                 return Get("SRCDIR")."/$f";
 125         } else {
 126                 return undef;
 127         }
 128 }
 129
 130 sub FindFile($) {
 131         my ($f) = @_;
 132         my $F;
 133         defined ($F = TryFindFile($f)) or Fail "Cannot find file $f";
 134         return $F;
 135 }
 136
 137 sub Init($$) {
 138         my ($srcdir,$defconfig) = @_;
 139         sub usage($) {
 140                 my ($dc) = @_;
 141                 print STDERR "Usage: [<srcdir>/]configure " . (defined $dc ? "[" : "") . "<config-name>" . (defined $dc ? "]" : "") .
 142                         " [<option>[=<value>] | -<option>] ...\n";
 143                 exit 1;
 144         }
 145         Set('CONFIG' => $defconfig) if defined $defconfig;
 146         if (@ARGV) {
 147                 usage($defconfig) if $ARGV[0] eq "--help";
 148                 if (!defined($defconfig) || $ARGV[0] !~ /^-?[A-Z][A-Z0-9_]*(=|$)/) {
 149                         # This does not look like an option, so read it as a file name
 150                         Set('CONFIG' => shift @ARGV);
 151                 }
 152         }
 153         Set("SRCDIR", $srcdir);
 154
 155         foreach my $x (@ARGV) {
 156                 if ($x =~ /^(\w+)=(.*)/) {
 157                         Override($1 => $2);
 158                 } elsif ($x =~ /^-(\w+)$/) {
 159                         Override($1 => 0);
 160                         delete $vars{$1};
 161                 } elsif ($x =~ /^(\w+)$/) {
 162                         Override($1 => 1);
 163                 } else {
 164                         print STDERR "Invalid option $x\n";
 165                         exit 1;
 166                 }
 167         }
 168
 169         defined Get("CONFIG") or usage($defconfig);
 170         if (!TryFindFile(Get("CONFIG"))) {
 171                 TryFindFile(Get("CONFIG")."/config") or Fail "Cannot find configuration " . Get("CONFIG");
 172                 Override("CONFIG" => Get("CONFIG")."/config");
 173         }
 174 }
 175
 176 sub Include($) {
 177         my ($f) = @_;
 178         $f = FindFile($f);
 179         Notice "Loading configuration $f\n";
 180         require $f;
 181 }
 182
 183 sub PostConfig(&) {
 184         unshift @postconfigs, $_[0];
 185 }
 186
 187 sub AtWrite(&) {
 188         unshift @atwrites, $_[0];
 189 }
 190
 191 sub Finish() {
 192         for my $post (@postconfigs) {
 193                 &$post();
 194         }
 195
 196         print "\n";
 197
 198         if (Get("SRCDIR") ne ".") {
 199                 Log "Preparing for compilation from directory " . Get("SRCDIR") . " to obj/ ... ";
 200                 -l "src" and unlink "src";
 201                 symlink Get("SRCDIR"), "src" or Fail "Cannot link source directory to src: $!";
 202                 Override("SRCDIR" => "src");
 203                 -l "Makefile" and unlink "Makefile";
 204                 -f "Makefile" and Fail "Makefile already exists";
 205                 symlink "src/Makefile", "Makefile" or Fail "Cannot link Makefile: $!";
 206         } else {
 207                 Log "Preparing for compilation from current directory to obj/ ... ";
 208         }
 209         if (-d "obj") {
 210                 `rm -rf obj`; Fail "Cannot delete old obj directory" if $?;
 211         }
 212         -d "obj" or mkdir("obj", 0777) or Fail "Cannot create obj directory: $!";
 213         -d "obj/ucw" or mkdir("obj/ucw", 0777) or Fail "Cannot create obj/ucw directory: $!";
 214         Log "done\n";
 215
 216         Log "Generating config.mk ... ";
 217         open X, ">obj/config.mk" or Fail $!;
 218         print X "# Generated automatically by $0, please don't touch manually.\n";
 219         foreach my $x (sort keys %vars) {
 220                 print X "$x=$vars{$x}\n";
 221         }
 222         print X "s=\${SRCDIR}\n";
 223         print X "o=obj\n";
 224         close X;
 225         Log "done\n";
 226
 227         for my $wr (@atwrites) {
 228                 &$wr();
 229         }
 230 }
 231
 232 1;  # OK