]> mj.ucw.cz Git - leo.git/blob - perl/UCW/Configure.pm
css.h: Fixed a wrong type
[leo.git] / 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                 if ($val) {
113                         Set($var);
114                 } else {
115                         UnSet($var);
116                 }
117                 Log (($val ? "yes" : "no") . "\n");
118         }
119 }
120
121 sub TryFindFile($) {
122         my ($f) = @_;
123         if ($f =~ m{^/}) {
124                 return (-f $f) ? $f : undef;
125         } elsif (-f $f) {
126                 return "./$f";
127         } elsif (-f (Get("SRCDIR")."/$f")) {
128                 return Get("SRCDIR")."/$f";
129         } else {
130                 return undef;
131         }
132 }
133
134 sub FindFile($) {
135         my ($f) = @_;
136         my $F;
137         defined ($F = TryFindFile($f)) or Fail "Cannot find file $f";
138         return $F;
139 }
140
141 sub Init($$) {
142         my ($srcdir,$defconfig) = @_;
143         sub usage($) {
144                 my ($dc) = @_;
145                 print STDERR "Usage: [<srcdir>/]configure " . (defined $dc ? "[" : "") . "<config-name>" . (defined $dc ? "]" : "") .
146                         " [<option>[=<value>] | -<option>] ...\n";
147                 exit 1;
148         }
149         Set('CONFIG' => $defconfig) if defined $defconfig;
150         if (@ARGV) {
151                 usage($defconfig) if $ARGV[0] eq "--help";
152                 if (!defined($defconfig) || $ARGV[0] !~ /^-?[A-Z][A-Z0-9_]*(=|$)/) {
153                         # This does not look like an option, so read it as a file name
154                         Set('CONFIG' => shift @ARGV);
155                 }
156         }
157         Set("SRCDIR", $srcdir);
158
159         foreach my $x (@ARGV) {
160                 if ($x =~ /^(\w+)=(.*)/) {
161                         Override($1 => $2);
162                 } elsif ($x =~ /^-(\w+)$/) {
163                         Override($1 => 0);
164                         delete $vars{$1};
165                 } elsif ($x =~ /^(\w+)$/) {
166                         Override($1 => 1);
167                 } else {
168                         print STDERR "Invalid option $x\n";
169                         exit 1;
170                 }
171         }
172
173         defined Get("CONFIG") or usage($defconfig);
174         if (!TryFindFile(Get("CONFIG"))) {
175                 TryFindFile(Get("CONFIG")."/config") or Fail "Cannot find configuration " . Get("CONFIG");
176                 Override("CONFIG" => Get("CONFIG")."/config");
177         }
178 }
179
180 sub Include($) {
181         my ($f) = @_;
182         $f = FindFile($f);
183         Notice "Loading configuration $f\n";
184         require $f;
185 }
186
187 sub PostConfig(&) {
188         unshift @postconfigs, $_[0];
189 }
190
191 sub AtWrite(&) {
192         unshift @atwrites, $_[0];
193 }
194
195 sub Finish() {
196         for my $post (@postconfigs) {
197                 &$post();
198         }
199
200         print "\n";
201
202         if (Get("SRCDIR") ne ".") {
203                 Log "Preparing for compilation from directory " . Get("SRCDIR") . " to obj/ ... ";
204                 -l "src" and unlink "src";
205                 symlink Get("SRCDIR"), "src" or Fail "Cannot link source directory to src: $!";
206                 Override("SRCDIR" => "src");
207                 -l "Makefile" and unlink "Makefile";
208                 -f "Makefile" and Fail "Makefile already exists";
209                 symlink "src/Makefile", "Makefile" or Fail "Cannot link Makefile: $!";
210         } else {
211                 Log "Preparing for compilation from current directory to obj/ ... ";
212         }
213         if (-d "obj") {
214                 `rm -rf obj`; Fail "Cannot delete old obj directory" if $?;
215         }
216         -d "obj" or mkdir("obj", 0777) or Fail "Cannot create obj directory: $!";
217         -d "obj/ucw" or mkdir("obj/ucw", 0777) or Fail "Cannot create obj/ucw directory: $!";
218         Log "done\n";
219
220         Log "Generating config.mk ... ";
221         open X, ">obj/config.mk" or Fail $!;
222         print X "# Generated automatically by $0, please don't touch manually.\n";
223         foreach my $x (sort keys %vars) {
224                 print X "$x=$vars{$x}\n";
225         }
226         print X "s=\${SRCDIR}\n";
227         print X "o=obj\n";
228         close X;
229         Log "done\n";
230
231         for my $wr (@atwrites) {
232                 &$wr();
233         }
234 }
235
236 1;  # OK