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