]> mj.ucw.cz Git - moe.git/blob - lib/perl/Configure.pm
Added libucw from Sherlock v3.12.2.
[moe.git] / 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 => 0);
123                         delete $vars{$1};
124                 } elsif ($x =~ /^(\w+)$/) {
125                         Override($1 => 1);
126                 } else {
127                         print STDERR "Invalid option $x\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/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         print X "s=\${SRCDIR}\n";
185         print X "o=obj\n";
186         close X;
187         Log "done\n";
188 }
189
190 1;  # OK