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);
  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 1;  # OK